Mercurial > hg > CbC > CbC_gcc
view gcc/ada/prep.adb @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children | 84e7813d76e9 |
line wrap: on
line source
------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- P R E P -- -- -- -- B o d y -- -- -- -- Copyright (C) 2002-2016, 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;