1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                            B A C K _ E N D                               --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--          Copyright (C) 1992-2021, Free Software Foundation, Inc.         --
10--                                                                          --
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.          --
20--                                                                          --
21-- GNAT was originally developed  by the GNAT team at  New York University. --
22-- Extensive contributions were provided by Ada Core Technologies Inc.      --
23--                                                                          --
24------------------------------------------------------------------------------
25
26--  This is the version of the Back_End package for GCC back ends
27
28with Atree;         use Atree;
29with Backend_Utils; use Backend_Utils;
30with Debug;         use Debug;
31with Elists;        use Elists;
32with Errout;        use Errout;
33with Lib;           use Lib;
34with Osint;         use Osint;
35with Opt;           use Opt;
36with Osint.C;       use Osint.C;
37with Namet;         use Namet;
38with Nlists;        use Nlists;
39with Stand;         use Stand;
40with Sinput;        use Sinput;
41with Stringt;       use Stringt;
42with Switch;        use Switch;
43with Switch.C;      use Switch.C;
44with System;        use System;
45with Types;         use Types;
46
47with System.OS_Lib; use System.OS_Lib;
48
49package body Back_End is
50
51   type Arg_Array is array (Nat) of Big_String_Ptr;
52   type Arg_Array_Ptr is access Arg_Array;
53   --  Types to access compiler arguments
54
55   flag_stack_check : Int;
56   pragma Import (C, flag_stack_check);
57   --  Indicates if stack checking is enabled, imported from misc.c
58
59   save_argc : Nat;
60   pragma Import (C, save_argc);
61   --  Saved value of argc (number of arguments), imported from misc.c
62
63   save_argv : Arg_Array_Ptr;
64   pragma Import (C, save_argv);
65   --  Saved value of argv (argument pointers), imported from misc.c
66
67   function Len_Arg (Arg : Pos) return Nat;
68   --  Determine length of argument number Arg on original gnat1 command line
69
70   -------------------
71   -- Call_Back_End --
72   -------------------
73
74   procedure Call_Back_End (Mode : Back_End_Mode_Type) is
75
76      --  The Source_File_Record type has a lot of components that are
77      --  meaningless to the back end, so a new record type is created
78      --  here to contain the needed information for each file.
79
80      type File_Info_Type is record
81         File_Name        : File_Name_Type;
82         Instance         : Instance_Id;
83         Num_Source_Lines : Nat;
84      end record;
85
86      File_Info_Array : array (1 .. Last_Source_File) of File_Info_Type;
87
88      procedure gigi
89        (gnat_root                     : Int;
90         max_gnat_node                 : Int;
91         number_name                   : Nat;
92         node_offsets_ptr              : Address;
93         slots_ptr                     : Address;
94
95         next_node_ptr                 : Address;
96         prev_node_ptr                 : Address;
97         elists_ptr                    : Address;
98         elmts_ptr                     : Address;
99
100         strings_ptr                   : Address;
101         string_chars_ptr              : Address;
102         list_headers_ptr              : Address;
103         number_file                   : Nat;
104
105         file_info_ptr                 : Address;
106         gigi_standard_boolean         : Entity_Id;
107         gigi_standard_integer         : Entity_Id;
108         gigi_standard_character       : Entity_Id;
109         gigi_standard_long_long_float : Entity_Id;
110         gigi_standard_exception_type  : Entity_Id;
111         gigi_operating_mode           : Back_End_Mode_Type);
112
113      pragma Import (C, gigi);
114
115   begin
116      --  Skip call if in -gnatdH mode
117
118      if Debug_Flag_HH then
119         return;
120      end if;
121
122      --  The back end needs to know the maximum line number that can appear
123      --  in a Sloc, in other words the maximum logical line number.
124
125      for J in 1 .. Last_Source_File loop
126         File_Info_Array (J).File_Name        := Full_Debug_Name (J);
127         File_Info_Array (J).Instance         := Instance (J);
128         File_Info_Array (J).Num_Source_Lines :=
129           Nat (Physical_To_Logical (Last_Source_Line (J), J));
130      end loop;
131
132      --  Deal with case of generating SCIL, we should not be here unless
133      --  debugging CodePeer mode in GNAT.
134
135      if Generate_SCIL then
136         Error_Msg_N ("'S'C'I'L generation not available", Cunit (Main_Unit));
137
138         if CodePeer_Mode
139           or else (Mode /= Generate_Object
140                     and then not Back_Annotate_Rep_Info)
141         then
142            return;
143         end if;
144      end if;
145
146      --  We should be here in GNATprove mode only when debugging GNAT. Do not
147      --  call gigi in that case, as it is not prepared to handle the special
148      --  form of the tree obtained in GNATprove mode.
149
150      if GNATprove_Mode then
151         return;
152      end if;
153
154      --  The actual call to the back end
155
156      gigi
157        (gnat_root          => Int (Cunit (Main_Unit)),
158         max_gnat_node      => Int (Last_Node_Id - First_Node_Id + 1),
159         number_name        => Name_Entries_Count,
160         node_offsets_ptr   => Node_Offsets_Address,
161         slots_ptr          => Slots_Address,
162
163         next_node_ptr      => Next_Node_Address,
164         prev_node_ptr      => Prev_Node_Address,
165         elists_ptr         => Elists_Address,
166         elmts_ptr          => Elmts_Address,
167
168         strings_ptr        => Strings_Address,
169         string_chars_ptr   => String_Chars_Address,
170         list_headers_ptr   => Lists_Address,
171         number_file        => Num_Source_Files,
172
173         file_info_ptr                 => File_Info_Array'Address,
174         gigi_standard_boolean         => Standard_Boolean,
175         gigi_standard_integer         => Standard_Integer,
176         gigi_standard_character       => Standard_Character,
177         gigi_standard_long_long_float => Standard_Long_Long_Float,
178         gigi_standard_exception_type  => Standard_Exception_Type,
179         gigi_operating_mode           => Mode);
180   end Call_Back_End;
181
182   -------------------------------
183   -- Gen_Or_Update_Object_File --
184   -------------------------------
185
186   procedure Gen_Or_Update_Object_File is
187   begin
188      null;
189   end Gen_Or_Update_Object_File;
190
191   -------------
192   -- Len_Arg --
193   -------------
194
195   function Len_Arg (Arg : Pos) return Nat is
196   begin
197      for J in 1 .. Nat'Last loop
198         if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
199            return J - 1;
200         end if;
201      end loop;
202
203      raise Program_Error;
204   end Len_Arg;
205
206   -----------------------------
207   -- Scan_Compiler_Arguments --
208   -----------------------------
209
210   procedure Scan_Compiler_Arguments is
211      Next_Arg : Positive;
212      --  Next argument to be scanned
213
214      Arg_Count : constant Natural := Natural (save_argc - 1);
215      Args      : Argument_List (1 .. Arg_Count);
216
217      Output_File_Name_Seen : Boolean := False;
218      --  Set to True after having scanned file_name for switch "-gnatO file"
219
220      procedure Scan_Back_End_Switches (Switch_Chars : String);
221      --  Procedure to scan out switches stored in Switch_Chars. The first
222      --  character is known to be a valid switch character, and there are no
223      --  blanks or other switch terminator characters in the string, so the
224      --  entire string should consist of valid switch characters, except that
225      --  an optional terminating NUL character is allowed.
226      --
227      --  Back end switches have already been checked and processed by GCC in
228      --  toplev.c, so no errors can occur and control will always return. The
229      --  switches must still be scanned to skip "-o" or internal GCC switches
230      --  with their argument.
231
232      ----------------------------
233      -- Scan_Back_End_Switches --
234      ----------------------------
235
236      procedure Scan_Back_End_Switches (Switch_Chars : String) is
237         First : constant Positive := Switch_Chars'First + 1;
238         Last  : constant Natural  := Switch_Last (Switch_Chars);
239
240      begin
241         --  Skip -o or internal GCC switches together with their argument
242
243         if Switch_Chars (First .. Last) = "o"
244           or else Is_Internal_GCC_Switch (Switch_Chars)
245         then
246            Next_Arg := Next_Arg + 1;
247
248         --  Store -G xxx as -Gxxx and go directly to the next argument
249
250         elsif Switch_Chars (First .. Last) = "G" then
251            Next_Arg := Next_Arg + 1;
252
253            --  Should never get there with -G not followed by an argument,
254            --  but use defensive code nonetheless. Store as -Gxxx to avoid
255            --  storing parameters in ALI files that might create confusion.
256
257            if Next_Arg <= Args'Last then
258               Store_Compilation_Switch (Switch_Chars & Args (Next_Arg).all);
259            end if;
260
261         --  Do not record -quiet switch
262
263         elsif Switch_Chars (First .. Last) = "quiet" then
264            null;
265
266         --  Store any other GCC switches. Also do special processing for some
267         --  specific switches that the Ada front-end knows about.
268
269         else
270
271            if not Scan_Common_Back_End_Switch (Switch_Chars) then
272
273               --  Store compilation switch, as Scan_Common_Back_End_Switch
274               --  only stores switches it recognizes.
275
276               Store_Compilation_Switch (Switch_Chars);
277
278               --  Back end switch -fdump-scos, which exists primarily for C,
279               --  is also accepted for Ada as a synonym of -gnateS.
280
281               if Switch_Chars (First .. Last) = "fdump-scos" then
282                  Opt.Generate_SCO := True;
283                  Opt.Generate_SCO_Instance_Table := True;
284               end if;
285            end if;
286         end if;
287      end Scan_Back_End_Switches;
288
289   --  Start of processing for Scan_Compiler_Arguments
290
291   begin
292      --  Acquire stack checking mode directly from GCC. The reason we do this
293      --  is to make sure that the indication of stack checking being enabled
294      --  is the same in the front end and the back end. This status obtained
295      --  from gcc is affected by more than just the switch -fstack-check.
296
297      Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
298
299      --  Put the arguments in Args
300
301      for Arg in Pos range 1 .. save_argc - 1 loop
302         declare
303            Argv_Ptr : constant Big_String_Ptr := save_argv (Arg);
304            Argv_Len : constant Nat            := Len_Arg (Arg);
305            Argv     : constant String         :=
306                         Argv_Ptr (1 .. Natural (Argv_Len));
307         begin
308            Args (Positive (Arg)) := new String'(Argv);
309         end;
310      end loop;
311
312      --  Loop through command line arguments, storing them for later access
313
314      Next_Arg := 1;
315      while Next_Arg <= Args'Last loop
316         Look_At_Arg : declare
317            Argv : constant String := Args (Next_Arg).all;
318
319         begin
320            --  If the previous switch has set the Output_File_Name_Present
321            --  flag (that is we have seen a -gnatO), then the next argument
322            --  is the name of the output object file.
323
324            if Output_File_Name_Present and then not Output_File_Name_Seen then
325               if Is_Switch (Argv) then
326                  Fail ("Object file name missing after -gnatO");
327               else
328                  Set_Output_Object_File_Name (Argv);
329                  Output_File_Name_Seen := True;
330               end if;
331
332            --  If the previous switch has set the Search_Directory_Present
333            --  flag (that is if we have just seen -I), then the next argument
334            --  is a search directory path.
335
336            elsif Search_Directory_Present then
337               if Is_Switch (Argv) then
338                  Fail ("search directory missing after -I");
339               else
340                  Add_Src_Search_Dir (Argv);
341                  Search_Directory_Present := False;
342               end if;
343
344            --  If not a switch, must be a file name
345
346            elsif not Is_Switch (Argv) then
347               Add_File (Argv);
348
349            --  We must recognize -nostdinc to suppress visibility on the
350            --  standard GNAT RTL sources. This is also a gcc switch.
351
352            elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then
353               Opt.No_Stdinc := True;
354               Scan_Back_End_Switches (Argv);
355
356            --  We must recognize -nostdlib to suppress visibility on the
357            --  standard GNAT RTL objects.
358
359            elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdlib" then
360               Opt.No_Stdlib := True;
361
362            elsif Is_Front_End_Switch (Argv) then
363               Scan_Front_End_Switches (Argv, Args, Next_Arg);
364
365            --  All non-front-end switches are back-end switches
366
367            else
368               Scan_Back_End_Switches (Argv);
369            end if;
370         end Look_At_Arg;
371
372         Next_Arg := Next_Arg + 1;
373      end loop;
374   end Scan_Compiler_Arguments;
375
376end Back_End;
377