1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Atree; use Atree;
28 with Debug; use Debug;
29 with Elists; use Elists;
31 with Osint; use Osint;
33 with Osint; use Osint;
34 with Osint.C; use Osint.C;
35 with Namet; use Namet;
36 with Nlists; use Nlists;
37 with Stand; use Stand;
38 with Sinput; use Sinput;
39 with Stringt; use Stringt;
40 with Switch; use Switch;
41 with Switch.C; use Switch.C;
42 with System; use System;
43 with Types; use Types;
45 package body Back_End is
51 procedure Call_Back_End (Mode : Back_End_Mode_Type) is
53 -- The File_Record type has a lot of components that are meaningless
54 -- to the back end, so a new record is created here to contain the
55 -- needed information for each file.
57 type Needed_File_Info_Type is record
58 File_Name : File_Name_Type;
59 First_Sloc : Source_Ptr;
60 Last_Sloc : Source_Ptr;
61 Num_Source_Lines : Nat;
65 array (Main_Unit .. Last_Unit) of Needed_File_Info_Type;
73 next_node_ptr : Address;
74 prev_node_ptr : Address;
78 strings_ptr : Address;
79 string_chars_ptr : Address;
80 list_headers_ptr : Address;
83 file_info_ptr : Address;
84 gigi_standard_integer : Entity_Id;
85 gigi_standard_long_long_float : Entity_Id;
86 gigi_standard_exception_type : Entity_Id;
87 gigi_operating_mode : Back_End_Mode_Type);
89 pragma Import (C, gigi);
91 S : Source_File_Index;
94 -- Skip call if in -gnatdH mode
100 for J in Main_Unit .. Last_Unit loop
101 S := Source_Index (J);
102 File_Info_Array (J).File_Name := File_Name (S);
103 File_Info_Array (J).First_Sloc := Source_Text (S)'First;
104 File_Info_Array (J).Last_Sloc := Source_Text (S)'Last;
105 File_Info_Array (J).Num_Source_Lines := Num_Source_Lines (S);
109 gnat_root => Int (Cunit (Main_Unit)),
110 max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1),
111 number_name => Name_Entries_Count,
112 nodes_ptr => Nodes_Address,
114 next_node_ptr => Next_Node_Address,
115 prev_node_ptr => Prev_Node_Address,
116 elists_ptr => Elists_Address,
117 elmts_ptr => Elmts_Address,
119 strings_ptr => Strings_Address,
120 string_chars_ptr => String_Chars_Address,
121 list_headers_ptr => Lists_Address,
122 number_units => Num_Units,
124 file_info_ptr => File_Info_Array'Address,
125 gigi_standard_integer => Standard_Integer,
126 gigi_standard_long_long_float => Standard_Long_Long_Float,
127 gigi_standard_exception_type => Standard_Exception_Type,
128 gigi_operating_mode => Mode);
131 -----------------------------
132 -- Scan_Compiler_Arguments --
133 -----------------------------
135 procedure Scan_Compiler_Arguments is
139 subtype Big_String is String (Positive);
140 type BSP is access Big_String;
142 type Arg_Array is array (Nat) of BSP;
143 type Arg_Array_Ptr is access Arg_Array;
145 -- Import flag_stack_check from toplev.c.
147 flag_stack_check : Int;
148 pragma Import (C, flag_stack_check); -- Import from toplev.c
151 pragma Import (C, save_argc); -- Import from toplev.c
153 save_argv : Arg_Array_Ptr;
154 pragma Import (C, save_argv); -- Import from toplev.c
156 Output_File_Name_Seen : Boolean := False;
157 -- Set to True after having scanned the file_name for
158 -- switch "-gnatO file_name"
162 function Len_Arg (Arg : Pos) return Nat;
163 -- Determine length of argument number Arg on the original
164 -- command line from gnat1
166 procedure Scan_Back_End_Switches (Switch_Chars : String);
167 -- Procedure to scan out switches stored in Switch_Chars. The first
168 -- character is known to be a valid switch character, and there are no
169 -- blanks or other switch terminator characters in the string, so the
170 -- entire string should consist of valid switch characters, except that
171 -- an optional terminating NUL character is allowed.
173 -- Back end switches have already been checked and processed by GCC
174 -- in toplev.c, so no errors can occur and control will always return.
175 -- The switches must still be scanned to skip the arguments of the
176 -- "-o" or the (undocumented) "-dumpbase" switch, by incrementing
177 -- the Next_Arg variable. The "-dumpbase" switch is used to set the
178 -- basename for GCC dumpfiles.
184 function Len_Arg (Arg : Pos) return Nat is
186 for J in 1 .. Nat'Last loop
187 if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
195 ----------------------------
196 -- Scan_Back_End_Switches --
197 ----------------------------
199 procedure Scan_Back_End_Switches (Switch_Chars : String) is
200 First : constant Positive := Switch_Chars'First + 1;
201 Last : Natural := Switch_Chars'Last;
205 and then Switch_Chars (Last) = ASCII.NUL
210 -- For dumpbase and o, skip following argument and do not
211 -- store either the switch or the following argument
213 if Switch_Chars (First .. Last) = "o"
214 or else Switch_Chars (First .. Last) = "dumpbase"
217 Next_Arg := Next_Arg + 1;
219 -- Do not record -quiet switch
221 elsif Switch_Chars (First .. Last) = "quiet" then
225 -- Store any other GCC switches
227 Store_Compilation_Switch (Switch_Chars);
229 end Scan_Back_End_Switches;
231 -- Start of processing for Scan_Compiler_Arguments
234 -- Acquire stack checking mode directly from GCC
236 Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
238 -- Loop through command line arguments, storing them for later access
240 while Next_Arg < save_argc loop
242 Look_At_Arg : declare
243 Argv_Ptr : constant BSP := save_argv (Next_Arg);
244 Argv_Len : constant Nat := Len_Arg (Next_Arg);
245 Argv : constant String := Argv_Ptr (1 .. Natural (Argv_Len));
248 -- If the previous switch has set the Output_File_Name_Present
249 -- flag (that is we have seen a -gnatO), then the next argument
250 -- is the name of the output object file.
252 if Output_File_Name_Present
253 and then not Output_File_Name_Seen
255 if Is_Switch (Argv) then
256 Fail ("Object file name missing after -gnatO");
259 Set_Output_Object_File_Name (Argv);
260 Output_File_Name_Seen := True;
263 elsif not Is_Switch (Argv) then -- must be a file name
266 -- We must recognize -nostdinc to suppress visibility on the
267 -- standard GNAT RTL sources. This is also a gcc switch.
269 elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then
270 Opt.No_Stdinc := True;
271 Scan_Back_End_Switches (Argv);
273 -- We must recognize -nostdlib to suppress visibility on the
274 -- standard GNAT RTL objects.
276 elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then
277 Opt.No_Stdlib := True;
279 elsif Is_Front_End_Switch (Argv) then
280 Scan_Front_End_Switches (Argv);
282 -- All non-front-end switches are back-end switches
285 Scan_Back_End_Switches (Argv);
289 Next_Arg := Next_Arg + 1;
291 end Scan_Compiler_Arguments;