diff options
Diffstat (limited to 'gcc-4.7/gcc/ada/prepcomp.adb')
| -rw-r--r-- | gcc-4.7/gcc/ada/prepcomp.adb | 747 |
1 files changed, 0 insertions, 747 deletions
diff --git a/gcc-4.7/gcc/ada/prepcomp.adb b/gcc-4.7/gcc/ada/prepcomp.adb deleted file mode 100644 index 2da21df3c..000000000 --- a/gcc-4.7/gcc/ada/prepcomp.adb +++ /dev/null @@ -1,747 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- P R E P C O M P -- --- -- --- B o d y -- --- -- --- Copyright (C) 2003-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 Errout; use Errout; -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; -with Types; use Types; - -package body Prepcomp is - - No_Preprocessing : Boolean := True; - -- Set to False 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 - -- because its type GNAT.Dynamic_Tables.Instance has a component P of - -- uninitialized private type GNAT.Dynamic_Tables.Table_Private and there - -- are no exported values for this private type. Warnings are Off because - -- it is never assigned a value. - - pragma Warnings (Off); - No_Mapping : Prep.Symbol_Table.Instance; - pragma Warnings (On); - - type Preproc_Data is record - Mapping : Symbol_Table.Instance; - File_Name : File_Name_Type := No_File; - 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_File, - 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 => 100, - 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 => 10, - Table_Increment => 100, - 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 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; - - ------------------- - -- 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 scanner and set its behavior for processing a 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_Line>> - 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_File_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 -- CODEFIX - ("`'-` 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 else 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<symbol> - - Scan; - - if Token /= Tok_Equal then - Error_Msg -- CODEFIX - ("`=` 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_File 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 (Last_Call => True); - Errout.Output_Messages; - 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 File_Name_Type := 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) - & """ not found"); - end if; - - -- Initialize the preprocessor and set the characteristics of the - -- scanner for a definition file. - - Prep.Setup_Hooks - (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 (Last_Call => True); - Errout.Output_Messages; - 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 .. Preprocessing_Symbol_Last loop - -- Check each symbol definition, fail immediately if syntax is not - -- correct. - - Check_Command_Line_Symbol_Definition - (Definition => Preprocessing_Symbol_Defs (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; |