1-- Lexical analysis for numbers. 2-- Copyright (C) 2002 - 2014 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16 17with Interfaces; use Interfaces; 18with Grt.Fcvt; use Grt.Fcvt; 19 20separate (Vhdl.Scanner) 21 22-- scan a decimal literal or a based literal. 23-- 24-- LRM93 13.4.1 25-- DECIMAL_LITERAL ::= INTEGER [ . INTEGER ] [ EXPONENT ] 26-- EXPONENT ::= E [ + ] INTEGER | E - INTEGER 27-- 28-- LRM93 13.4.2 29-- BASED_LITERAL ::= BASE # BASED_INTEGER [ . BASED_INTEGER ] # EXPONENT 30-- BASE ::= INTEGER 31procedure Scan_Literal is 32 -- Numbers of digits. 33 Scale : Integer; 34 Res : Bignum; 35 36 -- LRM 13.4.1 37 -- INTEGER ::= DIGIT { [ UNDERLINE ] DIGIT } 38 -- 39 -- Update SCALE, RES. 40 -- The first character must be a digit. 41 procedure Scan_Integer 42 is 43 C : Character; 44 begin 45 C := Source (Pos); 46 loop 47 -- C is a digit. 48 Bignum_Mul_Int (Res, 10, Character'Pos (C) - Character'Pos ('0')); 49 Scale := Scale + 1; 50 51 Pos := Pos + 1; 52 C := Source (Pos); 53 if C = '_' then 54 loop 55 Pos := Pos + 1; 56 C := Source (Pos); 57 exit when C /= '_'; 58 Error_Msg_Scan ("double underscore in number"); 59 end loop; 60 if C not in '0' .. '9' then 61 Error_Msg_Scan ("underscore must be followed by a digit"); 62 end if; 63 end if; 64 exit when C not in '0' .. '9'; 65 end loop; 66 end Scan_Integer; 67 68 C : Character; 69 D : Natural; 70 Ok : Boolean; 71 Has_Dot : Boolean; 72 Exp : Integer; 73 Exp_Neg : Boolean; 74 Base : Positive; 75begin 76 -- Start with a simple and fast conversion. 77 C := Source (Pos); 78 D := 0; 79 loop 80 D := D * 10 + Character'Pos (C) - Character'Pos ('0'); 81 82 Pos := Pos + 1; 83 C := Source (Pos); 84 if C = '_' then 85 loop 86 Pos := Pos + 1; 87 C := Source (Pos); 88 exit when C /= '_'; 89 Error_Msg_Scan ("double underscore in number"); 90 end loop; 91 if C not in '0' .. '9' then 92 Error_Msg_Scan ("underscore must be followed by a digit"); 93 end if; 94 end if; 95 if C not in '0' .. '9' then 96 if C = '.' or else C = '#' or else (C = 'e' or C = 'E' or C = ':') 97 then 98 -- Continue scanning. 99 Bignum_Int (Res, D); 100 exit; 101 end if; 102 103 -- Finished. 104 -- a universal integer. 105 Current_Token := Tok_Integer; 106 -- No possible overflow. 107 Current_Context.Lit_Int64 := Int64 (D); 108 return; 109 elsif D >= (Natural'Last / 10) - 1 then 110 -- Number may be greather than the natural limit. 111 Scale := 0; 112 Bignum_Int (Res, D); 113 Scan_Integer; 114 exit; 115 end if; 116 end loop; 117 118 Has_Dot := False; 119 Base := 10; 120 Scale := 0; 121 122 C := Source (Pos); 123 if C = '.' then 124 -- Decimal integer. 125 Has_Dot := True; 126 Pos := Pos + 1; 127 C := Source (Pos); 128 if C not in '0' .. '9' then 129 Error_Msg_Scan ("a dot must be followed by a digit"); 130 Current_Token := Tok_Real; 131 Current_Context.Lit_Fp64 := Fp64 (To_Float_64 (False, Res, Base, 0)); 132 return; 133 end if; 134 Scan_Integer; 135 elsif C = '#' 136 or else (C = ':' and then (Source (Pos + 1) in '0' .. '9' 137 or else Source (Pos + 1) in 'a' .. 'f' 138 or else Source (Pos + 1) in 'A' .. 'F')) 139 then 140 -- LRM 13.10 141 -- The number sign (#) of a based literal can be replaced by colon (:), 142 -- provided that the replacement is done for both occurrences. 143 -- GHDL: correctly handle 'variable v : integer range 0 to 7:= 3'. 144 -- Is there any other places where a digit can be followed 145 -- by a colon ? (See IR 1093). 146 147 -- Based integer. 148 declare 149 Number_Sign : constant Character := C; 150 Res_Int : Interfaces.Unsigned_64; 151 begin 152 Bignum_To_Int (Res, Res_Int, Ok); 153 if not Ok or else Res_Int > 16 then 154 -- LRM 13.4.2 155 -- The base must be [...] at most sixteen. 156 Error_Msg_Scan ("base must be at most 16"); 157 -- Fallback. 158 Base := 16; 159 elsif Res_Int < 2 then 160 -- LRM 13.4.2 161 -- The base must be at least two [...]. 162 Error_Msg_Scan ("base must be at least 2"); 163 -- Fallback. 164 Base := 2; 165 else 166 Base := Natural (Res_Int); 167 end if; 168 169 Pos := Pos + 1; 170 Bignum_Int (Res, 0); 171 C := Source (Pos); 172 loop 173 if C >= '0' and C <= '9' then 174 D := Character'Pos (C) - Character'Pos ('0'); 175 elsif C >= 'A' and C <= 'F' then 176 D := Character'Pos (C) - Character'Pos ('A') + 10; 177 elsif C >= 'a' and C <= 'f' then 178 D := Character'Pos (C) - Character'Pos ('a') + 10; 179 else 180 Error_Msg_Scan ("bad extended digit"); 181 exit; 182 end if; 183 184 if D >= Base then 185 -- LRM 13.4.2 186 -- The conventional meaning of base notation is 187 -- assumed; in particular the value of each extended 188 -- digit of a based literal must be less then the base. 189 Error_Msg_Scan ("digit beyond base"); 190 D := 1; 191 end if; 192 Pos := Pos + 1; 193 Bignum_Mul_Int (Res, Base, D); 194 Scale := Scale + 1; 195 196 C := Source (Pos); 197 if C = '_' then 198 loop 199 Pos := Pos + 1; 200 C := Source (Pos); 201 exit when C /= '_'; 202 Error_Msg_Scan ("double underscore in based integer"); 203 end loop; 204 elsif C = '.' then 205 if Has_Dot then 206 Error_Msg_Scan ("double dot ignored"); 207 else 208 Has_Dot := True; 209 Scale := 0; 210 end if; 211 Pos := Pos + 1; 212 C := Source (Pos); 213 elsif C = Number_Sign then 214 Pos := Pos + 1; 215 exit; 216 elsif C = '#' or C = ':' then 217 Error_Msg_Scan ("bad number sign replacement character"); 218 exit; 219 end if; 220 end loop; 221 end; 222 end if; 223 224 -- Exponent. 225 C := Source (Pos); 226 Exp := 0; 227 if C = 'E' or else C = 'e' then 228 Pos := Pos + 1; 229 C := Source (Pos); 230 Exp_Neg := False; 231 if C = '+' then 232 Pos := Pos + 1; 233 C := Source (Pos); 234 elsif C = '-' then 235 if Has_Dot then 236 Exp_Neg := True; 237 else 238 -- LRM 13.4.1 239 -- An exponent for an integer literal must not have a minus sign. 240 -- 241 -- LRM 13.4.2 242 -- An exponent for a based integer literal must not have a minus 243 -- sign. 244 Error_Msg_Scan 245 ("negative exponent not allowed for integer literal"); 246 end if; 247 Pos := Pos + 1; 248 C := Source (Pos); 249 end if; 250 if C not in '0' .. '9' then 251 Error_Msg_Scan ("digit expected after exponent"); 252 else 253 loop 254 -- C is a digit. 255 Exp := Exp * 10 + (Character'Pos (C) - Character'Pos ('0')); 256 257 Pos := Pos + 1; 258 C := Source (Pos); 259 if C = '_' then 260 loop 261 Pos := Pos + 1; 262 C := Source (Pos); 263 exit when C /= '_'; 264 Error_Msg_Scan ("double underscore not allowed in integer"); 265 end loop; 266 if C not in '0' .. '9' then 267 Error_Msg_Scan ("digit expected after underscore"); 268 exit; 269 end if; 270 elsif C not in '0' .. '9' then 271 exit; 272 end if; 273 end loop; 274 end if; 275 if Exp_Neg then 276 Exp := -Exp; 277 end if; 278 end if; 279 280 if Has_Dot then 281 -- a universal real. 282 Current_Token := Tok_Real; 283 284 Current_Context.Lit_Fp64 := 285 Fp64 (To_Float_64 (False, Res, Base, Exp - Scale)); 286 else 287 -- a universal integer. 288 Current_Token := Tok_Integer; 289 290 -- Set to a valid literal, in case of constraint error. 291 if Exp /= 0 then 292 Res := Bignum_Mul (Res, Bignum_Pow (Base, Exp)); 293 end if; 294 295 declare 296 U : Unsigned_64; 297 begin 298 Bignum_To_Int (Res, U, Ok); 299 if U > Unsigned_64 (Int64'Last) then 300 Ok := False; 301 else 302 Current_Context.Lit_Int64 := Int64 (U); 303 end if; 304 end; 305 if not Ok then 306 Error_Msg_Scan ("literal beyond integer bounds"); 307 end if; 308 end if; 309exception 310 when Constraint_Error => 311 Error_Msg_Scan ("literal overflow"); 312 313 Current_Token := Tok_Integer; 314 Current_Context.Lit_Int64 := 0; 315end Scan_Literal; 316