Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/switch-b.adb @ 111:04ced10e8804

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