1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
27 ------------------------------------------------------------------------------
29 with Atree; use Atree;
30 with Debug; use Debug;
31 with Elists; use Elists;
33 with Osint; use Osint;
35 with Osint; use Osint;
36 with Namet; use Namet;
37 with Nlists; use Nlists;
38 with Stand; use Stand;
39 with Sinput; use Sinput;
40 with Stringt; use Stringt;
41 with Switch; use Switch;
42 with System; use System;
43 with Types; use Types;
45 package body Back_End is
53 procedure Call_Back_End (Mode : Back_End_Mode_Type) is
55 -- The File_Record type has a lot of components that are meaningless
56 -- to the back end, so a new record is created here to contain the
57 -- needed information for each file.
59 type Needed_File_Info_Type is record
60 File_Name : File_Name_Type;
61 First_Sloc : Source_Ptr;
62 Last_Sloc : Source_Ptr;
63 Num_Source_Lines : Nat;
67 array (Main_Unit .. Last_Unit) of Needed_File_Info_Type;
75 next_node_ptr : Address;
76 prev_node_ptr : Address;
80 strings_ptr : Address;
81 string_chars_ptr : Address;
82 list_headers_ptr : Address;
85 file_info_ptr : Address;
86 gigi_standard_integer : Entity_Id;
87 gigi_standard_long_long_float : Entity_Id;
88 gigi_standard_exception_type : Entity_Id;
89 gigi_operating_mode : Back_End_Mode_Type);
91 pragma Import (C, gigi);
93 S : Source_File_Index;
96 -- Skip call if in -gnatdH mode
102 for J in Main_Unit .. Last_Unit loop
103 S := Source_Index (J);
104 File_Info_Array (J).File_Name := File_Name (S);
105 File_Info_Array (J).First_Sloc := Source_Text (S)'First;
106 File_Info_Array (J).Last_Sloc := Source_Text (S)'Last;
107 File_Info_Array (J).Num_Source_Lines := Num_Source_Lines (S);
111 gnat_root => Int (Cunit (Main_Unit)),
112 max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1),
113 number_name => Name_Entries_Count,
114 nodes_ptr => Nodes_Address,
116 next_node_ptr => Next_Node_Address,
117 prev_node_ptr => Prev_Node_Address,
118 elists_ptr => Elists_Address,
119 elmts_ptr => Elmts_Address,
121 strings_ptr => Strings_Address,
122 string_chars_ptr => String_Chars_Address,
123 list_headers_ptr => Lists_Address,
124 number_units => Num_Units,
126 file_info_ptr => File_Info_Array'Address,
127 gigi_standard_integer => Standard_Integer,
128 gigi_standard_long_long_float => Standard_Long_Long_Float,
129 gigi_standard_exception_type => Standard_Exception_Type,
130 gigi_operating_mode => Mode);
133 -----------------------------
134 -- Scan_Compiler_Arguments --
135 -----------------------------
137 procedure Scan_Compiler_Arguments is
141 subtype Big_String is String (Positive);
142 type BSP is access Big_String;
144 type Arg_Array is array (Nat) of BSP;
145 type Arg_Array_Ptr is access Arg_Array;
147 -- Import flag_stack_check from toplev.c.
149 flag_stack_check : Int;
150 pragma Import (C, flag_stack_check); -- Import from toplev.c
153 pragma Import (C, save_argc); -- Import from toplev.c
155 save_argv : Arg_Array_Ptr;
156 pragma Import (C, save_argv); -- Import from toplev.c
158 Output_File_Name_Seen : Boolean := False;
159 -- Set to True after having scanned the file_name for
160 -- switch "-gnatO file_name"
164 function Len_Arg (Arg : Pos) return Nat;
165 -- Determine length of argument number Arg on the original
166 -- command line from gnat1
168 procedure Scan_Back_End_Switches (Switch_Chars : String);
169 -- Procedure to scan out switches stored in Switch_Chars. The first
170 -- character is known to be a valid switch character, and there are no
171 -- blanks or other switch terminator characters in the string, so the
172 -- entire string should consist of valid switch characters, except that
173 -- an optional terminating NUL character is allowed.
175 -- Back end switches have already been checked and processed by GCC
176 -- in toplev.c, so no errors can occur and control will always return.
177 -- The switches must still be scanned to skip the arguments of the
178 -- "-o" or the (undocumented) "-dumpbase" switch, by incrementing
179 -- the Next_Arg variable. The "-dumpbase" switch is used to set the
180 -- basename for GCC dumpfiles.
186 function Len_Arg (Arg : Pos) return Nat is
188 for J in 1 .. Nat'Last loop
189 if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
197 ----------------------------
198 -- Scan_Back_End_Switches --
199 ----------------------------
201 procedure Scan_Back_End_Switches (Switch_Chars : String) is
202 First : constant Positive := Switch_Chars'First + 1;
203 Last : Natural := Switch_Chars'Last;
207 and then Switch_Chars (Last) = ASCII.NUL
212 if Switch_Chars (First .. Last) = "o"
213 or else Switch_Chars (First .. Last) = "dumpbase"
216 Next_Arg := Next_Arg + 1;
218 elsif Switch_Chars (First .. Last) = "quiet" then
219 null; -- do not record this switch
222 -- Store any other GCC switches
223 Store_Compilation_Switch (Switch_Chars);
225 end Scan_Back_End_Switches;
227 -- Start of processing for Scan_Compiler_Arguments
230 -- Acquire stack checking mode directly from GCC
232 Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
234 -- Loop through command line arguments, storing them for later access
236 while Next_Arg < save_argc loop
238 Look_At_Arg : declare
239 Argv_Ptr : constant BSP := save_argv (Next_Arg);
240 Argv_Len : constant Nat := Len_Arg (Next_Arg);
241 Argv : String := Argv_Ptr (1 .. Natural (Argv_Len));
244 -- If the previous switch has set the Output_File_Name_Present
245 -- flag (that is we have seen a -gnatO), then the next argument
246 -- is the name of the output object file.
248 if Output_File_Name_Present
249 and then not Output_File_Name_Seen
251 if Is_Switch (Argv) then
252 Fail ("Object file name missing after -gnatO");
255 Set_Output_Object_File_Name (Argv);
256 Output_File_Name_Seen := True;
259 elsif not Is_Switch (Argv) then -- must be a file name
262 elsif Is_Front_End_Switch (Argv) then
263 Scan_Front_End_Switches (Argv);
265 -- ??? Should be done in Scan_Front_End_Switches, after
266 -- Switch is splitted in compiler/make/bind units
268 if Argv (2) /= 'I' then
269 Store_Compilation_Switch (Argv);
272 -- All non-front-end switches are back-end switches
275 Scan_Back_End_Switches (Argv);
279 Next_Arg := Next_Arg + 1;
281 end Scan_Compiler_Arguments;