1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2006, 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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, 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
.C
; use Osint
.C
;
34 with Namet
; use Namet
;
35 with Nlists
; use Nlists
;
36 with Stand
; use Stand
;
37 with Sinput
; use Sinput
;
38 with Stringt
; use Stringt
;
39 with Switch
; use Switch
;
40 with Switch
.C
; use Switch
.C
;
41 with System
; use System
;
42 with Types
; use Types
;
44 package body Back_End
is
50 procedure Call_Back_End
(Mode
: Back_End_Mode_Type
) is
52 -- The File_Record type has a lot of components that are meaningless
53 -- to the back end, so a new record is created here to contain the
54 -- needed information for each file.
56 type Needed_File_Info_Type
is record
57 File_Name
: File_Name_Type
;
58 First_Sloc
: Source_Ptr
;
59 Last_Sloc
: Source_Ptr
;
60 Num_Source_Lines
: Nat
;
64 array (Main_Unit
.. Last_Unit
) of Needed_File_Info_Type
;
72 next_node_ptr
: Address
;
73 prev_node_ptr
: Address
;
77 strings_ptr
: Address
;
78 string_chars_ptr
: Address
;
79 list_headers_ptr
: Address
;
82 file_info_ptr
: Address
;
83 gigi_standard_integer
: Entity_Id
;
84 gigi_standard_long_long_float
: Entity_Id
;
85 gigi_standard_exception_type
: Entity_Id
;
86 gigi_operating_mode
: Back_End_Mode_Type
);
88 pragma Import
(C
, gigi
);
90 S
: Source_File_Index
;
93 -- Skip call if in -gnatdH mode
99 for J
in Main_Unit
.. Last_Unit
loop
100 S
:= Source_Index
(J
);
101 File_Info_Array
(J
).File_Name
:= File_Name
(S
);
102 File_Info_Array
(J
).First_Sloc
:= Source_Text
(S
)'First;
103 File_Info_Array
(J
).Last_Sloc
:= Source_Text
(S
)'Last;
104 File_Info_Array
(J
).Num_Source_Lines
:= Num_Source_Lines
(S
);
108 gnat_root
=> Int
(Cunit
(Main_Unit
)),
109 max_gnat_node
=> Int
(Last_Node_Id
- First_Node_Id
+ 1),
110 number_name
=> Name_Entries_Count
,
111 nodes_ptr
=> Nodes_Address
,
113 next_node_ptr
=> Next_Node_Address
,
114 prev_node_ptr
=> Prev_Node_Address
,
115 elists_ptr
=> Elists_Address
,
116 elmts_ptr
=> Elmts_Address
,
118 strings_ptr
=> Strings_Address
,
119 string_chars_ptr
=> String_Chars_Address
,
120 list_headers_ptr
=> Lists_Address
,
121 number_units
=> Num_Units
,
123 file_info_ptr
=> File_Info_Array
'Address,
124 gigi_standard_integer
=> Standard_Integer
,
125 gigi_standard_long_long_float
=> Standard_Long_Long_Float
,
126 gigi_standard_exception_type
=> Standard_Exception_Type
,
127 gigi_operating_mode
=> Mode
);
130 -----------------------------
131 -- Scan_Compiler_Arguments --
132 -----------------------------
134 procedure Scan_Compiler_Arguments
is
138 subtype Big_String
is String (Positive);
139 type BSP
is access Big_String
;
141 type Arg_Array
is array (Nat
) of BSP
;
142 type Arg_Array_Ptr
is access Arg_Array
;
144 -- Import flag_stack_check from toplev.c
146 flag_stack_check
: Int
;
147 pragma Import
(C
, flag_stack_check
); -- Import from toplev.c
150 pragma Import
(C
, save_argc
); -- Import from toplev.c
152 save_argv
: Arg_Array_Ptr
;
153 pragma Import
(C
, save_argv
); -- Import from toplev.c
155 Output_File_Name_Seen
: Boolean := False;
156 -- Set to True after having scanned the file_name for
157 -- switch "-gnatO file_name"
161 function Len_Arg
(Arg
: Pos
) return Nat
;
162 -- Determine length of argument number Arg on the original
163 -- command line from gnat1
165 procedure Scan_Back_End_Switches
(Switch_Chars
: String);
166 -- Procedure to scan out switches stored in Switch_Chars. The first
167 -- character is known to be a valid switch character, and there are no
168 -- blanks or other switch terminator characters in the string, so the
169 -- entire string should consist of valid switch characters, except that
170 -- an optional terminating NUL character is allowed.
172 -- Back end switches have already been checked and processed by GCC
173 -- in toplev.c, so no errors can occur and control will always return.
174 -- The switches must still be scanned to skip the arguments of the
175 -- "-o" or the (undocumented) "-dumpbase" switch, by incrementing
176 -- the Next_Arg variable. The "-dumpbase" switch is used to set the
177 -- basename for GCC dumpfiles.
183 function Len_Arg
(Arg
: Pos
) return Nat
is
185 for J
in 1 .. Nat
'Last loop
186 if save_argv
(Arg
).all (Natural (J
)) = ASCII
.NUL
then
194 ----------------------------
195 -- Scan_Back_End_Switches --
196 ----------------------------
198 procedure Scan_Back_End_Switches
(Switch_Chars
: String) is
199 First
: constant Positive := Switch_Chars
'First + 1;
200 Last
: Natural := Switch_Chars
'Last;
204 and then Switch_Chars
(Last
) = ASCII
.NUL
209 -- For these switches, skip following argument and do not
210 -- store either the switch or the following argument
212 if Switch_Chars
(First
.. Last
) = "o"
213 or else Switch_Chars
(First
.. Last
) = "dumpbase"
214 or else Switch_Chars
(First
.. Last
) = "-param"
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
241 Look_At_Arg
: declare
242 Argv_Ptr
: constant BSP
:= save_argv
(Next_Arg
);
243 Argv_Len
: constant Nat
:= Len_Arg
(Next_Arg
);
244 Argv
: constant String := Argv_Ptr
(1 .. Natural (Argv_Len
));
247 -- If the previous switch has set the Output_File_Name_Present
248 -- flag (that is we have seen a -gnatO), then the next argument
249 -- is the name of the output object file.
251 if Output_File_Name_Present
252 and then not Output_File_Name_Seen
254 if Is_Switch
(Argv
) then
255 Fail
("Object file name missing after -gnatO");
258 Set_Output_Object_File_Name
(Argv
);
259 Output_File_Name_Seen
:= True;
262 -- If the previous switch has set the Search_Directory_Present
263 -- flag (that is if we have just seen -I), then the next
264 -- argument is a search directory path.
266 elsif Search_Directory_Present
then
267 if Is_Switch
(Argv
) then
268 Fail
("search directory missing after -I");
270 Add_Src_Search_Dir
(Argv
);
271 Search_Directory_Present
:= False;
274 elsif not Is_Switch
(Argv
) then -- must be a file name
277 -- We must recognize -nostdinc to suppress visibility on the
278 -- standard GNAT RTL sources. This is also a gcc switch.
280 elsif Argv
(Argv
'First + 1 .. Argv
'Last) = "nostdinc" then
281 Opt
.No_Stdinc
:= True;
282 Scan_Back_End_Switches
(Argv
);
284 -- We must recognize -nostdlib to suppress visibility on the
285 -- standard GNAT RTL objects.
287 elsif Argv
(Argv
'First + 1 .. Argv
'Last) = "nostdlib" then
288 Opt
.No_Stdlib
:= True;
290 elsif Is_Front_End_Switch
(Argv
) then
291 Scan_Front_End_Switches
(Argv
);
293 -- All non-front-end switches are back-end switches
296 Scan_Back_End_Switches
(Argv
);
300 Next_Arg
:= Next_Arg
+ 1;
302 end Scan_Compiler_Arguments
;