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