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-2021, 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' | '9' | 'p' | '8' | 'f' | 'n' | 'w' then 373 Identifier_Character_Set := C; 374 Ptr := Ptr + 1; 375 else 376 Bad_Switch (Switch_Chars); 377 end if; 378 379 -- Processing for K switch 380 381 when 'K' => 382 Ptr := Ptr + 1; 383 Output_Linker_Option_List := True; 384 385 -- Processing for l switch 386 387 when 'l' => 388 Ptr := Ptr + 1; 389 Elab_Order_Output := True; 390 391 -- Processing for m switch 392 393 when 'm' => 394 if Ptr = Max then 395 Bad_Switch (Switch_Chars); 396 end if; 397 398 Ptr := Ptr + 1; 399 Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Messages, C); 400 401 -- Processing for n switch 402 403 when 'n' => 404 Ptr := Ptr + 1; 405 Bind_Main_Program := False; 406 407 -- Note: The -L option of the binder also implies -n, so 408 -- any change here must also be reflected in the processing 409 -- for -L that is found in Gnatbind.Scan_Bind_Arg. 410 411 -- Processing for o switch 412 413 when 'o' => 414 Ptr := Ptr + 1; 415 416 if Output_File_Name_Present then 417 Osint.Fail ("duplicate -o switch"); 418 else 419 Output_File_Name_Present := True; 420 end if; 421 422 -- Processing for O switch 423 424 when 'O' => 425 Ptr := Ptr + 1; 426 Output_Object_List := True; 427 Object_List_Filename := Get_Optional_Filename; 428 429 -- Processing for p switch 430 431 when 'p' => 432 Ptr := Ptr + 1; 433 Pessimistic_Elab_Order := True; 434 435 -- Processing for P switch 436 437 when 'P' => 438 Ptr := Ptr + 1; 439 CodePeer_Mode := True; 440 441 -- Processing for q switch 442 443 when 'q' => 444 Ptr := Ptr + 1; 445 Quiet_Output := True; 446 447 -- Processing for Q switch 448 449 when 'Q' => 450 if Ptr = Max then 451 Bad_Switch (Switch_Chars); 452 end if; 453 454 Ptr := Ptr + 1; 455 Scan_Nat 456 (Switch_Chars, Max, Ptr, 457 Quantity_Of_Default_Size_Sec_Stacks, C); 458 459 -- Processing for r switch 460 461 when 'r' => 462 Ptr := Ptr + 1; 463 List_Restrictions := True; 464 465 -- Processing for R switch 466 467 when 'R' => 468 Ptr := Ptr + 1; 469 List_Closure := True; 470 471 if Ptr <= Max and then Switch_Chars (Ptr) = 'a' then 472 Ptr := Ptr + 1; 473 List_Closure_All := True; 474 end if; 475 476 -- Processing for s switch 477 478 when 's' => 479 Ptr := Ptr + 1; 480 All_Sources := True; 481 Check_Source_Files := True; 482 483 -- Processing for t switch 484 485 when 't' => 486 Ptr := Ptr + 1; 487 Tolerate_Consistency_Errors := True; 488 489 -- Processing for T switch 490 491 when 'T' => 492 if Ptr = Max then 493 Bad_Switch (Switch_Chars); 494 end if; 495 496 Ptr := Ptr + 1; 497 Time_Slice_Set := True; 498 Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value, C); 499 Time_Slice_Value := Time_Slice_Value * 1_000; 500 501 -- Processing for u switch 502 503 when 'u' => 504 if Ptr = Max then 505 Bad_Switch (Switch_Chars); 506 end if; 507 508 Ptr := Ptr + 1; 509 Dynamic_Stack_Measurement := True; 510 Scan_Nat 511 (Switch_Chars, 512 Max, 513 Ptr, 514 Dynamic_Stack_Measurement_Array_Size, 515 C); 516 517 -- Processing for v switch 518 519 when 'v' => 520 Ptr := Ptr + 1; 521 Verbose_Mode := True; 522 523 -- Processing for V switch 524 525 when 'V' => 526 declare 527 Eq : Integer; 528 begin 529 Ptr := Ptr + 1; 530 Eq := Ptr; 531 while Eq <= Max and then Switch_Chars (Eq) /= '=' loop 532 Eq := Eq + 1; 533 end loop; 534 if Eq = Ptr or else Eq = Max then 535 Bad_Switch (Switch_Chars); 536 end if; 537 Bindgen.Set_Bind_Env 538 (Key => Switch_Chars (Ptr .. Eq - 1), 539 Value => Switch_Chars (Eq + 1 .. Max)); 540 Ptr := Max + 1; 541 end; 542 543 -- Processing for w switch 544 545 when 'w' => 546 if Ptr = Max then 547 Bad_Switch (Switch_Chars); 548 end if; 549 550 -- For the binder we only allow suppress/error cases 551 552 Ptr := Ptr + 1; 553 554 case Switch_Chars (Ptr) is 555 when 'e' => 556 Warning_Mode := Treat_As_Error; 557 558 when 'E' => 559 Warning_Mode := Treat_Run_Time_Warnings_As_Errors; 560 561 when 's' => 562 Warning_Mode := Suppress; 563 564 when others => 565 Bad_Switch (Switch_Chars); 566 end case; 567 568 Ptr := Ptr + 1; 569 570 -- Processing for W switch 571 572 when 'W' => 573 Ptr := Ptr + 1; 574 575 if Ptr > Max then 576 Bad_Switch (Switch_Chars); 577 end if; 578 579 begin 580 Wide_Character_Encoding_Method := 581 Get_WC_Encoding_Method (Switch_Chars (Ptr)); 582 exception 583 when Constraint_Error => 584 Bad_Switch (Switch_Chars); 585 end; 586 587 Wide_Character_Encoding_Method_Specified := True; 588 589 Upper_Half_Encoding := 590 Wide_Character_Encoding_Method in WC_Upper_Half_Encoding_Method; 591 592 Ptr := Ptr + 1; 593 594 -- Processing for x switch 595 596 when 'x' => 597 Ptr := Ptr + 1; 598 All_Sources := False; 599 Check_Source_Files := False; 600 601 -- Processing for X switch 602 603 when 'X' => 604 if Ptr = Max then 605 Bad_Switch (Switch_Chars); 606 end if; 607 608 Ptr := Ptr + 1; 609 Scan_Pos (Switch_Chars, Max, Ptr, Default_Exit_Status, C); 610 611 -- Processing for y switch 612 613 when 'y' => 614 Ptr := Ptr + 1; 615 Leap_Seconds_Support := True; 616 617 -- Processing for z switch 618 619 when 'z' => 620 Ptr := Ptr + 1; 621 No_Main_Subprogram := True; 622 623 -- Processing for Z switch 624 625 when 'Z' => 626 Ptr := Ptr + 1; 627 Zero_Formatting := True; 628 629 -- Processing for --RTS 630 631 when '-' => 632 633 if Ptr + 4 <= Max and then 634 Switch_Chars (Ptr + 1 .. Ptr + 3) = "RTS" 635 then 636 Ptr := Ptr + 4; 637 638 if Switch_Chars (Ptr) /= '=' or else Ptr = Max then 639 Osint.Fail ("missing path for --RTS"); 640 641 else 642 -- Valid --RTS switch 643 644 Opt.No_Stdinc := True; 645 Opt.RTS_Switch := True; 646 647 declare 648 Src_Path_Name : constant String_Ptr := 649 Get_RTS_Search_Dir 650 (Switch_Chars (Ptr + 1 .. Max), 651 Include); 652 Lib_Path_Name : constant String_Ptr := 653 Get_RTS_Search_Dir 654 (Switch_Chars (Ptr + 1 .. Max), 655 Objects); 656 657 begin 658 if Src_Path_Name /= null and then 659 Lib_Path_Name /= null 660 then 661 -- Set the RTS_*_Path_Name variables, so that the 662 -- correct directories will be set when a subsequent 663 -- call Osint.Add_Default_Search_Dirs is made. 664 665 RTS_Src_Path_Name := Src_Path_Name; 666 RTS_Lib_Path_Name := Lib_Path_Name; 667 668 Ptr := Max + 1; 669 670 elsif Src_Path_Name = null 671 and then Lib_Path_Name = null 672 then 673 Osint.Fail 674 ("RTS path not valid: missing adainclude and " 675 & "adalib directories"); 676 elsif Src_Path_Name = null then 677 Osint.Fail 678 ("RTS path not valid: missing adainclude directory"); 679 elsif Lib_Path_Name = null then 680 Osint.Fail 681 ("RTS path not valid: missing adalib directory"); 682 end if; 683 end; 684 end if; 685 686 else 687 Bad_Switch (Switch_Chars); 688 end if; 689 690 -- Anything else is an error (illegal switch character) 691 692 when others => 693 Bad_Switch (Switch_Chars); 694 end case; 695 696 if Ptr <= Max then 697 Bad_Switch (Switch_Chars); 698 end if; 699 end Check_Switch; 700 end Scan_Binder_Switches; 701 702end Switch.B; 703