1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2011, 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;
29 with Errout; use Errout;
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 with System.OS_Lib; use System.OS_Lib;
46 package body Back_End is
48 type Arg_Array is array (Nat) of Big_String_Ptr;
49 type Arg_Array_Ptr is access Arg_Array;
50 -- Types to access compiler arguments
52 flag_stack_check : Int;
53 pragma Import (C, flag_stack_check);
54 -- Indicates if stack checking is enabled, imported from decl.c
57 pragma Import (C, save_argc);
58 -- Saved value of argc (number of arguments), imported from misc.c
60 save_argv : Arg_Array_Ptr;
61 pragma Import (C, save_argv);
62 -- Saved value of argv (argument pointers), imported from misc.c
64 function Len_Arg (Arg : Pos) return Nat;
65 -- Determine length of argument number Arg on original gnat1 command line
71 procedure Call_Back_End (Mode : Back_End_Mode_Type) is
73 -- The Source_File_Record type has a lot of components that are
74 -- meaningless to the back end, so a new record type is created
75 -- here to contain the needed information for each file.
77 type File_Info_Type is record
78 File_Name : File_Name_Type;
79 Num_Source_Lines : Nat;
82 File_Info_Array : array (1 .. Last_Source_File) of File_Info_Type;
90 next_node_ptr : Address;
91 prev_node_ptr : Address;
95 strings_ptr : Address;
96 string_chars_ptr : Address;
97 list_headers_ptr : Address;
100 file_info_ptr : Address;
101 gigi_standard_boolean : Entity_Id;
102 gigi_standard_integer : Entity_Id;
103 gigi_standard_character : Entity_Id;
104 gigi_standard_long_long_float : Entity_Id;
105 gigi_standard_exception_type : Entity_Id;
106 gigi_operating_mode : Back_End_Mode_Type);
108 pragma Import (C, gigi);
111 -- Skip call if in -gnatdH mode
113 if Debug_Flag_HH then
117 -- The back end needs to know the maximum line number that can appear
118 -- in a Sloc, in other words the maximum logical line number.
120 for J in 1 .. Last_Source_File loop
121 File_Info_Array (J).File_Name := Full_Debug_Name (J);
122 File_Info_Array (J).Num_Source_Lines :=
123 Nat (Physical_To_Logical (Last_Source_Line (J), J));
126 if Generate_SCIL then
127 Error_Msg_N ("'S'C'I'L generation not available", Cunit (Main_Unit));
130 or else (Mode /= Generate_Object
131 and then not Back_Annotate_Rep_Info)
138 (gnat_root => Int (Cunit (Main_Unit)),
139 max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1),
140 number_name => Name_Entries_Count,
141 nodes_ptr => Nodes_Address,
143 next_node_ptr => Next_Node_Address,
144 prev_node_ptr => Prev_Node_Address,
145 elists_ptr => Elists_Address,
146 elmts_ptr => Elmts_Address,
148 strings_ptr => Strings_Address,
149 string_chars_ptr => String_Chars_Address,
150 list_headers_ptr => Lists_Address,
151 number_file => Num_Source_Files,
153 file_info_ptr => File_Info_Array'Address,
154 gigi_standard_boolean => Standard_Boolean,
155 gigi_standard_integer => Standard_Integer,
156 gigi_standard_character => Standard_Character,
157 gigi_standard_long_long_float => Standard_Long_Long_Float,
158 gigi_standard_exception_type => Standard_Exception_Type,
159 gigi_operating_mode => Mode);
166 function Len_Arg (Arg : Pos) return Nat is
168 for J in 1 .. Nat'Last loop
169 if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
177 -----------------------------
178 -- Scan_Compiler_Arguments --
179 -----------------------------
181 procedure Scan_Compiler_Arguments is
184 -- Next argument to be scanned
186 Output_File_Name_Seen : Boolean := False;
187 -- Set to True after having scanned file_name for switch "-gnatO file"
189 procedure Scan_Back_End_Switches (Switch_Chars : String);
190 -- Procedure to scan out switches stored in Switch_Chars. The first
191 -- character is known to be a valid switch character, and there are no
192 -- blanks or other switch terminator characters in the string, so the
193 -- entire string should consist of valid switch characters, except that
194 -- an optional terminating NUL character is allowed.
196 -- Back end switches have already been checked and processed by GCC in
197 -- toplev.c, so no errors can occur and control will always return. The
198 -- switches must still be scanned to skip "-o" or internal GCC switches
199 -- with their argument.
201 ----------------------------
202 -- Scan_Back_End_Switches --
203 ----------------------------
205 procedure Scan_Back_End_Switches (Switch_Chars : String) is
206 First : constant Positive := Switch_Chars'First + 1;
207 Last : constant Natural := Switch_Last (Switch_Chars);
210 -- Skip -o or internal GCC switches together with their argument
212 if Switch_Chars (First .. Last) = "o"
213 or else Is_Internal_GCC_Switch (Switch_Chars)
215 Next_Arg := Next_Arg + 1;
217 -- Do not record -quiet switch
219 elsif Switch_Chars (First .. Last) = "quiet" then
222 -- Store any other GCC switches
225 Store_Compilation_Switch (Switch_Chars);
227 -- Special check, the back end switch -fno-inline also sets the
228 -- front end flag to entirely inhibit all inlining.
230 if Switch_Chars (First .. Last) = "fno-inline" then
231 Opt.Suppress_All_Inlining := True;
233 -- Another special check, the switch -fpreserve-control-flow
234 -- which is also a back end switch sets the front end flag
235 -- that inhibits improper control flow transformations.
237 elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then
238 Opt.Suppress_Control_Flow_Optimizations := True;
241 end Scan_Back_End_Switches;
245 Arg_Count : constant Natural := Natural (save_argc - 1);
246 Args : Argument_List (1 .. Arg_Count);
248 -- Start of processing for Scan_Compiler_Arguments
251 -- Acquire stack checking mode directly from GCC
253 Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
255 -- Put the arguments in Args
257 for Arg in Pos range 1 .. save_argc - 1 loop
259 Argv_Ptr : constant Big_String_Ptr := save_argv (Arg);
260 Argv_Len : constant Nat := Len_Arg (Arg);
261 Argv : constant String :=
262 Argv_Ptr (1 .. Natural (Argv_Len));
264 Args (Positive (Arg)) := new String'(Argv);
268 -- Loop through command line arguments, storing them for later access
271 while Next_Arg <= Args'Last loop
272 Look_At_Arg : declare
273 Argv : constant String := Args (Next_Arg).all;
276 -- If the previous switch has set the Output_File_Name_Present
277 -- flag (that is we have seen a -gnatO), then the next argument
278 -- is the name of the output object file.
280 if Output_File_Name_Present
281 and then not Output_File_Name_Seen
283 if Is_Switch (Argv) then
284 Fail ("Object file name missing after -gnatO");
287 Set_Output_Object_File_Name (Argv);
288 Output_File_Name_Seen := True;
291 -- If the previous switch has set the Search_Directory_Present
292 -- flag (that is if we have just seen -I), then the next argument
293 -- is a search directory path.
295 elsif Search_Directory_Present then
296 if Is_Switch (Argv) then
297 Fail ("search directory missing after -I");
299 Add_Src_Search_Dir (Argv);
300 Search_Directory_Present := False;
303 elsif not Is_Switch (Argv) then -- must be a file name
306 -- We must recognize -nostdinc to suppress visibility on the
307 -- standard GNAT RTL sources. This is also a gcc switch.
309 elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then
310 Opt.No_Stdinc := True;
311 Scan_Back_End_Switches (Argv);
313 -- We must recognize -nostdlib to suppress visibility on the
314 -- standard GNAT RTL objects.
316 elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then
317 Opt.No_Stdlib := True;
319 elsif Is_Front_End_Switch (Argv) then
320 Scan_Front_End_Switches (Argv, Args, Next_Arg);
322 -- All non-front-end switches are back-end switches
325 Scan_Back_End_Switches (Argv);
329 Next_Arg := Next_Arg + 1;
331 end Scan_Compiler_Arguments;
333 -----------------------------
334 -- Register_Back_End_Types --
335 -----------------------------
337 procedure Register_Back_End_Types (Call_Back : Register_Type_Proc) is
338 procedure Enumerate_Modes (Call_Back : Register_Type_Proc);
339 pragma Import (C, Enumerate_Modes, "enumerate_modes");
342 Enumerate_Modes (Call_Back);
343 end Register_Back_End_Types;
345 -------------------------------
346 -- Gen_Or_Update_Object_File --
347 -------------------------------
349 procedure Gen_Or_Update_Object_File is
352 end Gen_Or_Update_Object_File;