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