1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S W I T C H - M -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-2003 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 2, 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 COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27with Debug; use Debug; 28with Osint; use Osint; 29with Opt; use Opt; 30with Table; 31 32package body Switch.M is 33 34 package Normalized_Switches is new Table.Table 35 (Table_Component_Type => String_Access, 36 Table_Index_Type => Integer, 37 Table_Low_Bound => 1, 38 Table_Initial => 20, 39 Table_Increment => 100, 40 Table_Name => "Switch.M.Normalized_Switches"); 41 -- This table is used to keep the normalized switches, so that they may be 42 -- reused for subsequent invocations of Normalize_Compiler_Switches with 43 -- similar switches. 44 45 Initial_Number_Of_Switches : constant := 10; 46 47 Global_Switches : Argument_List_Access := null; 48 -- Used by function Normalize_Compiler_Switches 49 50 --------------------------------- 51 -- Normalize_Compiler_Switches -- 52 --------------------------------- 53 54 procedure Normalize_Compiler_Switches 55 (Switch_Chars : String; 56 Switches : in out Argument_List_Access; 57 Last : out Natural) 58 is 59 Switch_Starts_With_Gnat : Boolean; 60 61 Ptr : Integer := Switch_Chars'First; 62 Max : constant Integer := Switch_Chars'Last; 63 C : Character := ' '; 64 65 Storing : String := Switch_Chars; 66 First_Stored : Positive := Ptr + 1; 67 Last_Stored : Positive := First_Stored; 68 69 procedure Add_Switch_Component (S : String); 70 -- Add a new String_Access component in Switches. If a string equal 71 -- to S is already stored in the table Normalized_Switches, use it. 72 -- Other wise add a new component to the table. 73 74 -------------------------- 75 -- Add_Switch_Component -- 76 -------------------------- 77 78 procedure Add_Switch_Component (S : String) is 79 begin 80 -- If Switches is null, allocate a new array 81 82 if Switches = null then 83 Switches := new Argument_List (1 .. Initial_Number_Of_Switches); 84 85 -- otherwise, if Switches is full, extend it 86 87 elsif Last = Switches'Last then 88 declare 89 New_Switches : Argument_List_Access := new Argument_List 90 (1 .. Switches'Length + Switches'Length); 91 begin 92 New_Switches (1 .. Switches'Length) := Switches.all; 93 Last := Switches'Length; 94 Switches := New_Switches; 95 end; 96 end if; 97 98 -- If this is the first switch, Last designates the first component 99 if Last = 0 then 100 Last := Switches'First; 101 102 else 103 Last := Last + 1; 104 end if; 105 106 -- Look into the table Normalized_Switches for a similar string. 107 -- If one is found, put it at the added component, and return. 108 109 for Index in 1 .. Normalized_Switches.Last loop 110 if S = Normalized_Switches.Table (Index).all then 111 Switches (Last) := Normalized_Switches.Table (Index); 112 return; 113 end if; 114 end loop; 115 116 -- No string equal to S was found in the table Normalized_Switches. 117 -- Add a new component in the table. 118 119 Switches (Last) := new String'(S); 120 Normalized_Switches.Increment_Last; 121 Normalized_Switches.Table (Normalized_Switches.Last) := 122 Switches (Last); 123 end Add_Switch_Component; 124 125 -- Start of processing for Normalize_Compiler_Switches 126 127 begin 128 Last := 0; 129 130 if Ptr = Max or else Switch_Chars (Ptr) /= '-' then 131 return; 132 end if; 133 134 Ptr := Ptr + 1; 135 136 Switch_Starts_With_Gnat := 137 Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"; 138 139 if Switch_Starts_With_Gnat then 140 Ptr := Ptr + 4; 141 First_Stored := Ptr; 142 end if; 143 144 while Ptr <= Max loop 145 C := Switch_Chars (Ptr); 146 147 -- Processing for a switch 148 149 case Switch_Starts_With_Gnat is 150 151 when False => 152 153 -- All switches that don't start with -gnat stay as is, 154 -- except -v and -pg 155 156 if Switch_Chars = "-pg" then 157 158 -- The gcc driver converts -pg to -p, so that is what 159 -- is stored in the ALI file. 160 161 Add_Switch_Component ("-p"); 162 163 elsif C /= 'v' then 164 Add_Switch_Component (Switch_Chars); 165 end if; 166 167 return; 168 169 when True => 170 171 case C is 172 173 -- One-letter switches 174 175 when 'a' | 'A' | 'b' | 'c' | 'D' | 'E' | 'f' | 176 'F' | 'g' | 'h' | 'H' | 'k' | 'l' | 'L' | 'n' | 'N' | 177 'o' | 'O' | 'p' | 'P' | 'q' | 'Q' | 'r' | 's' | 't' | 178 'u' | 'U' | 'v' | 'x' | 'X' | 'Z' => 179 Storing (First_Stored) := C; 180 Add_Switch_Component 181 (Storing (Storing'First .. First_Stored)); 182 Ptr := Ptr + 1; 183 184 -- One-letter switches followed by a positive number 185 186 when 'm' | 'T' => 187 Storing (First_Stored) := C; 188 Last_Stored := First_Stored; 189 190 loop 191 Ptr := Ptr + 1; 192 exit when Ptr > Max 193 or else Switch_Chars (Ptr) not in '0' .. '9'; 194 Last_Stored := Last_Stored + 1; 195 Storing (Last_Stored) := Switch_Chars (Ptr); 196 end loop; 197 198 Add_Switch_Component 199 (Storing (Storing'First .. Last_Stored)); 200 201 when 'd' => 202 Storing (First_Stored) := 'd'; 203 204 while Ptr < Max loop 205 Ptr := Ptr + 1; 206 C := Switch_Chars (Ptr); 207 exit when C = ASCII.NUL or else C = '/' 208 or else C = '-'; 209 210 if C in '1' .. '9' or else 211 C in 'a' .. 'z' or else 212 C in 'A' .. 'Z' 213 then 214 Storing (First_Stored + 1) := C; 215 Add_Switch_Component 216 (Storing (Storing'First .. First_Stored + 1)); 217 218 else 219 Last := 0; 220 return; 221 end if; 222 end loop; 223 224 return; 225 226 when 'e' => 227 228 -- Only -gnateD and -gnatep= need to be store in an ALI 229 -- file. 230 231 Storing (First_Stored) := 'e'; 232 Ptr := Ptr + 1; 233 234 if Ptr > Max 235 or else (Switch_Chars (Ptr) /= 'D' 236 and then Switch_Chars (Ptr) /= 'p') 237 then 238 Last := 0; 239 return; 240 end if; 241 242 if Switch_Chars (Ptr) = 'D' then 243 -- gnateD 244 245 Storing (First_Stored + 1 .. 246 First_Stored + Max - Ptr + 1) := 247 Switch_Chars (Ptr .. Max); 248 Add_Switch_Component 249 (Storing (Storing'First .. 250 First_Stored + Max - Ptr + 1)); 251 252 else 253 -- gnatep= 254 255 Ptr := Ptr + 1; 256 257 if Ptr = Max then 258 Last := 0; 259 return; 260 end if; 261 262 if Switch_Chars (Ptr) = '=' then 263 Ptr := Ptr + 1; 264 end if; 265 266 -- To normalize, always put a '=' after -gnatep. 267 -- Because that could lengthen the switch string, 268 -- declare a local variable. 269 270 declare 271 To_Store : String (1 .. Max - Ptr + 9); 272 273 begin 274 To_Store (1 .. 8) := "-gnatep="; 275 To_Store (9 .. Max - Ptr + 9) := 276 Switch_Chars (Ptr .. Max); 277 Add_Switch_Component (To_Store); 278 end; 279 end if; 280 281 return; 282 283 when 'i' => 284 Storing (First_Stored) := 'i'; 285 286 Ptr := Ptr + 1; 287 288 if Ptr > Max then 289 Last := 0; 290 return; 291 end if; 292 293 C := Switch_Chars (Ptr); 294 295 if C in '1' .. '5' 296 or else C = '8' 297 or else C = 'p' 298 or else C = 'f' 299 or else C = 'n' 300 or else C = 'w' 301 then 302 Storing (First_Stored + 1) := C; 303 Add_Switch_Component 304 (Storing (Storing'First .. First_Stored + 1)); 305 Ptr := Ptr + 1; 306 307 else 308 Last := 0; 309 return; 310 end if; 311 312 -- -gnatR may be followed by '0', '1', '2' or '3', 313 -- then by 's' 314 315 when 'R' => 316 Last_Stored := First_Stored; 317 Storing (Last_Stored) := 'R'; 318 Ptr := Ptr + 1; 319 320 if Ptr <= Max 321 and then Switch_Chars (Ptr) in '0' .. '9' 322 then 323 C := Switch_Chars (Ptr); 324 325 if C in '4' .. '9' then 326 Last := 0; 327 return; 328 329 else 330 Last_Stored := Last_Stored + 1; 331 Storing (Last_Stored) := C; 332 Ptr := Ptr + 1; 333 334 if Ptr <= Max 335 and then Switch_Chars (Ptr) = 's' then 336 Last_Stored := Last_Stored + 1; 337 Storing (Last_Stored) := 's'; 338 Ptr := Ptr + 1; 339 end if; 340 end if; 341 end if; 342 343 Add_Switch_Component 344 (Storing (Storing'First .. Last_Stored)); 345 346 -- Multiple switches 347 348 when 'V' | 'w' | 'y' => 349 Storing (First_Stored) := C; 350 Ptr := Ptr + 1; 351 352 if Ptr > Max then 353 if C = 'y' then 354 Add_Switch_Component 355 (Storing (Storing'First .. First_Stored)); 356 357 else 358 Last := 0; 359 return; 360 end if; 361 end if; 362 363 while Ptr <= Max loop 364 C := Switch_Chars (Ptr); 365 Ptr := Ptr + 1; 366 367 -- 'w' should be skipped in -gnatw 368 369 if C /= 'w' or else Storing (First_Stored) /= 'w' then 370 371 -- -gnatyMxxx 372 373 if C = 'M' 374 and then Storing (First_Stored) = 'y' then 375 Last_Stored := First_Stored + 1; 376 Storing (Last_Stored) := 'M'; 377 378 while Ptr <= Max loop 379 C := Switch_Chars (Ptr); 380 exit when C not in '0' .. '9'; 381 Last_Stored := Last_Stored + 1; 382 Storing (Last_Stored) := C; 383 Ptr := Ptr + 1; 384 end loop; 385 386 -- If there is no digit after -gnatyM, 387 -- the switch is invalid. 388 389 if Last_Stored = First_Stored + 1 then 390 Last := 0; 391 return; 392 393 else 394 Add_Switch_Component 395 (Storing (Storing'First .. Last_Stored)); 396 end if; 397 398 -- All other switches are -gnatxx 399 400 else 401 Storing (First_Stored + 1) := C; 402 Add_Switch_Component 403 (Storing (Storing'First .. First_Stored + 1)); 404 end if; 405 end if; 406 end loop; 407 408 -- Not a valid switch 409 410 when others => 411 Last := 0; 412 return; 413 414 end case; 415 416 end case; 417 end loop; 418 end Normalize_Compiler_Switches; 419 420 function Normalize_Compiler_Switches 421 (Switch_Chars : String) 422 return Argument_List 423 is 424 Last : Natural; 425 426 begin 427 Normalize_Compiler_Switches (Switch_Chars, Global_Switches, Last); 428 429 if Last = 0 then 430 return (1 .. 0 => null); 431 432 else 433 return Global_Switches (Global_Switches'First .. Last); 434 end if; 435 436 end Normalize_Compiler_Switches; 437 438 ------------------------ 439 -- Scan_Make_Switches -- 440 ------------------------ 441 442 procedure Scan_Make_Switches (Switch_Chars : String) is 443 Ptr : Integer := Switch_Chars'First; 444 Max : constant Integer := Switch_Chars'Last; 445 C : Character := ' '; 446 447 begin 448 -- Skip past the initial character (must be the switch character) 449 450 if Ptr = Max then 451 raise Bad_Switch; 452 453 else 454 Ptr := Ptr + 1; 455 end if; 456 457 -- A little check, "gnat" at the start of a switch is not allowed 458 -- except for the compiler (where it was already removed) 459 460 if Switch_Chars'Length >= Ptr + 3 461 and then Switch_Chars (Ptr .. Ptr + 3) = "gnat" 462 then 463 Osint.Fail 464 ("invalid switch: """, Switch_Chars, """ (gnat not needed here)"); 465 end if; 466 467 -- Loop to scan through switches given in switch string 468 469 Check_Switch : begin 470 C := Switch_Chars (Ptr); 471 472 -- Processing for a switch 473 474 case C is 475 476 when 'a' => 477 Ptr := Ptr + 1; 478 Check_Readonly_Files := True; 479 480 -- Processing for b switch 481 482 when 'b' => 483 Ptr := Ptr + 1; 484 Bind_Only := True; 485 Make_Steps := True; 486 487 -- Processing for B switch 488 489 when 'B' => 490 Ptr := Ptr + 1; 491 Build_Bind_And_Link_Full_Project := True; 492 493 -- Processing for c switch 494 495 when 'c' => 496 Ptr := Ptr + 1; 497 Compile_Only := True; 498 Make_Steps := True; 499 500 -- Processing for C switch 501 502 when 'C' => 503 Ptr := Ptr + 1; 504 Create_Mapping_File := True; 505 506 -- Processing for D switch 507 508 when 'D' => 509 Ptr := Ptr + 1; 510 511 if Object_Directory_Present then 512 Osint.Fail ("duplicate -D switch"); 513 514 else 515 Object_Directory_Present := True; 516 end if; 517 518 -- Processing for d switch 519 520 when 'd' => 521 522 -- Note: for the debug switch, the remaining characters in this 523 -- switch field must all be debug flags, since all valid switch 524 -- characters are also valid debug characters. This switch is not 525 -- documented on purpose because it is only used by the 526 -- implementors. 527 528 -- Loop to scan out debug flags 529 530 while Ptr < Max loop 531 Ptr := Ptr + 1; 532 C := Switch_Chars (Ptr); 533 exit when C = ASCII.NUL or else C = '/' or else C = '-'; 534 535 if C in '1' .. '9' or else 536 C in 'a' .. 'z' or else 537 C in 'A' .. 'Z' 538 then 539 Set_Debug_Flag (C); 540 else 541 raise Bad_Switch; 542 end if; 543 end loop; 544 545 -- Make sure Zero_Cost_Exceptions is set if gnatdX set. This 546 -- is for backwards compatibility with old versions and usage. 547 548 if Debug_Flag_XX then 549 Zero_Cost_Exceptions_Set := True; 550 Zero_Cost_Exceptions_Val := True; 551 end if; 552 553 return; 554 555 -- Processing for f switch 556 557 when 'f' => 558 Ptr := Ptr + 1; 559 Force_Compilations := True; 560 561 -- Processing for F switch 562 563 when 'F' => 564 Ptr := Ptr + 1; 565 Full_Path_Name_For_Brief_Errors := True; 566 567 -- Processing for h switch 568 569 when 'h' => 570 Ptr := Ptr + 1; 571 Usage_Requested := True; 572 573 -- Processing for i switch 574 575 when 'i' => 576 Ptr := Ptr + 1; 577 In_Place_Mode := True; 578 579 -- Processing for j switch 580 581 when 'j' => 582 Ptr := Ptr + 1; 583 584 declare 585 Max_Proc : Pos; 586 begin 587 Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc); 588 Maximum_Processes := Positive (Max_Proc); 589 end; 590 591 -- Processing for k switch 592 593 when 'k' => 594 Ptr := Ptr + 1; 595 Keep_Going := True; 596 597 -- Processing for l switch 598 599 when 'l' => 600 Ptr := Ptr + 1; 601 Link_Only := True; 602 Make_Steps := True; 603 604 when 'M' => 605 Ptr := Ptr + 1; 606 List_Dependencies := True; 607 608 -- Processing for n switch 609 610 when 'n' => 611 Ptr := Ptr + 1; 612 Do_Not_Execute := True; 613 614 -- Processing for o switch 615 616 when 'o' => 617 Ptr := Ptr + 1; 618 619 if Output_File_Name_Present then 620 raise Too_Many_Output_Files; 621 else 622 Output_File_Name_Present := True; 623 end if; 624 625 -- Processing for q switch 626 627 when 'q' => 628 Ptr := Ptr + 1; 629 Quiet_Output := True; 630 631 -- Processing for R switch 632 633 when 'R' => 634 Ptr := Ptr + 1; 635 Run_Path_Option := False; 636 637 -- Processing for s switch 638 639 when 's' => 640 Ptr := Ptr + 1; 641 Check_Switches := True; 642 643 -- Processing for v switch 644 645 when 'v' => 646 Ptr := Ptr + 1; 647 Verbose_Mode := True; 648 649 -- Processing for z switch 650 651 when 'z' => 652 Ptr := Ptr + 1; 653 No_Main_Subprogram := True; 654 655 -- Ignore extra switch character 656 657 when '/' | '-' => 658 Ptr := Ptr + 1; 659 660 -- Anything else is an error (illegal switch character) 661 662 when others => 663 raise Bad_Switch; 664 665 end case; 666 667 if Ptr <= Max then 668 Osint.Fail ("invalid switch: ", Switch_Chars); 669 end if; 670 671 end Check_Switch; 672 673 exception 674 when Bad_Switch => 675 Osint.Fail ("invalid switch: ", (1 => C)); 676 677 when Bad_Switch_Value => 678 Osint.Fail ("numeric value out of range for switch: ", (1 => C)); 679 680 when Missing_Switch_Value => 681 Osint.Fail ("missing numeric value for switch: ", (1 => C)); 682 683 when Too_Many_Output_Files => 684 Osint.Fail ("duplicate -o switch"); 685 686 end Scan_Make_Switches; 687 688end Switch.M; 689