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 (generate C code) 580 581 when 'g' => 582 -- Special check, -gnateg must occur after -gnatc 583 584 if Operating_Mode /= Check_Semantics then 585 Osint.Fail 586 ("gnateg requires previous occurrence of -gnatc"); 587 end if; 588 589 Generate_C_Code := True; 590 Ptr := Ptr + 1; 591 592 -- -gnateG (save preprocessor output) 593 594 when 'G' => 595 Generate_Processed_File := True; 596 Ptr := Ptr + 1; 597 598 -- -gnatei (max number of instantiations) 599 600 when 'i' => 601 Ptr := Ptr + 1; 602 Scan_Pos 603 (Switch_Chars, Max, Ptr, Maximum_Instantiations, C); 604 605 -- -gnateI (index of unit in multi-unit source) 606 607 when 'I' => 608 Ptr := Ptr + 1; 609 Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C); 610 611 -- -gnatel 612 613 when 'l' => 614 Ptr := Ptr + 1; 615 Elab_Info_Messages := True; 616 617 -- -gnateL 618 619 when 'L' => 620 Ptr := Ptr + 1; 621 Elab_Info_Messages := False; 622 623 -- -gnatem (mapping file) 624 625 when 'm' => 626 Store_Switch := False; 627 Ptr := Ptr + 1; 628 629 -- There may be an equal sign between -gnatem and 630 -- the path name of the mapping file. 631 632 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then 633 Ptr := Ptr + 1; 634 end if; 635 636 if Ptr > Max then 637 Bad_Switch ("-gnatem"); 638 end if; 639 640 Mapping_File_Name := 641 new String'(Switch_Chars (Ptr .. Max)); 642 return; 643 644 -- -gnateO= (object path file) 645 646 -- This is an internal switch 647 648 when 'O' => 649 Store_Switch := False; 650 Ptr := Ptr + 1; 651 652 -- Check for '=' 653 654 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then 655 Bad_Switch ("-gnateO"); 656 else 657 Object_Path_File_Name := 658 new String'(Switch_Chars (Ptr + 1 .. Max)); 659 end if; 660 661 return; 662 663 -- -gnatep (preprocessing data file) 664 665 when 'p' => 666 Store_Switch := False; 667 Ptr := Ptr + 1; 668 669 -- There may be an equal sign between -gnatep and 670 -- the path name of the mapping file. 671 672 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then 673 Ptr := Ptr + 1; 674 end if; 675 676 if Ptr > Max then 677 Bad_Switch ("-gnatep"); 678 end if; 679 680 Preprocessing_Data_File := 681 new String'(Switch_Chars (Ptr .. Max)); 682 683 -- Store the switch, normalizing to -gnatep= 684 685 Store_Compilation_Switch 686 ("-gnatep=" & Preprocessing_Data_File.all); 687 688 Ptr := Max + 1; 689 690 -- -gnateP (Treat pragma Pure/Preelaborate errs as warnings) 691 692 when 'P' => 693 Treat_Categorization_Errors_As_Warnings := True; 694 695 -- -gnates=file (specify extra file switches for gnat2why) 696 697 -- This is an internal switch 698 699 when 's' => 700 if not First_Switch then 701 Osint.Fail 702 ("-gnates must not be combined with other switches"); 703 end if; 704 705 -- Check for '=' 706 707 Ptr := Ptr + 1; 708 709 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then 710 Bad_Switch ("-gnates"); 711 else 712 SPARK_Switches_File_Name := 713 new String'(Switch_Chars (Ptr + 1 .. Max)); 714 end if; 715 716 return; 717 718 -- -gnateS (generate SCO information) 719 720 -- Include Source Coverage Obligation information in ALI 721 -- files for use by source coverage analysis tools 722 -- (gnatcov) (equivalent to -fdump-scos, provided for 723 -- backwards compatibility). 724 725 when 'S' => 726 Generate_SCO := True; 727 Generate_SCO_Instance_Table := True; 728 Ptr := Ptr + 1; 729 730 -- -gnatet (write target dependent information) 731 732 when 't' => 733 if not First_Switch then 734 Osint.Fail 735 ("-gnatet must not be combined with other switches"); 736 end if; 737 738 -- Check for '=' 739 740 Ptr := Ptr + 1; 741 742 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then 743 Bad_Switch ("-gnatet"); 744 else 745 Target_Dependent_Info_Write_Name := 746 new String'(Switch_Chars (Ptr + 1 .. Max)); 747 end if; 748 749 return; 750 751 -- -gnateT (read target dependent information) 752 753 when 'T' => 754 if not First_Switch then 755 Osint.Fail 756 ("-gnateT must not be combined with other switches"); 757 end if; 758 759 -- Check for '=' 760 761 Ptr := Ptr + 1; 762 763 if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then 764 Bad_Switch ("-gnateT"); 765 else 766 -- This parameter was stored by Set_Targ earlier 767 768 pragma Assert 769 (Target_Dependent_Info_Read_Name.all = 770 Switch_Chars (Ptr + 1 .. Max)); 771 null; 772 end if; 773 774 return; 775 776 -- -gnateu (unrecognized y,V,w switches) 777 778 when 'u' => 779 Ptr := Ptr + 1; 780 Ignore_Unrecognized_VWY_Switches := True; 781 782 -- -gnateV (validity checks on parameters) 783 784 when 'V' => 785 Ptr := Ptr + 1; 786 Check_Validity_Of_Parameters := True; 787 788 -- -gnateY (ignore Style_Checks pragmas) 789 790 when 'Y' => 791 Ignore_Style_Checks_Pragmas := True; 792 Ptr := Ptr + 1; 793 794 -- -gnatez (final delimiter of explicit switches) 795 796 -- This is an internal switch 797 798 -- All switches that come after -gnatez have been added by 799 -- the GCC driver and are not stored in the ALI file. See 800 -- also -gnatea above. 801 802 when 'z' => 803 Store_Switch := False; 804 Disable_Switch_Storing; 805 Ptr := Ptr + 1; 806 807 -- All other -gnate? switches are unassigned 808 809 when others => 810 Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max)); 811 end case; 812 813 -- -gnatE (dynamic elaboration checks) 814 815 when 'E' => 816 Ptr := Ptr + 1; 817 Dynamic_Elaboration_Checks := True; 818 819 -- -gnatf (full error messages) 820 821 when 'f' => 822 Ptr := Ptr + 1; 823 All_Errors_Mode := True; 824 825 -- -gnatF (overflow of predefined float types) 826 827 when 'F' => 828 Ptr := Ptr + 1; 829 External_Name_Exp_Casing := Uppercase; 830 External_Name_Imp_Casing := Uppercase; 831 832 -- -gnatg (GNAT implementation mode) 833 834 when 'g' => 835 Ptr := Ptr + 1; 836 GNAT_Mode := True; 837 GNAT_Mode_Config := True; 838 Identifier_Character_Set := 'n'; 839 System_Extend_Unit := Empty; 840 Warning_Mode := Treat_As_Error; 841 Style_Check_Main := True; 842 Ada_Version := Ada_2012; 843 Ada_Version_Explicit := Ada_2012; 844 Ada_Version_Pragma := Empty; 845 846 -- Set default warnings and style checks for -gnatg 847 848 Set_GNAT_Mode_Warnings; 849 Set_GNAT_Style_Check_Options; 850 851 -- -gnatG (output generated code) 852 853 when 'G' => 854 Ptr := Ptr + 1; 855 Print_Generated_Code := True; 856 857 -- Scan optional integer line limit value 858 859 if Nat_Present (Switch_Chars, Max, Ptr) then 860 Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G'); 861 Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40); 862 end if; 863 864 -- -gnath (help information) 865 866 when 'h' => 867 Ptr := Ptr + 1; 868 Usage_Requested := True; 869 870 -- -gnati (character set) 871 872 when 'i' => 873 if Ptr = Max then 874 Bad_Switch ("-gnati"); 875 end if; 876 877 Ptr := Ptr + 1; 878 C := Switch_Chars (Ptr); 879 880 if C in '1' .. '5' 881 or else C = '8' 882 or else C = '9' 883 or else C = 'p' 884 or else C = 'f' 885 or else C = 'n' 886 or else C = 'w' 887 then 888 Identifier_Character_Set := C; 889 Ptr := Ptr + 1; 890 891 else 892 Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max)); 893 end if; 894 895 -- -gnatI (ignore representation clauses) 896 897 when 'I' => 898 Ptr := Ptr + 1; 899 Ignore_Rep_Clauses := True; 900 901 -- -gnatj (messages in limited length lines) 902 903 when 'j' => 904 Ptr := Ptr + 1; 905 Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C); 906 907 -- -gnatk (limit file name length) 908 909 when 'k' => 910 Ptr := Ptr + 1; 911 Scan_Pos 912 (Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C); 913 914 -- -gnatl (output full source) 915 916 when 'l' => 917 Ptr := Ptr + 1; 918 Full_List := True; 919 920 -- There may be an equal sign between -gnatl and a file name 921 922 if Ptr <= Max and then Switch_Chars (Ptr) = '=' then 923 if Ptr = Max then 924 Osint.Fail ("file name for -gnatl= is null"); 925 else 926 Opt.Full_List_File_Name := 927 new String'(Switch_Chars (Ptr + 1 .. Max)); 928 Ptr := Max + 1; 929 end if; 930 end if; 931 932 -- -gnatL (corresponding source text) 933 934 when 'L' => 935 Ptr := Ptr + 1; 936 Dump_Source_Text := True; 937 938 -- -gnatm (max number or errors/warnings) 939 940 when 'm' => 941 Ptr := Ptr + 1; 942 Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C); 943 944 -- -gnatn (enable pragma Inline) 945 946 when 'n' => 947 Ptr := Ptr + 1; 948 Inline_Active := True; 949 950 -- There may be a digit (1 or 2) appended to the switch 951 952 if Ptr <= Max then 953 C := Switch_Chars (Ptr); 954 955 if C in '1' .. '2' then 956 Ptr := Ptr + 1; 957 Inline_Level := Character'Pos (C) - Character'Pos ('0'); 958 end if; 959 end if; 960 961 -- -gnatN (obsolescent) 962 963 when 'N' => 964 Ptr := Ptr + 1; 965 Inline_Active := True; 966 Front_End_Inlining := True; 967 968 -- -gnato (overflow checks) 969 970 when 'o' => 971 Ptr := Ptr + 1; 972 973 -- Case of -gnato0 (overflow checking turned off) 974 975 if Ptr <= Max and then Switch_Chars (Ptr) = '0' then 976 Ptr := Ptr + 1; 977 Suppress_Options.Suppress (Overflow_Check) := True; 978 979 -- We set strict mode in case overflow checking is turned 980 -- on locally (also records that we had a -gnato switch). 981 982 Suppress_Options.Overflow_Mode_General := Strict; 983 Suppress_Options.Overflow_Mode_Assertions := Strict; 984 985 -- All cases other than -gnato0 (overflow checking turned on) 986 987 else 988 Suppress_Options.Suppress (Overflow_Check) := False; 989 990 -- Case of no digits after the -gnato 991 992 if Ptr > Max 993 or else Switch_Chars (Ptr) not in '1' .. '3' 994 then 995 Suppress_Options.Overflow_Mode_General := Strict; 996 Suppress_Options.Overflow_Mode_Assertions := Strict; 997 998 -- At least one digit after the -gnato 999 1000 else 1001 -- Handle first digit after -gnato 1002 1003 Suppress_Options.Overflow_Mode_General := 1004 Get_Overflow_Mode (Switch_Chars (Ptr)); 1005 Ptr := Ptr + 1; 1006 1007 -- Only one digit after -gnato, set assertions mode to be 1008 -- the same as general mode. 1009 1010 if Ptr > Max 1011 or else Switch_Chars (Ptr) not in '1' .. '3' 1012 then 1013 Suppress_Options.Overflow_Mode_Assertions := 1014 Suppress_Options.Overflow_Mode_General; 1015 1016 -- Process second digit after -gnato 1017 1018 else 1019 Suppress_Options.Overflow_Mode_Assertions := 1020 Get_Overflow_Mode (Switch_Chars (Ptr)); 1021 Ptr := Ptr + 1; 1022 end if; 1023 end if; 1024 end if; 1025 1026 -- -gnatO (specify name of the object file) 1027 1028 -- This is an internal switch 1029 1030 when 'O' => 1031 Store_Switch := False; 1032 Ptr := Ptr + 1; 1033 Output_File_Name_Present := True; 1034 1035 -- -gnatp (suppress all checks) 1036 1037 when 'p' => 1038 Ptr := Ptr + 1; 1039 1040 -- Skip processing if cancelled by subsequent -gnat-p 1041 1042 if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then 1043 Store_Switch := False; 1044 1045 else 1046 -- Set all specific options as well as All_Checks in the 1047 -- Suppress_Options array, excluding Elaboration_Check, 1048 -- since this is treated specially because we do not want 1049 -- -gnatp to disable static elaboration processing. Also 1050 -- exclude Atomic_Synchronization, since this is not a real 1051 -- check. 1052 1053 for J in Suppress_Options.Suppress'Range loop 1054 if J /= Elaboration_Check 1055 and then 1056 J /= Atomic_Synchronization 1057 then 1058 Suppress_Options.Suppress (J) := True; 1059 end if; 1060 end loop; 1061 1062 Validity_Checks_On := False; 1063 Opt.Suppress_Checks := True; 1064 1065 -- Set overflow mode checking to strict in case it gets 1066 -- turned on locally (also signals that overflow checking 1067 -- has been specifically turned off). 1068 1069 Suppress_Options.Overflow_Mode_General := Strict; 1070 Suppress_Options.Overflow_Mode_Assertions := Strict; 1071 end if; 1072 1073 -- -gnatP (periodic poll) 1074 1075 when 'P' => 1076 Ptr := Ptr + 1; 1077 Polling_Required := True; 1078 1079 -- -gnatq (don't quit) 1080 1081 when 'q' => 1082 Ptr := Ptr + 1; 1083 Try_Semantics := True; 1084 1085 -- -gnatQ (always write ALI file) 1086 1087 when 'Q' => 1088 Ptr := Ptr + 1; 1089 Force_ALI_Tree_File := True; 1090 Try_Semantics := True; 1091 1092 -- -gnatr (restrictions as warnings) 1093 1094 when 'r' => 1095 Ptr := Ptr + 1; 1096 Treat_Restrictions_As_Warnings := True; 1097 1098 -- -gnatR (list rep. info) 1099 1100 when 'R' => 1101 1102 -- Not allowed if previous -gnatD given. See more extensive 1103 -- comments in the 'D' section for the inverse test. 1104 1105 if Debug_Generated_Code then 1106 Osint.Fail 1107 ("-gnatR not permitted since -gnatD given previously"); 1108 end if; 1109 1110 -- Set to annotate rep info, and set default -gnatR mode 1111 1112 Back_Annotate_Rep_Info := True; 1113 List_Representation_Info := 1; 1114 1115 -- Scan possible parameter 1116 1117 Ptr := Ptr + 1; 1118 while Ptr <= Max loop 1119 C := Switch_Chars (Ptr); 1120 1121 if C in '1' .. '3' then 1122 List_Representation_Info := 1123 Character'Pos (C) - Character'Pos ('0'); 1124 1125 elsif Switch_Chars (Ptr) = 's' then 1126 List_Representation_Info_To_File := True; 1127 1128 elsif Switch_Chars (Ptr) = 'm' then 1129 List_Representation_Info_Mechanisms := True; 1130 1131 else 1132 Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max)); 1133 end if; 1134 1135 Ptr := Ptr + 1; 1136 end loop; 1137 1138 -- -gnats (syntax check only) 1139 1140 when 's' => 1141 if not First_Switch then 1142 Osint.Fail 1143 ("-gnats must be first if combined with other switches"); 1144 end if; 1145 1146 Ptr := Ptr + 1; 1147 Operating_Mode := Check_Syntax; 1148 1149 -- -gnatS (print package Standard) 1150 1151 when 'S' => 1152 Print_Standard := True; 1153 Ptr := Ptr + 1; 1154 1155 -- -gnatt (output tree) 1156 1157 when 't' => 1158 Ptr := Ptr + 1; 1159 Tree_Output := True; 1160 Back_Annotate_Rep_Info := True; 1161 1162 -- -gnatT (change start of internal table sizes) 1163 1164 when 'T' => 1165 Ptr := Ptr + 1; 1166 Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C); 1167 1168 -- -gnatu (list units for compilation) 1169 1170 when 'u' => 1171 Ptr := Ptr + 1; 1172 List_Units := True; 1173 1174 -- -gnatU (unique tags) 1175 1176 when 'U' => 1177 Ptr := Ptr + 1; 1178 Unique_Error_Tag := True; 1179 1180 -- -gnatv (verbose mode) 1181 1182 when 'v' => 1183 Ptr := Ptr + 1; 1184 Verbose_Mode := True; 1185 1186 -- -gnatV (validity checks) 1187 1188 when 'V' => 1189 Store_Switch := False; 1190 Ptr := Ptr + 1; 1191 1192 if Ptr > Max then 1193 Bad_Switch ("-gnatV"); 1194 1195 else 1196 declare 1197 OK : Boolean; 1198 1199 begin 1200 Set_Validity_Check_Options 1201 (Switch_Chars (Ptr .. Max), OK, Ptr); 1202 1203 if not OK then 1204 Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max)); 1205 end if; 1206 1207 for Index in First_Char + 1 .. Max loop 1208 Store_Compilation_Switch 1209 ("-gnatV" & Switch_Chars (Index)); 1210 end loop; 1211 end; 1212 end if; 1213 1214 Ptr := Max + 1; 1215 1216 -- -gnatw (warning modes) 1217 1218 when 'w' => 1219 Store_Switch := False; 1220 Ptr := Ptr + 1; 1221 1222 if Ptr > Max then 1223 Bad_Switch ("-gnatw"); 1224 end if; 1225 1226 while Ptr <= Max loop 1227 C := Switch_Chars (Ptr); 1228 1229 -- Case of dot switch 1230 1231 if C = '.' and then Ptr < Max then 1232 Ptr := Ptr + 1; 1233 C := Switch_Chars (Ptr); 1234 1235 if Set_Dot_Warning_Switch (C) then 1236 Store_Compilation_Switch ("-gnatw." & C); 1237 else 1238 Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max)); 1239 end if; 1240 1241 -- Normal case, no dot 1242 1243 else 1244 if Set_Warning_Switch (C) then 1245 Store_Compilation_Switch ("-gnatw" & C); 1246 else 1247 Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max)); 1248 end if; 1249 end if; 1250 1251 Ptr := Ptr + 1; 1252 end loop; 1253 1254 return; 1255 1256 -- -gnatW (wide character encoding method) 1257 1258 when 'W' => 1259 Ptr := Ptr + 1; 1260 1261 if Ptr > Max then 1262 Bad_Switch ("-gnatW"); 1263 end if; 1264 1265 begin 1266 Wide_Character_Encoding_Method := 1267 Get_WC_Encoding_Method (Switch_Chars (Ptr)); 1268 exception 1269 when Constraint_Error => 1270 Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max)); 1271 end; 1272 1273 Wide_Character_Encoding_Method_Specified := True; 1274 1275 Upper_Half_Encoding := 1276 Wide_Character_Encoding_Method in 1277 WC_Upper_Half_Encoding_Method; 1278 1279 Ptr := Ptr + 1; 1280 1281 -- -gnatx (suppress cross-ref information) 1282 1283 when 'x' => 1284 Ptr := Ptr + 1; 1285 Xref_Active := False; 1286 1287 -- -gnatX (language extensions) 1288 1289 when 'X' => 1290 Ptr := Ptr + 1; 1291 Extensions_Allowed := True; 1292 Ada_Version := Ada_Version_Type'Last; 1293 Ada_Version_Explicit := Ada_Version_Type'Last; 1294 Ada_Version_Pragma := Empty; 1295 1296 -- -gnaty (style checks) 1297 1298 when 'y' => 1299 Ptr := Ptr + 1; 1300 Style_Check_Main := True; 1301 1302 if Ptr > Max then 1303 Set_Default_Style_Check_Options; 1304 1305 else 1306 Store_Switch := False; 1307 1308 declare 1309 OK : Boolean; 1310 1311 begin 1312 Set_Style_Check_Options 1313 (Switch_Chars (Ptr .. Max), OK, Ptr); 1314 1315 if not OK then 1316 Osint.Fail 1317 ("bad -gnaty switch (" & 1318 Style_Msg_Buf (1 .. Style_Msg_Len) & ')'); 1319 end if; 1320 1321 Ptr := First_Char + 1; 1322 while Ptr <= Max loop 1323 if Switch_Chars (Ptr) = 'M' then 1324 First_Char := Ptr; 1325 loop 1326 Ptr := Ptr + 1; 1327 exit when Ptr > Max 1328 or else Switch_Chars (Ptr) not in '0' .. '9'; 1329 end loop; 1330 1331 Store_Compilation_Switch 1332 ("-gnaty" & Switch_Chars (First_Char .. Ptr - 1)); 1333 1334 else 1335 Store_Compilation_Switch 1336 ("-gnaty" & Switch_Chars (Ptr)); 1337 Ptr := Ptr + 1; 1338 end if; 1339 end loop; 1340 end; 1341 end if; 1342 1343 -- -gnatz (stub generation) 1344 1345 when 'z' => 1346 1347 -- -gnatz must be the first and only switch in Switch_Chars, 1348 -- and is a two-letter switch. 1349 1350 if Ptr /= Switch_Chars'First + 5 1351 or else (Max - Ptr + 1) > 2 1352 then 1353 Osint.Fail 1354 ("-gnatz* may not be combined with other switches"); 1355 end if; 1356 1357 if Ptr = Max then 1358 Bad_Switch ("-gnatz"); 1359 end if; 1360 1361 Ptr := Ptr + 1; 1362 1363 -- Only one occurrence of -gnat* is permitted 1364 1365 if Distribution_Stub_Mode = No_Stubs then 1366 case Switch_Chars (Ptr) is 1367 when 'r' => 1368 Distribution_Stub_Mode := Generate_Receiver_Stub_Body; 1369 1370 when 'c' => 1371 Distribution_Stub_Mode := Generate_Caller_Stub_Body; 1372 1373 when others => 1374 Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max)); 1375 end case; 1376 1377 Ptr := Ptr + 1; 1378 1379 else 1380 Osint.Fail ("only one -gnatz* switch allowed"); 1381 end if; 1382 1383 -- -gnatZ (obsolescent) 1384 1385 when 'Z' => 1386 Ptr := Ptr + 1; 1387 Osint.Fail 1388 ("-gnatZ is no longer supported: consider using --RTS=zcx"); 1389 1390 -- Note on language version switches: whenever a new language 1391 -- version switch is added, Switch.M.Normalize_Compiler_Switches 1392 -- must be updated. 1393 1394 -- -gnat83 1395 1396 when '8' => 1397 if Ptr = Max then 1398 Bad_Switch ("-gnat8"); 1399 end if; 1400 1401 Ptr := Ptr + 1; 1402 1403 if Switch_Chars (Ptr) /= '3' then 1404 Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max)); 1405 else 1406 Ptr := Ptr + 1; 1407 Ada_Version := Ada_83; 1408 Ada_Version_Explicit := Ada_83; 1409 Ada_Version_Pragma := Empty; 1410 end if; 1411 1412 -- -gnat95 1413 1414 when '9' => 1415 if Ptr = Max then 1416 Bad_Switch ("-gnat9"); 1417 end if; 1418 1419 Ptr := Ptr + 1; 1420 1421 if Switch_Chars (Ptr) /= '5' then 1422 Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max)); 1423 else 1424 Ptr := Ptr + 1; 1425 Ada_Version := Ada_95; 1426 Ada_Version_Explicit := Ada_95; 1427 Ada_Version_Pragma := Empty; 1428 end if; 1429 1430 -- -gnat05 1431 1432 when '0' => 1433 if Ptr = Max then 1434 Bad_Switch ("-gnat0"); 1435 end if; 1436 1437 Ptr := Ptr + 1; 1438 1439 if Switch_Chars (Ptr) /= '5' then 1440 Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max)); 1441 else 1442 Ptr := Ptr + 1; 1443 Ada_Version := Ada_2005; 1444 Ada_Version_Explicit := Ada_2005; 1445 Ada_Version_Pragma := Empty; 1446 end if; 1447 1448 -- -gnat12 1449 1450 when '1' => 1451 if Ptr = Max then 1452 Bad_Switch ("-gnat1"); 1453 end if; 1454 1455 Ptr := Ptr + 1; 1456 1457 if Switch_Chars (Ptr) /= '2' then 1458 Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max)); 1459 else 1460 Ptr := Ptr + 1; 1461 Ada_Version := Ada_2012; 1462 Ada_Version_Explicit := Ada_2012; 1463 Ada_Version_Pragma := Empty; 1464 end if; 1465 1466 -- -gnat2005 and -gnat2012 1467 1468 when '2' => 1469 if Ptr > Max - 3 then 1470 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max)); 1471 1472 elsif Switch_Chars (Ptr .. Ptr + 3) = "2005" then 1473 Ada_Version := Ada_2005; 1474 1475 elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then 1476 Ada_Version := Ada_2012; 1477 1478 else 1479 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3)); 1480 end if; 1481 1482 Ada_Version_Explicit := Ada_Version; 1483 Ada_Version_Pragma := Empty; 1484 Ptr := Ptr + 4; 1485 1486 -- Switch cancellation, currently only -gnat-p is allowed. 1487 -- All we do here is the error checking, since the actual 1488 -- processing for switch cancellation is done by calls to 1489 -- Switch_Subsequently_Cancelled at the appropriate point. 1490 1491 when '-' => 1492 1493 -- Simple ignore -gnat-p 1494 1495 if Switch_Chars = "-gnat-p" then 1496 return; 1497 1498 -- Any other occurrence of minus is ignored. This is for 1499 -- maximum compatibility with previous version which ignored 1500 -- all occurrences of minus. 1501 1502 else 1503 Store_Switch := False; 1504 Ptr := Ptr + 1; 1505 end if; 1506 1507 -- We ignore '/' in switches, this is historical, still needed??? 1508 1509 when '/' => 1510 Store_Switch := False; 1511 1512 -- Anything else is an error (illegal switch character) 1513 1514 when others => 1515 Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max)); 1516 end case; 1517 1518 if Store_Switch then 1519 Store_Compilation_Switch 1520 ("-gnat" & Switch_Chars (First_Char .. Ptr - 1)); 1521 end if; 1522 1523 First_Switch := False; 1524 end loop; 1525 end if; 1526 end Scan_Front_End_Switches; 1527 1528 ----------------------------------- 1529 -- Switch_Subsequently_Cancelled -- 1530 ----------------------------------- 1531 1532 function Switch_Subsequently_Cancelled 1533 (C : String; 1534 Args : String_List; 1535 Arg_Rank : Positive) return Boolean 1536 is 1537 begin 1538 -- Loop through arguments following the current one 1539 1540 for Arg in Arg_Rank + 1 .. Args'Last loop 1541 if Args (Arg).all = "-gnat-" & C then 1542 return True; 1543 end if; 1544 end loop; 1545 1546 -- No match found, not cancelled 1547 1548 return False; 1549 end Switch_Subsequently_Cancelled; 1550 1551end Switch.C; 1552