1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- P R E P C O M P -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2003-2012, 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 Atree; use Atree; 27with Errout; use Errout; 28with Lib.Writ; use Lib.Writ; 29with Opt; use Opt; 30with Osint; use Osint; 31with Prep; use Prep; 32with Scans; use Scans; 33with Scn; use Scn; 34with Sinput.L; use Sinput.L; 35with Stringt; use Stringt; 36with Table; 37with Types; use Types; 38 39package body Prepcomp is 40 41 No_Preprocessing : Boolean := True; 42 -- Set to False if there is at least one source that needs to be 43 -- preprocessed. 44 45 Source_Index_Of_Preproc_Data_File : Source_File_Index := No_Source_File; 46 47 -- The following variable should be a constant, but this is not possible 48 -- because its type GNAT.Dynamic_Tables.Instance has a component P of 49 -- uninitialized private type GNAT.Dynamic_Tables.Table_Private and there 50 -- are no exported values for this private type. Warnings are Off because 51 -- it is never assigned a value. 52 53 pragma Warnings (Off); 54 No_Mapping : Prep.Symbol_Table.Instance; 55 pragma Warnings (On); 56 57 type Preproc_Data is record 58 Mapping : Symbol_Table.Instance; 59 File_Name : File_Name_Type := No_File; 60 Deffile : String_Id := No_String; 61 Undef_False : Boolean := False; 62 Always_Blank : Boolean := False; 63 Comments : Boolean := False; 64 No_Deletion : Boolean := False; 65 List_Symbols : Boolean := False; 66 Processed : Boolean := False; 67 end record; 68 -- Structure to keep the preprocessing data for a file name or for the 69 -- default (when Name_Id = No_Name). 70 71 No_Preproc_Data : constant Preproc_Data := 72 (Mapping => No_Mapping, 73 File_Name => No_File, 74 Deffile => No_String, 75 Undef_False => False, 76 Always_Blank => False, 77 Comments => False, 78 No_Deletion => False, 79 List_Symbols => False, 80 Processed => False); 81 82 Default_Data : Preproc_Data := No_Preproc_Data; 83 -- The preprocessing data to be used when no specific preprocessing data 84 -- is specified for a source. 85 86 Default_Data_Defined : Boolean := False; 87 -- True if source for which no specific preprocessing is specified need to 88 -- be preprocess with the Default_Data. 89 90 Current_Data : Preproc_Data := No_Preproc_Data; 91 92 package Preproc_Data_Table is new Table.Table 93 (Table_Component_Type => Preproc_Data, 94 Table_Index_Type => Int, 95 Table_Low_Bound => 1, 96 Table_Initial => 5, 97 Table_Increment => 100, 98 Table_Name => "Prepcomp.Preproc_Data_Table"); 99 -- Table to store the specific preprocessing data 100 101 Command_Line_Symbols : Symbol_Table.Instance; 102 -- A table to store symbol definitions specified on the command line with 103 -- -gnateD switches. 104 105 package Dependencies is new Table.Table 106 (Table_Component_Type => Source_File_Index, 107 Table_Index_Type => Int, 108 Table_Low_Bound => 1, 109 Table_Initial => 10, 110 Table_Increment => 100, 111 Table_Name => "Prepcomp.Dependencies"); 112 -- Table to store the dependencies on preprocessing files 113 114 procedure Add_Command_Line_Symbols; 115 -- Add the command line symbol definitions, if any, to Prep.Mapping table 116 117 procedure Skip_To_End_Of_Line; 118 -- Ignore errors and scan up to the next end of line or the end of file 119 120 ------------------------------ 121 -- Add_Command_Line_Symbols -- 122 ------------------------------ 123 124 procedure Add_Command_Line_Symbols is 125 Symbol_Id : Prep.Symbol_Id; 126 127 begin 128 for J in 1 .. Symbol_Table.Last (Command_Line_Symbols) loop 129 Symbol_Id := Prep.Index_Of (Command_Line_Symbols.Table (J).Symbol); 130 131 if Symbol_Id = No_Symbol then 132 Symbol_Table.Increment_Last (Prep.Mapping); 133 Symbol_Id := Symbol_Table.Last (Prep.Mapping); 134 end if; 135 136 Prep.Mapping.Table (Symbol_Id) := Command_Line_Symbols.Table (J); 137 end loop; 138 end Add_Command_Line_Symbols; 139 140 ---------------------- 141 -- Add_Dependencies -- 142 ---------------------- 143 144 procedure Add_Dependencies is 145 begin 146 for Index in 1 .. Dependencies.Last loop 147 Add_Preprocessing_Dependency (Dependencies.Table (Index)); 148 end loop; 149 end Add_Dependencies; 150 151 ------------------- 152 -- Check_Symbols -- 153 ------------------- 154 155 procedure Check_Symbols is 156 begin 157 -- If there is at least one switch -gnateD specified 158 159 if Symbol_Table.Last (Command_Line_Symbols) >= 1 then 160 Current_Data := No_Preproc_Data; 161 No_Preprocessing := False; 162 Current_Data.Processed := True; 163 164 -- Start with an empty, initialized mapping table; use Prep.Mapping, 165 -- because Prep.Index_Of uses Prep.Mapping. 166 167 Prep.Mapping := No_Mapping; 168 Symbol_Table.Init (Prep.Mapping); 169 170 -- Add the command line symbols 171 172 Add_Command_Line_Symbols; 173 174 -- Put the resulting Prep.Mapping in Current_Data, and immediately 175 -- set Prep.Mapping to nil. 176 177 Current_Data.Mapping := Prep.Mapping; 178 Prep.Mapping := No_Mapping; 179 180 -- Set the default data 181 182 Default_Data := Current_Data; 183 Default_Data_Defined := True; 184 end if; 185 end Check_Symbols; 186 187 ------------------------------ 188 -- Parse_Preprocessing_Data -- 189 ------------------------------ 190 191 procedure Parse_Preprocessing_Data_File (N : File_Name_Type) is 192 OK : Boolean := False; 193 Dash_Location : Source_Ptr; 194 Symbol_Data : Prep.Symbol_Data; 195 Symbol_Id : Prep.Symbol_Id; 196 T : constant Nat := Total_Errors_Detected; 197 198 begin 199 -- Load the preprocessing data file 200 201 Source_Index_Of_Preproc_Data_File := Load_Preprocessing_Data_File (N); 202 203 -- Fail if preprocessing data file cannot be found 204 205 if Source_Index_Of_Preproc_Data_File = No_Source_File then 206 Get_Name_String (N); 207 Fail ("preprocessing data file """ 208 & Name_Buffer (1 .. Name_Len) 209 & """ not found"); 210 end if; 211 212 -- Initialize scanner and set its behavior for processing a data file 213 214 Scn.Scanner.Initialize_Scanner (Source_Index_Of_Preproc_Data_File); 215 Scn.Scanner.Set_End_Of_Line_As_Token (True); 216 Scn.Scanner.Reset_Special_Characters; 217 218 For_Each_Line : loop 219 <<Scan_Line>> 220 Scan; 221 222 exit For_Each_Line when Token = Tok_EOF; 223 224 if Token = Tok_End_Of_Line then 225 goto Scan_Line; 226 end if; 227 228 -- Line is not empty 229 230 OK := False; 231 No_Preprocessing := False; 232 Current_Data := No_Preproc_Data; 233 234 case Token is 235 when Tok_Asterisk => 236 237 -- Default data 238 239 if Default_Data_Defined then 240 Error_Msg 241 ("multiple default preprocessing data", Token_Ptr); 242 243 else 244 OK := True; 245 Default_Data_Defined := True; 246 end if; 247 248 when Tok_String_Literal => 249 250 -- Specific data 251 252 String_To_Name_Buffer (String_Literal_Id); 253 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len)); 254 Current_Data.File_Name := Name_Find; 255 OK := True; 256 257 for Index in 1 .. Preproc_Data_Table.Last loop 258 if Current_Data.File_Name = 259 Preproc_Data_Table.Table (Index).File_Name 260 then 261 Error_Msg_File_1 := Current_Data.File_Name; 262 Error_Msg 263 ("multiple preprocessing data for{", Token_Ptr); 264 OK := False; 265 exit; 266 end if; 267 end loop; 268 269 when others => 270 Error_Msg ("`'*` or literal string expected", Token_Ptr); 271 end case; 272 273 -- If there is a problem, skip the line 274 275 if not OK then 276 Skip_To_End_Of_Line; 277 goto Scan_Line; 278 end if; 279 280 -- Scan past the * or the literal string 281 282 Scan; 283 284 -- A literal string in second position is a definition file 285 286 if Token = Tok_String_Literal then 287 Current_Data.Deffile := String_Literal_Id; 288 Current_Data.Processed := False; 289 Scan; 290 291 else 292 -- If there is no definition file, set Processed to True now 293 294 Current_Data.Processed := True; 295 end if; 296 297 -- Start with an empty, initialized mapping table; use Prep.Mapping, 298 -- because Prep.Index_Of uses Prep.Mapping. 299 300 Prep.Mapping := No_Mapping; 301 Symbol_Table.Init (Prep.Mapping); 302 303 -- Check the switches that may follow 304 305 while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop 306 if Token /= Tok_Minus then 307 Error_Msg -- CODEFIX 308 ("`'-` expected", Token_Ptr); 309 Skip_To_End_Of_Line; 310 goto Scan_Line; 311 end if; 312 313 -- Keep the location of the '-' for possible error reporting 314 315 Dash_Location := Token_Ptr; 316 317 -- Scan past the '-' 318 319 Scan; 320 OK := False; 321 Change_Reserved_Keyword_To_Symbol; 322 323 -- An identifier (or a reserved word converted to an 324 -- identifier) is expected and there must be no blank space 325 -- between the '-' and the identifier. 326 327 if Token = Tok_Identifier 328 and then Token_Ptr = Dash_Location + 1 329 then 330 Get_Name_String (Token_Name); 331 332 -- Check the character in the source, because the case is 333 -- significant. 334 335 case Sinput.Source (Token_Ptr) is 336 when 'a' => 337 338 -- All source text preserved (also implies -u) 339 340 if Name_Len = 1 then 341 Current_Data.No_Deletion := True; 342 Current_Data.Undef_False := True; 343 OK := True; 344 end if; 345 346 when 'u' => 347 348 -- Undefined symbol are False 349 350 if Name_Len = 1 then 351 Current_Data.Undef_False := True; 352 OK := True; 353 end if; 354 355 when 'b' => 356 357 -- Blank lines 358 359 if Name_Len = 1 then 360 Current_Data.Always_Blank := True; 361 OK := True; 362 end if; 363 364 when 'c' => 365 366 -- Comment removed lines 367 368 if Name_Len = 1 then 369 Current_Data.Comments := True; 370 OK := True; 371 end if; 372 373 when 's' => 374 375 -- List symbols 376 377 if Name_Len = 1 then 378 Current_Data.List_Symbols := True; 379 OK := True; 380 end if; 381 382 when 'D' => 383 384 -- Symbol definition 385 386 OK := Name_Len > 1; 387 388 if OK then 389 390 -- A symbol must be an Ada identifier; it cannot start 391 -- with an underline or a digit. 392 393 if Name_Buffer (2) = '_' 394 or else Name_Buffer (2) in '0' .. '9' 395 then 396 Error_Msg ("symbol expected", Token_Ptr + 1); 397 Skip_To_End_Of_Line; 398 goto Scan_Line; 399 end if; 400 401 -- Get the name id of the symbol 402 403 Symbol_Data.On_The_Command_Line := True; 404 Name_Buffer (1 .. Name_Len - 1) := 405 Name_Buffer (2 .. Name_Len); 406 Name_Len := Name_Len - 1; 407 Symbol_Data.Symbol := Name_Find; 408 409 if Name_Buffer (1 .. Name_Len) = "if" 410 or else Name_Buffer (1 .. Name_Len) = "else" 411 or else Name_Buffer (1 .. Name_Len) = "elsif" 412 or else Name_Buffer (1 .. Name_Len) = "end" 413 or else Name_Buffer (1 .. Name_Len) = "not" 414 or else Name_Buffer (1 .. Name_Len) = "and" 415 or else Name_Buffer (1 .. Name_Len) = "then" 416 then 417 Error_Msg ("symbol expected", Token_Ptr + 1); 418 Skip_To_End_Of_Line; 419 goto Scan_Line; 420 end if; 421 422 -- Get the name id of the original symbol, with 423 -- possibly capital letters. 424 425 Name_Len := Integer (Scan_Ptr - Token_Ptr - 1); 426 427 for J in 1 .. Name_Len loop 428 Name_Buffer (J) := 429 Sinput.Source (Token_Ptr + Text_Ptr (J)); 430 end loop; 431 432 Symbol_Data.Original := Name_Find; 433 434 -- Scan past D<symbol> 435 436 Scan; 437 438 if Token /= Tok_Equal then 439 Error_Msg -- CODEFIX 440 ("`=` expected", Token_Ptr); 441 Skip_To_End_Of_Line; 442 goto Scan_Line; 443 end if; 444 445 -- Scan past '=' 446 447 Scan; 448 449 -- Here any reserved word is OK 450 451 Change_Reserved_Keyword_To_Symbol 452 (All_Keywords => True); 453 454 -- Value can be an identifier (or a reserved word) 455 -- or a literal string. 456 457 case Token is 458 when Tok_String_Literal => 459 Symbol_Data.Is_A_String := True; 460 Symbol_Data.Value := String_Literal_Id; 461 462 when Tok_Identifier => 463 Symbol_Data.Is_A_String := False; 464 Start_String; 465 466 for J in Token_Ptr .. Scan_Ptr - 1 loop 467 Store_String_Char (Sinput.Source (J)); 468 end loop; 469 470 Symbol_Data.Value := End_String; 471 472 when others => 473 Error_Msg 474 ("literal string or identifier expected", 475 Token_Ptr); 476 Skip_To_End_Of_Line; 477 goto Scan_Line; 478 end case; 479 480 -- If symbol already exists, replace old definition 481 -- by new one. 482 483 Symbol_Id := Prep.Index_Of (Symbol_Data.Symbol); 484 485 -- Otherwise, add a new entry in the table 486 487 if Symbol_Id = No_Symbol then 488 Symbol_Table.Increment_Last (Prep.Mapping); 489 Symbol_Id := Symbol_Table.Last (Mapping); 490 end if; 491 492 Prep.Mapping.Table (Symbol_Id) := Symbol_Data; 493 end if; 494 495 when others => 496 null; 497 end case; 498 499 Scan; 500 end if; 501 502 if not OK then 503 Error_Msg ("invalid switch", Dash_Location); 504 Skip_To_End_Of_Line; 505 goto Scan_Line; 506 end if; 507 end loop; 508 509 -- Add the command line symbols, if any, possibly replacing symbols 510 -- just defined. 511 512 Add_Command_Line_Symbols; 513 514 -- Put the resulting Prep.Mapping in Current_Data, and immediately 515 -- set Prep.Mapping to nil. 516 517 Current_Data.Mapping := Prep.Mapping; 518 Prep.Mapping := No_Mapping; 519 520 -- Record Current_Data 521 522 if Current_Data.File_Name = No_File then 523 Default_Data := Current_Data; 524 525 else 526 Preproc_Data_Table.Increment_Last; 527 Preproc_Data_Table.Table (Preproc_Data_Table.Last) := Current_Data; 528 end if; 529 530 Current_Data := No_Preproc_Data; 531 end loop For_Each_Line; 532 533 Scn.Scanner.Set_End_Of_Line_As_Token (False); 534 535 -- Fail if there were errors in the preprocessing data file 536 537 if Total_Errors_Detected > T then 538 Errout.Finalize (Last_Call => True); 539 Errout.Output_Messages; 540 Fail ("errors found in preprocessing data file """ 541 & Get_Name_String (N) & """"); 542 end if; 543 544 -- Record the dependency on the preprocessor data file 545 546 Dependencies.Increment_Last; 547 Dependencies.Table (Dependencies.Last) := 548 Source_Index_Of_Preproc_Data_File; 549 end Parse_Preprocessing_Data_File; 550 551 --------------------------- 552 -- Prepare_To_Preprocess -- 553 --------------------------- 554 555 procedure Prepare_To_Preprocess 556 (Source : File_Name_Type; 557 Preprocessing_Needed : out Boolean) 558 is 559 Default : Boolean := False; 560 Index : Int := 0; 561 562 begin 563 -- By default, preprocessing is not needed 564 565 Preprocessing_Needed := False; 566 567 if No_Preprocessing then 568 return; 569 end if; 570 571 -- First, look for preprocessing data specific to the current source 572 573 for J in 1 .. Preproc_Data_Table.Last loop 574 if Preproc_Data_Table.Table (J).File_Name = Source then 575 Index := J; 576 Current_Data := Preproc_Data_Table.Table (J); 577 exit; 578 end if; 579 end loop; 580 581 -- If no specific preprocessing data, then take the default 582 583 if Index = 0 then 584 if Default_Data_Defined then 585 Current_Data := Default_Data; 586 Default := True; 587 588 else 589 -- If no default, then nothing to do 590 591 return; 592 end if; 593 end if; 594 595 -- Set the preprocessing flags according to the preprocessing data 596 597 if Current_Data.Comments and not Current_Data.Always_Blank then 598 Comment_Deleted_Lines := True; 599 Blank_Deleted_Lines := False; 600 else 601 Comment_Deleted_Lines := False; 602 Blank_Deleted_Lines := True; 603 end if; 604 605 No_Deletion := Current_Data.No_Deletion; 606 Undefined_Symbols_Are_False := Current_Data.Undef_False; 607 List_Preprocessing_Symbols := Current_Data.List_Symbols; 608 609 -- If not already done it, process the definition file 610 611 if Current_Data.Processed then 612 613 -- Set Prep.Mapping 614 615 Prep.Mapping := Current_Data.Mapping; 616 617 else 618 -- First put the mapping in Prep.Mapping, because Prep.Parse_Def_File 619 -- works on Prep.Mapping. 620 621 Prep.Mapping := Current_Data.Mapping; 622 623 String_To_Name_Buffer (Current_Data.Deffile); 624 625 declare 626 N : constant File_Name_Type := Name_Find; 627 Deffile : constant Source_File_Index := 628 Load_Definition_File (N); 629 Add_Deffile : Boolean := True; 630 T : constant Nat := Total_Errors_Detected; 631 632 begin 633 if Deffile = No_Source_File then 634 Fail ("definition file """ 635 & Get_Name_String (N) 636 & """ not found"); 637 end if; 638 639 -- Initialize the preprocessor and set the characteristics of the 640 -- scanner for a definition file. 641 642 Prep.Setup_Hooks 643 (Error_Msg => Errout.Error_Msg'Access, 644 Scan => Scn.Scanner.Scan'Access, 645 Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access, 646 Put_Char => null, 647 New_EOL => null); 648 649 Scn.Scanner.Set_End_Of_Line_As_Token (True); 650 Scn.Scanner.Reset_Special_Characters; 651 652 -- Initialize the scanner and process the definition file 653 654 Scn.Scanner.Initialize_Scanner (Deffile); 655 Prep.Parse_Def_File; 656 657 -- Reset the behaviour of the scanner to the default 658 659 Scn.Scanner.Set_End_Of_Line_As_Token (False); 660 661 -- Fail if errors were found while processing the definition file 662 663 if T /= Total_Errors_Detected then 664 Errout.Finalize (Last_Call => True); 665 Errout.Output_Messages; 666 Fail ("errors found in definition file """ 667 & Get_Name_String (N) 668 & """"); 669 end if; 670 671 for Index in 1 .. Dependencies.Last loop 672 if Dependencies.Table (Index) = Deffile then 673 Add_Deffile := False; 674 exit; 675 end if; 676 end loop; 677 678 if Add_Deffile then 679 Dependencies.Increment_Last; 680 Dependencies.Table (Dependencies.Last) := Deffile; 681 end if; 682 end; 683 684 -- Get back the mapping, indicate that the definition file is 685 -- processed and store back the preprocessing data. 686 687 Current_Data.Mapping := Prep.Mapping; 688 Current_Data.Processed := True; 689 690 if Default then 691 Default_Data := Current_Data; 692 693 else 694 Preproc_Data_Table.Table (Index) := Current_Data; 695 end if; 696 end if; 697 698 Preprocessing_Needed := True; 699 end Prepare_To_Preprocess; 700 701 --------------------------------------------- 702 -- Process_Command_Line_Symbol_Definitions -- 703 --------------------------------------------- 704 705 procedure Process_Command_Line_Symbol_Definitions is 706 Symbol_Data : Prep.Symbol_Data; 707 Found : Boolean := False; 708 709 begin 710 Symbol_Table.Init (Command_Line_Symbols); 711 712 -- The command line definitions have been stored temporarily in 713 -- array Symbol_Definitions. 714 715 for Index in 1 .. Preprocessing_Symbol_Last loop 716 -- Check each symbol definition, fail immediately if syntax is not 717 -- correct. 718 719 Check_Command_Line_Symbol_Definition 720 (Definition => Preprocessing_Symbol_Defs (Index).all, 721 Data => Symbol_Data); 722 Found := False; 723 724 -- If there is already a definition for this symbol, replace the old 725 -- definition by this one. 726 727 for J in 1 .. Symbol_Table.Last (Command_Line_Symbols) loop 728 if Command_Line_Symbols.Table (J).Symbol = Symbol_Data.Symbol then 729 Command_Line_Symbols.Table (J) := Symbol_Data; 730 Found := True; 731 exit; 732 end if; 733 end loop; 734 735 -- Otherwise, create a new entry in the table 736 737 if not Found then 738 Symbol_Table.Increment_Last (Command_Line_Symbols); 739 Command_Line_Symbols.Table 740 (Symbol_Table.Last (Command_Line_Symbols)) := Symbol_Data; 741 end if; 742 end loop; 743 end Process_Command_Line_Symbol_Definitions; 744 745 ------------------------- 746 -- Skip_To_End_Of_Line -- 747 ------------------------- 748 749 procedure Skip_To_End_Of_Line is 750 begin 751 Set_Ignore_Errors (To => True); 752 753 while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop 754 Scan; 755 end loop; 756 757 Set_Ignore_Errors (To => False); 758 end Skip_To_End_Of_Line; 759 760end Prepcomp; 761