diff options
Diffstat (limited to 'gcc-4.7/gcc/ada/prep.adb')
| -rw-r--r-- | gcc-4.7/gcc/ada/prep.adb | 1483 |
1 files changed, 0 insertions, 1483 deletions
diff --git a/gcc-4.7/gcc/ada/prep.adb b/gcc-4.7/gcc/ada/prep.adb deleted file mode 100644 index 2b0e1378b..000000000 --- a/gcc-4.7/gcc/ada/prep.adb +++ /dev/null @@ -1,1483 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- P R E P -- --- -- --- B o d y -- --- -- --- Copyright (C) 2002-2010, 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 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 - - --------------- - -- Behaviour -- - --------------- - - -- 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. - - 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_If | Tok_Else | Tok_Elsif | Tok_End | - Tok_And | 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; - - -- And put the value in the result - - Result.Is_A_String := False; - 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 and - -- 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 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; - - begin - -- Loop for each term - - loop - Change_Reserved_Keyword_To_Symbol; - - Current_Result := False; - - case Token is - - when Tok_Left_Paren => - - -- ( expression ) - - Scan.all; - Current_Result := Expression (Evaluation); - - if Token = Tok_Right_Paren then - Scan.all; - - else - Error_Msg -- CODEFIX - ("`)` expected", Token_Ptr); - end if; - - when Tok_Not => - - -- not expression - - Scan.all; - Current_Result := - not Expression (Evaluation, Complemented => True); - - 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; - - elsif Token = Tok_Equal then - Scan.all; - - Change_Reserved_Keyword_To_Symbol; - - if 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 - ("symbol or literal string expected", Token_Ptr); - end if; - - else - -- symbol (True or False) - - 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; - - 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; - - -- Check the next operator - - 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; - - 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; - - else - -- No operator: exit the term loop - - 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 -- - -------------------- - - 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_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; - - -- We need to call Scan for the first time, because Initialize_Scanner - -- is no longer 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; - - -- It is an error to have characters 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; - - -- It is an error to have character 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, not necessarily 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) - or else - (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; |