1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S Y S T E M . V A L _ U N S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1992-2012, 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_Util; use System.Val_Util; 34 35package body System.Val_Uns is 36 37 ----------------------- 38 -- Scan_Raw_Unsigned -- 39 ----------------------- 40 41 function Scan_Raw_Unsigned 42 (Str : String; 43 Ptr : not null access Integer; 44 Max : Integer) return Unsigned 45 is 46 P : Integer; 47 -- Local copy of the pointer 48 49 Uval : Unsigned; 50 -- Accumulated unsigned integer result 51 52 Expon : Integer; 53 -- Exponent value 54 55 Overflow : Boolean := False; 56 -- Set True if overflow is detected at any point 57 58 Base_Char : Character; 59 -- Base character (# or :) in based case 60 61 Base : Unsigned := 10; 62 -- Base value (reset in based case) 63 64 Digit : Unsigned; 65 -- Digit value 66 67 begin 68 P := Ptr.all; 69 Uval := Character'Pos (Str (P)) - Character'Pos ('0'); 70 P := P + 1; 71 72 -- Scan out digits of what is either the number or the base. 73 -- In either case, we are definitely scanning out in base 10. 74 75 declare 76 Umax : constant := (Unsigned'Last - 9) / 10; 77 -- Max value which cannot overflow on accumulating next digit 78 79 Umax10 : constant := Unsigned'Last / 10; 80 -- Numbers bigger than Umax10 overflow if multiplied by 10 81 82 begin 83 -- Loop through decimal digits 84 loop 85 exit when P > Max; 86 87 Digit := Character'Pos (Str (P)) - Character'Pos ('0'); 88 89 -- Non-digit encountered 90 91 if Digit > 9 then 92 if Str (P) = '_' then 93 Scan_Underscore (Str, P, Ptr, Max, False); 94 else 95 exit; 96 end if; 97 98 -- Accumulate result, checking for overflow 99 100 else 101 if Uval <= Umax then 102 Uval := 10 * Uval + Digit; 103 104 elsif Uval > Umax10 then 105 Overflow := True; 106 107 else 108 Uval := 10 * Uval + Digit; 109 110 if Uval < Umax10 then 111 Overflow := True; 112 end if; 113 end if; 114 115 P := P + 1; 116 end if; 117 end loop; 118 end; 119 120 Ptr.all := P; 121 122 -- Deal with based case 123 124 if P < Max and then (Str (P) = ':' or else Str (P) = '#') then 125 Base_Char := Str (P); 126 P := P + 1; 127 Base := Uval; 128 Uval := 0; 129 130 -- Check base value. Overflow is set True if we find a bad base, or 131 -- a digit that is out of range of the base. That way, we scan out 132 -- the numeral that is still syntactically correct, though illegal. 133 -- We use a safe base of 16 for this scan, to avoid zero divide. 134 135 if Base not in 2 .. 16 then 136 Overflow := True; 137 Base := 16; 138 end if; 139 140 -- Scan out based integer 141 142 declare 143 Umax : constant Unsigned := (Unsigned'Last - Base + 1) / Base; 144 -- Max value which cannot overflow on accumulating next digit 145 146 UmaxB : constant Unsigned := Unsigned'Last / Base; 147 -- Numbers bigger than UmaxB overflow if multiplied by base 148 149 begin 150 -- Loop to scan out based integer value 151 152 loop 153 -- We require a digit at this stage 154 155 if Str (P) in '0' .. '9' then 156 Digit := Character'Pos (Str (P)) - Character'Pos ('0'); 157 158 elsif Str (P) in 'A' .. 'F' then 159 Digit := 160 Character'Pos (Str (P)) - (Character'Pos ('A') - 10); 161 162 elsif Str (P) in 'a' .. 'f' then 163 Digit := 164 Character'Pos (Str (P)) - (Character'Pos ('a') - 10); 165 166 -- If we don't have a digit, then this is not a based number 167 -- after all, so we use the value we scanned out as the base 168 -- (now in Base), and the pointer to the base character was 169 -- already stored in Ptr.all. 170 171 else 172 Uval := Base; 173 exit; 174 end if; 175 176 -- If digit is too large, just signal overflow and continue. 177 -- The idea here is to keep scanning as long as the input is 178 -- syntactically valid, even if we have detected overflow 179 180 if Digit >= Base then 181 Overflow := True; 182 183 -- Here we accumulate the value, checking overflow 184 185 elsif Uval <= Umax then 186 Uval := Base * Uval + Digit; 187 188 elsif Uval > UmaxB then 189 Overflow := True; 190 191 else 192 Uval := Base * Uval + Digit; 193 194 if Uval < UmaxB then 195 Overflow := True; 196 end if; 197 end if; 198 199 -- If at end of string with no base char, not a based number 200 -- but we signal Constraint_Error and set the pointer past 201 -- the end of the field, since this is what the ACVC tests 202 -- seem to require, see CE3704N, line 204. 203 204 P := P + 1; 205 206 if P > Max then 207 Ptr.all := P; 208 Bad_Value (Str); 209 end if; 210 211 -- If terminating base character, we are done with loop 212 213 if Str (P) = Base_Char then 214 Ptr.all := P + 1; 215 exit; 216 217 -- Deal with underscore 218 219 elsif Str (P) = '_' then 220 Scan_Underscore (Str, P, Ptr, Max, True); 221 end if; 222 223 end loop; 224 end; 225 end if; 226 227 -- Come here with scanned unsigned value in Uval. The only remaining 228 -- required step is to deal with exponent if one is present. 229 230 Expon := Scan_Exponent (Str, Ptr, Max); 231 232 if Expon /= 0 and then Uval /= 0 then 233 234 -- For non-zero value, scale by exponent value. No need to do this 235 -- efficiently, since use of exponent in integer literals is rare, 236 -- and in any case the exponent cannot be very large. 237 238 declare 239 UmaxB : constant Unsigned := Unsigned'Last / Base; 240 -- Numbers bigger than UmaxB overflow if multiplied by base 241 242 begin 243 for J in 1 .. Expon loop 244 if Uval > UmaxB then 245 Overflow := True; 246 exit; 247 end if; 248 249 Uval := Uval * Base; 250 end loop; 251 end; 252 end if; 253 254 -- Return result, dealing with sign and overflow 255 256 if Overflow then 257 Bad_Value (Str); 258 else 259 return Uval; 260 end if; 261 end Scan_Raw_Unsigned; 262 263 ------------------- 264 -- Scan_Unsigned -- 265 ------------------- 266 267 function Scan_Unsigned 268 (Str : String; 269 Ptr : not null access Integer; 270 Max : Integer) return Unsigned 271 is 272 Start : Positive; 273 -- Save location of first non-blank character 274 275 begin 276 Scan_Plus_Sign (Str, Ptr, Max, Start); 277 278 if Str (Ptr.all) not in '0' .. '9' then 279 Ptr.all := Start; 280 Bad_Value (Str); 281 end if; 282 283 return Scan_Raw_Unsigned (Str, Ptr, Max); 284 end Scan_Unsigned; 285 286 -------------------- 287 -- Value_Unsigned -- 288 -------------------- 289 290 function Value_Unsigned (Str : String) return Unsigned is 291 V : Unsigned; 292 P : aliased Integer := Str'First; 293 begin 294 V := Scan_Unsigned (Str, P'Access, Str'Last); 295 Scan_Trailing_Blanks (Str, P); 296 return V; 297 end Value_Unsigned; 298 299end System.Val_Uns; 300