------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- B A C K _ E N D -- -- -- -- B o d y -- -- -- -- -- -- Copyright (C) 1992-2001 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 Atree; use Atree; with Debug; use Debug; with Elists; use Elists; with Lib; use Lib; with Osint; use Osint; with Opt; use Opt; with Osint; use Osint; with Osint.C; use Osint.C; with Namet; use Namet; with Nlists; use Nlists; with Stand; use Stand; with Sinput; use Sinput; with Stringt; use Stringt; with Switch; use Switch; with Switch.C; use Switch.C; with System; use System; with Types; use Types; package body Back_End is ------------------- -- Call_Back_End -- ------------------- procedure Call_Back_End (Mode : Back_End_Mode_Type) is -- The File_Record type has a lot of components that are meaningless -- to the back end, so a new record is created here to contain the -- needed information for each file. type Needed_File_Info_Type is record File_Name : File_Name_Type; First_Sloc : Source_Ptr; Last_Sloc : Source_Ptr; Num_Source_Lines : Nat; end record; File_Info_Array : array (Main_Unit .. Last_Unit) of Needed_File_Info_Type; procedure gigi ( gnat_root : Int; max_gnat_node : Int; number_name : Nat; nodes_ptr : Address; next_node_ptr : Address; prev_node_ptr : Address; elists_ptr : Address; elmts_ptr : Address; strings_ptr : Address; string_chars_ptr : Address; list_headers_ptr : Address; number_units : Int; file_info_ptr : Address; gigi_standard_integer : Entity_Id; gigi_standard_long_long_float : Entity_Id; gigi_standard_exception_type : Entity_Id; gigi_operating_mode : Back_End_Mode_Type); pragma Import (C, gigi); S : Source_File_Index; begin -- Skip call if in -gnatdH mode if Debug_Flag_HH then return; end if; for J in Main_Unit .. Last_Unit loop S := Source_Index (J); File_Info_Array (J).File_Name := File_Name (S); File_Info_Array (J).First_Sloc := Source_Text (S)'First; File_Info_Array (J).Last_Sloc := Source_Text (S)'Last; File_Info_Array (J).Num_Source_Lines := Num_Source_Lines (S); end loop; gigi ( gnat_root => Int (Cunit (Main_Unit)), max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1), number_name => Name_Entries_Count, nodes_ptr => Nodes_Address, next_node_ptr => Next_Node_Address, prev_node_ptr => Prev_Node_Address, elists_ptr => Elists_Address, elmts_ptr => Elmts_Address, strings_ptr => Strings_Address, string_chars_ptr => String_Chars_Address, list_headers_ptr => Lists_Address, number_units => Num_Units, file_info_ptr => File_Info_Array'Address, gigi_standard_integer => Standard_Integer, gigi_standard_long_long_float => Standard_Long_Long_Float, gigi_standard_exception_type => Standard_Exception_Type, gigi_operating_mode => Mode); end Call_Back_End; ----------------------------- -- Scan_Compiler_Arguments -- ----------------------------- procedure Scan_Compiler_Arguments is Next_Arg : Pos := 1; subtype Big_String is String (Positive); type BSP is access Big_String; type Arg_Array is array (Nat) of BSP; type Arg_Array_Ptr is access Arg_Array; -- Import flag_stack_check from toplev.c. flag_stack_check : Int; pragma Import (C, flag_stack_check); -- Import from toplev.c save_argc : Nat; pragma Import (C, save_argc); -- Import from toplev.c save_argv : Arg_Array_Ptr; pragma Import (C, save_argv); -- Import from toplev.c Output_File_Name_Seen : Boolean := False; -- Set to True after having scanned the file_name for -- switch "-gnatO file_name" -- Local functions function Len_Arg (Arg : Pos) return Nat; -- Determine length of argument number Arg on the original -- command line from gnat1 procedure Scan_Back_End_Switches (Switch_Chars : String); -- Procedure to scan out switches stored in Switch_Chars. The first -- character is known to be a valid switch character, and there are no -- blanks or other switch terminator characters in the string, so the -- entire string should consist of valid switch characters, except that -- an optional terminating NUL character is allowed. -- -- Back end switches have already been checked and processed by GCC -- in toplev.c, so no errors can occur and control will always return. -- The switches must still be scanned to skip the arguments of the -- "-o" or the (undocumented) "-dumpbase" switch, by incrementing -- the Next_Arg variable. The "-dumpbase" switch is used to set the -- basename for GCC dumpfiles. ------------- -- Len_Arg -- ------------- function Len_Arg (Arg : Pos) return Nat is begin for J in 1 .. Nat'Last loop if save_argv (Arg).all (Natural (J)) = ASCII.NUL then return J - 1; end if; end loop; raise Program_Error; end Len_Arg; ---------------------------- -- Scan_Back_End_Switches -- ---------------------------- procedure Scan_Back_End_Switches (Switch_Chars : String) is First : constant Positive := Switch_Chars'First + 1; Last : Natural := Switch_Chars'Last; begin if Last >= First and then Switch_Chars (Last) = ASCII.NUL then Last := Last - 1; end if; -- For dumpbase and o, skip following argument and do not -- store either the switch or the following argument if Switch_Chars (First .. Last) = "o" or else Switch_Chars (First .. Last) = "dumpbase" then Next_Arg := Next_Arg + 1; -- Do not record -quiet switch elsif Switch_Chars (First .. Last) = "quiet" then null; else -- Store any other GCC switches Store_Compilation_Switch (Switch_Chars); end if; end Scan_Back_End_Switches; -- Start of processing for Scan_Compiler_Arguments begin -- Acquire stack checking mode directly from GCC Opt.Stack_Checking_Enabled := (flag_stack_check /= 0); -- Loop through command line arguments, storing them for later access while Next_Arg < save_argc loop Look_At_Arg : declare Argv_Ptr : constant BSP := save_argv (Next_Arg); Argv_Len : constant Nat := Len_Arg (Next_Arg); Argv : String := Argv_Ptr (1 .. Natural (Argv_Len)); begin -- If the previous switch has set the Output_File_Name_Present -- flag (that is we have seen a -gnatO), then the next argument -- is the name of the output object file. if Output_File_Name_Present and then not Output_File_Name_Seen then if Is_Switch (Argv) then Fail ("Object file name missing after -gnatO"); else Set_Output_Object_File_Name (Argv); Output_File_Name_Seen := True; end if; elsif not Is_Switch (Argv) then -- must be a file name Add_File (Argv); -- We must recognize -nostdinc to suppress visibility on the -- standard GNAT RTL sources. This is also a gcc switch. elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then Opt.No_Stdinc := True; Scan_Back_End_Switches (Argv); elsif Is_Front_End_Switch (Argv) then Scan_Front_End_Switches (Argv); -- All non-front-end switches are back-end switches else Scan_Back_End_Switches (Argv); end if; end Look_At_Arg; Next_Arg := Next_Arg + 1; end loop; end Scan_Compiler_Arguments; end Back_End;