1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 with Uintp; use Uintp;
29 with Urealp; use Urealp;
35 -- Current source program character
37 Base_Char : Character;
38 -- Either # or : (character at start of based number)
44 -- Value of base in Uint format
47 -- Value of integer scanned by Scan_Integer in Uint format
50 -- Value of integer in numeric value being scanned
53 -- Scale value for real literal
56 -- Scale in Uint format
58 Exponent_Is_Negative : Boolean;
59 -- Set true for negative exponent
61 Extended_Digit_Value : Int;
62 -- Extended digit value
64 Point_Scanned : Boolean;
65 -- Flag for decimal point scanned in numeric literal
67 -----------------------
68 -- Local Subprograms --
69 -----------------------
71 procedure Error_Digit_Expected;
72 -- Signal error of bad digit, Scan_Ptr points to the location at which
73 -- the digit was expected on input, and is unchanged on return.
75 procedure Scan_Integer;
76 -- Procedure to scan integer literal. On entry, Scan_Ptr points to a
77 -- digit, on exit Scan_Ptr points past the last character of the integer.
78 -- For each digit encountered, UI_Int_Value is multiplied by 10, and the
79 -- value of the digit added to the result. In addition, the value in
80 -- Scale is decremented by one for each actual digit scanned.
82 --------------------------
83 -- Error_Digit_Expected --
84 --------------------------
86 procedure Error_Digit_Expected is
88 Error_Msg_S ("digit expected");
89 end Error_Digit_Expected;
95 procedure Scan_Integer is
97 -- Next character scanned
100 C := Source (Scan_Ptr);
102 -- Loop through digits (allowing underlines)
105 Accumulate_Checksum (C);
107 UI_Int_Value * 10 + (Character'Pos (C) - Character'Pos ('0'));
108 Scan_Ptr := Scan_Ptr + 1;
110 C := Source (Scan_Ptr);
113 Accumulate_Checksum ('_');
116 Scan_Ptr := Scan_Ptr + 1;
117 C := Source (Scan_Ptr);
119 Error_No_Double_Underline;
122 if C not in '0' .. '9' then
123 Error_Digit_Expected;
128 exit when C not in '0' .. '9';
134 ----------------------------------
135 -- Start of Processing for Nlit --
136 ----------------------------------
141 UI_Int_Value := Uint_0;
145 Point_Scanned := False;
146 UI_Num_Value := UI_Int_Value;
148 -- Various possibilities now for continuing the literal are
149 -- period, E/e (for exponent), or :/# (for based literal).
152 C := Source (Scan_Ptr);
156 -- Scan out point, but do not scan past .. which is a range sequence,
157 -- and must not be eaten up scanning a numeric literal.
159 while C = '.' and then Source (Scan_Ptr + 1) /= '.' loop
160 Accumulate_Checksum ('.');
162 if Point_Scanned then
163 Error_Msg_S ("duplicate point ignored");
166 Point_Scanned := True;
167 Scan_Ptr := Scan_Ptr + 1;
168 C := Source (Scan_Ptr);
170 if C not in '0' .. '9' then
171 Error_Msg ("real literal cannot end with point", Scan_Ptr - 1);
174 UI_Num_Value := UI_Int_Value;
178 -- Based literal case. The base is the value we already scanned.
179 -- In the case of colon, we insist that the following character
180 -- is indeed an extended digit or a period. This catches a number
181 -- of common errors, as well as catching the well known tricky
182 -- bug otherwise arising from "x : integer range 1 .. 10:= 6;"
185 or else (C = ':' and then
186 (Source (Scan_Ptr + 1) = '.'
188 Source (Scan_Ptr + 1) in '0' .. '9'
190 Source (Scan_Ptr + 1) in 'A' .. 'Z'
192 Source (Scan_Ptr + 1) in 'a' .. 'z'))
194 Accumulate_Checksum (C);
196 UI_Base := UI_Int_Value;
198 if UI_Base < 2 or else UI_Base > 16 then
199 Error_Msg_SC ("base not 2-16");
203 Base := UI_To_Int (UI_Base);
204 Scan_Ptr := Scan_Ptr + 1;
206 -- Scan out extended integer [. integer]
208 C := Source (Scan_Ptr);
209 UI_Int_Value := Uint_0;
213 if C in '0' .. '9' then
214 Accumulate_Checksum (C);
215 Extended_Digit_Value :=
216 Int'(Character'Pos (C)) - Int'(Character'Pos ('0'));
218 elsif C in 'A' .. 'F' then
219 Accumulate_Checksum (Character'Val (Character'Pos (C) + 32));
220 Extended_Digit_Value :=
221 Int'(Character'Pos (C)) - Int'(Character'Pos ('A')) + 10;
223 elsif C in 'a' .. 'f' then
224 Accumulate_Checksum (C);
225 Extended_Digit_Value :=
226 Int'(Character'Pos (C)) - Int'(Character'Pos ('a')) + 10;
229 Error_Msg_S ("extended digit expected");
233 if Extended_Digit_Value >= Base then
234 Error_Msg_S ("digit >= base");
237 UI_Int_Value := UI_Int_Value * UI_Base + Extended_Digit_Value;
239 Scan_Ptr := Scan_Ptr + 1;
240 C := Source (Scan_Ptr);
244 Accumulate_Checksum ('_');
245 Scan_Ptr := Scan_Ptr + 1;
246 C := Source (Scan_Ptr);
248 Error_No_Double_Underline;
252 Accumulate_Checksum ('.');
254 if Point_Scanned then
255 Error_Msg_S ("duplicate point ignored");
258 Scan_Ptr := Scan_Ptr + 1;
259 C := Source (Scan_Ptr);
260 Point_Scanned := True;
263 elsif C = Base_Char then
264 Accumulate_Checksum (C);
265 Scan_Ptr := Scan_Ptr + 1;
268 elsif C = '#' or else C = ':' then
269 Error_Msg_S ("based number delimiters must match");
270 Scan_Ptr := Scan_Ptr + 1;
273 elsif not Identifier_Char (C) then
274 if Base_Char = '#' then
275 Error_Msg_S ("missing '#");
277 Error_Msg_S ("missing ':");
285 UI_Num_Value := UI_Int_Value;
290 if not Point_Scanned then
294 UI_Scale := UI_From_Int (Scale);
297 if Source (Scan_Ptr) = 'e' or else Source (Scan_Ptr) = 'E' then
298 Accumulate_Checksum ('e');
299 Scan_Ptr := Scan_Ptr + 1;
300 Exponent_Is_Negative := False;
302 if Source (Scan_Ptr) = '+' then
303 Accumulate_Checksum ('+');
304 Scan_Ptr := Scan_Ptr + 1;
306 elsif Source (Scan_Ptr) = '-' then
307 Accumulate_Checksum ('-');
309 if not Point_Scanned then
310 Error_Msg_S ("negative exponent not allowed for integer literal");
312 Exponent_Is_Negative := True;
315 Scan_Ptr := Scan_Ptr + 1;
318 UI_Int_Value := Uint_0;
320 if Source (Scan_Ptr) in '0' .. '9' then
323 Error_Digit_Expected;
326 if Exponent_Is_Negative then
327 UI_Scale := UI_Scale - UI_Int_Value;
329 UI_Scale := UI_Scale + UI_Int_Value;
333 -- Case of real literal to be returned
335 if Point_Scanned then
336 Token := Tok_Real_Literal;
337 Token_Node := New_Node (N_Real_Literal, Token_Ptr);
338 Set_Realval (Token_Node,
344 -- Case of integer literal to be returned
347 Token := Tok_Integer_Literal;
348 Token_Node := New_Node (N_Integer_Literal, Token_Ptr);
351 Set_Intval (Token_Node, UI_Num_Value);
353 -- Avoid doing possibly expensive calculations in cases like
354 -- parsing 163E800_000# when semantics will not be done anyway.
355 -- This is especially useful when parsing garbled input.
357 elsif Operating_Mode /= Check_Syntax
358 and then (Serious_Errors_Detected = 0 or else Try_Semantics)
360 Set_Intval (Token_Node, UI_Num_Value * UI_Base ** UI_Scale);
363 Set_Intval (Token_Node, No_Uint);