1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
|
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- B A C K _ E N D --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Debug; use Debug;
with Elists; use Elists;
with Lib; use Lib;
with Osint; use Osint;
with Opt; use Opt;
with Osint.C; use Osint.C;
with Namet; use Namet;
with Nlists; use Nlists;
with Stand; use Stand;
with Sinput; use Sinput;
with Stringt; use Stringt;
with Switch; use Switch;
with Switch.C; use Switch.C;
with System; use System;
with Types; use Types;
package body Back_End is
-------------------
-- Call_Back_End --
-------------------
procedure Call_Back_End (Mode : Back_End_Mode_Type) is
-- The Source_File_Record type has a lot of components that are
-- meaningless to the back end, so a new record type is created
-- here to contain the needed information for each file.
type File_Info_Type is record
File_Name : File_Name_Type;
Num_Source_Lines : Nat;
end record;
File_Info_Array : array (1 .. Last_Source_File) of File_Info_Type;
procedure gigi
(gnat_root : Int;
max_gnat_node : Int;
number_name : Nat;
nodes_ptr : Address;
next_node_ptr : Address;
prev_node_ptr : Address;
elists_ptr : Address;
elmts_ptr : Address;
strings_ptr : Address;
string_chars_ptr : Address;
list_headers_ptr : Address;
number_file : Nat;
file_info_ptr : Address;
gigi_standard_boolean : Entity_Id;
gigi_standard_integer : Entity_Id;
gigi_standard_long_long_float : Entity_Id;
gigi_standard_exception_type : Entity_Id;
gigi_operating_mode : Back_End_Mode_Type);
pragma Import (C, gigi);
begin
-- Skip call if in -gnatdH mode
if Debug_Flag_HH then
return;
end if;
for J in 1 .. Last_Source_File loop
File_Info_Array (J).File_Name := Full_Debug_Name (J);
File_Info_Array (J).Num_Source_Lines := Num_Source_Lines (J);
end loop;
gigi
(gnat_root => Int (Cunit (Main_Unit)),
max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1),
number_name => Name_Entries_Count,
nodes_ptr => Nodes_Address,
next_node_ptr => Next_Node_Address,
prev_node_ptr => Prev_Node_Address,
elists_ptr => Elists_Address,
elmts_ptr => Elmts_Address,
strings_ptr => Strings_Address,
string_chars_ptr => String_Chars_Address,
list_headers_ptr => Lists_Address,
number_file => Num_Source_Files,
file_info_ptr => File_Info_Array'Address,
gigi_standard_boolean => Standard_Boolean,
gigi_standard_integer => Standard_Integer,
gigi_standard_long_long_float => Standard_Long_Long_Float,
gigi_standard_exception_type => Standard_Exception_Type,
gigi_operating_mode => Mode);
end Call_Back_End;
-----------------------------
-- Scan_Compiler_Arguments --
-----------------------------
procedure Scan_Compiler_Arguments is
Next_Arg : Pos := 1;
type Arg_Array is array (Nat) of Big_String_Ptr;
type Arg_Array_Ptr is access Arg_Array;
flag_stack_check : Int;
pragma Import (C, flag_stack_check);
-- Import from toplev.c
save_argc : Nat;
pragma Import (C, save_argc);
-- Import from toplev.c
save_argv : Arg_Array_Ptr;
pragma Import (C, save_argv);
-- Import from toplev.c
Output_File_Name_Seen : Boolean := False;
-- Set to True after having scanned file_name for switch "-gnatO file"
-- Local functions
function Len_Arg (Arg : Pos) return Nat;
-- Determine length of argument number Arg on the original command line
-- from gnat1.
procedure Scan_Back_End_Switches (Switch_Chars : String);
-- Procedure to scan out switches stored in Switch_Chars. The first
-- character is known to be a valid switch character, and there are no
-- blanks or other switch terminator characters in the string, so the
-- entire string should consist of valid switch characters, except that
-- an optional terminating NUL character is allowed.
--
-- Back end switches have already been checked and processed by GCC
-- in toplev.c, so no errors can occur and control will always return.
-- The switches must still be scanned to skip the arguments of the
-- "-o" or the (undocumented) "-dumpbase" switch, by incrementing
-- the Next_Arg variable. The "-dumpbase" switch is used to set the
-- basename for GCC dumpfiles.
-------------
-- Len_Arg --
-------------
function Len_Arg (Arg : Pos) return Nat is
begin
for J in 1 .. Nat'Last loop
if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
return J - 1;
end if;
end loop;
raise Program_Error;
end Len_Arg;
----------------------------
-- Scan_Back_End_Switches --
----------------------------
procedure Scan_Back_End_Switches (Switch_Chars : String) is
First : constant Positive := Switch_Chars'First + 1;
Last : Natural := Switch_Chars'Last;
begin
if Last >= First
and then Switch_Chars (Last) = ASCII.NUL
then
Last := Last - 1;
end if;
-- For switches -o, -dumpbase, --param, skip following argument and
-- do not store either the switch or the following argument.
if Switch_Chars (First .. Last) = "o" or else
Switch_Chars (First .. Last) = "dumpbase" or else
Switch_Chars (First .. Last) = "-param"
then
Next_Arg := Next_Arg + 1;
-- Do not record -quiet switch
elsif Switch_Chars (First .. Last) = "quiet" then
null;
-- Store any other GCC switches
else
Store_Compilation_Switch (Switch_Chars);
-- Special check, the back end switch -fno-inline also sets the
-- front end flag to entirely inhibit all inlining.
if Switch_Chars (First .. Last) = "fno-inline" then
Opt.Suppress_All_Inlining := True;
end if;
end if;
end Scan_Back_End_Switches;
-- Start of processing for Scan_Compiler_Arguments
begin
-- Acquire stack checking mode directly from GCC
Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
-- Loop through command line arguments, storing them for later access
while Next_Arg < save_argc loop
Look_At_Arg : declare
Argv_Ptr : constant Big_String_Ptr := save_argv (Next_Arg);
Argv_Len : constant Nat := Len_Arg (Next_Arg);
Argv : constant String :=
Argv_Ptr (1 .. Natural (Argv_Len));
begin
-- If the previous switch has set the Output_File_Name_Present
-- flag (that is we have seen a -gnatO), then the next argument
-- is the name of the output object file.
if Output_File_Name_Present
and then not Output_File_Name_Seen
then
if Is_Switch (Argv) then
Fail ("Object file name missing after -gnatO");
else
Set_Output_Object_File_Name (Argv);
Output_File_Name_Seen := True;
end if;
-- If the previous switch has set the Search_Directory_Present
-- flag (that is if we have just seen -I), then the next argument
-- is a search directory path.
elsif Search_Directory_Present then
if Is_Switch (Argv) then
Fail ("search directory missing after -I");
else
Add_Src_Search_Dir (Argv);
Search_Directory_Present := False;
end if;
elsif not Is_Switch (Argv) then -- must be a file name
Add_File (Argv);
-- We must recognize -nostdinc to suppress visibility on the
-- standard GNAT RTL sources. This is also a gcc switch.
elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then
Opt.No_Stdinc := True;
Scan_Back_End_Switches (Argv);
-- We must recognize -nostdlib to suppress visibility on the
-- standard GNAT RTL objects.
elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then
Opt.No_Stdlib := True;
elsif Is_Front_End_Switch (Argv) then
Scan_Front_End_Switches (Argv);
-- All non-front-end switches are back-end switches
else
Scan_Back_End_Switches (Argv);
end if;
end Look_At_Arg;
Next_Arg := Next_Arg + 1;
end loop;
end Scan_Compiler_Arguments;
end Back_End;
|
