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