1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2004 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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
; use Osint
;
34 with Osint
.C
; use Osint
.C
;
35 with Namet
; use Namet
;
36 with Nlists
; use Nlists
;
37 with Stand
; use Stand
;
38 with Sinput
; use Sinput
;
39 with Stringt
; use Stringt
;
40 with Switch
; use Switch
;
41 with Switch
.C
; use Switch
.C
;
42 with System
; use System
;
43 with Types
; use Types
;
45 package body Back_End
is
51 procedure Call_Back_End
(Mode
: Back_End_Mode_Type
) is
53 -- The File_Record type has a lot of components that are meaningless
54 -- to the back end, so a new record is created here to contain the
55 -- needed information for each file.
57 type Needed_File_Info_Type
is record
58 File_Name
: File_Name_Type
;
59 First_Sloc
: Source_Ptr
;
60 Last_Sloc
: Source_Ptr
;
61 Num_Source_Lines
: Nat
;
65 array (Main_Unit
.. Last_Unit
) of Needed_File_Info_Type
;
73 next_node_ptr
: Address
;
74 prev_node_ptr
: Address
;
78 strings_ptr
: Address
;
79 string_chars_ptr
: Address
;
80 list_headers_ptr
: Address
;
83 file_info_ptr
: Address
;
84 gigi_standard_integer
: Entity_Id
;
85 gigi_standard_long_long_float
: Entity_Id
;
86 gigi_standard_exception_type
: Entity_Id
;
87 gigi_operating_mode
: Back_End_Mode_Type
);
89 pragma Import
(C
, gigi
);
91 S
: Source_File_Index
;
94 -- Skip call if in -gnatdH mode
100 for J
in Main_Unit
.. Last_Unit
loop
101 S
:= Source_Index
(J
);
102 File_Info_Array
(J
).File_Name
:= File_Name
(S
);
103 File_Info_Array
(J
).First_Sloc
:= Source_Text
(S
)'First;
104 File_Info_Array
(J
).Last_Sloc
:= Source_Text
(S
)'Last;
105 File_Info_Array
(J
).Num_Source_Lines
:= Num_Source_Lines
(S
);
109 gnat_root
=> Int
(Cunit
(Main_Unit
)),
110 max_gnat_node
=> Int
(Last_Node_Id
- First_Node_Id
+ 1),
111 number_name
=> Name_Entries_Count
,
112 nodes_ptr
=> Nodes_Address
,
114 next_node_ptr
=> Next_Node_Address
,
115 prev_node_ptr
=> Prev_Node_Address
,
116 elists_ptr
=> Elists_Address
,
117 elmts_ptr
=> Elmts_Address
,
119 strings_ptr
=> Strings_Address
,
120 string_chars_ptr
=> String_Chars_Address
,
121 list_headers_ptr
=> Lists_Address
,
122 number_units
=> Num_Units
,
124 file_info_ptr
=> File_Info_Array
'Address,
125 gigi_standard_integer
=> Standard_Integer
,
126 gigi_standard_long_long_float
=> Standard_Long_Long_Float
,
127 gigi_standard_exception_type
=> Standard_Exception_Type
,
128 gigi_operating_mode
=> Mode
);
131 -----------------------------
132 -- Scan_Compiler_Arguments --
133 -----------------------------
135 procedure Scan_Compiler_Arguments
is
139 subtype Big_String
is String (Positive);
140 type BSP
is access Big_String
;
142 type Arg_Array
is array (Nat
) of BSP
;
143 type Arg_Array_Ptr
is access Arg_Array
;
145 -- Import flag_stack_check from toplev.c.
147 flag_stack_check
: Int
;
148 pragma Import
(C
, flag_stack_check
); -- Import from toplev.c
151 pragma Import
(C
, save_argc
); -- Import from toplev.c
153 save_argv
: Arg_Array_Ptr
;
154 pragma Import
(C
, save_argv
); -- Import from toplev.c
156 Output_File_Name_Seen
: Boolean := False;
157 -- Set to True after having scanned the file_name for
158 -- switch "-gnatO file_name"
162 function Len_Arg
(Arg
: Pos
) return Nat
;
163 -- Determine length of argument number Arg on the original
164 -- command line from gnat1
166 procedure Scan_Back_End_Switches
(Switch_Chars
: String);
167 -- Procedure to scan out switches stored in Switch_Chars. The first
168 -- character is known to be a valid switch character, and there are no
169 -- blanks or other switch terminator characters in the string, so the
170 -- entire string should consist of valid switch characters, except that
171 -- an optional terminating NUL character is allowed.
173 -- Back end switches have already been checked and processed by GCC
174 -- in toplev.c, so no errors can occur and control will always return.
175 -- The switches must still be scanned to skip the arguments of the
176 -- "-o" or the (undocumented) "-dumpbase" switch, by incrementing
177 -- the Next_Arg variable. The "-dumpbase" switch is used to set the
178 -- basename for GCC dumpfiles.
184 function Len_Arg
(Arg
: Pos
) return Nat
is
186 for J
in 1 .. Nat
'Last loop
187 if save_argv
(Arg
).all (Natural (J
)) = ASCII
.NUL
then
195 ----------------------------
196 -- Scan_Back_End_Switches --
197 ----------------------------
199 procedure Scan_Back_End_Switches
(Switch_Chars
: String) is
200 First
: constant Positive := Switch_Chars
'First + 1;
201 Last
: Natural := Switch_Chars
'Last;
205 and then Switch_Chars
(Last
) = ASCII
.NUL
210 -- For these switches, skip following argument and do not
211 -- store either the switch or the following argument
213 if Switch_Chars
(First
.. Last
) = "o"
214 or else Switch_Chars
(First
.. Last
) = "dumpbase"
215 or else Switch_Chars
(First
.. Last
) = "-param"
218 Next_Arg
:= Next_Arg
+ 1;
220 -- Do not record -quiet switch
222 elsif Switch_Chars
(First
.. Last
) = "quiet" then
226 -- Store any other GCC switches
228 Store_Compilation_Switch
(Switch_Chars
);
230 end Scan_Back_End_Switches
;
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 -- Loop through command line arguments, storing them for later access
241 while Next_Arg
< save_argc
loop
243 Look_At_Arg
: declare
244 Argv_Ptr
: constant BSP
:= save_argv
(Next_Arg
);
245 Argv_Len
: constant Nat
:= Len_Arg
(Next_Arg
);
246 Argv
: constant String := Argv_Ptr
(1 .. Natural (Argv_Len
));
249 -- If the previous switch has set the Output_File_Name_Present
250 -- flag (that is we have seen a -gnatO), then the next argument
251 -- is the name of the output object file.
253 if Output_File_Name_Present
254 and then not Output_File_Name_Seen
256 if Is_Switch
(Argv
) then
257 Fail
("Object file name missing after -gnatO");
260 Set_Output_Object_File_Name
(Argv
);
261 Output_File_Name_Seen
:= True;
264 elsif not Is_Switch
(Argv
) then -- must be a file name
267 -- We must recognize -nostdinc to suppress visibility on the
268 -- standard GNAT RTL sources. This is also a gcc switch.
270 elsif Argv
(Argv
'First + 1 .. Argv
'Last) = "nostdinc" then
271 Opt
.No_Stdinc
:= True;
272 Scan_Back_End_Switches
(Argv
);
274 -- We must recognize -nostdlib to suppress visibility on the
275 -- standard GNAT RTL objects.
277 elsif Argv
(Argv
'First + 1 .. Argv
'Last) = "nostdlib" then
278 Opt
.No_Stdlib
:= True;
280 elsif Is_Front_End_Switch
(Argv
) then
281 Scan_Front_End_Switches
(Argv
);
283 -- All non-front-end switches are back-end switches
286 Scan_Back_End_Switches
(Argv
);
290 Next_Arg
:= Next_Arg
+ 1;
292 end Scan_Compiler_Arguments
;