1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S W I T C H - C -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-2012, 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 package is for switch processing and should not depend on higher level 27-- packages such as those for the scanner, parser, etc. Doing so may cause 28-- circularities, especially for back ends using Adabkend. 29 30with Debug; use Debug; 31with Lib; use Lib; 32with Osint; use Osint; 33with Opt; use Opt; 34with Validsw; use Validsw; 35with Stylesw; use Stylesw; 36with Ttypes; use Ttypes; 37with Warnsw; use Warnsw; 38 39with Ada.Unchecked_Deallocation; 40with System.WCh_Con; use System.WCh_Con; 41 42package body Switch.C is 43 44 RTS_Specified : String_Access := null; 45 -- Used to detect multiple use of --RTS= flag 46 47 procedure Add_Symbol_Definition (Def : String); 48 -- Add a symbol definition from the command line 49 50 procedure Free is 51 new Ada.Unchecked_Deallocation (String_List, String_List_Access); 52 -- Avoid using System.Strings.Free, which also frees the designated strings 53 54 function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type; 55 -- Given a digit in the range 0 .. 3, returns the corresponding value of 56 -- Overflow_Mode_Type. Raises Program_Error if C is outside this range. 57 58 function Switch_Subsequently_Cancelled 59 (C : String; 60 Args : String_List; 61 Arg_Rank : Positive) return Boolean; 62 -- This function is called from Scan_Front_End_Switches. It determines if 63 -- the switch currently being scanned is followed by a switch of the form 64 -- "-gnat-" & C, where C is the argument. If so, then True is returned, 65 -- and Scan_Front_End_Switches will cancel the effect of the switch. If 66 -- no such switch is found, False is returned. 67 68 --------------------------- 69 -- Add_Symbol_Definition -- 70 --------------------------- 71 72 procedure Add_Symbol_Definition (Def : String) is 73 begin 74 -- If Preprocessor_Symbol_Defs is not large enough, double its size 75 76 if Preprocessing_Symbol_Last = Preprocessing_Symbol_Defs'Last then 77 declare 78 New_Symbol_Definitions : constant String_List_Access := 79 new String_List (1 .. 2 * Preprocessing_Symbol_Last); 80 begin 81 New_Symbol_Definitions (Preprocessing_Symbol_Defs'Range) := 82 Preprocessing_Symbol_Defs.all; 83 Free (Preprocessing_Symbol_Defs); 84 Preprocessing_Symbol_Defs := New_Symbol_Definitions; 85 end; 86 end if; 87 88 Preprocessing_Symbol_Last := Preprocessing_Symbol_Last + 1; 89 Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last) := 90 new String'(Def); 91 end Add_Symbol_Definition; 92 93 ----------------------- 94 -- Get_Overflow_Mode -- 95 ----------------------- 96 97 function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type is 98 begin 99 case C is 100 when '1' => 101 return Strict; 102 103 when '2' => 104 return Minimized; 105 106 -- Eliminated allowed only if Long_Long_Integer is 64 bits (since 107 -- the current implementation of System.Bignums assumes this). 108 109 when '3' => 110 if Standard_Long_Long_Integer_Size /= 64 then 111 Bad_Switch ("-gnato3 not implemented for this configuration"); 112 else 113 return Eliminated; 114 end if; 115 116 when others => 117 raise Program_Error; 118 end case; 119 end Get_Overflow_Mode; 120 121 ----------------------------- 122 -- Scan_Front_End_Switches -- 123 ----------------------------- 124 125 procedure Scan_Front_End_Switches 126 (Switch_Chars : String; 127 Args : String_List; 128 Arg_Rank : Positive) 129 is 130 First_Switch : Boolean := True; 131 -- False for all but first switch 132 133 Max : constant Natural := Switch_Chars'Last; 134 Ptr : Natural; 135 C : Character := ' '; 136 Dot : Boolean; 137 138 Store_Switch : Boolean; 139 -- For -gnatxx switches, the normal processing, signalled by this flag 140 -- being set to True, is to store the switch on exit from the case 141 -- statement, the switch stored is -gnat followed by the characters 142 -- from First_Char to Ptr-1. For cases like -gnaty, where the switch 143 -- is stored in separate pieces, this flag is set to False, and the 144 -- appropriate calls to Store_Compilation_Switch are made from within 145 -- the case branch. 146 147 First_Char : Positive; 148 -- Marks start of switch to be stored 149 150 begin 151 Ptr := Switch_Chars'First; 152 153 -- Skip past the initial character (must be the switch character) 154 155 if Ptr = Max then 156 Bad_Switch (C); 157 else 158 Ptr := Ptr + 1; 159 end if; 160 161 -- Handle switches that do not start with -gnat 162 163 if Ptr + 3 > Max or else Switch_Chars (Ptr .. Ptr + 3) /= "gnat" then 164 165 -- There are two front-end switches that do not start with -gnat: 166 -- -I, --RTS 167 168 if Switch_Chars (Ptr) = 'I' then 169 170 -- Set flag Search_Directory_Present if switch is "-I" only: 171 -- the directory will be the next argument. 172 173 if Ptr = Max then 174 Search_Directory_Present := True; 175 return; 176 end if; 177 178 Ptr := Ptr + 1; 179 180 -- Find out whether this is a -I- or regular -Ixxx switch 181 182 -- Note: -I switches are not recorded in the ALI file, since the 183 -- meaning of the program depends on the source files compiled, 184 -- not where they came from. 185 186 if Ptr = Max and then Switch_Chars (Ptr) = '-' then 187 Look_In_Primary_Dir := False; 188 else 189 Add_Src_Search_Dir (Switch_Chars (Ptr .. Max)); 190 end if; 191 192 -- Processing of the --RTS switch. --RTS may have been modified by 193 -- gcc into -fRTS (for GCC targets). 194 195 elsif Ptr + 3 <= Max 196 and then (Switch_Chars (Ptr .. Ptr + 3) = "fRTS" 197 or else 198 Switch_Chars (Ptr .. Ptr + 3) = "-RTS") 199 then 200 Ptr := Ptr + 1; 201 202 if Ptr + 4 > Max 203 or else Switch_Chars (Ptr + 3) /= '=' 204 then 205 Osint.Fail ("missing path for --RTS"); 206 else 207 -- Check that this is the first time --RTS is specified or if 208 -- it is not the first time, the same path has been specified. 209 210 if RTS_Specified = null then 211 RTS_Specified := new String'(Switch_Chars (Ptr + 4 .. Max)); 212 213 elsif 214 RTS_Specified.all /= Switch_Chars (Ptr + 4 .. Max) 215 then 216 Osint.Fail ("--RTS cannot be specified multiple times"); 217 end if; 218 219 -- Valid --RTS switch 220 221 Opt.No_Stdinc := True; 222 Opt.RTS_Switch := True; 223 224 RTS_Src_Path_Name := 225 Get_RTS_Search_Dir 226 (Switch_Chars (Ptr + 4 .. Max), Include); 227 228 RTS_Lib_Path_Name := 229 Get_RTS_Search_Dir 230 (Switch_Chars (Ptr + 4 .. Max), Objects); 231 232 if RTS_Src_Path_Name /= null 233 and then RTS_Lib_Path_Name /= null 234 then 235 -- Store the -fRTS switch (Note: Store_Compilation_Switch 236 -- changes -fRTS back into --RTS for the actual output). 237 238 Store_Compilation_Switch (Switch_Chars); 239 240 elsif RTS_Src_Path_Name = null 241 and then RTS_Lib_Path_Name = null 242 then 243 Osint.Fail ("RTS path not valid: missing " & 244 "adainclude and adalib directories"); 245 246 elsif RTS_Src_Path_Name = null then 247 Osint.Fail ("RTS path not valid: missing " & 248 "adainclude directory"); 249 250 elsif RTS_Lib_Path_Name = null then 251 Osint.Fail ("RTS path not valid: missing " & 252 "adalib directory"); 253 end if; 254 end if; 255 256 -- There are no other switches not starting with -gnat 257 258 else 259 Bad_Switch (Switch_Chars); 260 end if; 261 262 -- Case of switch starting with -gnat 263 264 else 265 Ptr := Ptr + 4; 266 267 -- Loop to scan through switches given in switch string 268 269 while Ptr <= Max loop 270 First_Char := Ptr; 271 Store_Switch := True; 272 273 C := Switch_Chars (Ptr); 274 275 case C is 276 277 when 'a' => 278 Ptr := Ptr + 1; 279 Assertions_Enabled := True; 280 Debug_Pragmas_Enabled := True; 281 282 -- Processing for A switch 283 284 when 'A' => 285 Ptr := Ptr + 1; 286 Config_File := False; 287 288 -- Processing for b switch 289 290 when 'b' => 291 Ptr := Ptr + 1; 292 Brief_Output := True; 293 294 -- Processing for B switch 295 296 when 'B' => 297 Ptr := Ptr + 1; 298 Assume_No_Invalid_Values := True; 299 300 -- Processing for c switch 301 302 when 'c' => 303 if not First_Switch then 304 Osint.Fail 305 ("-gnatc must be first if combined with other switches"); 306 end if; 307 308 Ptr := Ptr + 1; 309 Operating_Mode := Check_Semantics; 310 311 -- Processing for C switch 312 313 when 'C' => 314 Ptr := Ptr + 1; 315 316 if not CodePeer_Mode then 317 CodePeer_Mode := True; 318 319 -- Suppress compiler warnings by default, since what we are 320 -- interested in here is what CodePeer can find out. Note 321 -- that if -gnatwxxx is specified after -gnatC on the 322 -- command line, we do not want to override this setting in 323 -- Adjust_Global_Switches, and assume that the user wants to 324 -- get both warnings from GNAT and CodePeer messages. 325 326 Warning_Mode := Suppress; 327 end if; 328 329 -- Processing for d switch 330 331 when 'd' => 332 Store_Switch := False; 333 Dot := False; 334 335 -- Note: for the debug switch, the remaining characters in this 336 -- switch field must all be debug flags, since all valid switch 337 -- characters are also valid debug characters. 338 339 -- Loop to scan out debug flags 340 341 while Ptr < Max loop 342 Ptr := Ptr + 1; 343 C := Switch_Chars (Ptr); 344 exit when C = ASCII.NUL or else C = '/' or else C = '-'; 345 346 if C in '1' .. '9' or else 347 C in 'a' .. 'z' or else 348 C in 'A' .. 'Z' 349 then 350 if Dot then 351 Set_Dotted_Debug_Flag (C); 352 Store_Compilation_Switch ("-gnatd." & C); 353 else 354 Set_Debug_Flag (C); 355 Store_Compilation_Switch ("-gnatd" & C); 356 end if; 357 358 elsif C = '.' then 359 Dot := True; 360 361 elsif Dot then 362 Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max)); 363 else 364 Bad_Switch ("-gnatd" & Switch_Chars (Ptr .. Max)); 365 end if; 366 end loop; 367 368 return; 369 370 -- Processing for D switch 371 372 when 'D' => 373 Ptr := Ptr + 1; 374 375 -- Scan optional integer line limit value 376 377 if Nat_Present (Switch_Chars, Max, Ptr) then 378 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'D'); 379 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40); 380 end if; 381 382 -- Note: -gnatD also sets -gnatx (to turn off cross-reference 383 -- generation in the ali file) since otherwise this generation 384 -- gets confused by the "wrong" Sloc values put in the tree. 385 386 Debug_Generated_Code := True; 387 Xref_Active := False; 388 Set_Debug_Flag ('g'); 389 390 -- -gnate? (extended switches) 391 392 when 'e' => 393 Ptr := Ptr + 1; 394 395 -- The -gnate? switches are all double character switches 396 -- so we must always have a character after the e. 397 398 if Ptr > Max then 399 Bad_Switch ("-gnate"); 400 end if; 401 402 case Switch_Chars (Ptr) is 403 404 -- -gnatea (initial delimiter of explicit switches) 405 406 -- All switches that come before -gnatea have been added by 407 -- the GCC driver and are not stored in the ALI file. 408 -- See also -gnatez below. 409 410 when 'a' => 411 Store_Switch := False; 412 Enable_Switch_Storing; 413 Ptr := Ptr + 1; 414 415 -- -gnateA (aliasing checks on parameters) 416 417 when 'A' => 418 Ptr := Ptr + 1; 419 Check_Aliasing_Of_Parameters := True; 420 421 -- -gnatec (configuration pragmas) 422 423 when 'c' => 424 Store_Switch := False; 425 Ptr := Ptr + 1; 426 427 -- There may be an equal sign between -gnatec and 428 -- the path name of the config file. 429 430 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then 431 Ptr := Ptr + 1; 432 end if; 433 434 if Ptr > Max then 435 Bad_Switch ("-gnatec"); 436 end if; 437 438 declare 439 Config_File_Name : constant String_Access := 440 new String' 441 (Switch_Chars (Ptr .. Max)); 442 443 begin 444 if Config_File_Names = null then 445 Config_File_Names := 446 new String_List'(1 => Config_File_Name); 447 448 else 449 declare 450 New_Names : constant String_List_Access := 451 new String_List 452 (1 .. 453 Config_File_Names'Length + 1); 454 455 begin 456 for Index in Config_File_Names'Range loop 457 New_Names (Index) := 458 Config_File_Names (Index); 459 Config_File_Names (Index) := null; 460 end loop; 461 462 New_Names (New_Names'Last) := Config_File_Name; 463 Free (Config_File_Names); 464 Config_File_Names := New_Names; 465 end; 466 end if; 467 end; 468 469 return; 470 471 -- -gnateC switch (CodePeer SCIL generation) 472 473 -- Not enabled for now, keep it for later??? 474 -- use -gnatd.I only for now 475 476 -- when 'C' => 477 -- Ptr := Ptr + 1; 478 -- Generate_SCIL := True; 479 480 -- -gnated switch (disable atomic synchronization) 481 482 when 'd' => 483 Suppress_Options.Suppress (Atomic_Synchronization) := 484 True; 485 486 -- -gnateD switch (preprocessing symbol definition) 487 488 when 'D' => 489 Store_Switch := False; 490 Ptr := Ptr + 1; 491 492 if Ptr > Max then 493 Bad_Switch ("-gnateD"); 494 end if; 495 496 Add_Symbol_Definition (Switch_Chars (Ptr .. Max)); 497 498 -- Store the switch 499 500 Store_Compilation_Switch 501 ("-gnateD" & Switch_Chars (Ptr .. Max)); 502 Ptr := Max + 1; 503 504 -- -gnateE (extra exception information) 505 506 when 'E' => 507 Exception_Extra_Info := True; 508 Ptr := Ptr + 1; 509 510 -- -gnatef (full source path for brief error messages) 511 512 when 'f' => 513 Store_Switch := False; 514 Ptr := Ptr + 1; 515 Full_Path_Name_For_Brief_Errors := True; 516 517 -- -gnateF (Check_Float_Overflow) 518 519 when 'F' => 520 Ptr := Ptr + 1; 521 Check_Float_Overflow := True; 522 523 -- -gnateG (save preprocessor output) 524 525 when 'G' => 526 Generate_Processed_File := True; 527 Ptr := Ptr + 1; 528 529 -- -gnatei (max number of instantiations) 530 531 when 'i' => 532 Ptr := Ptr + 1; 533 Scan_Pos 534 (Switch_Chars, Max, Ptr, Maximum_Instantiations, C); 535 536 -- -gnateI (index of unit in multi-unit source) 537 538 when 'I' => 539 Ptr := Ptr + 1; 540 Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C); 541 542 -- -gnatem (mapping file) 543 544 when 'm' => 545 Store_Switch := False; 546 Ptr := Ptr + 1; 547 548 -- There may be an equal sign between -gnatem and 549 -- the path name of the mapping file. 550 551 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then 552 Ptr := Ptr + 1; 553 end if; 554 555 if Ptr > Max then 556 Bad_Switch ("-gnatem"); 557 end if; 558 559 Mapping_File_Name := 560 new String'(Switch_Chars (Ptr .. Max)); 561 return; 562 563 -- -gnateO= (object path file) 564 565 when 'O' => 566 Store_Switch := False; 567 Ptr := Ptr + 1; 568 569 -- Check for '=' 570 571 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then 572 Bad_Switch ("-gnateO"); 573 574 else 575 Object_Path_File_Name := 576 new String'(Switch_Chars (Ptr + 1 .. Max)); 577 end if; 578 579 return; 580 581 -- -gnatep (preprocessing data file) 582 583 when 'p' => 584 Store_Switch := False; 585 Ptr := Ptr + 1; 586 587 -- There may be an equal sign between -gnatep and 588 -- the path name of the mapping file. 589 590 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then 591 Ptr := Ptr + 1; 592 end if; 593 594 if Ptr > Max then 595 Bad_Switch ("-gnatep"); 596 end if; 597 598 Preprocessing_Data_File := 599 new String'(Switch_Chars (Ptr .. Max)); 600 601 -- Store the switch, normalizing to -gnatep= 602 603 Store_Compilation_Switch 604 ("-gnatep=" & Preprocessing_Data_File.all); 605 606 Ptr := Max + 1; 607 608 -- -gnateP (Treat pragma Pure/Preelaborate errs as warnings) 609 610 when 'P' => 611 Treat_Categorization_Errors_As_Warnings := True; 612 613 -- -gnateS (generate SCO information) 614 615 -- Include Source Coverage Obligation information in ALI 616 -- files for the benefit of source coverage analysis tools 617 -- (xcov). 618 619 when 'S' => 620 Generate_SCO := True; 621 Generate_SCO_Instance_Table := True; 622 Ptr := Ptr + 1; 623 624 -- -gnatet (generate target dependent information) 625 626 when 't' => 627 Generate_Target_Dependent_Info := True; 628 Ptr := Ptr + 1; 629 630 -- -gnateV (validity checks on parameters) 631 632 when 'V' => 633 Ptr := Ptr + 1; 634 Check_Validity_Of_Parameters := True; 635 636 -- -gnateY (ignore Style_Checks pragmas) 637 638 when 'Y' => 639 Ignore_Style_Checks_Pragmas := True; 640 Ptr := Ptr + 1; 641 642 -- -gnatez (final delimiter of explicit switches) 643 644 -- All switches that come after -gnatez have been added by 645 -- the GCC driver and are not stored in the ALI file. See 646 -- also -gnatea above. 647 648 when 'z' => 649 Store_Switch := False; 650 Disable_Switch_Storing; 651 Ptr := Ptr + 1; 652 653 -- All other -gnate? switches are unassigned 654 655 when others => 656 Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max)); 657 end case; 658 659 -- -gnatE (dynamic elaboration checks) 660 661 when 'E' => 662 Ptr := Ptr + 1; 663 Dynamic_Elaboration_Checks := True; 664 665 -- -gnatf (full error messages) 666 667 when 'f' => 668 Ptr := Ptr + 1; 669 All_Errors_Mode := True; 670 671 -- Processing for F switch 672 673 when 'F' => 674 Ptr := Ptr + 1; 675 External_Name_Exp_Casing := Uppercase; 676 External_Name_Imp_Casing := Uppercase; 677 678 -- Processing for g switch 679 680 when 'g' => 681 Ptr := Ptr + 1; 682 GNAT_Mode := True; 683 Identifier_Character_Set := 'n'; 684 System_Extend_Unit := Empty; 685 Warning_Mode := Treat_As_Error; 686 687 -- Set Ada 2012 mode explicitly. We don't want to rely on the 688 -- implicit setting here, since for example, we want 689 -- Preelaborate_05 treated as Preelaborate 690 691 Ada_Version := Ada_2012; 692 Ada_Version_Explicit := Ada_Version; 693 694 -- Set default warnings and style checks for -gnatg 695 696 Set_GNAT_Mode_Warnings; 697 Set_GNAT_Style_Check_Options; 698 699 -- Processing for G switch 700 701 when 'G' => 702 Ptr := Ptr + 1; 703 Print_Generated_Code := True; 704 705 -- Scan optional integer line limit value 706 707 if Nat_Present (Switch_Chars, Max, Ptr) then 708 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G'); 709 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40); 710 end if; 711 712 -- Processing for h switch 713 714 when 'h' => 715 Ptr := Ptr + 1; 716 Usage_Requested := True; 717 718 -- Processing for i switch 719 720 when 'i' => 721 if Ptr = Max then 722 Bad_Switch ("-gnati"); 723 end if; 724 725 Ptr := Ptr + 1; 726 C := Switch_Chars (Ptr); 727 728 if C in '1' .. '5' 729 or else C = '8' 730 or else C = '9' 731 or else C = 'p' 732 or else C = 'f' 733 or else C = 'n' 734 or else C = 'w' 735 then 736 Identifier_Character_Set := C; 737 Ptr := Ptr + 1; 738 739 else 740 Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max)); 741 end if; 742 743 -- Processing for I switch 744 745 when 'I' => 746 Ptr := Ptr + 1; 747 Ignore_Rep_Clauses := True; 748 749 -- Processing for j switch 750 751 when 'j' => 752 Ptr := Ptr + 1; 753 Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C); 754 755 -- Processing for k switch 756 757 when 'k' => 758 Ptr := Ptr + 1; 759 Scan_Pos 760 (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C); 761 762 -- Processing for l switch 763 764 when 'l' => 765 Ptr := Ptr + 1; 766 Full_List := True; 767 768 -- There may be an equal sign between -gnatl and a file name 769 770 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then 771 if Ptr = Max then 772 Osint.Fail ("file name for -gnatl= is null"); 773 else 774 Opt.Full_List_File_Name := 775 new String'(Switch_Chars (Ptr + 1 .. Max)); 776 Ptr := Max + 1; 777 end if; 778 end if; 779 780 -- Processing for L switch 781 782 when 'L' => 783 Ptr := Ptr + 1; 784 Dump_Source_Text := True; 785 786 -- Processing for m switch 787 788 when 'm' => 789 Ptr := Ptr + 1; 790 Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C); 791 792 -- Processing for n switch 793 794 when 'n' => 795 Ptr := Ptr + 1; 796 Inline_Active := True; 797 798 -- There may be a digit (1 or 2) appended to the switch 799 800 if Ptr <= Max then 801 C := Switch_Chars (Ptr); 802 803 if C in '1' .. '2' then 804 Ptr := Ptr + 1; 805 Inline_Level := Character'Pos (C) - Character'Pos ('0'); 806 end if; 807 end if; 808 809 -- Processing for N switch 810 811 when 'N' => 812 Ptr := Ptr + 1; 813 Inline_Active := True; 814 Front_End_Inlining := True; 815 816 -- Processing for o switch 817 818 when 'o' => 819 Ptr := Ptr + 1; 820 Suppress_Options.Suppress (Overflow_Check) := False; 821 822 -- Case of no digits after the -gnato 823 824 if Ptr > Max or else Switch_Chars (Ptr) not in '1' .. '3' then 825 Suppress_Options.Overflow_Mode_General := Strict; 826 Suppress_Options.Overflow_Mode_Assertions := Strict; 827 828 -- At least one digit after the -gnato 829 830 else 831 -- Handle first digit after -gnato 832 833 Suppress_Options.Overflow_Mode_General := 834 Get_Overflow_Mode (Switch_Chars (Ptr)); 835 Ptr := Ptr + 1; 836 837 -- Only one digit after -gnato, set assertions mode to 838 -- be the same as general mode. 839 840 if Ptr > Max 841 or else Switch_Chars (Ptr) not in '1' .. '3' 842 then 843 Suppress_Options.Overflow_Mode_Assertions := 844 Suppress_Options.Overflow_Mode_General; 845 846 -- Process second digit after -gnato 847 848 else 849 Suppress_Options.Overflow_Mode_Assertions := 850 Get_Overflow_Mode (Switch_Chars (Ptr)); 851 Ptr := Ptr + 1; 852 end if; 853 end if; 854 855 -- Processing for O switch 856 857 when 'O' => 858 Store_Switch := False; 859 Ptr := Ptr + 1; 860 Output_File_Name_Present := True; 861 862 -- Processing for p switch 863 864 when 'p' => 865 Ptr := Ptr + 1; 866 867 -- Skip processing if cancelled by subsequent -gnat-p 868 869 if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then 870 Store_Switch := False; 871 872 else 873 -- Set all specific options as well as All_Checks in the 874 -- Suppress_Options array, excluding Elaboration_Check, 875 -- since this is treated specially because we do not want 876 -- -gnatp to disable static elaboration processing. Also 877 -- exclude Atomic_Synchronization, since this is not a real 878 -- check. 879 880 for J in Suppress_Options.Suppress'Range loop 881 if J /= Elaboration_Check 882 and then 883 J /= Atomic_Synchronization 884 then 885 Suppress_Options.Suppress (J) := True; 886 end if; 887 end loop; 888 889 Validity_Checks_On := False; 890 Opt.Suppress_Checks := True; 891 end if; 892 893 -- Processing for P switch 894 895 when 'P' => 896 Ptr := Ptr + 1; 897 Polling_Required := True; 898 899 -- Processing for q switch 900 901 when 'q' => 902 Ptr := Ptr + 1; 903 Try_Semantics := True; 904 905 -- Processing for Q switch 906 907 when 'Q' => 908 Ptr := Ptr + 1; 909 Force_ALI_Tree_File := True; 910 Try_Semantics := True; 911 912 -- Processing for r switch 913 914 when 'r' => 915 Ptr := Ptr + 1; 916 Treat_Restrictions_As_Warnings := True; 917 918 -- Processing for R switch 919 920 when 'R' => 921 Back_Annotate_Rep_Info := True; 922 List_Representation_Info := 1; 923 924 Ptr := Ptr + 1; 925 while Ptr <= Max loop 926 C := Switch_Chars (Ptr); 927 928 if C in '1' .. '3' then 929 List_Representation_Info := 930 Character'Pos (C) - Character'Pos ('0'); 931 932 elsif Switch_Chars (Ptr) = 's' then 933 List_Representation_Info_To_File := True; 934 935 elsif Switch_Chars (Ptr) = 'm' then 936 List_Representation_Info_Mechanisms := True; 937 938 else 939 Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max)); 940 end if; 941 942 Ptr := Ptr + 1; 943 end loop; 944 945 -- Processing for s switch 946 947 when 's' => 948 if not First_Switch then 949 Osint.Fail 950 ("-gnats must be first if combined with other switches"); 951 end if; 952 953 Ptr := Ptr + 1; 954 Operating_Mode := Check_Syntax; 955 956 -- Processing for S switch 957 958 when 'S' => 959 Print_Standard := True; 960 Ptr := Ptr + 1; 961 962 -- Processing for t switch 963 964 when 't' => 965 Ptr := Ptr + 1; 966 Tree_Output := True; 967 Back_Annotate_Rep_Info := True; 968 969 -- Processing for T switch 970 971 when 'T' => 972 Ptr := Ptr + 1; 973 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C); 974 975 -- Processing for u switch 976 977 when 'u' => 978 Ptr := Ptr + 1; 979 List_Units := True; 980 981 -- Processing for U switch 982 983 when 'U' => 984 Ptr := Ptr + 1; 985 Unique_Error_Tag := True; 986 987 -- Processing for v switch 988 989 when 'v' => 990 Ptr := Ptr + 1; 991 Verbose_Mode := True; 992 993 -- Processing for V switch 994 995 when 'V' => 996 Store_Switch := False; 997 Ptr := Ptr + 1; 998 999 if Ptr > Max then 1000 Bad_Switch ("-gnatV"); 1001 1002 else 1003 declare 1004 OK : Boolean; 1005 1006 begin 1007 Set_Validity_Check_Options 1008 (Switch_Chars (Ptr .. Max), OK, Ptr); 1009 1010 if not OK then 1011 Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max)); 1012 end if; 1013 1014 for Index in First_Char + 1 .. Max loop 1015 Store_Compilation_Switch 1016 ("-gnatV" & Switch_Chars (Index)); 1017 end loop; 1018 end; 1019 end if; 1020 1021 Ptr := Max + 1; 1022 1023 -- Processing for w switch 1024 1025 when 'w' => 1026 Store_Switch := False; 1027 Ptr := Ptr + 1; 1028 1029 if Ptr > Max then 1030 Bad_Switch ("-gnatw"); 1031 end if; 1032 1033 while Ptr <= Max loop 1034 C := Switch_Chars (Ptr); 1035 1036 -- Case of dot switch 1037 1038 if C = '.' and then Ptr < Max then 1039 Ptr := Ptr + 1; 1040 C := Switch_Chars (Ptr); 1041 1042 if Set_Dot_Warning_Switch (C) then 1043 Store_Compilation_Switch ("-gnatw." & C); 1044 else 1045 Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max)); 1046 end if; 1047 1048 -- Normal case, no dot 1049 1050 else 1051 if Set_Warning_Switch (C) then 1052 Store_Compilation_Switch ("-gnatw" & C); 1053 else 1054 Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max)); 1055 end if; 1056 end if; 1057 1058 Ptr := Ptr + 1; 1059 end loop; 1060 1061 return; 1062 1063 -- Processing for W switch 1064 1065 when 'W' => 1066 Ptr := Ptr + 1; 1067 1068 if Ptr > Max then 1069 Bad_Switch ("-gnatW"); 1070 end if; 1071 1072 begin 1073 Wide_Character_Encoding_Method := 1074 Get_WC_Encoding_Method (Switch_Chars (Ptr)); 1075 exception 1076 when Constraint_Error => 1077 Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max)); 1078 end; 1079 1080 Wide_Character_Encoding_Method_Specified := True; 1081 1082 Upper_Half_Encoding := 1083 Wide_Character_Encoding_Method in 1084 WC_Upper_Half_Encoding_Method; 1085 1086 Ptr := Ptr + 1; 1087 1088 -- Processing for x switch 1089 1090 when 'x' => 1091 Ptr := Ptr + 1; 1092 Xref_Active := False; 1093 1094 -- Processing for X switch 1095 1096 when 'X' => 1097 Ptr := Ptr + 1; 1098 Extensions_Allowed := True; 1099 Ada_Version := Ada_Version_Type'Last; 1100 Ada_Version_Explicit := Ada_Version_Type'Last; 1101 1102 -- Processing for y switch 1103 1104 when 'y' => 1105 Ptr := Ptr + 1; 1106 1107 if Ptr > Max then 1108 Set_Default_Style_Check_Options; 1109 1110 else 1111 Store_Switch := False; 1112 1113 declare 1114 OK : Boolean; 1115 1116 begin 1117 Set_Style_Check_Options 1118 (Switch_Chars (Ptr .. Max), OK, Ptr); 1119 1120 if not OK then 1121 Osint.Fail 1122 ("bad -gnaty switch (" & 1123 Style_Msg_Buf (1 .. Style_Msg_Len) & ')'); 1124 end if; 1125 1126 Ptr := First_Char + 1; 1127 while Ptr <= Max loop 1128 if Switch_Chars (Ptr) = 'M' then 1129 First_Char := Ptr; 1130 loop 1131 Ptr := Ptr + 1; 1132 exit when Ptr > Max 1133 or else Switch_Chars (Ptr) not in '0' .. '9'; 1134 end loop; 1135 1136 Store_Compilation_Switch 1137 ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1)); 1138 1139 else 1140 Store_Compilation_Switch 1141 ("-gnaty" & Switch_Chars (Ptr)); 1142 Ptr := Ptr + 1; 1143 end if; 1144 end loop; 1145 end; 1146 end if; 1147 1148 -- Processing for z switch 1149 1150 when 'z' => 1151 1152 -- -gnatz must be the first and only switch in Switch_Chars, 1153 -- and is a two-letter switch. 1154 1155 if Ptr /= Switch_Chars'First + 5 1156 or else (Max - Ptr + 1) > 2 1157 then 1158 Osint.Fail 1159 ("-gnatz* may not be combined with other switches"); 1160 end if; 1161 1162 if Ptr = Max then 1163 Bad_Switch ("-gnatz"); 1164 end if; 1165 1166 Ptr := Ptr + 1; 1167 1168 -- Only one occurrence of -gnat* is permitted 1169 1170 if Distribution_Stub_Mode = No_Stubs then 1171 case Switch_Chars (Ptr) is 1172 when 'r' => 1173 Distribution_Stub_Mode := Generate_Receiver_Stub_Body; 1174 1175 when 'c' => 1176 Distribution_Stub_Mode := Generate_Caller_Stub_Body; 1177 1178 when others => 1179 Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max)); 1180 end case; 1181 1182 Ptr := Ptr + 1; 1183 1184 else 1185 Osint.Fail ("only one -gnatz* switch allowed"); 1186 end if; 1187 1188 -- Processing for Z switch 1189 1190 when 'Z' => 1191 Ptr := Ptr + 1; 1192 Osint.Fail 1193 ("-gnatZ is no longer supported: consider using --RTS=zcx"); 1194 1195 -- Note on language version switches: whenever a new language 1196 -- version switch is added, Switch.M.Normalize_Compiler_Switches 1197 -- must be updated. 1198 1199 -- Processing for 83 switch 1200 1201 when '8' => 1202 if Ptr = Max then 1203 Bad_Switch ("-gnat8"); 1204 end if; 1205 1206 Ptr := Ptr + 1; 1207 1208 if Switch_Chars (Ptr) /= '3' then 1209 Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max)); 1210 else 1211 Ptr := Ptr + 1; 1212 Ada_Version := Ada_83; 1213 Ada_Version_Explicit := Ada_Version; 1214 end if; 1215 1216 -- Processing for 95 switch 1217 1218 when '9' => 1219 if Ptr = Max then 1220 Bad_Switch ("-gnat9"); 1221 end if; 1222 1223 Ptr := Ptr + 1; 1224 1225 if Switch_Chars (Ptr) /= '5' then 1226 Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max)); 1227 else 1228 Ptr := Ptr + 1; 1229 Ada_Version := Ada_95; 1230 Ada_Version_Explicit := Ada_Version; 1231 end if; 1232 1233 -- Processing for 05 switch 1234 1235 when '0' => 1236 if Ptr = Max then 1237 Bad_Switch ("-gnat0"); 1238 end if; 1239 1240 Ptr := Ptr + 1; 1241 1242 if Switch_Chars (Ptr) /= '5' then 1243 Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max)); 1244 else 1245 Ptr := Ptr + 1; 1246 Ada_Version := Ada_2005; 1247 Ada_Version_Explicit := Ada_Version; 1248 end if; 1249 1250 -- Processing for 12 switch 1251 1252 when '1' => 1253 if Ptr = Max then 1254 Bad_Switch ("-gnat1"); 1255 end if; 1256 1257 Ptr := Ptr + 1; 1258 1259 if Switch_Chars (Ptr) /= '2' then 1260 Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max)); 1261 else 1262 Ptr := Ptr + 1; 1263 Ada_Version := Ada_2012; 1264 Ada_Version_Explicit := Ada_Version; 1265 end if; 1266 1267 -- Processing for 2005 and 2012 switches 1268 1269 when '2' => 1270 if Ptr > Max - 3 then 1271 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max)); 1272 1273 elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" then 1274 Ada_Version := Ada_2005; 1275 1276 elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then 1277 Ada_Version := Ada_2012; 1278 1279 else 1280 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3)); 1281 end if; 1282 1283 Ada_Version_Explicit := Ada_Version; 1284 Ptr := Ptr + 4; 1285 1286 -- Switch cancellation, currently only -gnat-p is allowed. 1287 -- All we do here is the error checking, since the actual 1288 -- processing for switch cancellation is done by calls to 1289 -- Switch_Subsequently_Cancelled at the appropriate point. 1290 1291 when '-' => 1292 1293 -- Simple ignore -gnat-p 1294 1295 if Switch_Chars = "-gnat-p" then 1296 return; 1297 1298 -- Any other occurrence of minus is ignored. This is for 1299 -- maximum compatibility with previous version which ignored 1300 -- all occurrences of minus. 1301 1302 else 1303 Store_Switch := False; 1304 Ptr := Ptr + 1; 1305 end if; 1306 1307 -- We ignore '/' in switches, this is historical, still needed??? 1308 1309 when '/' => 1310 Store_Switch := False; 1311 1312 -- Anything else is an error (illegal switch character) 1313 1314 when others => 1315 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max)); 1316 end case; 1317 1318 if Store_Switch then 1319 Store_Compilation_Switch 1320 ("-gnat" & Switch_Chars (First_Char .. Ptr - 1)); 1321 end if; 1322 1323 First_Switch := False; 1324 end loop; 1325 end if; 1326 end Scan_Front_End_Switches; 1327 1328 ----------------------------------- 1329 -- Switch_Subsequently_Cancelled -- 1330 ----------------------------------- 1331 1332 function Switch_Subsequently_Cancelled 1333 (C : String; 1334 Args : String_List; 1335 Arg_Rank : Positive) return Boolean 1336 is 1337 begin 1338 -- Loop through arguments following the current one 1339 1340 for Arg in Arg_Rank + 1 .. Args'Last loop 1341 if Args (Arg).all = "-gnat-" & C then 1342 return True; 1343 end if; 1344 end loop; 1345 1346 -- No match found, not cancelled 1347 1348 return False; 1349 end Switch_Subsequently_Cancelled; 1350 1351end Switch.C; 1352