OSDN Git Service

2011-12-05 Bob Duff <duff@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / switch-b.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                         GNAT COMPILER COMPONENTS                         --
4 --                                                                          --
5 --                             S W I T C H - B                              --
6 --                                                                          --
7 --                                 B o d y                                  --
8 --                                                                          --
9 --          Copyright (C) 2001-2011, 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 with Debug;  use Debug;
27 with Osint;  use Osint;
28 with Opt;    use Opt;
29
30 with System.WCh_Con; use System.WCh_Con;
31
32 package body Switch.B is
33
34    --------------------------
35    -- Scan_Binder_Switches --
36    --------------------------
37
38    procedure Scan_Binder_Switches (Switch_Chars : String) is
39       Max : constant Integer := Switch_Chars'Last;
40       Ptr : Integer          := Switch_Chars'First;
41       C   : Character        := ' ';
42
43       function Get_Optional_Filename return String_Ptr;
44       --  If current character is '=', return a newly allocated string that
45       --  contains the remainder of the current switch (after the '='), else
46       --  return null.
47
48       function Get_Stack_Size (S : Character) return Int;
49       --  Used for -d and -D to scan stack size including handling k/m. S is
50       --  set to 'd' or 'D' to indicate the switch being scanned.
51
52       ---------------------------
53       -- Get_Optional_Filename --
54       ---------------------------
55
56       function Get_Optional_Filename return String_Ptr is
57          Result : String_Ptr;
58
59       begin
60          if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
61             if Ptr = Max then
62                Bad_Switch (Switch_Chars);
63             else
64                Result := new String'(Switch_Chars (Ptr + 1 .. Max));
65                Ptr := Max + 1;
66                return Result;
67             end if;
68          end if;
69
70          return null;
71       end Get_Optional_Filename;
72
73       --------------------
74       -- Get_Stack_Size --
75       --------------------
76
77       function Get_Stack_Size (S : Character) return Int is
78          Result : Int;
79
80       begin
81          Scan_Pos (Switch_Chars, Max, Ptr, Result, S);
82
83          --  In the following code, we enable overflow checking since the
84          --  multiplication by K or M may cause overflow, which is an error.
85
86          declare
87             pragma Unsuppress (Overflow_Check);
88
89          begin
90             --  Check for additional character 'k' (for kilobytes) or 'm' (for
91             --  Megabytes), but only if we have not reached the end of the
92             --  switch string. Note that if this appears before the end of the
93             --  string we will get an error when we test to make sure that the
94             --  string is exhausted (at the end of the case).
95
96             if Ptr <= Max then
97                if Switch_Chars (Ptr) = 'k' then
98                   Result := Result * 1024;
99                   Ptr := Ptr + 1;
100
101                elsif Switch_Chars (Ptr) = 'm' then
102                   Result := Result * (1024 * 1024);
103                   Ptr := Ptr + 1;
104                end if;
105             end if;
106
107          exception
108             when Constraint_Error =>
109                Osint.Fail ("numeric value out of range for switch: " & S);
110          end;
111
112          return Result;
113       end Get_Stack_Size;
114
115    --  Start of processing for Scan_Binder_Switches
116
117    begin
118       --  Skip past the initial character (must be the switch character)
119
120       if Ptr = Max then
121          Bad_Switch (Switch_Chars);
122       else
123          Ptr := Ptr + 1;
124       end if;
125
126       --  A little check, "gnat" at the start of a switch is not allowed except
127       --  for the compiler
128
129       if Switch_Chars'Last >= Ptr + 3
130         and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
131       then
132          Osint.Fail ("invalid switch: """ & Switch_Chars & """"
133                      & " (gnat not needed here)");
134       end if;
135
136       --  Loop to scan through switches given in switch string
137
138       Check_Switch : begin
139          C := Switch_Chars (Ptr);
140
141          case C is
142
143          --  Processing for a switch
144
145          when 'a' =>
146             Ptr := Ptr + 1;
147             Use_Pragma_Linker_Constructor := True;
148
149          --  Processing for A switch
150
151          when 'A' =>
152             Ptr := Ptr + 1;
153             Output_ALI_List := True;
154             ALI_List_Filename := Get_Optional_Filename;
155
156          --  Processing for b switch
157
158          when 'b' =>
159             Ptr := Ptr + 1;
160             Brief_Output := True;
161
162          --  Processing for c switch
163
164          when 'c' =>
165             Ptr := Ptr + 1;
166             Check_Only := True;
167
168          --  Processing for d switch
169
170          when 'd' =>
171
172             if Ptr = Max then
173                Bad_Switch (Switch_Chars);
174             end if;
175
176             Ptr := Ptr + 1;
177             C := Switch_Chars (Ptr);
178
179             --  Case where character after -d is a digit (default stack size)
180
181             if C in '0' .. '9' then
182
183                --  In this case, we process the default primary stack size
184
185                Default_Stack_Size := Get_Stack_Size ('d');
186
187             --  Case where character after -d is not digit (debug flags)
188
189             else
190                --  Note: for the debug switch, the remaining characters in this
191                --  switch field must all be debug flags, since all valid switch
192                --  characters are also valid debug characters. This switch is
193                --  not documented on purpose because it is only used by the
194                --  implementors.
195
196                --  Loop to scan out debug flags
197
198                loop
199                   C := Switch_Chars (Ptr);
200
201                   if C in 'a' .. 'z' or else C in 'A' .. 'Z' then
202                      Set_Debug_Flag (C);
203                   else
204                      Bad_Switch (Switch_Chars);
205                   end if;
206
207                   Ptr := Ptr + 1;
208                   exit when Ptr > Max;
209                end loop;
210             end if;
211
212          --  Processing for D switch
213
214          when 'D' =>
215             if Ptr = Max then
216                Bad_Switch (Switch_Chars);
217             end if;
218
219             Ptr := Ptr + 1;
220             Default_Sec_Stack_Size := Get_Stack_Size ('D');
221
222          --  Processing for e switch
223
224          when 'e' =>
225             Ptr := Ptr + 1;
226             Elab_Dependency_Output := True;
227
228          --  Processing for E switch
229
230          when 'E' =>
231             Ptr := Ptr + 1;
232             Exception_Tracebacks := True;
233
234          --  Processing for F switch
235
236          when 'F' =>
237             Ptr := Ptr + 1;
238             Force_Checking_Of_Elaboration_Flags := True;
239
240          --  Processing for g switch
241
242          when 'g' =>
243             Ptr := Ptr + 1;
244
245             if Ptr <= Max then
246                C := Switch_Chars (Ptr);
247
248                if C in '0' .. '3' then
249                   Debugger_Level :=
250                     Character'Pos
251                       (Switch_Chars (Ptr)) - Character'Pos ('0');
252                   Ptr := Ptr + 1;
253                end if;
254
255             else
256                Debugger_Level := 2;
257             end if;
258
259          --  Processing for h switch
260
261          when 'h' =>
262             Ptr := Ptr + 1;
263             Usage_Requested := True;
264
265          --  Processing for H switch
266
267          when 'H' =>
268             if Ptr = Max then
269                Bad_Switch (Switch_Chars);
270             end if;
271
272             Ptr := Ptr + 1;
273             Scan_Nat (Switch_Chars, Max, Ptr, Heap_Size, C);
274
275             if Heap_Size /= 32 and then Heap_Size /= 64 then
276                Bad_Switch (Switch_Chars);
277             end if;
278
279          --  Processing for i switch
280
281          when 'i' =>
282             if Ptr = Max then
283                Bad_Switch (Switch_Chars);
284             end if;
285
286             Ptr := Ptr + 1;
287             C := Switch_Chars (Ptr);
288
289             if C in '1' .. '5'
290               or else C = '8'
291               or else C = 'p'
292               or else C = 'f'
293               or else C = 'n'
294               or else C = 'w'
295             then
296                Identifier_Character_Set := C;
297                Ptr := Ptr + 1;
298             else
299                Bad_Switch (Switch_Chars);
300             end if;
301
302          --  Processing for K switch
303
304          when 'K' =>
305             Ptr := Ptr + 1;
306             Output_Linker_Option_List := True;
307
308          --  Processing for l switch
309
310          when 'l' =>
311             Ptr := Ptr + 1;
312             Elab_Order_Output := True;
313
314          --  Processing for m switch
315
316          when 'm' =>
317             if Ptr = Max then
318                Bad_Switch (Switch_Chars);
319             end if;
320
321             Ptr := Ptr + 1;
322             Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Messages, C);
323
324          --  Processing for n switch
325
326          when 'n' =>
327             Ptr := Ptr + 1;
328             Bind_Main_Program := False;
329
330             --  Note: The -L option of the binder also implies -n, so
331             --  any change here must also be reflected in the processing
332             --  for -L that is found in Gnatbind.Scan_Bind_Arg.
333
334          --  Processing for o switch
335
336          when 'o' =>
337             Ptr := Ptr + 1;
338
339             if Output_File_Name_Present then
340                Osint.Fail ("duplicate -o switch");
341             else
342                Output_File_Name_Present := True;
343             end if;
344
345          --  Processing for O switch
346
347          when 'O' =>
348             Ptr := Ptr + 1;
349             Output_Object_List := True;
350             Object_List_Filename := Get_Optional_Filename;
351
352          --  Processing for p switch
353
354          when 'p' =>
355             Ptr := Ptr + 1;
356             Pessimistic_Elab_Order := True;
357
358          --  Processing for P switch
359
360          when 'P' =>
361             Ptr := Ptr + 1;
362             CodePeer_Mode := True;
363
364          --  Processing for q switch
365
366          when 'q' =>
367             Ptr := Ptr + 1;
368             Quiet_Output := True;
369
370          --  Processing for r switch
371
372          when 'r' =>
373             Ptr := Ptr + 1;
374             List_Restrictions := True;
375
376          --  Processing for R switch
377
378          when 'R' =>
379             Ptr := Ptr + 1;
380             List_Closure := True;
381
382          --  Processing for s switch
383
384          when 's' =>
385             Ptr := Ptr + 1;
386             All_Sources := True;
387             Check_Source_Files := True;
388
389          --  Processing for t switch
390
391          when 't' =>
392             Ptr := Ptr + 1;
393             Tolerate_Consistency_Errors := True;
394
395          --  Processing for T switch
396
397          when 'T' =>
398             if Ptr = Max then
399                Bad_Switch (Switch_Chars);
400             end if;
401
402             Ptr := Ptr + 1;
403             Time_Slice_Set := True;
404             Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value, C);
405             Time_Slice_Value := Time_Slice_Value * 1_000;
406
407          --  Processing for u switch
408
409          when 'u' =>
410             if Ptr = Max then
411                Bad_Switch (Switch_Chars);
412             end if;
413
414             Ptr := Ptr + 1;
415             Dynamic_Stack_Measurement := True;
416             Scan_Nat
417               (Switch_Chars,
418                Max,
419                Ptr,
420                Dynamic_Stack_Measurement_Array_Size,
421                C);
422
423          --  Processing for v switch
424
425          when 'v' =>
426             Ptr := Ptr + 1;
427             Verbose_Mode := True;
428
429          --  Processing for w switch
430
431          when 'w' =>
432             if Ptr = Max then
433                Bad_Switch (Switch_Chars);
434             end if;
435
436             --  For the binder we only allow suppress/error cases
437
438             Ptr := Ptr + 1;
439
440             case Switch_Chars (Ptr) is
441                when 'e' =>
442                   Warning_Mode := Treat_As_Error;
443
444                when 's' =>
445                   Warning_Mode := Suppress;
446
447                when others =>
448                   Bad_Switch (Switch_Chars);
449             end case;
450
451             Ptr := Ptr + 1;
452
453          --  Processing for W switch
454
455          when 'W' =>
456             Ptr := Ptr + 1;
457
458             if Ptr > Max then
459                Bad_Switch (Switch_Chars);
460             end if;
461
462             begin
463                Wide_Character_Encoding_Method :=
464                  Get_WC_Encoding_Method (Switch_Chars (Ptr));
465             exception
466                when Constraint_Error =>
467                   Bad_Switch (Switch_Chars);
468             end;
469
470             Wide_Character_Encoding_Method_Specified := True;
471
472             Upper_Half_Encoding :=
473               Wide_Character_Encoding_Method in WC_Upper_Half_Encoding_Method;
474
475             Ptr := Ptr + 1;
476
477          --  Processing for x switch
478
479          when 'x' =>
480             Ptr := Ptr + 1;
481             All_Sources := False;
482             Check_Source_Files := False;
483
484          --  Processing for X switch
485
486          when 'X' =>
487             if Ptr = Max then
488                Bad_Switch (Switch_Chars);
489             end if;
490
491             Ptr := Ptr + 1;
492             Scan_Pos (Switch_Chars, Max, Ptr, Default_Exit_Status, C);
493
494          --  Processing for y switch
495
496          when 'y' =>
497             Ptr := Ptr + 1;
498             Leap_Seconds_Support := True;
499
500          --  Processing for z switch
501
502          when 'z' =>
503             Ptr := Ptr + 1;
504             No_Main_Subprogram := True;
505
506          --  Processing for Z switch
507
508          when 'Z' =>
509             Ptr := Ptr + 1;
510             Zero_Formatting := True;
511
512          --  Processing for --RTS
513
514          when '-' =>
515
516             if Ptr + 4 <= Max and then
517               Switch_Chars (Ptr + 1 .. Ptr + 3) = "RTS"
518             then
519                Ptr := Ptr + 4;
520
521                if Switch_Chars (Ptr) /= '=' or else Ptr = Max then
522                   Osint.Fail ("missing path for --RTS");
523
524                else
525                   --  Valid --RTS switch
526
527                   Opt.No_Stdinc := True;
528                   Opt.RTS_Switch := True;
529
530                   declare
531                      Src_Path_Name : constant String_Ptr :=
532                                        Get_RTS_Search_Dir
533                                          (Switch_Chars
534                                            (Ptr + 1 .. Switch_Chars'Last),
535                                           Include);
536                      Lib_Path_Name : constant String_Ptr :=
537                                        Get_RTS_Search_Dir
538                                          (Switch_Chars
539                                            (Ptr + 1 .. Switch_Chars'Last),
540                                           Objects);
541
542                   begin
543                      if Src_Path_Name /= null and then
544                        Lib_Path_Name /= null
545                      then
546                         --  Set the RTS_*_Path_Name variables, so that the
547                         --  correct directories will be set when a subsequent
548                         --  call Osint.Add_Default_Search_Dirs is made.
549
550                         RTS_Src_Path_Name := Src_Path_Name;
551                         RTS_Lib_Path_Name := Lib_Path_Name;
552
553                         Ptr := Max + 1;
554
555                      elsif  Src_Path_Name = null
556                        and then Lib_Path_Name = null
557                      then
558                         Osint.Fail ("RTS path not valid: missing " &
559                                     "adainclude and adalib directories");
560                      elsif Src_Path_Name = null then
561                         Osint.Fail ("RTS path not valid: missing " &
562                                     "adainclude directory");
563                      elsif  Lib_Path_Name = null then
564                         Osint.Fail ("RTS path not valid: missing " &
565                                     "adalib directory");
566                      end if;
567                   end;
568                end if;
569
570             else
571                Bad_Switch (Switch_Chars);
572             end if;
573
574          --  Anything else is an error (illegal switch character)
575
576          when others =>
577             Bad_Switch (Switch_Chars);
578          end case;
579
580          if Ptr <= Max then
581             Bad_Switch (Switch_Chars);
582          end if;
583       end Check_Switch;
584    end Scan_Binder_Switches;
585
586 end Switch.B;