| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- B A C K _ E N D -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- $Revision: 1.23 $ |
| -- -- |
| -- 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. -- |
| -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| 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 Namet; use Namet; |
| with Nlists; use Nlists; |
| with Stand; use Stand; |
| with Sinput; use Sinput; |
| with Stringt; use Stringt; |
| with Switch; use Switch; |
| with System; use System; |
| with Types; use Types; |
| |
| package body Back_End is |
| |
| -- Local subprograms |
| |
| ------------------- |
| -- 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; |
| |
| if Switch_Chars (First .. Last) = "o" |
| or else Switch_Chars (First .. Last) = "dumpbase" |
| |
| then |
| Next_Arg := Next_Arg + 1; |
| |
| elsif Switch_Chars (First .. Last) = "quiet" then |
| null; -- do not record this switch |
| |
| 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); |
| |
| elsif Is_Front_End_Switch (Argv) then |
| Scan_Front_End_Switches (Argv); |
| |
| -- ??? Should be done in Scan_Front_End_Switches, after |
| -- Switch is splitted in compiler/make/bind units |
| |
| if Argv (2) /= 'I' then |
| Store_Compilation_Switch (Argv); |
| end if; |
| |
| -- 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; |
