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