File : s-carsi8.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME LIBRARY COMPONENTS --
4 -- --
5 -- S Y S T E M . C O M P A R E _ A R R A Y _ S I G N E D _ 8 --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2002-2009, Free Software Foundation, Inc. --
10 -- --
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. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
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/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 with System.Address_Operations; use System.Address_Operations;
33
34 with Ada.Unchecked_Conversion;
35
36 package body System.Compare_Array_Signed_8 is
37
38 type Word is mod 2 ** 32;
39 -- Used to process operands by words
40
41 type Big_Words is array (Natural) of Word;
42 type Big_Words_Ptr is access Big_Words;
43 for Big_Words_Ptr'Storage_Size use 0;
44 -- Array type used to access by words
45
46 type Byte is range -128 .. +127;
47 for Byte'Size use 8;
48 -- Used to process operands by bytes
49
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
54
55 function To_Big_Words is new
56 Ada.Unchecked_Conversion (System.Address, Big_Words_Ptr);
57
58 function To_Big_Bytes is new
59 Ada.Unchecked_Conversion (System.Address, Big_Bytes_Ptr);
60
61 ----------------------
62 -- Compare_Array_S8 --
63 ----------------------
64
65 function Compare_Array_S8
66 (Left : System.Address;
67 Right : System.Address;
68 Left_Len : Natural;
69 Right_Len : Natural) return Integer
70 is
71 Compare_Len : constant Natural := Natural'Min (Left_Len, Right_Len);
72
73 begin
74 -- If operands are non-aligned, or length is too short, go by bytes
75
76 if ModA (OrA (Left, Right), 4) /= 0 or else Compare_Len < 4 then
77 return Compare_Array_S8_Unaligned (Left, Right, Left_Len, Right_Len);
78 end if;
79
80 -- Here we can go by words
81
82 declare
83 LeftP : constant Big_Words_Ptr :=
84 To_Big_Words (Left);
85 RightP : constant Big_Words_Ptr :=
86 To_Big_Words (Right);
87 Words_To_Compare : constant Natural := Compare_Len / 4;
88 Bytes_Compared_As_Words : constant Natural := Words_To_Compare * 4;
89
90 begin
91 for J in 0 .. Words_To_Compare - 1 loop
92 if LeftP (J) /= RightP (J) then
93 return Compare_Array_S8_Unaligned
94 (AddA (Left, Address (4 * J)),
95 AddA (Right, Address (4 * J)),
96 4, 4);
97 end if;
98 end loop;
99
100 return Compare_Array_S8_Unaligned
101 (AddA (Left, Address (Bytes_Compared_As_Words)),
102 AddA (Right, Address (Bytes_Compared_As_Words)),
103 Left_Len - Bytes_Compared_As_Words,
104 Right_Len - Bytes_Compared_As_Words);
105 end;
106 end Compare_Array_S8;
107
108 --------------------------------
109 -- Compare_Array_S8_Unaligned --
110 --------------------------------
111
112 function Compare_Array_S8_Unaligned
113 (Left : System.Address;
114 Right : System.Address;
115 Left_Len : Natural;
116 Right_Len : Natural) return Integer
117 is
118 Compare_Len : constant Natural := Natural'Min (Left_Len, Right_Len);
119
120 LeftP : constant Big_Bytes_Ptr := To_Big_Bytes (Left);
121 RightP : constant Big_Bytes_Ptr := To_Big_Bytes (Right);
122
123 begin
124 for J in 0 .. Compare_Len - 1 loop
125 if LeftP (J) /= RightP (J) then
126 if LeftP (J) > RightP (J) then
127 return +1;
128 else
129 return -1;
130 end if;
131 end if;
132 end loop;
133
134 if Left_Len = Right_Len then
135 return 0;
136 elsif Left_Len > Right_Len then
137 return +1;
138 else
139 return -1;
140 end if;
141 end Compare_Array_S8_Unaligned;
142
143 end System.Compare_Array_Signed_8;