------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- P R E P C O M P -- -- -- -- B o d y -- -- -- -- Copyright (C) 2003-2006, 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, 51 Franklin Street, Fifth Floor, -- -- Boston, MA 02110-1301, USA. -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; with Errout; use Errout; with Namet; use Namet; with Lib.Writ; use Lib.Writ; with Opt; use Opt; with Osint; use Osint; with Prep; use Prep; with Scans; use Scans; with Scn; use Scn; with Sinput.L; use Sinput.L; with Stringt; use Stringt; with Table; package body Prepcomp is No_Preprocessing : Boolean := True; -- Set to True if there is at least one source that needs to be -- preprocessed. Source_Index_Of_Preproc_Data_File : Source_File_Index := No_Source_File; -- The following variable should be a constant, but this is not -- possible. Warnings are Off because it is never assigned a value. pragma Warnings (Off); No_Mapping : Prep.Symbol_Table.Instance; pragma Warnings (On); type String_Ptr is access String; type String_Array is array (Positive range <>) of String_Ptr; type String_Array_Ptr is access String_Array; procedure Free is new Ada.Unchecked_Deallocation (String_Array, String_Array_Ptr); Symbol_Definitions : String_Array_Ptr := new String_Array (1 .. 4); -- An extensible array to temporarily stores symbol definitions specified -- on the command line with -gnateD switches. Last_Definition : Natural := 0; -- Index of last symbol definition in array Symbol_Definitions type Preproc_Data is record Mapping : Symbol_Table.Instance; File_Name : Name_Id := No_Name; Deffile : String_Id := No_String; Undef_False : Boolean := False; Always_Blank : Boolean := False; Comments : Boolean := False; List_Symbols : Boolean := False; Processed : Boolean := False; end record; -- Structure to keep the preprocessing data for a file name or for the -- default (when Name_Id = No_Name). No_Preproc_Data : constant Preproc_Data := (Mapping => No_Mapping, File_Name => No_Name, Deffile => No_String, Undef_False => False, Always_Blank => False, Comments => False, List_Symbols => False, Processed => False); Default_Data : Preproc_Data := No_Preproc_Data; -- The preprocessing data to be used when no specific preprocessing data -- is specified for a source. Default_Data_Defined : Boolean := False; -- True if source for which no specific preprocessing is specified need to -- be preprocess with the Default_Data. Current_Data : Preproc_Data := No_Preproc_Data; package Preproc_Data_Table is new Table.Table (Table_Component_Type => Preproc_Data, Table_Index_Type => Int, Table_Low_Bound => 1, Table_Initial => 5, Table_Increment => 5, Table_Name => "Prepcomp.Preproc_Data_Table"); -- Table to store the specific preprocessing data Command_Line_Symbols : Symbol_Table.Instance; -- A table to store symbol definitions specified on the command line with -- -gnateD switches. package Dependencies is new Table.Table (Table_Component_Type => Source_File_Index, Table_Index_Type => Int, Table_Low_Bound => 1, Table_Initial => 5, Table_Increment => 5, Table_Name => "Prepcomp.Dependencies"); -- Table to store the dependencies on preprocessing files procedure Add_Command_Line_Symbols; -- Add the command line symbol definitions, if any, to the -- Prep.Mapping table. procedure Skip_To_End_Of_Line; -- Ignore errors and scan up to the next end of line or the end of file ------------------------------ -- Add_Command_Line_Symbols -- ------------------------------ procedure Add_Command_Line_Symbols is Symbol_Id : Prep.Symbol_Id; begin for J in 1 .. Symbol_Table.Last (Command_Line_Symbols) loop Symbol_Id := Prep.Index_Of (Command_Line_Symbols.Table (J).Symbol); if Symbol_Id = No_Symbol then Symbol_Table.Increment_Last (Prep.Mapping); Symbol_Id := Symbol_Table.Last (Prep.Mapping); end if; Prep.Mapping.Table (Symbol_Id) := Command_Line_Symbols.Table (J); end loop; end Add_Command_Line_Symbols; ---------------------- -- Add_Dependencies -- ---------------------- procedure Add_Dependencies is begin for Index in 1 .. Dependencies.Last loop Add_Preprocessing_Dependency (Dependencies.Table (Index)); end loop; end Add_Dependencies; --------------------------- -- Add_Symbol_Definition -- --------------------------- procedure Add_Symbol_Definition (Def : String) is begin -- If Symbol_Definitions is not large enough, double it if Last_Definition = Symbol_Definitions'Last then declare New_Symbol_Definitions : constant String_Array_Ptr := new String_Array (1 .. 2 * Last_Definition); begin New_Symbol_Definitions (Symbol_Definitions'Range) := Symbol_Definitions.all; Free (Symbol_Definitions); Symbol_Definitions := New_Symbol_Definitions; end; end if; Last_Definition := Last_Definition + 1; Symbol_Definitions (Last_Definition) := new String'(Def); end Add_Symbol_Definition; ------------------- -- Check_Symbols -- ------------------- procedure Check_Symbols is begin -- If there is at least one switch -gnateD specified if Symbol_Table.Last (Command_Line_Symbols) >= 1 then Current_Data := No_Preproc_Data; No_Preprocessing := False; Current_Data.Processed := True; -- Start with an empty, initialized mapping table; use Prep.Mapping, -- because Prep.Index_Of uses Prep.Mapping. Prep.Mapping := No_Mapping; Symbol_Table.Init (Prep.Mapping); -- Add the command line symbols Add_Command_Line_Symbols; -- Put the resulting Prep.Mapping in Current_Data, and immediately -- set Prep.Mapping to nil. Current_Data.Mapping := Prep.Mapping; Prep.Mapping := No_Mapping; -- Set the default data Default_Data := Current_Data; Default_Data_Defined := True; end if; end Check_Symbols; ------------------------------ -- Parse_Preprocessing_Data -- ------------------------------ procedure Parse_Preprocessing_Data_File (N : File_Name_Type) is OK : Boolean := False; Dash_Location : Source_Ptr; Symbol_Data : Prep.Symbol_Data; Symbol_Id : Prep.Symbol_Id; T : constant Nat := Total_Errors_Detected; begin -- Load the preprocessing data file Source_Index_Of_Preproc_Data_File := Load_Preprocessing_Data_File (N); -- Fail if preprocessing data file cannot be found if Source_Index_Of_Preproc_Data_File = No_Source_File then Get_Name_String (N); Fail ("preprocessing data file """, Name_Buffer (1 .. Name_Len), """ not found"); end if; -- Initialize the sanner and set its behavior for a processing data file Scn.Scanner.Initialize_Scanner (Source_Index_Of_Preproc_Data_File); Scn.Scanner.Set_End_Of_Line_As_Token (True); Scn.Scanner.Reset_Special_Characters; For_Each_Line : loop <> Scan; exit For_Each_Line when Token = Tok_EOF; if Token = Tok_End_Of_Line then goto Scan_Line; end if; -- Line is not empty OK := False; No_Preprocessing := False; Current_Data := No_Preproc_Data; case Token is when Tok_Asterisk => -- Default data if Default_Data_Defined then Error_Msg ("multiple default preprocessing data", Token_Ptr); else OK := True; Default_Data_Defined := True; end if; when Tok_String_Literal => -- Specific data String_To_Name_Buffer (String_Literal_Id); Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); Current_Data.File_Name := Name_Find; OK := True; for Index in 1 .. Preproc_Data_Table.Last loop if Current_Data.File_Name = Preproc_Data_Table.Table (Index).File_Name then Error_Msg_Name_1 := Current_Data.File_Name; Error_Msg ("multiple preprocessing data for{", Token_Ptr); OK := False; exit; end if; end loop; when others => Error_Msg ("`'*` or literal string expected", Token_Ptr); end case; -- If there is a problem, skip the line if not OK then Skip_To_End_Of_Line; goto Scan_Line; end if; -- Scan past the * or the literal string Scan; -- A literal string in second position is a definition file if Token = Tok_String_Literal then Current_Data.Deffile := String_Literal_Id; Current_Data.Processed := False; Scan; else -- If there is no definition file, set Processed to True now Current_Data.Processed := True; end if; -- Start with an empty, initialized mapping table; use Prep.Mapping, -- because Prep.Index_Of uses Prep.Mapping. Prep.Mapping := No_Mapping; Symbol_Table.Init (Prep.Mapping); -- Check the switches that may follow while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop if Token /= Tok_Minus then Error_Msg ("`'-` expected", Token_Ptr); Skip_To_End_Of_Line; goto Scan_Line; end if; -- Keep the location of the '-' for possible error reporting Dash_Location := Token_Ptr; -- Scan past the '-' Scan; OK := False; Change_Reserved_Keyword_To_Symbol; -- An identifier (or a reserved word converted to an -- identifier) is expected and there must be no blank space -- between the '-' and the identifier. if Token = Tok_Identifier and then Token_Ptr = Dash_Location + 1 then Get_Name_String (Token_Name); -- Check the character in the source, because the case is -- significant. case Sinput.Source (Token_Ptr) is when 'u' => -- Undefined symbol are False if Name_Len = 1 then Current_Data.Undef_False := True; OK := True; end if; when 'b' => -- Blank lines if Name_Len = 1 then Current_Data.Always_Blank := True; OK := True; end if; when 'c' => -- Comment removed lines if Name_Len = 1 then Current_Data.Comments := True; OK := True; end if; when 's' => -- List symbols if Name_Len = 1 then Current_Data.List_Symbols := True; OK := True; end if; when 'D' => -- Symbol definition OK := Name_Len > 1; if OK then -- A symbol must be an Ada identifier; it cannot start -- with an underline or a digit. if Name_Buffer (2) = '_' or Name_Buffer (2) in '0' .. '9' then Error_Msg ("symbol expected", Token_Ptr + 1); Skip_To_End_Of_Line; goto Scan_Line; end if; -- Get the name id of the symbol Symbol_Data.On_The_Command_Line := True; Name_Buffer (1 .. Name_Len - 1) := Name_Buffer (2 .. Name_Len); Name_Len := Name_Len - 1; Symbol_Data.Symbol := Name_Find; if Name_Buffer (1 .. Name_Len) = "if" or else Name_Buffer (1 .. Name_Len) = "else" or else Name_Buffer (1 .. Name_Len) = "elsif" or else Name_Buffer (1 .. Name_Len) = "end" or else Name_Buffer (1 .. Name_Len) = "not" or else Name_Buffer (1 .. Name_Len) = "and" or else Name_Buffer (1 .. Name_Len) = "then" then Error_Msg ("symbol expected", Token_Ptr + 1); Skip_To_End_Of_Line; goto Scan_Line; end if; -- Get the name id of the original symbol, with -- possibly capital letters. Name_Len := Integer (Scan_Ptr - Token_Ptr - 1); for J in 1 .. Name_Len loop Name_Buffer (J) := Sinput.Source (Token_Ptr + Text_Ptr (J)); end loop; Symbol_Data.Original := Name_Find; -- Scan past D Scan; if Token /= Tok_Equal then Error_Msg ("`=` expected", Token_Ptr); Skip_To_End_Of_Line; goto Scan_Line; end if; -- Scan past '=' Scan; -- Here any reserved word is OK Change_Reserved_Keyword_To_Symbol (All_Keywords => True); -- Value can be an identifier (or a reserved word) -- or a literal string. case Token is when Tok_String_Literal => Symbol_Data.Is_A_String := True; Symbol_Data.Value := String_Literal_Id; when Tok_Identifier => Symbol_Data.Is_A_String := False; Start_String; for J in Token_Ptr .. Scan_Ptr - 1 loop Store_String_Char (Sinput.Source (J)); end loop; Symbol_Data.Value := End_String; when others => Error_Msg ("literal string or identifier expected", Token_Ptr); Skip_To_End_Of_Line; goto Scan_Line; end case; -- If symbol already exists, replace old definition -- by new one. Symbol_Id := Prep.Index_Of (Symbol_Data.Symbol); -- Otherwise, add a new entry in the table if Symbol_Id = No_Symbol then Symbol_Table.Increment_Last (Prep.Mapping); Symbol_Id := Symbol_Table.Last (Mapping); end if; Prep.Mapping.Table (Symbol_Id) := Symbol_Data; end if; when others => null; end case; Scan; end if; if not OK then Error_Msg ("invalid switch", Dash_Location); Skip_To_End_Of_Line; goto Scan_Line; end if; end loop; -- Add the command line symbols, if any, possibly replacing symbols -- just defined. Add_Command_Line_Symbols; -- Put the resulting Prep.Mapping in Current_Data, and immediately -- set Prep.Mapping to nil. Current_Data.Mapping := Prep.Mapping; Prep.Mapping := No_Mapping; -- Record Current_Data if Current_Data.File_Name = No_Name then Default_Data := Current_Data; else Preproc_Data_Table.Increment_Last; Preproc_Data_Table.Table (Preproc_Data_Table.Last) := Current_Data; end if; Current_Data := No_Preproc_Data; end loop For_Each_Line; Scn.Scanner.Set_End_Of_Line_As_Token (False); -- Fail if there were errors in the preprocessing data file if Total_Errors_Detected > T then Errout.Finalize; Fail ("errors found in preprocessing data file """, Get_Name_String (N), """"); end if; -- Record the dependency on the preprocessor data file Dependencies.Increment_Last; Dependencies.Table (Dependencies.Last) := Source_Index_Of_Preproc_Data_File; end Parse_Preprocessing_Data_File; --------------------------- -- Prepare_To_Preprocess -- --------------------------- procedure Prepare_To_Preprocess (Source : File_Name_Type; Preprocessing_Needed : out Boolean) is Default : Boolean := False; Index : Int := 0; begin -- By default, preprocessing is not needed Preprocessing_Needed := False; if No_Preprocessing then return; end if; -- First, look for preprocessing data specific to the current source for J in 1 .. Preproc_Data_Table.Last loop if Preproc_Data_Table.Table (J).File_Name = Source then Index := J; Current_Data := Preproc_Data_Table.Table (J); exit; end if; end loop; -- If no specific preprocessing data, then take the default if Index = 0 then if Default_Data_Defined then Current_Data := Default_Data; Default := True; else -- If no default, then nothing to do return; end if; end if; -- Set the preprocessing flags according to the preprocessing data if Current_Data.Comments and then not Current_Data.Always_Blank then Comment_Deleted_Lines := True; Blank_Deleted_Lines := False; else Comment_Deleted_Lines := False; Blank_Deleted_Lines := True; end if; Undefined_Symbols_Are_False := Current_Data.Undef_False; List_Preprocessing_Symbols := Current_Data.List_Symbols; -- If not already done it, process the definition file if Current_Data.Processed then -- Set Prep.Mapping Prep.Mapping := Current_Data.Mapping; else -- First put the mapping in Prep.Mapping, because Prep.Parse_Def_File -- works on Prep.Mapping. Prep.Mapping := Current_Data.Mapping; String_To_Name_Buffer (Current_Data.Deffile); declare N : constant Name_Id := Name_Find; Deffile : constant Source_File_Index := Load_Definition_File (N); Add_Deffile : Boolean := True; T : constant Nat := Total_Errors_Detected; begin if Deffile = No_Source_File then Fail ("definition file """, Get_Name_String (N), """ cannot be found"); end if; -- Initialize the preprocessor and set the characteristics of the -- scanner for a definition file. Prep.Initialize (Error_Msg => Errout.Error_Msg'Access, Scan => Scn.Scanner.Scan'Access, Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access, Put_Char => null, New_EOL => null); Scn.Scanner.Set_End_Of_Line_As_Token (True); Scn.Scanner.Reset_Special_Characters; -- Initialize the scanner and process the definition file Scn.Scanner.Initialize_Scanner (Deffile); Prep.Parse_Def_File; -- Reset the behaviour of the scanner to the default Scn.Scanner.Set_End_Of_Line_As_Token (False); -- Fail if errors were found while processing the definition file if T /= Total_Errors_Detected then Errout.Finalize; Fail ("errors found in definition file """, Get_Name_String (N), """"); end if; for Index in 1 .. Dependencies.Last loop if Dependencies.Table (Index) = Deffile then Add_Deffile := False; exit; end if; end loop; if Add_Deffile then Dependencies.Increment_Last; Dependencies.Table (Dependencies.Last) := Deffile; end if; end; -- Get back the mapping, indicate that the definition file is -- processed and store back the preprocessing data. Current_Data.Mapping := Prep.Mapping; Current_Data.Processed := True; if Default then Default_Data := Current_Data; else Preproc_Data_Table.Table (Index) := Current_Data; end if; end if; Preprocessing_Needed := True; end Prepare_To_Preprocess; --------------------------------------------- -- Process_Command_Line_Symbol_Definitions -- --------------------------------------------- procedure Process_Command_Line_Symbol_Definitions is Symbol_Data : Prep.Symbol_Data; Found : Boolean := False; begin Symbol_Table.Init (Command_Line_Symbols); -- The command line definitions have been stored temporarily in -- array Symbol_Definitions. for Index in 1 .. Last_Definition loop -- Check each symbol definition, fail immediately if syntax is not -- correct. Check_Command_Line_Symbol_Definition (Definition => Symbol_Definitions (Index).all, Data => Symbol_Data); Found := False; -- If there is already a definition for this symbol, replace the old -- definition by this one. for J in 1 .. Symbol_Table.Last (Command_Line_Symbols) loop if Command_Line_Symbols.Table (J).Symbol = Symbol_Data.Symbol then Command_Line_Symbols.Table (J) := Symbol_Data; Found := True; exit; end if; end loop; -- Otherwise, create a new entry in the table if not Found then Symbol_Table.Increment_Last (Command_Line_Symbols); Command_Line_Symbols.Table (Symbol_Table.Last (Command_Line_Symbols)) := Symbol_Data; end if; end loop; end Process_Command_Line_Symbol_Definitions; ------------------------- -- Skip_To_End_Of_Line -- ------------------------- procedure Skip_To_End_Of_Line is begin Set_Ignore_Errors (To => True); while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop Scan; end loop; Set_Ignore_Errors (To => False); end Skip_To_End_Of_Line; end Prepcomp;