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