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 Source_File_Record type has a lot of components that are
52 -- meaningless to the back end, so a new record type is created
53 -- here to contain the needed information for each file.
55 type File_Info_Type
is record
56 File_Name
: File_Name_Type
;
57 Num_Source_Lines
: Nat
;
60 File_Info_Array
: array (1 .. Last_Source_File
) of File_Info_Type
;
68 next_node_ptr
: Address
;
69 prev_node_ptr
: Address
;
73 strings_ptr
: Address
;
74 string_chars_ptr
: Address
;
75 list_headers_ptr
: Address
;
78 file_info_ptr
: Address
;
79 gigi_standard_integer
: Entity_Id
;
80 gigi_standard_long_long_float
: Entity_Id
;
81 gigi_standard_exception_type
: Entity_Id
;
82 gigi_operating_mode
: Back_End_Mode_Type
);
84 pragma Import
(C
, gigi
);
87 -- Skip call if in -gnatdH mode
93 for I
in 1 .. Last_Source_File
loop
94 File_Info_Array
(I
).File_Name
:= Full_Debug_Name
(I
);
95 File_Info_Array
(I
).Num_Source_Lines
:= Num_Source_Lines
(I
);
99 gnat_root
=> Int
(Cunit
(Main_Unit
)),
100 max_gnat_node
=> Int
(Last_Node_Id
- First_Node_Id
+ 1),
101 number_name
=> Name_Entries_Count
,
102 nodes_ptr
=> Nodes_Address
,
104 next_node_ptr
=> Next_Node_Address
,
105 prev_node_ptr
=> Prev_Node_Address
,
106 elists_ptr
=> Elists_Address
,
107 elmts_ptr
=> Elmts_Address
,
109 strings_ptr
=> Strings_Address
,
110 string_chars_ptr
=> String_Chars_Address
,
111 list_headers_ptr
=> Lists_Address
,
112 number_file
=> Num_Source_Files
,
114 file_info_ptr
=> File_Info_Array
'Address,
115 gigi_standard_integer
=> Standard_Integer
,
116 gigi_standard_long_long_float
=> Standard_Long_Long_Float
,
117 gigi_standard_exception_type
=> Standard_Exception_Type
,
118 gigi_operating_mode
=> Mode
);
121 -----------------------------
122 -- Scan_Compiler_Arguments --
123 -----------------------------
125 procedure Scan_Compiler_Arguments
is
128 subtype Big_String
is String (Positive);
129 type BSP
is access Big_String
;
131 type Arg_Array
is array (Nat
) of BSP
;
132 type Arg_Array_Ptr
is access Arg_Array
;
134 -- Import flag_stack_check from toplev.c
136 flag_stack_check
: Int
;
137 pragma Import
(C
, flag_stack_check
); -- Import from toplev.c
140 pragma Import
(C
, save_argc
); -- Import from toplev.c
142 save_argv
: Arg_Array_Ptr
;
143 pragma Import
(C
, save_argv
); -- Import from toplev.c
145 Output_File_Name_Seen
: Boolean := False;
146 -- Set to True after having scanned the file_name for
147 -- switch "-gnatO file_name"
151 function Len_Arg
(Arg
: Pos
) return Nat
;
152 -- Determine length of argument number Arg on the original
153 -- command line from gnat1
155 procedure Scan_Back_End_Switches
(Switch_Chars
: String);
156 -- Procedure to scan out switches stored in Switch_Chars. The first
157 -- character is known to be a valid switch character, and there are no
158 -- blanks or other switch terminator characters in the string, so the
159 -- entire string should consist of valid switch characters, except that
160 -- an optional terminating NUL character is allowed.
162 -- Back end switches have already been checked and processed by GCC
163 -- in toplev.c, so no errors can occur and control will always return.
164 -- The switches must still be scanned to skip the arguments of the
165 -- "-o" or the (undocumented) "-dumpbase" switch, by incrementing
166 -- the Next_Arg variable. The "-dumpbase" switch is used to set the
167 -- basename for GCC dumpfiles.
173 function Len_Arg
(Arg
: Pos
) return Nat
is
175 for J
in 1 .. Nat
'Last loop
176 if save_argv
(Arg
).all (Natural (J
)) = ASCII
.NUL
then
184 ----------------------------
185 -- Scan_Back_End_Switches --
186 ----------------------------
188 procedure Scan_Back_End_Switches
(Switch_Chars
: String) is
189 First
: constant Positive := Switch_Chars
'First + 1;
190 Last
: Natural := Switch_Chars
'Last;
194 and then Switch_Chars
(Last
) = ASCII
.NUL
199 -- For these switches, skip following argument and do not
200 -- store either the switch or the following argument
202 if Switch_Chars
(First
.. Last
) = "o"
203 or else Switch_Chars
(First
.. Last
) = "dumpbase"
204 or else Switch_Chars
(First
.. Last
) = "-param"
207 Next_Arg
:= Next_Arg
+ 1;
209 -- Do not record -quiet switch
211 elsif Switch_Chars
(First
.. Last
) = "quiet" then
215 -- Store any other GCC switches
217 Store_Compilation_Switch
(Switch_Chars
);
219 -- Special check, the back end switch -fno-inline also sets the
220 -- front end flag to entirely inhibit all inlining.
222 if Switch_Chars
(First
.. Last
) = "fno-inline" then
223 Opt
.Suppress_All_Inlining
:= True;
226 end Scan_Back_End_Switches
;
228 -- Start of processing for Scan_Compiler_Arguments
231 -- Acquire stack checking mode directly from GCC
233 Opt
.Stack_Checking_Enabled
:= (flag_stack_check
/= 0);
235 -- Loop through command line arguments, storing them for later access
237 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
: constant 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 -- If the previous switch has set the Search_Directory_Present
260 -- flag (that is if we have just seen -I), then the next
261 -- argument is a search directory path.
263 elsif Search_Directory_Present
then
264 if Is_Switch
(Argv
) then
265 Fail
("search directory missing after -I");
267 Add_Src_Search_Dir
(Argv
);
268 Search_Directory_Present
:= False;
271 elsif not Is_Switch
(Argv
) then -- must be a file name
274 -- We must recognize -nostdinc to suppress visibility on the
275 -- standard GNAT RTL sources. This is also a gcc switch.
277 elsif Argv
(Argv
'First + 1 .. Argv
'Last) = "nostdinc" then
278 Opt
.No_Stdinc
:= True;
279 Scan_Back_End_Switches
(Argv
);
281 -- We must recognize -nostdlib to suppress visibility on the
282 -- standard GNAT RTL objects.
284 elsif Argv
(Argv
'First + 1 .. Argv
'Last) = "nostdlib" then
285 Opt
.No_Stdlib
:= True;
287 elsif Is_Front_End_Switch
(Argv
) then
288 Scan_Front_End_Switches
(Argv
);
290 -- All non-front-end switches are back-end switches
293 Scan_Back_End_Switches
(Argv
);
297 Next_Arg
:= Next_Arg
+ 1;
299 end Scan_Compiler_Arguments
;