GCC v8.2
[gcc.git] / gcc / ada / libgnat / s-casi32.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 _ 3 2       --
6 --                                                                          --
7 --                                 B o d y                                  --
8 --                                                                          --
9 --          Copyright (C) 2002-2018, 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 -- 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.               --
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_32 is
37
38    type Word is range -2**31 .. 2**31 - 1;
39    for Word'Size use 32;
40    --  Used to process operands by words
41
42    type Uword is new Word;
43    for Uword'Alignment use 1;
44    --  Used to process operands when unaligned
45
46    type WP is access Word;
47    type UP is access Uword;
48
49    function W is new Ada.Unchecked_Conversion (Address, WP);
50    function U is new Ada.Unchecked_Conversion (Address, UP);
51
52    -----------------------
53    -- Compare_Array_S32 --
54    -----------------------
55
56    function Compare_Array_S32
57      (Left      : System.Address;
58       Right     : System.Address;
59       Left_Len  : Natural;
60       Right_Len : Natural) return Integer
61    is
62       Clen : Natural := Natural'Min (Left_Len, Right_Len);
63       --  Number of elements left to compare
64
65       L : Address := Left;
66       R : Address := Right;
67       --  Pointers to next elements to compare
68
69    begin
70       --  Case of going by aligned words
71
72       if ModA (OrA (Left, Right), 4) = 0 then
73          while Clen /= 0 loop
74             if W (L).all /= W (R).all then
75                if W (L).all > W (R).all then
76                   return +1;
77                else
78                   return -1;
79                end if;
80             end if;
81
82             Clen := Clen - 1;
83             L := AddA (L, 4);
84             R := AddA (R, 4);
85          end loop;
86
87       --  Case of going by unaligned words
88
89       else
90          while Clen /= 0 loop
91             if U (L).all /= U (R).all then
92                if U (L).all > U (R).all then
93                   return +1;
94                else
95                   return -1;
96                end if;
97             end if;
98
99             Clen := Clen - 1;
100             L := AddA (L, 4);
101             R := AddA (R, 4);
102          end loop;
103       end if;
104
105       --  Here if common section equal, result decided by lengths
106
107       if Left_Len = Right_Len then
108          return 0;
109       elsif Left_Len > Right_Len then
110          return +1;
111       else
112          return -1;
113       end if;
114    end Compare_Array_S32;
115
116 end System.Compare_Array_Signed_32;