1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY COMPONENTS --
5 -- S Y S T E M . C O M P A R E _ A R R A Y _ U N S I G N E D _ 8 --
9 -- Copyright (C) 2002-2023, 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 3, 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. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with System
.Address_Operations
; use System
.Address_Operations
;
33 with System
.Storage_Elements
; use System
.Storage_Elements
;
35 with Ada
.Unchecked_Conversion
;
37 package body System
.Compare_Array_Unsigned_8
is
39 type Word
is mod 2 ** 32;
40 -- Used to process operands by words
42 type Big_Words
is array (Natural) of Word
;
43 type Big_Words_Ptr
is access Big_Words
;
44 for Big_Words_Ptr
'Storage_Size use 0;
45 -- Array type used to access by words
47 type Byte
is mod 2 ** 8;
48 -- Used to process operands by bytes
50 type Big_Bytes
is array (Natural) of Byte
;
51 type Big_Bytes_Ptr
is access Big_Bytes
;
52 for Big_Bytes_Ptr
'Storage_Size use 0;
53 -- Array type used to access by bytes
55 function To_Big_Words
is new
56 Ada
.Unchecked_Conversion
(System
.Address
, Big_Words_Ptr
);
58 function To_Big_Bytes
is new
59 Ada
.Unchecked_Conversion
(System
.Address
, Big_Bytes_Ptr
);
61 pragma Annotate
(Gnatcheck
, Exempt_On
, "Improper_Returns",
62 "early returns for performance");
64 ----------------------
65 -- Compare_Array_U8 --
66 ----------------------
68 function Compare_Array_U8
69 (Left
: System
.Address
;
70 Right
: System
.Address
;
72 Right_Len
: Natural) return Integer
74 Compare_Len
: constant Natural := Natural'Min (Left_Len
, Right_Len
);
77 -- If operands are non-aligned, or length is too short, go by bytes
79 if ModA
(OrA
(Left
, Right
), 4) /= 0 or else Compare_Len
< 4 then
80 return Compare_Array_U8_Unaligned
(Left
, Right
, Left_Len
, Right_Len
);
83 -- Here we can go by words
86 LeftP
: constant Big_Words_Ptr
:=
88 RightP
: constant Big_Words_Ptr
:=
90 Words_To_Compare
: constant Natural := Compare_Len
/ 4;
91 Bytes_Compared_As_Words
: constant Natural := Words_To_Compare
* 4;
94 for J
in 0 .. Words_To_Compare
- 1 loop
95 if LeftP
(J
) /= RightP
(J
) then
96 return Compare_Array_U8_Unaligned
97 (Left
+ Storage_Offset
(4 * J
),
98 Right
+ Storage_Offset
(4 * J
),
103 pragma Assert
(Left_Len
>= Bytes_Compared_As_Words
);
104 pragma Assert
(Right_Len
>= Bytes_Compared_As_Words
);
105 -- Left_Len and Right_Len are always greater or equal to
106 -- Bytes_Compared_As_Words because:
107 -- * Compare_Len is min (Left_Len, Right_Len)
108 -- * Words_To_Compare = Compare_Len / 4
109 -- * Bytes_Compared_As_Words = Words_To_Compare * 4
110 return Compare_Array_U8_Unaligned
111 (Left
+ Storage_Offset
(Bytes_Compared_As_Words
),
112 Right
+ Storage_Offset
(Bytes_Compared_As_Words
),
113 Left_Len
- Bytes_Compared_As_Words
,
114 Right_Len
- Bytes_Compared_As_Words
);
116 end Compare_Array_U8
;
118 --------------------------------
119 -- Compare_Array_U8_Unaligned --
120 --------------------------------
122 function Compare_Array_U8_Unaligned
123 (Left
: System
.Address
;
124 Right
: System
.Address
;
126 Right_Len
: Natural) return Integer
128 Compare_Len
: constant Natural := Natural'Min (Left_Len
, Right_Len
);
130 LeftP
: constant Big_Bytes_Ptr
:= To_Big_Bytes
(Left
);
131 RightP
: constant Big_Bytes_Ptr
:= To_Big_Bytes
(Right
);
134 for J
in 0 .. Compare_Len
- 1 loop
135 if LeftP
(J
) /= RightP
(J
) then
136 if LeftP
(J
) > RightP
(J
) then
144 if Left_Len
= Right_Len
then
146 elsif Left_Len
> Right_Len
then
151 end Compare_Array_U8_Unaligned
;
153 pragma Annotate
(Gnatcheck
, Exempt_Off
, "Improper_Returns");
154 end System
.Compare_Array_Unsigned_8
;