1 ------------------------------------------------------------------------------
3 -- GNU ADA RUNTIME LIBRARY COMPONENTS --
5 -- S Y S T E M . S T R I N G _ C O M P A R E --
9 -- Copyright (C) 2002 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Unchecked_Conversion
;
36 package body System
.String_Compare
is
38 type Word
is mod 2 ** 32;
39 -- Used to process operands by words
41 type Big_Words
is array (Natural) of Word
;
42 type Big_Words_Ptr
is access Big_Words
;
43 -- Array type used to access by words
45 type Byte
is mod 2 ** 8;
46 -- Used to process operands by bytes
48 type Big_Bytes
is array (Natural) of Byte
;
49 type Big_Bytes_Ptr
is access Big_Bytes
;
50 -- Array type used to access by bytes
52 function To_Big_Words
is new
53 Unchecked_Conversion
(System
.Address
, Big_Words_Ptr
);
55 function To_Big_Bytes
is new
56 Unchecked_Conversion
(System
.Address
, Big_Bytes_Ptr
);
63 (Left
: System
.Address
;
64 Right
: System
.Address
;
69 Compare_Len
: constant Natural := Natural'Min (Left_Len
, Right_Len
);
72 -- If operands are non-aligned, or length is too short, go by bytes
74 if (((Left
or Right
) and 2#
11#
) /= 0) or else Compare_Len
< 4 then
75 return Str_Compare_Bytes
(Left
, Right
, Left_Len
, Right_Len
);
78 -- Here we can go by words
81 LeftP
: constant Big_Words_Ptr
:= To_Big_Words
(Left
);
82 RightP
: constant Big_Words_Ptr
:= To_Big_Words
(Right
);
83 Clen4
: constant Natural := Compare_Len
/ 4 - 1;
84 Clen4F
: constant Natural := Clen4
* 4;
87 for J
in 0 .. Clen4
loop
88 if LeftP
(J
) /= RightP
(J
) then
89 return Str_Compare_Bytes
90 (Left
+ Address
(4 * J
),
91 Right
+ Address
(4 * J
),
96 return Str_Compare_Bytes
97 (Left
+ Address
(Clen4F
),
98 Right
+ Address
(Clen4F
),
104 -----------------------
105 -- Str_Compare_Bytes --
106 -----------------------
108 function Str_Compare_Bytes
109 (Left
: System
.Address
;
110 Right
: System
.Address
;
115 Compare_Len
: constant Natural := Natural'Min (Left_Len
, Right_Len
);
117 LeftP
: constant Big_Bytes_Ptr
:= To_Big_Bytes
(Left
);
118 RightP
: constant Big_Bytes_Ptr
:= To_Big_Bytes
(Right
);
121 for J
in 0 .. Compare_Len
- 1 loop
122 if LeftP
(J
) /= RightP
(J
) then
123 if LeftP
(J
) > RightP
(J
) then
131 if Left_Len
= Right_Len
then
133 elsif Left_Len
> Right_Len
then
138 end Str_Compare_Bytes
;
140 end System
.String_Compare
;