blob: 241c3cca4a56dc037292fb2b61a3cecfa5ccaa0c [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P R E P --
-- --
-- B o d y --
-- --
-- Copyright (C) 2002-2018, 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 3, 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 COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Csets; use Csets;
with Err_Vars; use Err_Vars;
with Opt; use Opt;
with Osint; use Osint;
with Output; use Output;
with Scans; use Scans;
with Snames; use Snames;
with Sinput;
with Stringt; use Stringt;
with Table;
with Uintp; use Uintp;
with GNAT.Heap_Sort_G;
package body Prep is
use Symbol_Table;
type Token_Name_Array is array (Token_Type) of Name_Id;
Token_Names : constant Token_Name_Array :=
(Tok_Abort => Name_Abort,
Tok_Abs => Name_Abs,
Tok_Abstract => Name_Abstract,
Tok_Accept => Name_Accept,
Tok_Aliased => Name_Aliased,
Tok_All => Name_All,
Tok_Array => Name_Array,
Tok_And => Name_And,
Tok_At => Name_At,
Tok_Begin => Name_Begin,
Tok_Body => Name_Body,
Tok_Case => Name_Case,
Tok_Constant => Name_Constant,
Tok_Declare => Name_Declare,
Tok_Delay => Name_Delay,
Tok_Delta => Name_Delta,
Tok_Digits => Name_Digits,
Tok_Else => Name_Else,
Tok_Elsif => Name_Elsif,
Tok_End => Name_End,
Tok_Entry => Name_Entry,
Tok_Exception => Name_Exception,
Tok_Exit => Name_Exit,
Tok_For => Name_For,
Tok_Function => Name_Function,
Tok_Generic => Name_Generic,
Tok_Goto => Name_Goto,
Tok_If => Name_If,
Tok_Is => Name_Is,
Tok_Limited => Name_Limited,
Tok_Loop => Name_Loop,
Tok_Mod => Name_Mod,
Tok_New => Name_New,
Tok_Null => Name_Null,
Tok_Of => Name_Of,
Tok_Or => Name_Or,
Tok_Others => Name_Others,
Tok_Out => Name_Out,
Tok_Package => Name_Package,
Tok_Pragma => Name_Pragma,
Tok_Private => Name_Private,
Tok_Procedure => Name_Procedure,
Tok_Protected => Name_Protected,
Tok_Raise => Name_Raise,
Tok_Range => Name_Range,
Tok_Record => Name_Record,
Tok_Rem => Name_Rem,
Tok_Renames => Name_Renames,
Tok_Requeue => Name_Requeue,
Tok_Return => Name_Return,
Tok_Reverse => Name_Reverse,
Tok_Select => Name_Select,
Tok_Separate => Name_Separate,
Tok_Subtype => Name_Subtype,
Tok_Tagged => Name_Tagged,
Tok_Task => Name_Task,
Tok_Terminate => Name_Terminate,
Tok_Then => Name_Then,
Tok_Type => Name_Type,
Tok_Until => Name_Until,
Tok_Use => Name_Use,
Tok_When => Name_When,
Tok_While => Name_While,
Tok_With => Name_With,
Tok_Xor => Name_Xor,
others => No_Name);
Already_Initialized : Boolean := False;
-- Used to avoid repetition of the part of the initialisation that needs
-- to be done only once.
Empty_String : String_Id;
-- "", as a string_id
String_False : String_Id;
-- "false", as a string_id
--------------
-- Behavior --
--------------
-- Accesses to procedure specified by procedure Initialize
Error_Msg : Error_Msg_Proc;
-- Report an error
Scan : Scan_Proc;
-- Scan one token
Set_Ignore_Errors : Set_Ignore_Errors_Proc;
-- Indicate if error should be taken into account
Put_Char : Put_Char_Proc;
-- Output one character
New_EOL : New_EOL_Proc;
-- Output an end of line indication
-------------------------------
-- State of the Preprocessor --
-------------------------------
type Pp_State is record
If_Ptr : Source_Ptr;
-- The location of the #if statement (used to flag #if with no
-- corresponding #end if, at the end).
Else_Ptr : Source_Ptr;
-- The location of the #else statement (used to detect multiple #else's)
Deleting : Boolean;
-- Set to True when the code should be deleted or commented out
Match_Seen : Boolean;
-- Set to True when a condition in an #if or an #elsif is True. Also set
-- to True if Deleting at the previous level is True. Used to decide if
-- Deleting should be set to True in a following #elsif or #else.
end record;
type Pp_Depth is new Nat;
Ground : constant Pp_Depth := 0;
package Pp_States is new Table.Table
(Table_Component_Type => Pp_State,
Table_Index_Type => Pp_Depth,
Table_Low_Bound => 1,
Table_Initial => 10,
Table_Increment => 100,
Table_Name => "Prep.Pp_States");
-- A stack of the states of the preprocessor, for nested #if
type Operator is (None, Op_Or, Op_And);
-----------------
-- Subprograms --
-----------------
function Deleting return Boolean;
-- Return True if code should be deleted or commented out
function Expression
(Evaluate_It : Boolean;
Complemented : Boolean := False) return Boolean;
-- Evaluate a condition in an #if or an #elsif statement. If Evaluate_It
-- is False, the condition is effectively evaluated, otherwise, only the
-- syntax is checked.
procedure Go_To_End_Of_Line;
-- Advance the scan pointer until we reach an end of line or the end of the
-- buffer.
function Matching_Strings (S1, S2 : String_Id) return Boolean;
-- Returns True if the two string parameters are equal (case insensitive)
---------------------------------------
-- Change_Reserved_Keyword_To_Symbol --
---------------------------------------
procedure Change_Reserved_Keyword_To_Symbol
(All_Keywords : Boolean := False)
is
New_Name : constant Name_Id := Token_Names (Token);
begin
if New_Name /= No_Name then
case Token is
when Tok_And
| Tok_Else
| Tok_Elsif
| Tok_End
| Tok_If
| Tok_Or
| Tok_Then
=>
if All_Keywords then
Token := Tok_Identifier;
Token_Name := New_Name;
end if;
when others =>
Token := Tok_Identifier;
Token_Name := New_Name;
end case;
end if;
end Change_Reserved_Keyword_To_Symbol;
------------------------------------------
-- Check_Command_Line_Symbol_Definition --
------------------------------------------
procedure Check_Command_Line_Symbol_Definition
(Definition : String;
Data : out Symbol_Data)
is
Index : Natural := 0;
Result : Symbol_Data;
begin
-- Look for the character '='
for J in Definition'Range loop
if Definition (J) = '=' then
Index := J;
exit;
end if;
end loop;
-- If no character '=', then the value is True
if Index = 0 then
-- Put the symbol in the name buffer
Name_Len := Definition'Length;
Name_Buffer (1 .. Name_Len) := Definition;
Result := True_Value;
elsif Index = Definition'First then
Fail ("invalid symbol definition """ & Definition & """");
else
-- Put the symbol in the name buffer
Name_Len := Index - Definition'First;
Name_Buffer (1 .. Name_Len) :=
String'(Definition (Definition'First .. Index - 1));
-- Check the syntax of the value
if Definition (Index + 1) /= '"'
or else Definition (Definition'Last) /= '"'
then
for J in Index + 1 .. Definition'Last loop
case Definition (J) is
when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
null;
when others =>
Fail ("illegal value """
& Definition (Index + 1 .. Definition'Last)
& """");
end case;
end loop;
end if;
-- Even if the value is a string, we still set Is_A_String to False,
-- to avoid adding additional quotes in the preprocessed sources when
-- replacing $<symbol>.
Result.Is_A_String := False;
-- Put the value in the result
Start_String;
Store_String_Chars (Definition (Index + 1 .. Definition'Last));
Result.Value := End_String;
end if;
-- Now, check the syntax of the symbol (we don't allow accented or
-- wide characters).
if Name_Buffer (1) not in 'a' .. 'z'
and then Name_Buffer (1) not in 'A' .. 'Z'
then
Fail ("symbol """
& Name_Buffer (1 .. Name_Len)
& """ does not start with a letter");
end if;
for J in 2 .. Name_Len loop
case Name_Buffer (J) is
when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' =>
null;
when '_' =>
if J = Name_Len then
Fail ("symbol """
& Name_Buffer (1 .. Name_Len)
& """ end with a '_'");
elsif Name_Buffer (J + 1) = '_' then
Fail ("symbol """
& Name_Buffer (1 .. Name_Len)
& """ contains consecutive '_'");
end if;
when others =>
Fail ("symbol """
& Name_Buffer (1 .. Name_Len)
& """ contains illegal character(s)");
end case;
end loop;
Result.On_The_Command_Line := True;
-- Put the symbol name in the result
declare
Sym : constant String := Name_Buffer (1 .. Name_Len);
begin
for Index in 1 .. Name_Len loop
Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
end loop;
Result.Symbol := Name_Find;
Name_Len := Sym'Length;
Name_Buffer (1 .. Name_Len) := Sym;
Result.Original := Name_Find;
end;
Data := Result;
end Check_Command_Line_Symbol_Definition;
--------------
-- Deleting --
--------------
function Deleting return Boolean is
begin
-- Always return False when not inside an #if statement
if Opt.No_Deletion or else Pp_States.Last = Ground then
return False;
else
return Pp_States.Table (Pp_States.Last).Deleting;
end if;
end Deleting;
----------------
-- Expression --
----------------
function Expression
(Evaluate_It : Boolean;
Complemented : Boolean := False) return Boolean
is
Evaluation : Boolean := Evaluate_It;
-- Is set to False after an "or else" when left term is True and after
-- an "and then" when left term is False.
Final_Result : Boolean := False;
Current_Result : Boolean := False;
-- Value of a term
Current_Operator : Operator := None;
Symbol1 : Symbol_Id;
Symbol2 : Symbol_Id;
Symbol_Name1 : Name_Id;
Symbol_Name2 : Name_Id;
Symbol_Pos1 : Source_Ptr;
Symbol_Pos2 : Source_Ptr;
Symbol_Value1 : String_Id;
Symbol_Value2 : String_Id;
Relop : Token_Type;
begin
-- Loop for each term
loop
Change_Reserved_Keyword_To_Symbol;
Current_Result := False;
-- Scan current term, starting with Token
case Token is
-- Handle parenthesized expression
when Tok_Left_Paren =>
Scan.all;
Current_Result := Expression (Evaluation);
if Token = Tok_Right_Paren then
Scan.all;
else
Error_Msg -- CODEFIX
("`)` expected", Token_Ptr);
end if;
-- Handle not expression
when Tok_Not =>
Scan.all;
Current_Result :=
not Expression (Evaluation, Complemented => True);
-- Handle sequence starting with identifier
when Tok_Identifier =>
Symbol_Name1 := Token_Name;
Symbol_Pos1 := Token_Ptr;
Scan.all;
if Token = Tok_Apostrophe then
-- symbol'Defined
Scan.all;
if Token = Tok_Identifier
and then Token_Name = Name_Defined
then
Scan.all;
else
Error_Msg ("identifier `Defined` expected", Token_Ptr);
end if;
if Evaluation then
Current_Result := Index_Of (Symbol_Name1) /= No_Symbol;
end if;
-- Handle relational operator
elsif Token = Tok_Equal
or else Token = Tok_Less
or else Token = Tok_Less_Equal
or else Token = Tok_Greater
or else Token = Tok_Greater_Equal
then
Relop := Token;
Scan.all;
Change_Reserved_Keyword_To_Symbol;
if Token = Tok_Integer_Literal then
-- symbol = integer
-- symbol < integer
-- symbol <= integer
-- symbol > integer
-- symbol >= integer
declare
Value : constant Int := UI_To_Int (Int_Literal_Value);
Data : Symbol_Data;
Symbol_Value : Int;
-- Value of symbol as Int
begin
if Evaluation then
Symbol1 := Index_Of (Symbol_Name1);
if Symbol1 = No_Symbol then
Error_Msg_Name_1 := Symbol_Name1;
Error_Msg ("unknown symbol %", Symbol_Pos1);
Symbol_Value1 := No_String;
else
Data := Mapping.Table (Symbol1);
if Data.Is_A_String then
Error_Msg_Name_1 := Symbol_Name1;
Error_Msg
("symbol % value is not integer",
Symbol_Pos1);
else
begin
String_To_Name_Buffer (Data.Value);
Symbol_Value :=
Int'Value (Name_Buffer (1 .. Name_Len));
case Relop is
when Tok_Equal =>
Current_Result :=
Symbol_Value = Value;
when Tok_Less =>
Current_Result :=
Symbol_Value < Value;
when Tok_Less_Equal =>
Current_Result :=
Symbol_Value <= Value;
when Tok_Greater =>
Current_Result :=
Symbol_Value > Value;
when Tok_Greater_Equal =>
Current_Result :=
Symbol_Value >= Value;
when others =>
null;
end case;
exception
when Constraint_Error =>
Error_Msg_Name_1 := Symbol_Name1;
Error_Msg
("symbol % value is not an integer",
Symbol_Pos1);
end;
end if;
end if;
end if;
Scan.all;
end;
-- Error if relational operator other than = if not numbers
elsif Relop /= Tok_Equal then
Error_Msg ("number expected", Token_Ptr);
-- Equality comparison of two strings
elsif Token = Tok_Identifier then
-- symbol = symbol
Symbol_Name2 := Token_Name;
Symbol_Pos2 := Token_Ptr;
Scan.all;
if Evaluation then
Symbol1 := Index_Of (Symbol_Name1);
if Symbol1 = No_Symbol then
if Undefined_Symbols_Are_False then
Symbol_Value1 := String_False;
else
Error_Msg_Name_1 := Symbol_Name1;
Error_Msg ("unknown symbol %", Symbol_Pos1);
Symbol_Value1 := No_String;
end if;
else
Symbol_Value1 :=
Mapping.Table (Symbol1).Value;
end if;
Symbol2 := Index_Of (Symbol_Name2);
if Symbol2 = No_Symbol then
if Undefined_Symbols_Are_False then
Symbol_Value2 := String_False;
else
Error_Msg_Name_1 := Symbol_Name2;
Error_Msg ("unknown symbol %", Symbol_Pos2);
Symbol_Value2 := No_String;
end if;
else
Symbol_Value2 := Mapping.Table (Symbol2).Value;
end if;
if Symbol_Value1 /= No_String
and then
Symbol_Value2 /= No_String
then
Current_Result :=
Matching_Strings (Symbol_Value1, Symbol_Value2);
end if;
end if;
elsif Token = Tok_String_Literal then
-- symbol = "value"
if Evaluation then
Symbol1 := Index_Of (Symbol_Name1);
if Symbol1 = No_Symbol then
if Undefined_Symbols_Are_False then
Symbol_Value1 := String_False;
else
Error_Msg_Name_1 := Symbol_Name1;
Error_Msg ("unknown symbol %", Symbol_Pos1);
Symbol_Value1 := No_String;
end if;
else
Symbol_Value1 := Mapping.Table (Symbol1).Value;
end if;
if Symbol_Value1 /= No_String then
Current_Result :=
Matching_Strings
(Symbol_Value1,
String_Literal_Id);
end if;
end if;
Scan.all;
else
Error_Msg
("literal integer, symbol or literal string expected",
Token_Ptr);
end if;
-- Handle True or False
else
if Evaluation then
Symbol1 := Index_Of (Symbol_Name1);
if Symbol1 = No_Symbol then
if Undefined_Symbols_Are_False then
Symbol_Value1 := String_False;
else
Error_Msg_Name_1 := Symbol_Name1;
Error_Msg ("unknown symbol %", Symbol_Pos1);
Symbol_Value1 := No_String;
end if;
else
Symbol_Value1 := Mapping.Table (Symbol1).Value;
end if;
if Symbol_Value1 /= No_String then
String_To_Name_Buffer (Symbol_Value1);
for Index in 1 .. Name_Len loop
Name_Buffer (Index) :=
Fold_Lower (Name_Buffer (Index));
end loop;
if Name_Buffer (1 .. Name_Len) = "true" then
Current_Result := True;
elsif Name_Buffer (1 .. Name_Len) = "false" then
Current_Result := False;
else
Error_Msg_Name_1 := Symbol_Name1;
Error_Msg
("value of symbol % is not True or False",
Symbol_Pos1);
end if;
end if;
end if;
end if;
-- Unrecognized sequence
when others =>
Error_Msg ("`(`, NOT or symbol expected", Token_Ptr);
end case;
-- Update the cumulative final result
case Current_Operator is
when None =>
Final_Result := Current_Result;
when Op_Or =>
Final_Result := Final_Result or Current_Result;
when Op_And =>
Final_Result := Final_Result and Current_Result;
end case;
-- Handle AND
if Token = Tok_And then
if Complemented then
Error_Msg
("mixing NOT and AND is not allowed, parentheses are required",
Token_Ptr);
elsif Current_Operator = Op_Or then
Error_Msg ("mixing OR and AND is not allowed", Token_Ptr);
end if;
Current_Operator := Op_And;
Scan.all;
if Token = Tok_Then then
Scan.all;
if Final_Result = False then
Evaluation := False;
end if;
end if;
-- Handle OR
elsif Token = Tok_Or then
if Complemented then
Error_Msg
("mixing NOT and OR is not allowed, parentheses are required",
Token_Ptr);
elsif Current_Operator = Op_And then
Error_Msg ("mixing AND and OR is not allowed", Token_Ptr);
end if;
Current_Operator := Op_Or;
Scan.all;
if Token = Tok_Else then
Scan.all;
if Final_Result then
Evaluation := False;
end if;
end if;
-- No AND/OR operator, so exit from the loop through terms
else
exit;
end if;
end loop;
return Final_Result;
end Expression;
-----------------------
-- Go_To_End_Of_Line --
-----------------------
procedure Go_To_End_Of_Line is
begin
-- Scan until we get an end of line or we reach the end of the buffer
while Token /= Tok_End_Of_Line
and then Token /= Tok_EOF
loop
Scan.all;
end loop;
end Go_To_End_Of_Line;
--------------
-- Index_Of --
--------------
function Index_Of (Symbol : Name_Id) return Symbol_Id is
begin
if Mapping.Table /= null then
for J in Symbol_Id range 1 .. Symbol_Table.Last (Mapping) loop
if Mapping.Table (J).Symbol = Symbol then
return J;
end if;
end loop;
end if;
return No_Symbol;
end Index_Of;
----------------
-- Initialize --
----------------
procedure Initialize is
begin
if not Already_Initialized then
Start_String;
Store_String_Chars ("True");
True_Value.Value := End_String;
Start_String;
Empty_String := End_String;
Start_String;
Store_String_Chars ("False");
String_False := End_String;
Already_Initialized := True;
end if;
end Initialize;
------------------
-- List_Symbols --
------------------
procedure List_Symbols (Foreword : String) is
Order : array (0 .. Integer (Symbol_Table.Last (Mapping)))
of Symbol_Id;
-- After alphabetical sorting, this array stores the indexes of the
-- symbols in the order they are displayed.
function Lt (Op1, Op2 : Natural) return Boolean;
-- Comparison routine for sort call
procedure Move (From : Natural; To : Natural);
-- Move routine for sort call
--------
-- Lt --
--------
function Lt (Op1, Op2 : Natural) return Boolean is
S1 : constant String :=
Get_Name_String (Mapping.Table (Order (Op1)).Symbol);
S2 : constant String :=
Get_Name_String (Mapping.Table (Order (Op2)).Symbol);
begin
return S1 < S2;
end Lt;
----------
-- Move --
----------
procedure Move (From : Natural; To : Natural) is
begin
Order (To) := Order (From);
end Move;
package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt);
Max_L : Natural;
-- Maximum length of any symbol
-- Start of processing for List_Symbols_Case
begin
if Symbol_Table.Last (Mapping) = 0 then
return;
end if;
if Foreword'Length > 0 then
Write_Eol;
Write_Line (Foreword);
for J in Foreword'Range loop
Write_Char ('=');
end loop;
end if;
-- Initialize the order
for J in Order'Range loop
Order (J) := Symbol_Id (J);
end loop;
-- Sort alphabetically
Sort_Syms.Sort (Order'Last);
Max_L := 7;
for J in 1 .. Symbol_Table.Last (Mapping) loop
Get_Name_String (Mapping.Table (J).Original);
Max_L := Integer'Max (Max_L, Name_Len);
end loop;
Write_Eol;
Write_Str ("Symbol");
for J in 1 .. Max_L - 5 loop
Write_Char (' ');
end loop;
Write_Line ("Value");
Write_Str ("------");
for J in 1 .. Max_L - 5 loop
Write_Char (' ');
end loop;
Write_Line ("------");
for J in 1 .. Order'Last loop
declare
Data : constant Symbol_Data := Mapping.Table (Order (J));
begin
Get_Name_String (Data.Original);
Write_Str (Name_Buffer (1 .. Name_Len));
for K in Name_Len .. Max_L loop
Write_Char (' ');
end loop;
String_To_Name_Buffer (Data.Value);
if Data.Is_A_String then
Write_Char ('"');
for J in 1 .. Name_Len loop
Write_Char (Name_Buffer (J));
if Name_Buffer (J) = '"' then
Write_Char ('"');
end if;
end loop;
Write_Char ('"');
else
Write_Str (Name_Buffer (1 .. Name_Len));
end if;
end;
Write_Eol;
end loop;
Write_Eol;
end List_Symbols;
----------------------
-- Matching_Strings --
----------------------
function Matching_Strings (S1, S2 : String_Id) return Boolean is
begin
String_To_Name_Buffer (S1);
for Index in 1 .. Name_Len loop
Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
end loop;
declare
String1 : constant String := Name_Buffer (1 .. Name_Len);
begin
String_To_Name_Buffer (S2);
for Index in 1 .. Name_Len loop
Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
end loop;
return String1 = Name_Buffer (1 .. Name_Len);
end;
end Matching_Strings;
--------------------
-- Parse_Def_File --
--------------------
-- This procedure REALLY needs some more comments ???
procedure Parse_Def_File is
Symbol : Symbol_Id;
Symbol_Name : Name_Id;
Original_Name : Name_Id;
Data : Symbol_Data;
Value_Start : Source_Ptr;
Value_End : Source_Ptr;
Ch : Character;
use ASCII;
begin
Def_Line_Loop :
loop
Scan.all;
exit Def_Line_Loop when Token = Tok_EOF;
if Token /= Tok_End_Of_Line then
Change_Reserved_Keyword_To_Symbol;
if Token /= Tok_Identifier then
Error_Msg ("identifier expected", Token_Ptr);
goto Cleanup;
end if;
Symbol_Name := Token_Name;
Name_Len := 0;
for Ptr in Token_Ptr .. Scan_Ptr - 1 loop
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Sinput.Source (Ptr);
end loop;
Original_Name := Name_Find;
Scan.all;
if Token /= Tok_Colon_Equal then
Error_Msg -- CODEFIX
("`:=` expected", Token_Ptr);
goto Cleanup;
end if;
Scan.all;
if Token = Tok_Integer_Literal then
declare
Ptr : Source_Ptr := Token_Ptr;
begin
Start_String;
while Ptr < Scan_Ptr loop
Store_String_Char (Sinput.Source (Ptr));
Ptr := Ptr + 1;
end loop;
Data := (Symbol => Symbol_Name,
Original => Original_Name,
On_The_Command_Line => False,
Is_A_String => False,
Value => End_String);
end;
Scan.all;
if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
Error_Msg ("extraneous text in definition", Token_Ptr);
goto Cleanup;
end if;
elsif Token = Tok_String_Literal then
Data := (Symbol => Symbol_Name,
Original => Original_Name,
On_The_Command_Line => False,
Is_A_String => True,
Value => String_Literal_Id);
Scan.all;
if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
Error_Msg ("extraneous text in definition", Token_Ptr);
goto Cleanup;
end if;
elsif Token = Tok_End_Of_Line or else Token = Tok_EOF then
Data := (Symbol => Symbol_Name,
Original => Original_Name,
On_The_Command_Line => False,
Is_A_String => False,
Value => Empty_String);
else
Value_Start := Token_Ptr;
Value_End := Token_Ptr - 1;
Scan_Ptr := Token_Ptr;
Value_Chars_Loop :
loop
Ch := Sinput.Source (Scan_Ptr);
case Ch is
when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
Value_End := Scan_Ptr;
Scan_Ptr := Scan_Ptr + 1;
when ' ' | HT | VT | CR | LF | FF =>
exit Value_Chars_Loop;
when others =>
Error_Msg ("illegal character", Scan_Ptr);
goto Cleanup;
end case;
end loop Value_Chars_Loop;
Scan.all;
if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
Error_Msg ("extraneous text in definition", Token_Ptr);
goto Cleanup;
end if;
Start_String;
while Value_Start <= Value_End loop
Store_String_Char (Sinput.Source (Value_Start));
Value_Start := Value_Start + 1;
end loop;
Data := (Symbol => Symbol_Name,
Original => Original_Name,
On_The_Command_Line => False,
Is_A_String => False,
Value => End_String);
end if;
-- Now that we have the value, get the symbol index
Symbol := Index_Of (Symbol_Name);
if Symbol /= No_Symbol then
-- If we already have an entry for this symbol, replace it
-- with the new value, except if the symbol was declared on
-- the command line.
if Mapping.Table (Symbol).On_The_Command_Line then
goto Continue;
end if;
else
-- As it is the first time we see this symbol, create a new
-- entry in the table.
if Mapping.Table = null then
Symbol_Table.Init (Mapping);
end if;
Symbol_Table.Increment_Last (Mapping);
Symbol := Symbol_Table.Last (Mapping);
end if;
Mapping.Table (Symbol) := Data;
goto Continue;
<<Cleanup>>
Set_Ignore_Errors (To => True);
while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop
Scan.all;
end loop;
Set_Ignore_Errors (To => False);
<<Continue>>
null;
end if;
end loop Def_Line_Loop;
end Parse_Def_File;
----------------
-- Preprocess --
----------------
procedure Preprocess (Source_Modified : out Boolean) is
Start_Of_Processing : Source_Ptr;
Cond : Boolean;
Preprocessor_Line : Boolean := False;
No_Error_Found : Boolean := True;
Modified : Boolean := False;
procedure Output (From, To : Source_Ptr);
-- Output the characters with indexes From .. To in the buffer to the
-- output file.
procedure Output_Line (From, To : Source_Ptr);
-- Output a line or the end of a line from the buffer to the output
-- file, followed by an end of line terminator. Depending on the value
-- of Deleting and the switches, the line may be commented out, blank or
-- not output at all.
------------
-- Output --
------------
procedure Output (From, To : Source_Ptr) is
begin
for J in From .. To loop
Put_Char (Sinput.Source (J));
end loop;
end Output;
-----------------
-- Output_Line --
-----------------
procedure Output_Line (From, To : Source_Ptr) is
begin
if Deleting or else Preprocessor_Line then
if Blank_Deleted_Lines then
New_EOL.all;
elsif Comment_Deleted_Lines then
Put_Char ('-');
Put_Char ('-');
Put_Char ('!');
if From < To then
Put_Char (' ');
Output (From, To);
end if;
New_EOL.all;
end if;
else
Output (From, To);
New_EOL.all;
end if;
end Output_Line;
-- Start of processing for Preprocess
begin
Start_Of_Processing := Scan_Ptr;
-- First a call to Scan, because Initialize_Scanner is not doing it
Scan.all;
Input_Line_Loop : loop
exit Input_Line_Loop when Token = Tok_EOF;
Preprocessor_Line := False;
if Token /= Tok_End_Of_Line then
-- Preprocessor line
if Token = Tok_Special and then Special_Character = '#' then
Modified := True;
Preprocessor_Line := True;
Scan.all;
case Token is
-- #if
when Tok_If =>
declare
If_Ptr : constant Source_Ptr := Token_Ptr;
begin
Scan.all;
Cond := Expression (not Deleting);
-- Check for an eventual "then"
if Token = Tok_Then then
Scan.all;
end if;
-- It is an error to have trailing characters after
-- the condition or "then".
if Token /= Tok_End_Of_Line
and then Token /= Tok_EOF
then
Error_Msg
("extraneous text on preprocessor line",
Token_Ptr);
No_Error_Found := False;
Go_To_End_Of_Line;
end if;
declare
-- Set the initial state of this new "#if". This
-- must be done before incrementing the Last of
-- the table, otherwise function Deleting does
-- not report the correct value.
New_State : constant Pp_State :=
(If_Ptr => If_Ptr,
Else_Ptr => 0,
Deleting => Deleting
or else not Cond,
Match_Seen => Deleting or else Cond);
begin
Pp_States.Increment_Last;
Pp_States.Table (Pp_States.Last) := New_State;
end;
end;
-- #elsif
when Tok_Elsif =>
Cond := False;
if Pp_States.Last = 0
or else Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
then
Error_Msg ("no IF for this ELSIF", Token_Ptr);
No_Error_Found := False;
else
Cond :=
not Pp_States.Table (Pp_States.Last).Match_Seen;
end if;
Scan.all;
Cond := Expression (Cond);
-- Check for an eventual "then"
if Token = Tok_Then then
Scan.all;
end if;
-- It is an error to have trailing characters after the
-- condition or "then".
if Token /= Tok_End_Of_Line
and then Token /= Tok_EOF
then
Error_Msg
("extraneous text on preprocessor line",
Token_Ptr);
No_Error_Found := False;
Go_To_End_Of_Line;
end if;
-- Depending on the value of the condition, set the new
-- values of Deleting and Match_Seen.
if Pp_States.Last > 0 then
if Pp_States.Table (Pp_States.Last).Match_Seen then
Pp_States.Table (Pp_States.Last).Deleting := True;
else
if Cond then
Pp_States.Table (Pp_States.Last).Match_Seen :=
True;
Pp_States.Table (Pp_States.Last).Deleting :=
False;
end if;
end if;
end if;
-- #else
when Tok_Else =>
if Pp_States.Last = 0 then
Error_Msg ("no IF for this ELSE", Token_Ptr);
No_Error_Found := False;
elsif
Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
then
Error_Msg -- CODEFIX
("duplicate ELSE line", Token_Ptr);
No_Error_Found := False;
end if;
-- Set the possibly new values of Deleting and Match_Seen
if Pp_States.Last > 0 then
if Pp_States.Table (Pp_States.Last).Match_Seen then
Pp_States.Table (Pp_States.Last).Deleting :=
True;
else
Pp_States.Table (Pp_States.Last).Match_Seen :=
True;
Pp_States.Table (Pp_States.Last).Deleting :=
False;
end if;
-- Set the Else_Ptr to check for illegal #elsif later
Pp_States.Table (Pp_States.Last).Else_Ptr :=
Token_Ptr;
end if;
Scan.all;
-- Error of character present after "#else"
if Token /= Tok_End_Of_Line
and then Token /= Tok_EOF
then
Error_Msg
("extraneous text on preprocessor line",
Token_Ptr);
No_Error_Found := False;
Go_To_End_Of_Line;
end if;
-- #end if;
when Tok_End =>
if Pp_States.Last = 0 then
Error_Msg ("no IF for this END", Token_Ptr);
No_Error_Found := False;
end if;
Scan.all;
if Token /= Tok_If then
Error_Msg -- CODEFIX
("IF expected", Token_Ptr);
No_Error_Found := False;
else
Scan.all;
if Token /= Tok_Semicolon then
Error_Msg -- CODEFIX
("`;` Expected", Token_Ptr);
No_Error_Found := False;
else
Scan.all;
-- Error of character present after "#end if;"
if Token /= Tok_End_Of_Line
and then Token /= Tok_EOF
then
Error_Msg
("extraneous text on preprocessor line",
Token_Ptr);
No_Error_Found := False;
end if;
end if;
end if;
-- In case of one of the errors above, skip the tokens
-- until the end of line is reached.
Go_To_End_Of_Line;
-- Decrement the depth of the #if stack
if Pp_States.Last > 0 then
Pp_States.Decrement_Last;
end if;
-- Illegal preprocessor line
when others =>
No_Error_Found := False;
if Pp_States.Last = 0 then
Error_Msg -- CODEFIX
("IF expected", Token_Ptr);
elsif
Pp_States.Table (Pp_States.Last).Else_Ptr = 0
then
Error_Msg
("IF, ELSIF, ELSE, or `END IF` expected",
Token_Ptr);
else
Error_Msg ("IF or `END IF` expected", Token_Ptr);
end if;
-- Skip to the end of this illegal line
Go_To_End_Of_Line;
end case;
-- Not a preprocessor line
else
-- Do not report errors for those lines, even if there are
-- Ada parsing errors.
Set_Ignore_Errors (To => True);
if Deleting then
Go_To_End_Of_Line;
else
while Token /= Tok_End_Of_Line
and then Token /= Tok_EOF
loop
if Token = Tok_Special
and then Special_Character = '$'
then
Modified := True;
declare
Dollar_Ptr : constant Source_Ptr := Token_Ptr;
Symbol : Symbol_Id;
begin
Scan.all;
Change_Reserved_Keyword_To_Symbol;
if Token = Tok_Identifier
and then Token_Ptr = Dollar_Ptr + 1
then
-- $symbol
Symbol := Index_Of (Token_Name);
-- If symbol exists, replace by its value
if Symbol /= No_Symbol then
Output (Start_Of_Processing, Dollar_Ptr - 1);
Start_Of_Processing := Scan_Ptr;
String_To_Name_Buffer
(Mapping.Table (Symbol).Value);
if Mapping.Table (Symbol).Is_A_String then
-- Value is an Ada string
Put_Char ('"');
for J in 1 .. Name_Len loop
Put_Char (Name_Buffer (J));
if Name_Buffer (J) = '"' then
Put_Char ('"');
end if;
end loop;
Put_Char ('"');
else
-- Value is a sequence of characters, not
-- an Ada string.
for J in 1 .. Name_Len loop
Put_Char (Name_Buffer (J));
end loop;
end if;
end if;
end if;
end;
end if;
Scan.all;
end loop;
end if;
Set_Ignore_Errors (To => False);
end if;
end if;
pragma Assert (Token = Tok_End_Of_Line or else Token = Tok_EOF);
-- At this point, the token is either end of line or EOF. The line to
-- possibly output stops just before the token.
Output_Line (Start_Of_Processing, Token_Ptr - 1);
-- If we are at the end of a line, the scan pointer is at the first
-- non-blank character (may not be the first character of the line),
-- so we have to deduct Start_Of_Processing from the token pointer.
if Token = Tok_End_Of_Line then
if Sinput.Source (Token_Ptr) = ASCII.CR
and then Sinput.Source (Token_Ptr + 1) = ASCII.LF
then
Start_Of_Processing := Token_Ptr + 2;
else
Start_Of_Processing := Token_Ptr + 1;
end if;
end if;
-- Now, scan the first token of the next line. If the token is EOF,
-- the scan pointer will not move, and the token will still be EOF.
Set_Ignore_Errors (To => True);
Scan.all;
Set_Ignore_Errors (To => False);
end loop Input_Line_Loop;
-- Report an error for any missing some "#end if;"
for Level in reverse 1 .. Pp_States.Last loop
Error_Msg ("no `END IF` for this IF", Pp_States.Table (Level).If_Ptr);
No_Error_Found := False;
end loop;
Source_Modified := No_Error_Found and Modified;
end Preprocess;
-----------------
-- Setup_Hooks --
-----------------
procedure Setup_Hooks
(Error_Msg : Error_Msg_Proc;
Scan : Scan_Proc;
Set_Ignore_Errors : Set_Ignore_Errors_Proc;
Put_Char : Put_Char_Proc;
New_EOL : New_EOL_Proc)
is
begin
pragma Assert (Already_Initialized);
Prep.Error_Msg := Error_Msg;
Prep.Scan := Scan;
Prep.Set_Ignore_Errors := Set_Ignore_Errors;
Prep.Put_Char := Put_Char;
Prep.New_EOL := New_EOL;
end Setup_Hooks;
end Prep;