| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- S C N . N L I T -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- $Revision$ -- |
| -- -- |
| -- Copyright (C) 1992-2001 Free Software Foundation, Inc. -- |
| -- -- |
| -- GNAT is free software; you can redistribute it and/or modify it under -- |
| -- terms of the GNU General Public License as published by the Free Soft- -- |
| -- ware Foundation; either version 2, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
| -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- |
| -- for more details. You should have received a copy of the GNU General -- |
| -- Public License distributed with GNAT; see file COPYING. If not, write -- |
| -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- |
| -- MA 02111-1307, USA. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Uintp; use Uintp; |
| with Urealp; use Urealp; |
| |
| separate (Scn) |
| procedure Nlit is |
| |
| C : Character; |
| -- Current source program character |
| |
| Base_Char : Character; |
| -- Either # or : (character at start of based number) |
| |
| Base : Int; |
| -- Value of base |
| |
| UI_Base : Uint; |
| -- Value of base in Uint format |
| |
| UI_Int_Value : Uint; |
| -- Value of integer scanned by Scan_Integer in Uint format |
| |
| UI_Num_Value : Uint; |
| -- Value of integer in numeric value being scanned |
| |
| Scale : Int; |
| -- Scale value for real literal |
| |
| UI_Scale : Uint; |
| -- Scale in Uint format |
| |
| Exponent_Is_Negative : Boolean; |
| -- Set true for negative exponent |
| |
| Extended_Digit_Value : Int; |
| -- Extended digit value |
| |
| Point_Scanned : Boolean; |
| -- Flag for decimal point scanned in numeric literal |
| |
| ----------------------- |
| -- Local Subprograms -- |
| ----------------------- |
| |
| procedure Error_Digit_Expected; |
| -- Signal error of bad digit, Scan_Ptr points to the location at which |
| -- the digit was expected on input, and is unchanged on return. |
| |
| procedure Scan_Integer; |
| -- Procedure to scan integer literal. On entry, Scan_Ptr points to a |
| -- digit, on exit Scan_Ptr points past the last character of the integer. |
| -- For each digit encountered, UI_Int_Value is multiplied by 10, and the |
| -- value of the digit added to the result. In addition, the value in |
| -- Scale is decremented by one for each actual digit scanned. |
| |
| -------------------------- |
| -- Error_Digit_Expected -- |
| -------------------------- |
| |
| procedure Error_Digit_Expected is |
| begin |
| Error_Msg_S ("digit expected"); |
| end Error_Digit_Expected; |
| |
| ------------------- |
| -- Scan_Integer -- |
| ------------------- |
| |
| procedure Scan_Integer is |
| C : Character; |
| -- Next character scanned |
| |
| begin |
| C := Source (Scan_Ptr); |
| |
| -- Loop through digits (allowing underlines) |
| |
| loop |
| Accumulate_Checksum (C); |
| UI_Int_Value := |
| UI_Int_Value * 10 + (Character'Pos (C) - Character'Pos ('0')); |
| Scan_Ptr := Scan_Ptr + 1; |
| Scale := Scale - 1; |
| C := Source (Scan_Ptr); |
| |
| if C = '_' then |
| Accumulate_Checksum ('_'); |
| |
| loop |
| Scan_Ptr := Scan_Ptr + 1; |
| C := Source (Scan_Ptr); |
| exit when C /= '_'; |
| Error_No_Double_Underline; |
| end loop; |
| |
| if C not in '0' .. '9' then |
| Error_Digit_Expected; |
| exit; |
| end if; |
| |
| else |
| exit when C not in '0' .. '9'; |
| end if; |
| end loop; |
| |
| end Scan_Integer; |
| |
| ---------------------------------- |
| -- Start of Processing for Nlit -- |
| ---------------------------------- |
| |
| begin |
| Base := 10; |
| UI_Base := Uint_10; |
| UI_Int_Value := Uint_0; |
| Scale := 0; |
| Scan_Integer; |
| Scale := 0; |
| Point_Scanned := False; |
| UI_Num_Value := UI_Int_Value; |
| |
| -- Various possibilities now for continuing the literal are |
| -- period, E/e (for exponent), or :/# (for based literal). |
| |
| Scale := 0; |
| C := Source (Scan_Ptr); |
| |
| if C = '.' then |
| |
| -- Scan out point, but do not scan past .. which is a range sequence, |
| -- and must not be eaten up scanning a numeric literal. |
| |
| while C = '.' and then Source (Scan_Ptr + 1) /= '.' loop |
| Accumulate_Checksum ('.'); |
| |
| if Point_Scanned then |
| Error_Msg_S ("duplicate point ignored"); |
| end if; |
| |
| Point_Scanned := True; |
| Scan_Ptr := Scan_Ptr + 1; |
| C := Source (Scan_Ptr); |
| |
| if C not in '0' .. '9' then |
| Error_Msg ("real literal cannot end with point", Scan_Ptr - 1); |
| else |
| Scan_Integer; |
| UI_Num_Value := UI_Int_Value; |
| end if; |
| end loop; |
| |
| -- Based literal case. The base is the value we already scanned. |
| -- In the case of colon, we insist that the following character |
| -- is indeed an extended digit or a period. This catches a number |
| -- of common errors, as well as catching the well known tricky |
| -- bug otherwise arising from "x : integer range 1 .. 10:= 6;" |
| |
| elsif C = '#' |
| or else (C = ':' and then |
| (Source (Scan_Ptr + 1) = '.' |
| or else |
| Source (Scan_Ptr + 1) in '0' .. '9' |
| or else |
| Source (Scan_Ptr + 1) in 'A' .. 'Z' |
| or else |
| Source (Scan_Ptr + 1) in 'a' .. 'z')) |
| then |
| Accumulate_Checksum (C); |
| Base_Char := C; |
| UI_Base := UI_Int_Value; |
| |
| if UI_Base < 2 or else UI_Base > 16 then |
| Error_Msg_SC ("base not 2-16"); |
| UI_Base := Uint_16; |
| end if; |
| |
| Base := UI_To_Int (UI_Base); |
| Scan_Ptr := Scan_Ptr + 1; |
| |
| -- Scan out extended integer [. integer] |
| |
| C := Source (Scan_Ptr); |
| UI_Int_Value := Uint_0; |
| Scale := 0; |
| |
| loop |
| if C in '0' .. '9' then |
| Accumulate_Checksum (C); |
| Extended_Digit_Value := |
| Int'(Character'Pos (C)) - Int'(Character'Pos ('0')); |
| |
| elsif C in 'A' .. 'F' then |
| Accumulate_Checksum (Character'Val (Character'Pos (C) + 32)); |
| Extended_Digit_Value := |
| Int'(Character'Pos (C)) - Int'(Character'Pos ('A')) + 10; |
| |
| elsif C in 'a' .. 'f' then |
| Accumulate_Checksum (C); |
| Extended_Digit_Value := |
| Int'(Character'Pos (C)) - Int'(Character'Pos ('a')) + 10; |
| |
| else |
| Error_Msg_S ("extended digit expected"); |
| exit; |
| end if; |
| |
| if Extended_Digit_Value >= Base then |
| Error_Msg_S ("digit >= base"); |
| end if; |
| |
| UI_Int_Value := UI_Int_Value * UI_Base + Extended_Digit_Value; |
| Scale := Scale - 1; |
| Scan_Ptr := Scan_Ptr + 1; |
| C := Source (Scan_Ptr); |
| |
| if C = '_' then |
| loop |
| Accumulate_Checksum ('_'); |
| Scan_Ptr := Scan_Ptr + 1; |
| C := Source (Scan_Ptr); |
| exit when C /= '_'; |
| Error_No_Double_Underline; |
| end loop; |
| |
| elsif C = '.' then |
| Accumulate_Checksum ('.'); |
| |
| if Point_Scanned then |
| Error_Msg_S ("duplicate point ignored"); |
| end if; |
| |
| Scan_Ptr := Scan_Ptr + 1; |
| C := Source (Scan_Ptr); |
| Point_Scanned := True; |
| Scale := 0; |
| |
| elsif C = Base_Char then |
| Accumulate_Checksum (C); |
| Scan_Ptr := Scan_Ptr + 1; |
| exit; |
| |
| elsif C = '#' or else C = ':' then |
| Error_Msg_S ("based number delimiters must match"); |
| Scan_Ptr := Scan_Ptr + 1; |
| exit; |
| |
| elsif not Identifier_Char (C) then |
| if Base_Char = '#' then |
| Error_Msg_S ("missing '#"); |
| else |
| Error_Msg_S ("missing ':"); |
| end if; |
| |
| exit; |
| end if; |
| |
| end loop; |
| |
| UI_Num_Value := UI_Int_Value; |
| end if; |
| |
| -- Scan out exponent |
| |
| if not Point_Scanned then |
| Scale := 0; |
| UI_Scale := Uint_0; |
| else |
| UI_Scale := UI_From_Int (Scale); |
| end if; |
| |
| if Source (Scan_Ptr) = 'e' or else Source (Scan_Ptr) = 'E' then |
| Accumulate_Checksum ('e'); |
| Scan_Ptr := Scan_Ptr + 1; |
| Exponent_Is_Negative := False; |
| |
| if Source (Scan_Ptr) = '+' then |
| Accumulate_Checksum ('+'); |
| Scan_Ptr := Scan_Ptr + 1; |
| |
| elsif Source (Scan_Ptr) = '-' then |
| Accumulate_Checksum ('-'); |
| |
| if not Point_Scanned then |
| Error_Msg_S ("negative exponent not allowed for integer literal"); |
| else |
| Exponent_Is_Negative := True; |
| end if; |
| |
| Scan_Ptr := Scan_Ptr + 1; |
| end if; |
| |
| UI_Int_Value := Uint_0; |
| |
| if Source (Scan_Ptr) in '0' .. '9' then |
| Scan_Integer; |
| else |
| Error_Digit_Expected; |
| end if; |
| |
| if Exponent_Is_Negative then |
| UI_Scale := UI_Scale - UI_Int_Value; |
| else |
| UI_Scale := UI_Scale + UI_Int_Value; |
| end if; |
| end if; |
| |
| -- Case of real literal to be returned |
| |
| if Point_Scanned then |
| Token := Tok_Real_Literal; |
| Token_Node := New_Node (N_Real_Literal, Token_Ptr); |
| Set_Realval (Token_Node, |
| UR_From_Components ( |
| Num => UI_Num_Value, |
| Den => -UI_Scale, |
| Rbase => Base)); |
| |
| -- Case of integer literal to be returned |
| |
| else |
| Token := Tok_Integer_Literal; |
| Token_Node := New_Node (N_Integer_Literal, Token_Ptr); |
| |
| if UI_Scale = 0 then |
| Set_Intval (Token_Node, UI_Num_Value); |
| |
| -- Avoid doing possibly expensive calculations in cases like |
| -- parsing 163E800_000# when semantics will not be done anyway. |
| -- This is especially useful when parsing garbled input. |
| |
| elsif Operating_Mode /= Check_Syntax |
| and then (Errors_Detected = 0 or else Try_Semantics) |
| then |
| Set_Intval (Token_Node, UI_Num_Value * UI_Base ** UI_Scale); |
| |
| else |
| Set_Intval (Token_Node, No_Uint); |
| end if; |
| |
| end if; |
| |
| return; |
| |
| end Nlit; |