diff options
Diffstat (limited to 'gcc/ada/prep.adb')
| -rw-r--r-- | gcc/ada/prep.adb | 1446 |
1 files changed, 1446 insertions, 0 deletions
diff --git a/gcc/ada/prep.adb b/gcc/ada/prep.adb new file mode 100644 index 00000000000..6b9000c7a0c --- /dev/null +++ b/gcc/ada/prep.adb @@ -0,0 +1,1446 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- P R E P -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2002-2003, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Csets; use Csets; +with Err_Vars; use Err_Vars; +with Namet; use Namet; +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 Types; use Types; + +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 + + Name_Defined : Name_Id; + -- defined, as a name_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 => 10, + 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) 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) 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 ("`)` expected", Token_Ptr); + end if; + + when Tok_Not => + + -- not expression + + Scan.all; + Current_Result := not Expression (Evaluation); + + 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 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 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; + + ---------------- + -- Preprocess -- + ---------------- + + procedure Preprocess is + Start_Of_Processing : Source_Ptr; + Cond : Boolean; + Preprocessor_Line : Boolean := False; + + procedure Output (From, To : Source_Ptr); + -- Output the characters with indices 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 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 Initialyze_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 + Preprocessor_Line := True; + Scan.all; + + case Token is + + when Tok_If => + -- #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); + 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 (not Cond), + Match_Seen => Deleting or Cond); + + begin + Pp_States.Increment_Last; + Pp_States.Table (Pp_States.Last) := New_State; + end; + end; + + when Tok_Elsif => + -- #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); + + 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); + + 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; + + when Tok_Else => + -- #else + + if Pp_States.Last = 0 then + Error_Msg ("no IF for this ELSE", Token_Ptr); + + elsif + Pp_States.Table (Pp_States.Last).Else_Ptr /= 0 + then + Error_Msg ("duplicate ELSE line", Token_Ptr); + 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); + Go_To_End_Of_Line; + end if; + + when Tok_End => + -- #end if; + + if Pp_States.Last = 0 then + Error_Msg ("no IF for this END", Token_Ptr); + end if; + + Scan.all; + + if Token /= Tok_If then + Error_Msg ("IF expected", Token_Ptr); + + else + Scan.all; + + if Token /= Tok_Semicolon then + Error_Msg ("`;` Expected", Token_Ptr); + + 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); + 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; + + when others => + -- Illegal preprocessor line + + if Pp_States.Last = 0 then + Error_Msg ("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 + 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 there is such a symbol, replace it 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 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, we scan the first token of the next line. + -- If the token is EOF, the scan ponter will not move, and the token + -- will still be EOF. + + Scan.all; + 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); + end loop; + end Preprocess; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize + (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 + if not Already_Initialized then + Start_String; + Store_String_Chars ("True"); + True_Value.Value := End_String; + + Start_String; + Empty_String := End_String; + + Name_Len := 7; + Name_Buffer (1 .. Name_Len) := "defined"; + Name_Defined := Name_Find; + + Start_String; + Store_String_Chars ("False"); + String_False := End_String; + + Already_Initialized := True; + end if; + + 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 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 thehe indices 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 ("`:=` 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 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 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; + +end Prep; |