+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- B A C K _ E N D --
--- --
--- B o d y --
--- --
--- $Revision: 1.1.16.1 $
--- --
--- 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 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;
projects / msp430-gcc.git / blobdiff