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 32with System.Address_Operations; use System.Address_Operations; 33 34with Ada.Unchecked_Conversion; 35 36package 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 116end System.Compare_Array_Signed_32; 117