1------------------------------------------------------------------------------
2--                                                                          --
3--                         GNAT COMPILER COMPONENTS                         --
4--                                                                          --
5--                             A D A B K E N D                              --
6--                                                                          --
7--                                 B o d y                                  --
8--                                                                          --
9--                     Copyright (C) 2001-2019, AdaCore                     --
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------------------------------------------------------------------------------
22
23--  This is the version of the Back_End package for back ends written in Ada
24
25with Atree;    use Atree;
26with Debug;
27with Lib;
28with Opt;      use Opt;
29with Output;   use Output;
30with Osint;    use Osint;
31with Osint.C;  use Osint.C;
32with Switch.C; use Switch.C;
33with Types;    use Types;
34
35with System.OS_Lib; use System.OS_Lib;
36
37package body Adabkend is
38
39   use Switch;
40
41   -------------------
42   -- Call_Back_End --
43   -------------------
44
45   procedure Call_Back_End is
46   begin
47      if (Opt.Verbose_Mode or Opt.Full_List)
48        and then not Debug.Debug_Flag_7
49      then
50         Write_Eol;
51         Write_Str (Product_Name);
52         Write_Str (", Copyright ");
53         Write_Str (Copyright_Years);
54         Write_Str (" Ada Core Technologies, Inc.");
55         Write_Str (" (http://www.adacore.com)");
56         Write_Eol;
57         Write_Eol;
58      end if;
59
60      --  The front end leaves the Current_Error_Node at a location that is
61      --  meaningless and confusing when emitting bug boxes from the back end.
62      --  Reset the global variable in order to emit "No source file position
63      --  information available" messages on back end crashes.
64
65      Current_Error_Node := Empty;
66
67      Driver (Lib.Cunit (Types.Main_Unit));
68   end Call_Back_End;
69
70   -----------------------------
71   -- Scan_Compiler_Arguments --
72   -----------------------------
73
74   procedure Scan_Compiler_Arguments is
75      Output_File_Name_Seen : Boolean := False;
76      --  Set to True after having scanned the file_name for switch
77      --  "-gnatO file_name"
78
79      Argument_Count : constant Integer := Arg_Count - 1;
80      --  Number of arguments (excluding program name)
81
82      Args     : Argument_List (1 .. Argument_Count);
83      Next_Arg : Positive := 1;
84
85      procedure Scan_Back_End_Switches (Switch_Chars : String);
86      --  Procedure to scan out switches stored in Switch_Chars. The first
87      --  character is known to be a valid switch character, and there are no
88      --  blanks or other switch terminator characters in the string, so the
89      --  entire string should consist of valid switch characters, except that
90      --  an optional terminating NUL character is allowed.
91      --
92      --  If the switch is not valid, control will not return. The switches
93      --  must still be scanned to skip the "-o" arguments, or internal GCC
94      --  switches, which may be safely ignored by other back ends.
95
96      ----------------------------
97      -- Scan_Back_End_Switches --
98      ----------------------------
99
100      procedure Scan_Back_End_Switches (Switch_Chars : String) is
101         First : constant Positive := Switch_Chars'First + 1;
102         Last  : constant Natural  := Switch_Last (Switch_Chars);
103
104      begin
105         --  Process any back end switches, returning if the switch does not
106         --  affect code generation or falling through if it does, so the
107         --  switch will get stored.
108
109         --  Skip -o, -G or internal GCC switches together with their argument.
110
111         if Switch_Chars (First .. Last) = "o"
112           or else Switch_Chars (First .. Last) = "G"
113           or else Is_Internal_GCC_Switch (Switch_Chars)
114         then
115            Next_Arg := Next_Arg + 1;
116            return; -- ignore this switch
117
118         --  Set optimization indicators appropriately. In gcc-based GNAT this
119         --  is picked up from imported variables set by the gcc driver, but
120         --  for compilers with non-gcc back ends we do it here to allow use
121         --  of these switches by the front end. Allowed optimization switches
122         --  are -Os (optimize for size), -O[0123], and -O (same as -O1).
123
124         elsif Switch_Chars (First) = 'O' then
125            if First = Last then
126               Optimization_Level := 1;
127
128            elsif Last - First = 1 then
129               if Switch_Chars (Last) = 's' then
130                  Optimize_Size := 1;
131                  Optimization_Level := 2;  -- Consistent with gcc setting
132
133               elsif Switch_Chars (Last) in '0' .. '3' then
134                  Optimization_Level :=
135                    Character'Pos (Switch_Chars (Last)) - Character'Pos ('0');
136
137               else
138                  Fail ("invalid switch: " & Switch_Chars);
139               end if;
140
141            else
142               Fail ("invalid switch: " & Switch_Chars);
143            end if;
144
145         elsif Switch_Chars (First .. Last) = "quiet" then
146            return; -- ignore this switch
147
148         elsif Switch_Chars (First .. Last) = "c" then
149            return; -- ignore this switch
150
151         --  The -x switch and its language name argument will generally be
152         --  ignored by non-gcc back ends. In any case, we save the switch and
153         --  argument in the compilation switches.
154
155         elsif Switch_Chars (First .. Last) = "x" then
156            Lib.Store_Compilation_Switch (Switch_Chars);
157            Next_Arg := Next_Arg + 1;
158
159            declare
160               Argv : constant String := Args (Next_Arg).all;
161
162            begin
163               if Is_Switch (Argv) then
164                  Fail ("language name missing after -x");
165               else
166                  Lib.Store_Compilation_Switch (Argv);
167               end if;
168            end;
169
170            return;
171
172         --  Special check, the back end switch -fno-inline also sets the
173         --  front end flags to entirely inhibit all inlining. So we store it
174         --  and set the appropriate flags.
175
176         elsif Switch_Chars (First .. Last) = "fno-inline" then
177            Lib.Store_Compilation_Switch (Switch_Chars);
178            Opt.Disable_FE_Inline := True;
179            Opt.Disable_FE_Inline_Always := True;
180            return;
181
182         --  Similar processing for -fpreserve-control-flow
183
184         elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then
185            Lib.Store_Compilation_Switch (Switch_Chars);
186            Opt.Suppress_Control_Flow_Optimizations := True;
187            return;
188
189         --  Recognize -gxxx switches
190
191         elsif Switch_Chars (First) = 'g' then
192            Debugger_Level := 2;
193
194            if First < Last then
195               case Switch_Chars (First + 1) is
196                  when '0' =>
197                     Debugger_Level := 0;
198                  when '1' =>
199                     Debugger_Level := 1;
200                  when '2' =>
201                     Debugger_Level := 2;
202                  when '3' =>
203                     Debugger_Level := 3;
204                  when others =>
205                     null;
206               end case;
207            end if;
208
209         --  Ignore all other back end switches
210
211         elsif Is_Back_End_Switch (Switch_Chars) then
212            null;
213
214         --  Give error for junk switch
215
216         else
217            Fail ("invalid switch: " & Switch_Chars);
218         end if;
219
220         --  Store any other GCC switches
221
222         Lib.Store_Compilation_Switch (Switch_Chars);
223      end Scan_Back_End_Switches;
224
225   --  Start of processing for Scan_Compiler_Args
226
227   begin
228      --  Put all the arguments in argument list Args
229
230      for Arg in 1 .. Argument_Count loop
231         declare
232            Argv : String (1 .. Len_Arg (Arg));
233         begin
234            Fill_Arg (Argv'Address, Arg);
235            Args (Arg) := new String'(Argv);
236         end;
237      end loop;
238
239      --  Loop through command line arguments, storing them for later access
240
241      while Next_Arg <= Argument_Count loop
242         Look_At_Arg : declare
243            Argv : constant String := Args (Next_Arg).all;
244
245         begin
246            if Argv'Length = 0 then
247               Fail ("Empty argument");
248            end if;
249
250            --  If the previous switch has set the Output_File_Name_Present
251            --  flag (that is we have seen a -gnatO), then the next argument
252            --  is the name of the output object file.
253
254            if Opt.Output_File_Name_Present
255              and then not Output_File_Name_Seen
256            then
257               if Is_Switch (Argv) then
258                  Fail ("Object file name missing after -gnatO");
259               else
260                  Set_Output_Object_File_Name (Argv);
261                  Output_File_Name_Seen := True;
262               end if;
263
264               --  If the previous switch has set the Search_Directory_Present
265               --  flag (that is if we have just seen -I), then the next
266               --  argument is a search directory path.
267
268            elsif Search_Directory_Present then
269               if Is_Switch (Argv) then
270                  Fail ("search directory missing after -I");
271               else
272                  Add_Src_Search_Dir (Argv);
273
274                  --  Add directory to lib search so that back end can take as
275                  --  input ALI files if needed. Otherwise this won't have any
276                  --  impact on the compiler.
277
278                  Add_Lib_Search_Dir (Argv);
279
280                  Search_Directory_Present := False;
281               end if;
282
283            --  If not a switch, must be a file name
284
285            elsif not Is_Switch (Argv) then
286               Add_File (Argv);
287
288            --  We must recognize -nostdinc to suppress visibility on the
289            --  standard GNAT RTL sources.
290
291            elsif Argv (Argv'First + 1 .. Argv'Last) = "nostdinc" then
292               Opt.No_Stdinc := True;
293
294            --  Front end switch
295
296            elsif Is_Front_End_Switch (Argv) then
297               Scan_Front_End_Switches (Argv, Args, Next_Arg);
298
299            --  All non-front-end switches are back-end switches
300
301            else
302               Scan_Back_End_Switches (Argv);
303            end if;
304         end Look_At_Arg;
305
306         Next_Arg := Next_Arg + 1;
307      end loop;
308   end Scan_Compiler_Arguments;
309
310end Adabkend;
311