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