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 _ 1 6        --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 2002-2019, 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
32with System.Address_Operations; use System.Address_Operations;
33
34with Ada.Unchecked_Conversion;
35
36package body System.Compare_Array_Signed_16 is
37
38   type Word is mod 2 ** 32;
39   --  Used to process operands by words
40
41   type Half is range -(2 ** 15) .. (2 ** 15) - 1;
42   for Half'Size use 16;
43   --  Used to process operands by half words
44
45   type Uhalf is new Half;
46   for Uhalf'Alignment use 1;
47   --  Used to process operands when unaligned
48
49   type WP is access Word;
50   type HP is access Half;
51   type UP is access Uhalf;
52
53   function W is new Ada.Unchecked_Conversion (Address, WP);
54   function H is new Ada.Unchecked_Conversion (Address, HP);
55   function U is new Ada.Unchecked_Conversion (Address, UP);
56
57   -----------------------
58   -- Compare_Array_S16 --
59   -----------------------
60
61   function Compare_Array_S16
62     (Left      : System.Address;
63      Right     : System.Address;
64      Left_Len  : Natural;
65      Right_Len : Natural) return Integer
66   is
67      Clen : Natural := Natural'Min (Left_Len, Right_Len);
68      --  Number of elements left to compare
69
70      L : Address := Left;
71      R : Address := Right;
72      --  Pointers to next elements to compare
73
74   begin
75      --  Go by words if possible
76
77      if ModA (OrA (Left, Right), 4) = 0 then
78         while Clen > 1
79           and then W (L).all = W (R).all
80         loop
81            Clen := Clen - 2;
82            L := AddA (L, 4);
83            R := AddA (R, 4);
84         end loop;
85      end if;
86
87      --  Case of going by aligned half words
88
89      if ModA (OrA (Left, Right), 2) = 0 then
90         while Clen /= 0 loop
91            if H (L).all /= H (R).all then
92               if H (L).all > H (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, 2);
101            R := AddA (R, 2);
102         end loop;
103
104      --  Case of going by unaligned half words
105
106      else
107         while Clen /= 0 loop
108            if U (L).all /= U (R).all then
109               if U (L).all > U (R).all then
110                  return +1;
111               else
112                  return -1;
113               end if;
114            end if;
115
116            Clen := Clen - 1;
117            L := AddA (L, 2);
118            R := AddA (R, 2);
119         end loop;
120      end if;
121
122      --  Here if common section equal, result decided by lengths
123
124      if Left_Len = Right_Len then
125         return 0;
126      elsif Left_Len > Right_Len then
127         return +1;
128      else
129         return -1;
130      end if;
131   end Compare_Array_S16;
132
133end System.Compare_Array_Signed_16;
134