diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/ada/prepcomp.adb | |
download | cbb-gcc-4.6.4-15d2061ac0796199866debe9ac87130894b0cdd3.tar.bz2 cbb-gcc-4.6.4-15d2061ac0796199866debe9ac87130894b0cdd3.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
Diffstat (limited to 'gcc/ada/prepcomp.adb')
-rw-r--r-- | gcc/ada/prepcomp.adb | 788 |
1 files changed, 788 insertions, 0 deletions
diff --git a/gcc/ada/prepcomp.adb b/gcc/ada/prepcomp.adb new file mode 100644 index 000000000..62f962aa4 --- /dev/null +++ b/gcc/ada/prepcomp.adb @@ -0,0 +1,788 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 Ada.Unchecked_Deallocation; + +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 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 : 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; + + --------------------------- + -- 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 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 .. 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; |