1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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 3, 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 COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree; use Atree;
27 with Debug; use Debug;
28 with Elists; use Elists;
30 with Osint; use Osint;
32 with Osint.C; use Osint.C;
33 with Namet; use Namet;
34 with Nlists; use Nlists;
35 with Stand; use Stand;
36 with Sinput; use Sinput;
37 with Stringt; use Stringt;
38 with Switch; use Switch;
39 with Switch.C; use Switch.C;
40 with System; use System;
41 with Types; use Types;
43 package body Back_End is
49 procedure Call_Back_End (Mode : Back_End_Mode_Type) is
51 -- The File_Record type has a lot of components that are meaningless
52 -- to the back end, so a new record is created here to contain the
53 -- needed information for each file.
55 type Needed_File_Info_Type is record
56 File_Name : File_Name_Type;
57 First_Sloc : Source_Ptr;
58 Last_Sloc : Source_Ptr;
59 Num_Source_Lines : Nat;
63 array (Main_Unit .. Last_Unit) of Needed_File_Info_Type;
71 next_node_ptr : Address;
72 prev_node_ptr : Address;
76 strings_ptr : Address;
77 string_chars_ptr : Address;
78 list_headers_ptr : Address;
81 file_info_ptr : Address;
82 gigi_standard_integer : Entity_Id;
83 gigi_standard_long_long_float : Entity_Id;
84 gigi_standard_exception_type : Entity_Id;
85 gigi_operating_mode : Back_End_Mode_Type);
87 pragma Import (C, gigi);
89 S : Source_File_Index;
92 -- Skip call if in -gnatdH mode
98 for J in Main_Unit .. Last_Unit loop
99 S := Source_Index (J);
100 File_Info_Array (J).File_Name := File_Name (S);
101 File_Info_Array (J).First_Sloc := Source_Text (S)'First;
102 File_Info_Array (J).Last_Sloc := Source_Text (S)'Last;
103 File_Info_Array (J).Num_Source_Lines := Num_Source_Lines (S);
107 gnat_root => Int (Cunit (Main_Unit)),
108 max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1),
109 number_name => Name_Entries_Count,
110 nodes_ptr => Nodes_Address,
112 next_node_ptr => Next_Node_Address,
113 prev_node_ptr => Prev_Node_Address,
114 elists_ptr => Elists_Address,
115 elmts_ptr => Elmts_Address,
117 strings_ptr => Strings_Address,
118 string_chars_ptr => String_Chars_Address,
119 list_headers_ptr => Lists_Address,
120 number_units => Num_Units,
122 file_info_ptr => File_Info_Array'Address,
123 gigi_standard_integer => Standard_Integer,
124 gigi_standard_long_long_float => Standard_Long_Long_Float,
125 gigi_standard_exception_type => Standard_Exception_Type,
126 gigi_operating_mode => Mode);
129 -----------------------------
130 -- Scan_Compiler_Arguments --
131 -----------------------------
133 procedure Scan_Compiler_Arguments is
137 subtype Big_String is String (Positive);
138 type BSP is access Big_String;
140 type Arg_Array is array (Nat) of BSP;
141 type Arg_Array_Ptr is access Arg_Array;
143 -- Import flag_stack_check from toplev.c
145 flag_stack_check : Int;
146 pragma Import (C, flag_stack_check); -- Import from toplev.c
149 pragma Import (C, save_argc); -- Import from toplev.c
151 save_argv : Arg_Array_Ptr;
152 pragma Import (C, save_argv); -- Import from toplev.c
154 Output_File_Name_Seen : Boolean := False;
155 -- Set to True after having scanned the file_name for
156 -- switch "-gnatO file_name"
160 function Len_Arg (Arg : Pos) return Nat;
161 -- Determine length of argument number Arg on the original
162 -- command line from gnat1
164 procedure Scan_Back_End_Switches (Switch_Chars : String);
165 -- Procedure to scan out switches stored in Switch_Chars. The first
166 -- character is known to be a valid switch character, and there are no
167 -- blanks or other switch terminator characters in the string, so the
168 -- entire string should consist of valid switch characters, except that
169 -- an optional terminating NUL character is allowed.
171 -- Back end switches have already been checked and processed by GCC
172 -- in toplev.c, so no errors can occur and control will always return.
173 -- The switches must still be scanned to skip the arguments of the
174 -- "-o" or the (undocumented) "-dumpbase" switch, by incrementing
175 -- the Next_Arg variable. The "-dumpbase" switch is used to set the
176 -- basename for GCC dumpfiles.
182 function Len_Arg (Arg : Pos) return Nat is
184 for J in 1 .. Nat'Last loop
185 if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
193 ----------------------------
194 -- Scan_Back_End_Switches --
195 ----------------------------
197 procedure Scan_Back_End_Switches (Switch_Chars : String) is
198 First : constant Positive := Switch_Chars'First + 1;
199 Last : Natural := Switch_Chars'Last;
203 and then Switch_Chars (Last) = ASCII.NUL
208 -- For these switches, skip following argument and do not
209 -- store either the switch or the following argument
211 if Switch_Chars (First .. Last) = "o"
212 or else Switch_Chars (First .. Last) = "dumpbase"
213 or else Switch_Chars (First .. Last) = "-param"
216 Next_Arg := Next_Arg + 1;
218 -- Do not record -quiet switch
220 elsif Switch_Chars (First .. Last) = "quiet" then
224 -- Store any other GCC switches
226 Store_Compilation_Switch (Switch_Chars);
228 end Scan_Back_End_Switches;
230 -- Start of processing for Scan_Compiler_Arguments
233 -- Acquire stack checking mode directly from GCC
235 Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
237 -- Loop through command line arguments, storing them for later access
239 while Next_Arg < save_argc loop
240 Look_At_Arg : declare
241 Argv_Ptr : constant BSP := save_argv (Next_Arg);
242 Argv_Len : constant Nat := Len_Arg (Next_Arg);
243 Argv : constant String := Argv_Ptr (1 .. Natural (Argv_Len));
246 -- If the previous switch has set the Output_File_Name_Present
247 -- flag (that is we have seen a -gnatO), then the next argument
248 -- is the name of the output object file.
250 if Output_File_Name_Present
251 and then not Output_File_Name_Seen
253 if Is_Switch (Argv) then
254 Fail ("Object file name missing after -gnatO");
257 Set_Output_Object_File_Name (Argv);
258 Output_File_Name_Seen := True;
261 -- If the previous switch has set the Search_Directory_Present
262 -- flag (that is if we have just seen -I), then the next
263 -- argument is a search directory path.
265 elsif Search_Directory_Present then
266 if Is_Switch (Argv) then
267 Fail ("search directory missing after -I");
269 Add_Src_Search_Dir (Argv);
270 Search_Directory_Present := False;
273 elsif not Is_Switch (Argv) then -- must be a file name
276 -- We must recognize -nostdinc to suppress visibility on the
277 -- standard GNAT RTL sources. This is also a gcc switch.
279 elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then
280 Opt.No_Stdinc := True;
281 Scan_Back_End_Switches (Argv);
283 -- We must recognize -nostdlib to suppress visibility on the
284 -- standard GNAT RTL objects.
286 elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then
287 Opt.No_Stdlib := True;
289 elsif Is_Front_End_Switch (Argv) then
290 Scan_Front_End_Switches (Argv);
292 -- All non-front-end switches are back-end switches
295 Scan_Back_End_Switches (Argv);
299 Next_Arg := Next_Arg + 1;
301 end Scan_Compiler_Arguments;