1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S Y S T E M . V A L _ L L I -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-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.Unsigned_Types; use System.Unsigned_Types; 33with System.Val_LLU; use System.Val_LLU; 34with System.Val_Util; use System.Val_Util; 35 36package body System.Val_LLI is 37 38 ---------------------------- 39 -- Scan_Long_Long_Integer -- 40 ---------------------------- 41 42 function Scan_Long_Long_Integer 43 (Str : String; 44 Ptr : not null access Integer; 45 Max : Integer) return Long_Long_Integer 46 is 47 Uval : Long_Long_Unsigned; 48 -- Unsigned result 49 50 Minus : Boolean := False; 51 -- Set to True if minus sign is present, otherwise to False 52 53 Start : Positive; 54 -- Saves location of first non-blank 55 56 begin 57 Scan_Sign (Str, Ptr, Max, Minus, Start); 58 59 if Str (Ptr.all) not in '0' .. '9' then 60 Ptr.all := Start; 61 Bad_Value (Str); 62 end if; 63 64 Uval := Scan_Raw_Long_Long_Unsigned (Str, Ptr, Max); 65 66 -- Deal with overflow cases, and also with maximum negative number 67 68 if Uval > Long_Long_Unsigned (Long_Long_Integer'Last) then 69 if Minus 70 and then Uval = Long_Long_Unsigned (-(Long_Long_Integer'First)) 71 then 72 return Long_Long_Integer'First; 73 else 74 Bad_Value (Str); 75 end if; 76 77 -- Negative values 78 79 elsif Minus then 80 return -(Long_Long_Integer (Uval)); 81 82 -- Positive values 83 84 else 85 return Long_Long_Integer (Uval); 86 end if; 87 end Scan_Long_Long_Integer; 88 89 ----------------------------- 90 -- Value_Long_Long_Integer -- 91 ----------------------------- 92 93 function Value_Long_Long_Integer (Str : String) return Long_Long_Integer is 94 begin 95 -- We have to special case Str'Last = Positive'Last because the normal 96 -- circuit ends up setting P to Str'Last + 1 which is out of bounds. We 97 -- deal with this by converting to a subtype which fixes the bounds. 98 99 if Str'Last = Positive'Last then 100 declare 101 subtype NT is String (1 .. Str'Length); 102 begin 103 return Value_Long_Long_Integer (NT (Str)); 104 end; 105 106 -- Normal case where Str'Last < Positive'Last 107 108 else 109 declare 110 V : Long_Long_Integer; 111 P : aliased Integer := Str'First; 112 begin 113 V := Scan_Long_Long_Integer (Str, P'Access, Str'Last); 114 Scan_Trailing_Blanks (Str, P); 115 return V; 116 end; 117 end if; 118 end Value_Long_Long_Integer; 119 120end System.Val_LLI; 121