|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 68178 (0x10a52)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Host_Dependencies; -- Host dependents constants
with Lex_Identifier_Token_Value;
-- contains data structures and subprogram
-- to distinguish identifiers from
-- reserved words
with Lexical_Error_Message; -- outputs error messages.
with Parsetables; -- tables from parser generator
use Parsetables;
with Grammar_Constants; -- constants from the parser generator
use Grammar_Constants;
with Text_Io;
package body Lex is
--| Overview
--|
--| Package Lex is implemented as a state machine via case statements.
--| The implementation is optimized to minimize the number of times
--| each character is handled. Each character is handled twice: once
--| on input and once on lexing based on the character.
--|
--| The algorithm depends on having an End_Of_Line_Character
--| terminate each source file line. This concludes the final token
--| on the line for the case statement scanners.
--| Notes
--|
--| Abbreviations Used:
--|
--| Char : Character
--| CST : Current_Source_Token
--| gram : grammar
--| sym : symbol
--| val : value
--| RW : Reserved Word
--|
use Parserdeclarations;
package Lem renames Lexical_Error_Message;
package Pt renames Parsetables;
package Gc renames Grammar_Constants;
-- other package renames are in the package spec
------------------------------------------------------------------
-- Character Types
------------------------------------------------------------------
subtype Graphic_Character is Character range ' ' .. Ascii.Tilde;
subtype Upper_Case_Letter is Character range 'A' .. 'Z';
subtype Lower_Case_Letter is Character range Ascii.Lc_A .. Ascii.Lc_Z;
subtype Digit is Character range '0' .. '9';
subtype Valid_Base_Range is Gc.Parserinteger range 2 .. 16;
subtype End_Of_Line_Character is Character range Ascii.Lf .. Ascii.Cr;
------------------------------------------------------------------
-- Source position management
------------------------------------------------------------------
Current_Column : Hd.Source_Column := 1;
Current_Line : Hd.Source_Line := 1;
--| the position of Next_Char in the source file.
--| Visible so the Lexical_Error_message package can use them.
------------------------------------------------------------------
-- Source Input Buffers and their Management
------------------------------------------------------------------
Next_Char : Character := ' '; --| input buffer for next character
--| to scan from source file
End_Of_Line_Buffer : constant --| character that signals end of
--| line buffer
Character :=
End_Of_Line_Character'First;
subtype Line_Buffer_Range is Positive
range 1 .. ((Hd.Source_Column'Last) + 2);
--| The first extra element is needed to hold the End_Of_Line_Buffer
--| character. The second extra element allows Line_Buffer_Index
--| to exceed Line_Buffer_Last.
Line_Buffer : String (Line_Buffer_Range) := ( -- 1 =>
End_Of_Line_Buffer,
others => ' ');
--| input buffer containing source file line being lexed.
Line_Buffer_Last : Hd.Source_Column := Line_Buffer'First;
--| length of source file line being lexed.
Line_Buffer_Index : Line_Buffer_Range := Line_Buffer_Range'First;
--| index of character being lexed.
End_Of_File_Reached : Boolean := False;
--| true when end of the input source has been reached
------------------------------------------------------------------
-- Token to be Returned and its Management
------------------------------------------------------------------
Cst : Pd.Parsestackelement;
--| token being assembled for return by
--| subprogram GetNextSourceToken
subtype Cst_Initialization_Type is Pd.Parsestackelement;
Cst_Initializer : Cst_Initialization_Type;
--| short cut to initializing discriminants properly
End_Of_File_Token : Cst_Initialization_Type;
------------------------------------------------------------------
-- Other objects
------------------------------------------------------------------
Exit_After_Get_Next_Char : Boolean := False;
--| true; call Get_Next_Char before exiting, so that
--| Next_Char contains the next character to be scanned.
--| This object is not located in subprogram GetNextSourceToken,
--| to save the time of re-elaboration on each call.
Previous_Token_Value : Pt.Tokenrange := Pt.Stringtokenvalue;
--| used to resolve tick use as a token in T'('a') versus
--| use as a delimiter in a character literal.
Source_File : Text_Io.File_Type;
------------------------------------------------------------------
-- Declarations for Scan_Numeric_Literal and Scan_Comment
------------------------------------------------------------------
Temp_Source_Text : Pd.Source_Text; --| temporary to hold value of
--| Source_Text
------------------------------------------------------------------
subtype Work_String_Range_Plus_Zero is
Natural range 0 .. Natural (Hd.Source_Column'Last);
Work_String : String (1 .. Work_String_Range_Plus_Zero'Last);
Work_String_Length : Work_String_Range_Plus_Zero;
-- Must initialize to 0 before each use.
------------------------------------------------------------------
-- Declarations for Procedures:
--
-- Scan_Exponent, Scan_Based_Integer, Scan_Integer,
-- and Scan_Numeric_Literal
------------------------------------------------------------------
Seen_Radix_Point : Boolean := False;
--| true : real
--| false : integer
------------------------------------------------------------------
-- Subprogram Specifications Local to Package Lex
------------------------------------------------------------------
procedure Get_Next_Char; --| Obtains next character
--| Requires
--|
--| This subprogram requires an opened source file, and
--| Current Column > Line_Buffer_Last on its first call to initialize
--| the input buffers Next_Char and Line_Buffer correctly.
--|
--| Effects
--|
--| This subprogram places the next character from the source file
--| in Next_Char and updates the source file position.
--| Subprogram Get_Next_Line sets End_Of_File_Reached true, and causes
--| Next_Char to be set to the last character in Line_Buffer.
--|
--| Modifies
--|
--| Current_Column
--| Current_Line
--| Next_Char
--| Line_Buffer
--| Line_Buffer_Last
--| Line_Buffer_Index
--| End_Of_File_Reached
--|
------------------------------------------------------------------
procedure Get_Next_Line; --| gets next source file line to lex
--| Requires
--|
--| This subprogram requires the source file to be open.
--|
--| Effects
--|
--| This subprogram gets next source line from input file.
--| Sets Current_Column and Line_Buffer_Index to 1, and
--| increments Current_Line.
--| If the End of File is detected,
--| End_Of_File_Reached is set true,
--| End_Of_File_Token is set up,
--| and Next_Char is set to End_Of_Line_Buffer.
--|
--| Modifies
--|
--| Current_Line
--| End_Of_File_Reached
--| End_Of_File_Token - only when the end of file is reached.
--| Line_Buffer
--| Line_Buffer_Last
--|
------------------------------------------------------------------
function Look_Ahead ( --| Return character n columns ahead
--| in current in current line.
In_Columns_Ahead : in --| Number of columns ahead to get
Hd.Source_Column --| return character from.
) return Character;
--| Requires
--|
--| Line_Buffer
--| Line_Buffer_Last
--|
--| Effects
--|
--| Return character In_Columns_Ahead in Line_Buffer.
--| If this character is off the end of Line_Buffer,
--| End_Of_Line_Buffer character is returned.
--|
------------------------------------------------------------------
procedure Set_Cst_Gram_Sym_Val ( --| Sets gram_sym_val for current
--| token.
In_Token_Value : in Pt.Tokenrange);
--| value of token
--| Effects
--|
--| This subprogram fills in gram_sym_val for the current token.
--|
------------------------------------------------------------------
procedure Set_Cst_Source_Rep ( --| Saves the symbol representation
--| in the current token.
In_String : in String);
--| string holding symbol.
--| Effects
--|
--| This subprogram fills in lexed_token.symrep for the current token.
--|
------------------------------------------------------------------
procedure Initialize_Cst; --| Sets lx_srcpos for current token.
--| Requires
--|
--| This subprogram requires Current_Column and Current_Line.
--|
--| Effects
--|
--| This subprogram sets common fields in CST.
--|
------------------------------------------------------------------
procedure Add_Next_Char_To_Source_Rep;
--| appends Next_Char to growing
--| source representation
--| Requires
--|
--| Next_Char
--|
--| Effects
--|
--| This subprogram appends Next_Char to the growing source
--| representation.
--|
--| Modifies
--|
--| Work_String
--| Work_String_Length
--|
------------------------------------------------------------------
procedure Check_For_Consecutive_Underlines;
--| Issues an error message if
--| consecutive underlines occur.
--| Requires
--|
--| Work_String
--| Work_String_Length
--|
--| Effects
--|
--| Issues an error message if consecutive underlines occur.
--|
------------------------------------------------------------------
procedure Check_For_Terminal_Underline;
--| Issues an error message if
--| a terminal underline occurs.
--| Requires
--|
--| Work_String
--| Work_String_Length
--|
--| Effects
--|
--| This subprogram issues an error message if a terminal underline
--| occurs.
------------------------------------------------------------------
procedure Scan_Comment; --| Scans comments.
--| Requires
--|
--| This subprogram requires an opened source file.
--|
--| Effects
--|
--| This subprogram scans the rest of a comment.
--|
--| Modifies
--|
--| CST
--|
------------------------------------------------------------------
procedure Scan_Identifier_Including_Rw;
--| Scans identifiers including
--| reserved words
--| Requires
--|
--| This subprogram requires an opened source file.
--|
--| Effects
--|
--| This subprogram scans the rest of the identifier,
--| and determines if its a reserved word.
--|
--| Modifies
--|
--| CST
--|
------------------------------------------------------------------
procedure Scan_Exponent; --| Scans exponent field in
--| appropriate numeric_literals
--| Requires
--|
--| This subprogram requires an opened source file.
--|
--| Effects
--|
--| This subprogram scans the end of numeric_literals which
--| contain exponents.
--|
--| Modifies
--|
--| Work_String
--| Work_String_Length
--|
------------------------------------------------------------------
procedure Scan_Based_Integer
( --| scans a based integer field of
--| a numeric literal
In_Base_To_Use : in --| the base to use for lexing.
Valid_Base_Range);
--| Requires
--|
--| This subprogram requires an opened source file.
--| Effects
--|
--| This subprogram scans a based integer field in a numeric literal,
--| verifying that is lexically correct.
--|
--| Modifies
--|
--| Work_String
--| Work_String_Length
--|
--| Notes
--|
--| This subprogram and Scan_Integer are nearly identical.
--| They are separate to save the overhead of:
--|
--| - passing a base in for decimal literals; and
--|
--| - distinguishing the extended digit 'E' from the exponent
--| delimiter 'E'.
--|
------------------------------------------------------------------
procedure Scan_Integer; --| scans an integer field of
--| a numeric literal
--| Requires
--|
--| This subprogram requires an opened source file.
--|
--| Effects
--|
--| This subprogram scans an integer field in a numeric literal,
--| verifying it is lexically correct.
--|
--| Modifies
--|
--| Work_String
--| Work_String_Length
--|
--| Notes
--|
--| This subprogram and Scan_Based_Integer are nearly identical.
--| They are separate to save the overhead of:
--|
--| - passing a base in for decimal literals; and
--|
--| - distinguishing the extended digit 'E' from the exponent
--| delimiter 'E'.
--|
------------------------------------------------------------------
procedure Scan_Numeric_Literal; --| Scans numbers
--| Requires
--|
--| This subprogram requires an opened source file, and the
--| Universal Arithmetic package to handle conversions.
--|
--| Effects
--|
--| This subprogram scans the rest of the numeric literal and converts
--| it to internal universal number format.
--|
--| Modifies
--|
--| CST
--|
-------------------------------------------------------------------
procedure Scan_String_Literal; --| Scans string literals
--| Requires
--|
--| This subprogram requires an opened source file.
--|
--| Effects
--|
--| This subprogram scans the rest of the string literal.
--|
--| Modifies
--|
--| CST
--|
------------------------------------------------------------------
-- Subprogram Bodies Global to Package Lex
-- (declared in package specification).
------------------------------------------------------------------
procedure Initialization is
begin
End_Of_File_Reached := False;
-- forces Get_Next_Char to call Get_Next_Line
Current_Column := Line_Buffer_Last + 1;
Get_Next_Char;
end Initialization;
------------------------------------------------------------------
function Getnextnoncommenttoken return Pd.Parsestackelement is separate;
------------------------------------------------------------------
function Getnextsourcetoken return Pd.Parsestackelement is
--| Overview
--|
--| Note the following LRM Sections:
--| LRM Section 2.2 - Lexical Elements, Separators and Delimiters
--| LRM Section 2.2 - Notes
--| LRM Section 2.5 - Character Literals
--| LRM Section 2.7 - Comments
--| LRM Section 2.7 - Note
--| LRM Section 2.10 - Allowed Replacements of Characters
--|
begin
if (End_Of_File_Reached) then
Cst := End_Of_File_Token;
else
-- this else terminates
-- shortly before the return statement
-- This loop performs the following functions:
--
-- 1) It scans for and ignores repeated separators.
-- 2) It reports illegal characters between tokens.
-- 3) It identifies and lexes tokens.
-- Delimiters and character literals are handled
-- by code inside this loop.
-- Complex tokens: identifiers, string and
-- numeric literals are lexed by called
-- subprograms.
-- 4) It recognizes and processes comments that
-- occur before the first token found. Comments
-- after tokens are processed by a separate loop
-- after this one.
Scan_For_Token:
loop
case Next_Char is
when Upper_Case_Letter | Lower_Case_Letter =>
Initialize_Cst;
Scan_Identifier_Including_Rw;
exit Scan_For_Token;
-- Next_Char already updated
when Digit =>
Initialize_Cst;
Scan_Numeric_Literal;
exit Scan_For_Token;
-- Next_Char already updated
when Ascii.Quotation |
-- '"'
Ascii.Percent =>
-- '%'
Initialize_Cst;
Scan_String_Literal;
exit Scan_For_Token;
-- Next_Char already updated
when ''' =>
Initialize_Cst;
if ((Gc."=" (Previous_Token_Value,
Pt.Identifiertokenvalue)) or else
(Gc."=" (Previous_Token_Value,
Pt.Alltokenvalue)) or else
(Gc."=" (Previous_Token_Value,
Pt.Stringtokenvalue)) or else
(Gc."=" (Previous_Token_Value,
Pt.Charactertokenvalue)) or else
(Gc."=" (Previous_Token_Value,
Pt.Rightparen_Tokenvalue))) then
-- CST is a ' delimiter
Set_Cst_Gram_Sym_Val (Pt.Apostrophe_Tokenvalue);
elsif (Look_Ahead (2) = ''') then
-- CST is a character literal
Cst.Gram_Sym_Val := Pt.Charactertokenvalue;
Get_Next_Char;
if not (Next_Char in Graphic_Character) then
-- flag as an error
Lem.Output_Message
(Current_Line, Current_Column,
Integer'Image
(Character'Pos (Next_Char))
-- convert to string
, Lem.Character_Is_Non_Graphic);
end if;
-- save the source representation.
Set_Cst_Source_Rep ("'" & Next_Char);
Get_Next_Char;
-- pass by the closing
-- single quote
else
-- flag single quote use as illegal
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Illegal_Use_Of_Single_Quote);
-- assume CST is a ' delimiter;
Set_Cst_Gram_Sym_Val (Pt.Apostrophe_Tokenvalue);
end if;
Exit_After_Get_Next_Char := True;
when Ascii.Ampersand =>
-- '&'
Initialize_Cst;
Set_Cst_Gram_Sym_Val (Pt.Ampersand_Tokenvalue);
Exit_After_Get_Next_Char := True;
when '(' =>
Initialize_Cst;
Set_Cst_Gram_Sym_Val (Pt.Leftparen_Tokenvalue);
Exit_After_Get_Next_Char := True;
when ')' =>
Initialize_Cst;
Set_Cst_Gram_Sym_Val (Pt.Rightparen_Tokenvalue);
Exit_After_Get_Next_Char := True;
when '*' =>
Initialize_Cst;
Get_Next_Char;
case Next_Char is
when '*' =>
Set_Cst_Gram_Sym_Val
(Pd.Exponentiation_Tokenvalue);
Exit_After_Get_Next_Char := True;
when others =>
Set_Cst_Gram_Sym_Val (Pt.Star_Tokenvalue);
exit Scan_For_Token;
-- Next_Char already updated
end case;
when '+' =>
Initialize_Cst;
Set_Cst_Gram_Sym_Val (Pt.Plus_Tokenvalue);
Exit_After_Get_Next_Char := True;
when ',' =>
Initialize_Cst;
Set_Cst_Gram_Sym_Val (Pt.Comma_Tokenvalue);
Exit_After_Get_Next_Char := True;
when '-' =>
-- Minus_Sign or Hyphen
Initialize_Cst;
Get_Next_Char;
case Next_Char is
when '-' =>
-- Minus_Sign or Hyphen
-- two hyphens indicate a comment
Set_Cst_Gram_Sym_Val
(Pt.Comment_Tokenvalue);
Scan_Comment;
Exit_After_Get_Next_Char := True;
when others =>
Set_Cst_Gram_Sym_Val (Pt.Minus_Tokenvalue);
exit Scan_For_Token;
-- Next_Char already updated
end case;
when '.' =>
Initialize_Cst;
Get_Next_Char;
case Next_Char is
when '.' =>
Set_Cst_Gram_Sym_Val (Pt.Dotdot_Tokenvalue);
Exit_After_Get_Next_Char := True;
when others =>
Set_Cst_Gram_Sym_Val (Pt.Dot_Tokenvalue);
exit Scan_For_Token;
-- Next_Char already updated
end case;
when '/' =>
Initialize_Cst;
Get_Next_Char;
case Next_Char is
when '=' =>
Set_Cst_Gram_Sym_Val (Pd.
Notequals_Tokenvalue);
Exit_After_Get_Next_Char := True;
when others =>
Set_Cst_Gram_Sym_Val (Pt.Slash_Tokenvalue);
exit Scan_For_Token;
-- Next_Char already updated
end case;
when Ascii.Colon =>
-- ':'
Initialize_Cst;
Get_Next_Char;
case Next_Char is
when '=' =>
Set_Cst_Gram_Sym_Val
(Pd.Assignment_Tokenvalue);
Exit_After_Get_Next_Char := True;
when others =>
Set_Cst_Gram_Sym_Val (Pt.Colon_Tokenvalue);
exit Scan_For_Token;
-- Next_Char already updated
end case;
when Ascii.Semicolon =>
-- ';'
Initialize_Cst;
Set_Cst_Gram_Sym_Val (Pt.Semicolon_Tokenvalue);
Exit_After_Get_Next_Char := True;
when '<' =>
Initialize_Cst;
Get_Next_Char;
case Next_Char is
when '=' =>
Set_Cst_Gram_Sym_Val (Pt.Lteq_Tokenvalue);
Exit_After_Get_Next_Char := True;
when '<' =>
Set_Cst_Gram_Sym_Val
(Pd.Startlabel_Tokenvalue);
Exit_After_Get_Next_Char := True;
when '>' =>
Set_Cst_Gram_Sym_Val (Pd.Box_Tokenvalue);
Exit_After_Get_Next_Char := True;
when others =>
Set_Cst_Gram_Sym_Val (Pt.Lt_Tokenvalue);
exit Scan_For_Token;
-- Next_Char already updated
end case;
when '=' =>
Initialize_Cst;
Get_Next_Char;
case Next_Char is
when '>' =>
Set_Cst_Gram_Sym_Val (Pd.Arrow_Tokenvalue);
Exit_After_Get_Next_Char := True;
when others =>
Set_Cst_Gram_Sym_Val (Pt.Eq_Tokenvalue);
exit Scan_For_Token;
-- Next_Char already updated
end case;
when '>' =>
Initialize_Cst;
Get_Next_Char;
case Next_Char is
when '=' =>
Set_Cst_Gram_Sym_Val (Pt.Gteq_Tokenvalue);
Exit_After_Get_Next_Char := True;
when '>' =>
Set_Cst_Gram_Sym_Val (Pd.
Endlabel_Tokenvalue);
Exit_After_Get_Next_Char := True;
when others =>
Set_Cst_Gram_Sym_Val (Pt.Gt_Tokenvalue);
exit Scan_For_Token;
-- Next_Char already updated
end case;
when Ascii.Bar |
-- '|'
Ascii.Exclam =>
-- '!'
-- vertical bar and its alternative
Initialize_Cst;
Set_Cst_Gram_Sym_Val (Pt.Bar_Tokenvalue);
Exit_After_Get_Next_Char := True;
when Ascii.Ht =>
-- Horizontal Tab
-- a lexical unit separator - skip it.
-- position Current_Column properly. This is done
-- here to save the cost of a test on every
-- character in Get_Next_Char.
Current_Column := Hd.Findtabcolumn (Current_Column);
when ' ' | End_Of_Line_Character =>
-- rest of the lexical unit separators
if (End_Of_File_Reached) then
return End_Of_File_Token;
end if;
when Ascii.Underline =>
-- '_'
case Look_Ahead (1) is
when Upper_Case_Letter | Lower_Case_Letter =>
-- flag illegal leading under line
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Leading_Underline);
Initialize_Cst;
Scan_Identifier_Including_Rw;
exit Scan_For_Token;
-- Next_Char already updated
when Digit =>
-- flag illegal leading under line
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Leading_Underline);
Initialize_Cst;
Scan_Numeric_Literal;
exit Scan_For_Token;
-- Next_Char already updated
when others =>
-- flag illegal character for start
-- of token
Lem.Output_Message
(Current_Line, Current_Column, "_",
Lem.Character_Can_Not_Start_Token);
end case;
when Ascii.Sharp |
-- '#'
Ascii.Dollar |
-- '$'
Ascii.Query |
-- '?'
Ascii.At_Sign |
-- '@'
Ascii.L_Bracket |
-- '['
Ascii.Back_Slash |
-- '\'
Ascii.R_Bracket |
-- ']'
Ascii.Circumflex |
-- '^'
Ascii.Grave |
-- '`'
Ascii.L_Brace |
-- '{'
Ascii.R_Brace |
-- '}'
Ascii.Tilde =>
-- '~'
-- flag illegal character for start of token
Lem.Output_Message
(Current_Line, Current_Column, Next_Char & ""
-- convert to string
, Lem.Character_Can_Not_Start_Token);
when Ascii.Nul ..
-- Null to
Ascii.Bs |
-- Back Space
Ascii.So ..
-- Shift Out to
Ascii.Us |
-- Unit Separator
Ascii.Del =>
-- Delete
-- flag as non-graphic ASCII control character
Lem.Output_Message
(Current_Line, Current_Column,
Integer'Image (Character'Pos (Next_Char))
-- convert to string
, Lem.Character_Is_Non_Graphic);
when others =>
-- should never happen due to 's
-- definition of CHARACTER. flag as illegal anyhow
Lem.Output_Message (Current_Line, Current_Column,
Lem.Character_Is_Non_Ascii);
end case;
Get_Next_Char;
-- for next time through loop.
if (Exit_After_Get_Next_Char) then
Exit_After_Get_Next_Char := False;
exit Scan_For_Token;
end if;
end loop Scan_For_Token;
-- Next_Char already updated
Previous_Token_Value := Cst.Gram_Sym_Val;
-- for resolving T'('c')
end if;
-- (End_Of_File_Reached)
return Cst;
-- On leaving: object Next_Char should contain character
-- to scan on next call of this function.
end Getnextsourcetoken;
------------------------------------------------------------------
-- Subprogram Bodies Local to Package Lex
------------------------------------------------------------------
procedure Get_Next_Char is
begin
--| Algorithm
--|
--| Source File is scanned returning each character until the
--| end of the file is found. Proper column positioning for a tab
--| character is done in GetNextSourceToken for speed.
--|
-- The End_Of_Line_Character that Get_Next_Line
-- inserts needs to be seen by the scanning
-- case statements to terminate tokens correctly.
Current_Column := Current_Column + 1;
Line_Buffer_Index := Line_Buffer_Index + 1;
Next_Char := Line_Buffer (Line_Buffer_Index);
if (Line_Buffer_Index > Line_Buffer_Last) then
Get_Next_Line;
-- Current_Column and Line_Buffer_Index are handled there.
Next_Char := Line_Buffer (Line_Buffer_Index);
end if;
end Get_Next_Char; -- procedure
------------------------------------------------------------------
procedure Get_Next_Line is
begin
-- Get next source line from CURRENT_INPUT. Update column and
-- line counts
Current_Column := 1;
Line_Buffer_Index := 1;
Ignore_Null_Line:
loop
-- do NOT move next statement out of loop
if (Current_Line < Hd.Source_Line'Last) then
begin
-- block
Current_Line :=
Hd.Source_Line -- type conversion
(Text_Io.Line (File => Text_Io.Current_Input));
if (Current_Line >= Hd.Source_Line'Last) then
raise Constraint_Error;
end if;
exception
when others =>
Current_Line := Hd.Source_Line'Last;
Lem.Output_Message
(Current_Line, Current_Column,
Hd.Source_Line'Image (Hd.Source_Line'Last),
Lem.Source_Line_Maximum_Exceeded);
end; -- block
end if;
Text_Io.Get_Line (File => Text_Io.Current_Input,
Item => Line_Buffer
(1 .. (Line_Buffer'Last - 1)),
Last => Line_Buffer_Last);
-- flag a line that is too long as an error
if (Line_Buffer_Last >= Line_Buffer'Last - 1) and then
(Text_Io.End_Of_Line (File => Text_Io.Current_Input)) then
Lem.Output_Message (Current_Line, Current_Column,
Lem.Source_Line_Too_Long);
end if;
exit Ignore_Null_Line when
(Line_Buffer_Last /= (Line_Buffer'First - 1));
end loop Ignore_Null_Line;
Line_Buffer_Last := Line_Buffer_Last + 1;
Line_Buffer (Line_Buffer_Last) := End_Of_Line_Buffer;
exception
-- when end of file is reached
when Text_Io.End_Error =>
-- save that state for GetNextSourceToken
End_Of_File_Reached := True;
-- update column and line counts
Line_Buffer_Last := 1;
Line_Buffer (Line_Buffer_Last) := End_Of_Line_Buffer;
Line_Buffer_Index := 1;
Current_Column := 1;
-- Current_Line is ok.
-- Last call to GET_LINE advanced it one.
-- set the value of End_Of_File_Token
-- the discriminants were set up by the object declaration
End_Of_File_Token.Gram_Sym_Val := Pt.Eof_Tokenvalue;
End_Of_File_Token.Lexed_Token := (Srcpos_Line => Current_Line,
Srcpos_Column => Current_Column,
Text => Pd.Null_Source_Text);
end Get_Next_Line;
------------------------------------------------------------------
function Look_Ahead
(In_Columns_Ahead : in Hd.Source_Column) return Character is
------------------------------------------------------------------
-- Declarations for subprogram Look_Ahead
------------------------------------------------------------------
Position_To_Try : Integer := Integer
--type conversion
(Line_Buffer_Index + In_Columns_Ahead);
------------------------------------------------------------------
begin
-- if request is past the end of line
if (Position_To_Try > Integer (Line_Buffer_Last)) then
-- type conversion
-- return the end_of_line character
return End_Of_Line_Buffer;
else
-- else return the requested character
return Line_Buffer (Position_To_Try);
end if;
end Look_Ahead;
-- function
------------------------------------------------------------------
procedure Set_Cst_Gram_Sym_Val (In_Token_Value : in Pt.Tokenrange) is
begin
Cst.Gram_Sym_Val := In_Token_Value;
end Set_Cst_Gram_Sym_Val;
----------------------------------------------------------------------
procedure Set_Cst_Source_Rep (In_String : in String) is
begin
-- store the representation
Pd.Put_Source_Text (In_String, Cst.Lexed_Token.Text);
end Set_Cst_Source_Rep;
------------------------------------------------------------------
procedure Initialize_Cst is
begin
-- Set up discriminants, and source position properly
-- Set other CST fields to null values
Cst := Cst_Initializer;
Cst.Lexed_Token := (Srcpos_Line => Current_Line,
Srcpos_Column => Current_Column,
Text => Pd.Null_Source_Text);
end Initialize_Cst;
------------------------------------------------------------------
procedure Add_Next_Char_To_Source_Rep is
begin
-- append the character to growing source representation
Work_String_Length := Work_String_Length + 1;
Work_String (Work_String_Length) := Next_Char;
end Add_Next_Char_To_Source_Rep;
------------------------------------------------------------------
procedure Check_For_Consecutive_Underlines is
begin
-- flag consecutive underlines as an error (leading
-- underlines are handled in GetNextSourceToken).
if (Work_String (Work_String_Length) = Ascii.Underline) then
Lem.Output_Message (Current_Line, Current_Column,
Lem.Consecutive_Underlines);
end if;
end Check_For_Consecutive_Underlines;
-- procedure
------------------------------------------------------------------
procedure Check_For_Terminal_Underline is
begin
-- flag a trailing underline as an error.
-- trailing underlines are saved for the same
-- reason as leading ones.
-- See comment in GetNextSourceToken.
if (Work_String (Work_String_Length) = Ascii.Underline)
-- check the preceeding character
then
Lem.Output_Message (Current_Line, Current_Column,
Lem.Terminal_Underline);
end if;
end Check_For_Terminal_Underline;
------------------------------------------------------------------
procedure Scan_Comment is
--| Overview
--|
--| Note the following LRM Sections:
--| LRM Section 2.7 - Comments
--| LRM Section 2.7 - Note
--|
begin
-- get to the beginning of the comment
Get_Next_Char;
Set_Cst_Source_Rep (Line_Buffer
(Line_Buffer_Index .. Line_Buffer_Last - 1));
-- subtract 1 so that the carridge return is not also returned.
Line_Buffer_Index := Line_Buffer_Last + 1;
-- force next call to Get_Next_Char to call Get_Next_Line
end Scan_Comment;
------------------------------------------------------------------
procedure Scan_Identifier_Including_Rw is
--| Overview
--|
--| Note the following LRM Sections:
--| LRM Section 2.3 - Identifiers
--| LRM Section 2.3 - Note
--| LRM Section 2.9 - Reserved Words
--| LRM Section 2.9 - Notes
--|
------------------------------------------------------------------
begin
Work_String_Length := 0;
-- scan source file for rest of token
-- note that first character of the token is stored first
Scan_For_Identifier_Including_Rw:
loop
Add_Next_Char_To_Source_Rep;
-- set up for processing next characte
Get_Next_Char;
case Next_Char is
when Upper_Case_Letter | Lower_Case_Letter | Digit =>
-- action is at start of next loop cycle
null;
when Ascii.Underline =>
-- '_'
Check_For_Consecutive_Underlines;
when others =>
Check_For_Terminal_Underline;
-- token is terminated by any character except letter
-- digit, or underline;
exit Scan_For_Identifier_Including_Rw; -- this loop
end case;
end loop Scan_For_Identifier_Including_Rw;
-- find out what kind of token it is
Lex_Identifier_Token_Value.Find
(In_Identifier => Work_String (1 .. Work_String_Length),
Out_Token_Value => Cst.Gram_Sym_Val);
-- store the source representation of the token found
Set_Cst_Source_Rep (Work_String (1 .. Work_String_Length));
end Scan_Identifier_Including_Rw;
------------------------------------------------------------------
procedure Scan_Exponent is
--| Overview
--|
--| Note the following LRM Sections:
--| LRM Section 2.4.1 - Decimal Literals
--| LRM Section 2.4.1 - Notes
--| LRM Section 2.4.2 - Based Literals
--|
begin
-- Check for missing 'E' or 'e',
-- and for existence of the exponent
case Next_Char is
when 'E' | 'e' =>
null; -- normal case
when others =>
return; -- no exponent to process
end case;
-- add first character to growing literal
Add_Next_Char_To_Source_Rep;
-- scan source file for rest of the exponent
-- verify that next character is legal for an integer field
Get_Next_Char;
case Next_Char is
when '+' =>
-- add sign character to growing literal
Add_Next_Char_To_Source_Rep;
Get_Next_Char;
when '-' =>
-- Minus_Sign
if not (Seen_Radix_Point) then
-- flag negative exponent as illegal in an integer
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Negative_Exponent_Illegal_In_Integer);
end if;
-- add sign character to growing literal
Add_Next_Char_To_Source_Rep;
Get_Next_Char;
when others =>
null;
end case;
case Next_Char is
when Digit =>
-- scan the integer field of the exponent
Scan_Integer;
when Ascii.Underline =>
-- '_'
if (Look_Ahead (1) in Digit) then
-- flag illegal leading under line
Lem.Output_Message (Current_Line, Current_Column,
Lem.Leading_Underline);
-- scan the integer field of the exponent
Scan_Integer;
else
-- issue error message that integer field is missing
Lem.Output_Message (Current_Line, Current_Column,
Lem.Exponent_Missing_Integer_Field);
end if;
when others =>
-- issue an error message that integer field is missing
Lem.Output_Message (Current_Line, Current_Column,
Lem.Exponent_Missing_Integer_Field);
end case;
end Scan_Exponent;
------------------------------------------------------------------
procedure Scan_Based_Integer (In_Base_To_Use : in Valid_Base_Range) is
--| Overview
--|
--| Note the following LRM Sections:
--| LRM Section 2.4 - Numeric Literals
--| LRM Section 2.4.2 - Based Literals
--|
------------------------------------------------------------------
-- Declarations for Procedure Scan_Based_Integer
------------------------------------------------------------------
Bad : constant Gc.Parserinteger := Gc.Parserinteger'Last;
--| an integer value greater than 15 to use as a flag to indicate
--| illegal values.
Transform : constant array (Character) of Gc.Parserinteger :=
-------- ( nul, soh, stx, etx, eot, enq, ack, bel,
(Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad,
-------- bs, ht, lf, vt, ff, cr, so, si,
Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad,
-------- dle, dc1, dc2, dc3, dc4, nak, syn, etb,
Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad,
-------- can, em, sub, esc, fs, gs, rs, us,
Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad,
-------- ' ', '!', '"', '#', '$', '%', '&', ''',
Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad,
-------- '(', ')', '*', '+', ',', '-', '.', '/',
Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad,
-------- '0', '1', '2', '3', '4', '5', '6', '7',
0, 1, 2, 3, 4, 5, 6, 7,
-------- '8', '9', ':', ';', '<', '=', '>', '?',
8, 9, Bad, Bad, Bad, Bad, Bad, Bad,
-------- '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
Bad, 10, 11, 12, 13, 14, 15, Bad,
-------- 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad,
-------- 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad,
-------- 'X', 'Y', 'Z', '[', '\', ']', '^', '_',
Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad,
-------- '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g',
Bad, 10, 11, 12, 13, 14, 15, Bad,
-------- 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad,
-------- 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad,
-------- 'x', 'y', 'z', '{', '|', '}', '~', del);
Bad, Bad, Bad, Bad, Bad, Bad, Bad, Bad);
--| used to transform a character value to an integer value for
--| purpose of checking that a digit is within the legal range
--| for the base passed in via In_Base_To_Use.
------------------------------------------------------------------
begin
-- check that first character, if not an under line,
-- is a valid digit for base being used.
if (Next_Char /= Ascii.Underline) and then
(Transform (Next_Char) >= In_Base_To_Use) then
-- flag digit as invalid for base
Lem.Output_Message (Current_Line, Current_Column, Next_Char & ""
-- convert to string
, Lem.Digit_Invalid_For_Base);
end if;
-- scan source file for rest of the field
-- note that first character of the field is stored first
Scan_For_Based_Integer:
loop
Add_Next_Char_To_Source_Rep;
-- set up for processing next character
Get_Next_Char;
case Next_Char is
when 'A' .. 'F' | 'a' .. 'f' | Digit =>
-- check if Next_Char is in valid base range
if (Transform (Next_Char) >= In_Base_To_Use) then
-- flag digit as invalid for base
Lem.Output_Message
(Current_Line, Current_Column, Next_Char & ""
-- convert to string
, Lem.Digit_Invalid_For_Base);
end if;
-- rest of action is at start of next loop cycle
when Ascii.Underline =>
-- '_'
Check_For_Consecutive_Underlines;
when others =>
Check_For_Terminal_Underline;
-- field is terminated by any character except
-- extended digit (letters a to f and digits),
-- or underline
exit Scan_For_Based_Integer; -- this loop
end case;
end loop Scan_For_Based_Integer;
-- Next_Char already updated
end Scan_Based_Integer;
------------------------------------------------------------------
procedure Scan_Integer is
--| Overview
--|
--| Note the following LRM Sections:
--| LRM Section 2.4 - Numeric Literals
--| LRM Section 2.4.1 - Decimal Literals
--| LRM Section 2.4.1 - Notes
--|
begin
-- scan source file for rest of the field
-- note that first character of the field is stored first
Scan_For_Integer:
loop
Add_Next_Char_To_Source_Rep;
-- set up for processing next character
Get_Next_Char;
case Next_Char is
when Digit =>
-- rest of action is at start of next loop cycle
null;
when Ascii.Underline =>
-- '_'
Check_For_Consecutive_Underlines;
when others =>
Check_For_Terminal_Underline;
-- field is terminated by any character except
-- digit, or underline
exit Scan_For_Integer; -- this loop
end case;
end loop Scan_For_Integer; -- Next_Char already updated
end Scan_Integer;
------------------------------------------------------------------
procedure Scan_Numeric_Literal is
--| Overview
--|
--| Note the following LRM Sections:
--| LRM Section 2.4 - Numeric Literals
--| LRM Section 2.4.1 - Decimal Literals
--| LRM Section 2.4.1 - Notes
--| LRM Section 2.4.2 - Based Literals
--| LRM Section 2.10 - Allowed Replacements of Characters
--|
------------------------------------------------------------------
-- Declarations for Scan_Numeric_Literal
------------------------------------------------------------------
Based_Literal_Delimiter : Character;
--| holds value of first based_literal delimeter:
--| ASCII.COLON (':') or ASCII.SHARP ('#');
--| so the second one can be checked to be identical.
Base_Being_Used : Gc.Parserinteger;
--| base value to be passed to Scan_Based_Literal.
------------------------------------------------------------------
begin
Cst.Gram_Sym_Val := Pt.Numerictokenvalue;
Work_String_Length := 0;
-- also used by sub-scanners called from this subprogram.
-- Scan first field
Scan_Integer;
-- Now, scan rest of literal dependent on what Next_char is
case Next_Char is
-- have a decimal_literal
when '.' =>
if (Look_Ahead (1) = '.') then
-- next token is a range double delimiter.
-- finished with numeric_literal.
Seen_Radix_Point := False; -- have an integer_literal
-- already set_up for next scanner,
-- no call to Get_Next_Char.
else
Seen_Radix_Point := True;
Add_Next_Char_To_Source_Rep;
Get_Next_Char;
case Next_Char is
when Digit =>
Scan_Integer;
-- check and flag multiple radix points
while (Next_Char = '.') and then
(Look_Ahead (1) in Digit) loop
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Too_Many_Radix_Points);
Add_Next_Char_To_Source_Rep;
Get_Next_Char;
Scan_Integer;
end loop;
when Ascii.Underline =>
-- '_'
-- flag illegal leading under line
Lem.Output_Message (Current_Line, Current_Column,
Lem.Leading_Underline);
Scan_Integer;
-- not flagging an integer consisting of a
-- single underline as a trailing radix
-- point case. Check and flag multiple radix
-- points.
while (Next_Char = '.') and then
(Look_Ahead (1) in Digit) loop
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Too_Many_Radix_Points);
Add_Next_Char_To_Source_Rep;
Get_Next_Char;
Scan_Integer;
end loop;
when others =>
-- flag trailing radix point as an error
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Digit_Needed_After_Radix_Point);
end case;
Scan_Exponent; -- check for and process exponent
end if;
-- have a based_literal
when Ascii.Sharp | -- '#'
Ascii.Colon =>
-- ':'
Based_Literal_Delimiter := Next_Char;
Base_Being_Used := Gc.Parserinteger'Value
(Work_String (1 .. Work_String_Length));
if (Base_Being_Used not in Valid_Base_Range) then
-- flag illegal bases as errors
Lem.Output_Message (Current_Line, Current_Column,
Work_String (1 .. Work_String_Length),
Lem.Base_Out_Of_Legal_Range_Use_16);
Base_Being_Used := 16;
-- we use the maximum base to pass all the
-- extended_digits as legal.
end if;
Add_Next_Char_To_Source_Rep; -- save the base delimiter
Get_Next_Char;
case Next_Char is
when 'A' .. 'F' | 'a' .. 'f' | Digit =>
Scan_Based_Integer (Base_Being_Used);
when Ascii.Underline =>
-- '_'
-- flag illegal leading under line
Lem.Output_Message (Current_Line, Current_Column,
Lem.Leading_Underline);
-- not flagging an integer consisting of a single
-- under line as a trailing radix point case.
Scan_Based_Integer (Base_Being_Used);
when '.' =>
-- flag leading radix point as an error
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Digit_Needed_Before_Radix_Point);
when Ascii.Sharp | -- '#'
Ascii.Colon =>
-- ':'
-- flag missing field as an error
Lem.Output_Message (Current_Line, Current_Column,
Lem.No_Integer_In_Based_Number);
-- based_literal_delimiter_mismatch handled in
-- next case statement.
when others =>
-- flag missing field as an error
Lem.Output_Message (Current_Line, Current_Column,
Lem.No_Integer_In_Based_Number);
end case;
case Next_Char is
when '.' =>
Seen_Radix_Point := True; -- have a real_literal
Add_Next_Char_To_Source_Rep;
Get_Next_Char;
case Next_Char is
when 'A' .. 'F' | 'a' .. 'f' | Digit =>
Scan_Based_Integer (Base_Being_Used);
-- check and flag multiple radix points
while (Next_Char = '.') and then
((Look_Ahead (1) in Digit) or
(Look_Ahead (1) in 'A' .. 'F') or
(Look_Ahead (1) in 'a' .. 'f')) loop
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Too_Many_Radix_Points);
Add_Next_Char_To_Source_Rep;
Get_Next_Char;
Scan_Based_Integer (Base_Being_Used);
end loop;
when Ascii.Underline =>
-- '_'
-- flag illegal leading under lined
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Leading_Underline);
-- not flagging an integer consisting of
-- a single underline as a trailing
-- radix point case.
Scan_Based_Integer (Base_Being_Used);
when others =>
-- flag trailing radix point as an error
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Digit_Needed_After_Radix_Point);
end case;
case Next_Char is
when Ascii.Sharp | -- '#'
Ascii.Colon =>
-- ':'
Add_Next_Char_To_Source_Rep;
-- save the base delimiter
if (Next_Char /= Based_Literal_Delimiter) then
-- flag based_literal delimiter
-- mismatch as an error
Lem.Output_Message
(Current_Line, Current_Column,
"Opener: " & Based_Literal_Delimiter &
" Closer: " & Next_Char,
Lem.Based_Literal_Delimiter_Mismatch);
end if;
Get_Next_Char; -- after base delimiter
-- check for and process exponent
Scan_Exponent;
when others =>
-- flag missing second
-- based_literal delimiter as an error
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Missing_Second_Based_Literal_Delimiter);
end case;
when Ascii.Sharp | -- '#'
Ascii.Colon =>
-- ':'
-- have an integer_literal
Seen_Radix_Point := False;
-- save the base delimiter
Add_Next_Char_To_Source_Rep;
if (Next_Char /= Based_Literal_Delimiter) then
-- flag based_literal delimiter mismatch error
Lem.Output_Message
(Current_Line, Current_Column,
"Opener: " & Based_Literal_Delimiter &
" Closer: " & Next_Char,
Lem.Based_Literal_Delimiter_Mismatch);
end if;
Get_Next_Char; -- get character after base delimiter
Scan_Exponent; -- check for and process exponent
when others =>
-- assume an integer_literal
Seen_Radix_Point := False;
-- flag missing second
-- based_literal delimiter as an error
Lem.Output_Message
(Current_Line, Current_Column,
Lem.Missing_Second_Based_Literal_Delimiter);
end case;
--we have an integer_literal
when others =>
Seen_Radix_Point := False; -- have an integer_literal
Scan_Exponent; -- check for and process exponent
end case;
-- one last error check
if (Next_Char in Upper_Case_Letter) or
(Next_Char in Lower_Case_Letter) then
-- flag missing space between numeric_literal and
-- identifier (including RW) as an error.
Lem.Output_Message (Current_Line, Current_Column,
Lem.Space_Must_Separate_Num_And_Ids);
end if;
-- now store the source representation of the token found.
Set_Cst_Source_Rep (Work_String (1 .. Work_String_Length));
end Scan_Numeric_Literal;
------------------------------------------------------------------
procedure Scan_String_Literal is
--| Overview
--|
--| Note the following LRM Sections:
--| LRM Section 2.6 - String Literals
--| LRM Section 2.6 - Note
--| LRM Section 2.10 - Allowed Replacements of Characters
--|
String_Delimiter : Character := Next_Char;
begin
Work_String_Length := 0;
Cst.Gram_Sym_Val := Pt.Stringtokenvalue;
-- scan until matching string delimiter or end of line is found
Scan_For_String:
loop
Get_Next_Char;
if (Next_Char = String_Delimiter) then
Get_Next_Char;
if (Next_Char = String_Delimiter) then
-- add one string delimiter to growing string
Add_Next_Char_To_Source_Rep;
else
-- string is ended
exit Scan_For_String;
end if;
elsif (Next_Char in Graphic_Character) then
-- add graphic character to growing string
Add_Next_Char_To_Source_Rep;
elsif (Next_Char in End_Of_Line_Character) then
-- string is ended. flag the error.
Lem.Output_Message (Current_Line, Current_Column,
Lem.No_Ending_String_Delimiter);
exit Scan_For_String;
else
-- flag non-graphic characters as errors
Lem.Output_Message
(Current_Line, Current_Column,
Integer'Image (Character'Pos (Next_Char))
-- convert to string
, Lem.Only_Graphic_Characters_In_Strings);
end if;
end loop Scan_For_String; -- Next_Char already updated
-- now store the source representation found without the
-- string delimiters
Set_Cst_Source_Rep (Work_String (1 .. Work_String_Length));
return;
end Scan_String_Literal;
------------------------------------------------------------------
function Show_Current_Line return Hd.Source_Line is
--| Overview
--| Return current line number
begin
return Current_Line;
end Show_Current_Line;
end Lex;