1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2010, 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 with System
.OS_Lib
; use System
.OS_Lib
;
45 package body Back_End
is
47 type Arg_Array
is array (Nat
) of Big_String_Ptr
;
48 type Arg_Array_Ptr
is access Arg_Array
;
49 -- Types to access compiler arguments
51 flag_stack_check
: Int
;
52 pragma Import
(C
, flag_stack_check
);
53 -- Indicates if stack checking is enabled, imported from decl.c
56 pragma Import
(C
, save_argc
);
57 -- Saved value of argc (number of arguments), imported from misc.c
59 save_argv
: Arg_Array_Ptr
;
60 pragma Import
(C
, save_argv
);
61 -- Saved value of argv (argument pointers), imported from misc.c
63 function Len_Arg
(Arg
: Pos
) return Nat
;
64 -- Determine length of argument number Arg on original gnat1 command line
70 procedure Call_Back_End
(Mode
: Back_End_Mode_Type
) is
72 -- The Source_File_Record type has a lot of components that are
73 -- meaningless to the back end, so a new record type is created
74 -- here to contain the needed information for each file.
76 type File_Info_Type
is record
77 File_Name
: File_Name_Type
;
78 Num_Source_Lines
: Nat
;
81 File_Info_Array
: array (1 .. Last_Source_File
) of File_Info_Type
;
89 next_node_ptr
: Address
;
90 prev_node_ptr
: Address
;
94 strings_ptr
: Address
;
95 string_chars_ptr
: Address
;
96 list_headers_ptr
: Address
;
99 file_info_ptr
: Address
;
100 gigi_standard_boolean
: Entity_Id
;
101 gigi_standard_integer
: Entity_Id
;
102 gigi_standard_character
: Entity_Id
;
103 gigi_standard_long_long_float
: Entity_Id
;
104 gigi_standard_exception_type
: Entity_Id
;
105 gigi_operating_mode
: Back_End_Mode_Type
);
107 pragma Import
(C
, gigi
);
110 -- Skip call if in -gnatdH mode
112 if Debug_Flag_HH
then
116 for J
in 1 .. Last_Source_File
loop
117 File_Info_Array
(J
).File_Name
:= Full_Debug_Name
(J
);
118 File_Info_Array
(J
).Num_Source_Lines
:= Num_Source_Lines
(J
);
122 (gnat_root
=> Int
(Cunit
(Main_Unit
)),
123 max_gnat_node
=> Int
(Last_Node_Id
- First_Node_Id
+ 1),
124 number_name
=> Name_Entries_Count
,
125 nodes_ptr
=> Nodes_Address
,
127 next_node_ptr
=> Next_Node_Address
,
128 prev_node_ptr
=> Prev_Node_Address
,
129 elists_ptr
=> Elists_Address
,
130 elmts_ptr
=> Elmts_Address
,
132 strings_ptr
=> Strings_Address
,
133 string_chars_ptr
=> String_Chars_Address
,
134 list_headers_ptr
=> Lists_Address
,
135 number_file
=> Num_Source_Files
,
137 file_info_ptr
=> File_Info_Array
'Address,
138 gigi_standard_boolean
=> Standard_Boolean
,
139 gigi_standard_integer
=> Standard_Integer
,
140 gigi_standard_character
=> Standard_Character
,
141 gigi_standard_long_long_float
=> Standard_Long_Long_Float
,
142 gigi_standard_exception_type
=> Standard_Exception_Type
,
143 gigi_operating_mode
=> Mode
);
150 function Len_Arg
(Arg
: Pos
) return Nat
is
152 for J
in 1 .. Nat
'Last loop
153 if save_argv
(Arg
).all (Natural (J
)) = ASCII
.NUL
then
161 -----------------------------
162 -- Scan_Compiler_Arguments --
163 -----------------------------
165 procedure Scan_Compiler_Arguments
is
168 -- Next argument to be scanned
170 Output_File_Name_Seen
: Boolean := False;
171 -- Set to True after having scanned file_name for switch "-gnatO file"
173 procedure Scan_Back_End_Switches
(Switch_Chars
: String);
174 -- Procedure to scan out switches stored in Switch_Chars. The first
175 -- character is known to be a valid switch character, and there are no
176 -- blanks or other switch terminator characters in the string, so the
177 -- entire string should consist of valid switch characters, except that
178 -- an optional terminating NUL character is allowed.
180 -- Back end switches have already been checked and processed by GCC in
181 -- toplev.c, so no errors can occur and control will always return. The
182 -- switches must still be scanned to skip "-o" or internal GCC switches
183 -- with their argument.
185 ----------------------------
186 -- Scan_Back_End_Switches --
187 ----------------------------
189 procedure Scan_Back_End_Switches
(Switch_Chars
: String) is
190 First
: constant Positive := Switch_Chars
'First + 1;
191 Last
: constant Natural := Switch_Last
(Switch_Chars
);
194 -- Skip -o or internal GCC switches together with their argument
196 if Switch_Chars
(First
.. Last
) = "o"
197 or else Is_Internal_GCC_Switch
(Switch_Chars
)
199 Next_Arg
:= Next_Arg
+ 1;
201 -- Do not record -quiet switch
203 elsif Switch_Chars
(First
.. Last
) = "quiet" then
206 -- Store any other GCC switches
209 Store_Compilation_Switch
(Switch_Chars
);
211 -- Special check, the back end switch -fno-inline also sets the
212 -- front end flag to entirely inhibit all inlining.
214 if Switch_Chars
(First
.. Last
) = "fno-inline" then
215 Opt
.Suppress_All_Inlining
:= True;
217 -- Another special check, the switch -fpreserve-control-flow
218 -- which is also a back end switch sets the front end flag
219 -- that inhibits improper control flow transformations.
221 elsif Switch_Chars
(First
.. Last
) = "fpreserve-control-flow" then
222 Opt
.Suppress_Control_Flow_Optimizations
:= True;
225 end Scan_Back_End_Switches
;
229 Arg_Count
: constant Natural := Natural (save_argc
- 1);
230 Args
: Argument_List
(1 .. Arg_Count
);
232 -- Start of processing for Scan_Compiler_Arguments
235 -- Acquire stack checking mode directly from GCC
237 Opt
.Stack_Checking_Enabled
:= (flag_stack_check
/= 0);
239 -- Put the arguments in Args
241 for Arg
in Pos
range 1 .. save_argc
- 1 loop
243 Argv_Ptr
: constant Big_String_Ptr
:= save_argv
(Arg
);
244 Argv_Len
: constant Nat
:= Len_Arg
(Arg
);
245 Argv
: constant String :=
246 Argv_Ptr
(1 .. Natural (Argv_Len
));
248 Args
(Positive (Arg
)) := new String'(Argv);
252 -- Loop through command line arguments, storing them for later access
255 while Next_Arg <= Args'Last loop
256 Look_At_Arg : declare
257 Argv : constant String := Args (Next_Arg).all;
260 -- If the previous switch has set the Output_File_Name_Present
261 -- flag (that is we have seen a -gnatO), then the next argument
262 -- is the name of the output object file.
264 if Output_File_Name_Present
265 and then not Output_File_Name_Seen
267 if Is_Switch (Argv) then
268 Fail ("Object file name missing after -gnatO");
271 Set_Output_Object_File_Name (Argv);
272 Output_File_Name_Seen := True;
275 -- If the previous switch has set the Search_Directory_Present
276 -- flag (that is if we have just seen -I), then the next argument
277 -- is a search directory path.
279 elsif Search_Directory_Present then
280 if Is_Switch (Argv) then
281 Fail ("search directory missing after -I");
283 Add_Src_Search_Dir (Argv);
284 Search_Directory_Present := False;
287 elsif not Is_Switch (Argv) then -- must be a file name
290 -- We must recognize -nostdinc to suppress visibility on the
291 -- standard GNAT RTL sources. This is also a gcc switch.
293 elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then
294 Opt.No_Stdinc := True;
295 Scan_Back_End_Switches (Argv);
297 -- We must recognize -nostdlib to suppress visibility on the
298 -- standard GNAT RTL objects.
300 elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then
301 Opt.No_Stdlib := True;
303 elsif Is_Front_End_Switch (Argv) then
304 Scan_Front_End_Switches (Argv, Args, Next_Arg);
306 -- All non-front-end switches are back-end switches
309 Scan_Back_End_Switches (Argv);
313 Next_Arg := Next_Arg + 1;
315 end Scan_Compiler_Arguments;