1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- G P R E P -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2002-2013, 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 Csets; 28with Errutil; 29with Namet; use Namet; 30with Opt; 31with Osint; use Osint; 32with Output; use Output; 33with Prep; use Prep; 34with Scng; 35with Sinput.C; 36with Snames; 37with Stringt; use Stringt; 38with Switch; use Switch; 39with Types; use Types; 40 41with Ada.Text_IO; use Ada.Text_IO; 42 43with GNAT.Case_Util; use GNAT.Case_Util; 44with GNAT.Command_Line; 45with GNAT.Directory_Operations; use GNAT.Directory_Operations; 46 47with System.OS_Lib; use System.OS_Lib; 48 49package body GPrep is 50 51 Copyright_Displayed : Boolean := False; 52 -- Used to prevent multiple displays of the copyright notice 53 54 ------------------------ 55 -- Argument Line Data -- 56 ------------------------ 57 58 Unix_Line_Terminators : Boolean := False; 59 -- Set to True with option -T 60 61 type String_Array is array (Boolean) of String_Access; 62 Yes_No : constant String_Array := 63 (False => new String'("YES"), 64 True => new String'("NO")); 65 66 Infile_Name : Name_Id := No_Name; 67 Outfile_Name : Name_Id := No_Name; 68 Deffile_Name : Name_Id := No_Name; 69 70 Output_Directory : Name_Id := No_Name; 71 -- Used when the specified output is an existing directory 72 73 Input_Directory : Name_Id := No_Name; 74 -- Used when the specified input and output are existing directories 75 76 Source_Ref_Pragma : Boolean := False; 77 -- Record command line options (set if -r switch set) 78 79 Text_Outfile : aliased Ada.Text_IO.File_Type; 80 Outfile : constant File_Access := Text_Outfile'Access; 81 82 File_Name_Buffer_Initial_Size : constant := 50; 83 File_Name_Buffer : String_Access := 84 new String (1 .. File_Name_Buffer_Initial_Size); 85 -- A buffer to build output file names from input file names 86 87 ----------------- 88 -- Subprograms -- 89 ----------------- 90 91 procedure Display_Copyright; 92 -- Display the copyright notice 93 94 procedure Post_Scan; 95 -- Null procedure, needed by instantiation of Scng below 96 97 package Scanner is new Scng 98 (Post_Scan, 99 Errutil.Error_Msg, 100 Errutil.Error_Msg_S, 101 Errutil.Error_Msg_SC, 102 Errutil.Error_Msg_SP, 103 Errutil.Style); 104 -- The scanner for the preprocessor 105 106 function Is_ASCII_Letter (C : Character) return Boolean; 107 -- True if C is in 'a' .. 'z' or in 'A' .. 'Z' 108 109 procedure Double_File_Name_Buffer; 110 -- Double the size of the file name buffer 111 112 procedure Preprocess_Infile_Name; 113 -- When the specified output is a directory, preprocess the infile name 114 -- for symbol substitution, to get the output file name. 115 116 procedure Process_Files; 117 -- Process the single input file or all the files in the directory tree 118 -- rooted at the input directory. 119 120 procedure Process_Command_Line_Symbol_Definition (S : String); 121 -- Process a -D switch on the command line 122 123 procedure Put_Char_To_Outfile (C : Character); 124 -- Output one character to the output file. Used to initialize the 125 -- preprocessor. 126 127 procedure New_EOL_To_Outfile; 128 -- Output a new line to the output file. Used to initialize the 129 -- preprocessor. 130 131 procedure Scan_Command_Line; 132 -- Scan the switches and the file names 133 134 procedure Usage; 135 -- Display the usage 136 137 ----------------------- 138 -- Display_Copyright -- 139 ----------------------- 140 141 procedure Display_Copyright is 142 begin 143 if not Copyright_Displayed then 144 Display_Version ("GNAT Preprocessor", "1996"); 145 Copyright_Displayed := True; 146 end if; 147 end Display_Copyright; 148 149 ----------------------------- 150 -- Double_File_Name_Buffer -- 151 ----------------------------- 152 153 procedure Double_File_Name_Buffer is 154 New_Buffer : constant String_Access := 155 new String (1 .. 2 * File_Name_Buffer'Length); 156 begin 157 New_Buffer (File_Name_Buffer'Range) := File_Name_Buffer.all; 158 Free (File_Name_Buffer); 159 File_Name_Buffer := New_Buffer; 160 end Double_File_Name_Buffer; 161 162 -------------- 163 -- Gnatprep -- 164 -------------- 165 166 procedure Gnatprep is 167 begin 168 -- Do some initializations (order is important here) 169 170 Csets.Initialize; 171 Snames.Initialize; 172 Stringt.Initialize; 173 Prep.Initialize; 174 175 -- Initialize the preprocessor 176 177 Prep.Setup_Hooks 178 (Error_Msg => Errutil.Error_Msg'Access, 179 Scan => Scanner.Scan'Access, 180 Set_Ignore_Errors => Errutil.Set_Ignore_Errors'Access, 181 Put_Char => Put_Char_To_Outfile'Access, 182 New_EOL => New_EOL_To_Outfile'Access); 183 184 -- Set the scanner characteristics for the preprocessor 185 186 Scanner.Set_Special_Character ('#'); 187 Scanner.Set_Special_Character ('$'); 188 Scanner.Set_End_Of_Line_As_Token (True); 189 190 -- Initialize the mapping table of symbols to values 191 192 Prep.Symbol_Table.Init (Prep.Mapping); 193 194 -- Parse the switches and arguments 195 196 Scan_Command_Line; 197 198 if Opt.Verbose_Mode then 199 Display_Copyright; 200 end if; 201 202 -- Test we had all the arguments needed 203 204 if Infile_Name = No_Name then 205 206 -- No input file specified, just output the usage and exit 207 208 Usage; 209 return; 210 211 elsif Outfile_Name = No_Name then 212 213 -- No output file specified, just output the usage and exit 214 215 Usage; 216 return; 217 end if; 218 219 -- If a pragma Source_File_Name, we need to keep line numbers. So, if 220 -- the deleted lines are not put as comment, we must output them as 221 -- blank lines. 222 223 if Source_Ref_Pragma and (not Opt.Comment_Deleted_Lines) then 224 Opt.Blank_Deleted_Lines := True; 225 end if; 226 227 -- If we have a definition file, parse it 228 229 if Deffile_Name /= No_Name then 230 declare 231 Deffile : Source_File_Index; 232 233 begin 234 Errutil.Initialize; 235 Deffile := Sinput.C.Load_File (Get_Name_String (Deffile_Name)); 236 237 -- Set Main_Source_File to the definition file for the benefit of 238 -- Errutil.Finalize. 239 240 Sinput.Main_Source_File := Deffile; 241 242 if Deffile = No_Source_File then 243 Fail ("unable to find definition file """ 244 & Get_Name_String (Deffile_Name) 245 & """"); 246 end if; 247 248 Scanner.Initialize_Scanner (Deffile); 249 250 Prep.Parse_Def_File; 251 end; 252 end if; 253 254 -- If there are errors in the definition file, output them and exit 255 256 if Total_Errors_Detected > 0 then 257 Errutil.Finalize (Source_Type => "definition"); 258 Fail ("errors in definition file """ 259 & Get_Name_String (Deffile_Name) 260 & """"); 261 end if; 262 263 -- If -s switch was specified, print a sorted list of symbol names and 264 -- values, if any. 265 266 if Opt.List_Preprocessing_Symbols then 267 Prep.List_Symbols (Foreword => ""); 268 end if; 269 270 Output_Directory := No_Name; 271 Input_Directory := No_Name; 272 273 -- Check if the specified output is an existing directory 274 275 if Is_Directory (Get_Name_String (Outfile_Name)) then 276 Output_Directory := Outfile_Name; 277 278 -- As the output is an existing directory, check if the input too 279 -- is a directory. 280 281 if Is_Directory (Get_Name_String (Infile_Name)) then 282 Input_Directory := Infile_Name; 283 end if; 284 end if; 285 286 -- And process the single input or the files in the directory tree 287 -- rooted at the input directory. 288 289 Process_Files; 290 end Gnatprep; 291 292 --------------------- 293 -- Is_ASCII_Letter -- 294 --------------------- 295 296 function Is_ASCII_Letter (C : Character) return Boolean is 297 begin 298 return C in 'A' .. 'Z' or else C in 'a' .. 'z'; 299 end Is_ASCII_Letter; 300 301 ------------------------ 302 -- New_EOL_To_Outfile -- 303 ------------------------ 304 305 procedure New_EOL_To_Outfile is 306 begin 307 New_Line (Outfile.all); 308 end New_EOL_To_Outfile; 309 310 --------------- 311 -- Post_Scan -- 312 --------------- 313 314 procedure Post_Scan is 315 begin 316 null; 317 end Post_Scan; 318 319 ---------------------------- 320 -- Preprocess_Infile_Name -- 321 ---------------------------- 322 323 procedure Preprocess_Infile_Name is 324 Len : Natural; 325 First : Positive; 326 Last : Natural; 327 Symbol : Name_Id; 328 Data : Symbol_Data; 329 330 begin 331 -- Initialize the buffer with the name of the input file 332 333 Get_Name_String (Infile_Name); 334 Len := Name_Len; 335 336 while File_Name_Buffer'Length < Len loop 337 Double_File_Name_Buffer; 338 end loop; 339 340 File_Name_Buffer (1 .. Len) := Name_Buffer (1 .. Len); 341 342 -- Look for possible symbols in the file name 343 344 First := 1; 345 while First < Len loop 346 347 -- A symbol starts with a dollar sign followed by a letter 348 349 if File_Name_Buffer (First) = '$' and then 350 Is_ASCII_Letter (File_Name_Buffer (First + 1)) 351 then 352 Last := First + 1; 353 354 -- Find the last letter of the symbol 355 356 while Last < Len and then 357 Is_ASCII_Letter (File_Name_Buffer (Last + 1)) 358 loop 359 Last := Last + 1; 360 end loop; 361 362 -- Get the symbol name id 363 364 Name_Len := Last - First; 365 Name_Buffer (1 .. Name_Len) := 366 File_Name_Buffer (First + 1 .. Last); 367 To_Lower (Name_Buffer (1 .. Name_Len)); 368 Symbol := Name_Find; 369 370 -- And look for this symbol name in the symbol table 371 372 for Index in 1 .. Symbol_Table.Last (Mapping) loop 373 Data := Mapping.Table (Index); 374 375 if Data.Symbol = Symbol then 376 377 -- We found the symbol. If its value is not a string, 378 -- replace the symbol in the file name with the value of 379 -- the symbol. 380 381 if not Data.Is_A_String then 382 String_To_Name_Buffer (Data.Value); 383 384 declare 385 Sym_Len : constant Positive := Last - First + 1; 386 Offset : constant Integer := Name_Len - Sym_Len; 387 New_Len : constant Natural := Len + Offset; 388 389 begin 390 while New_Len > File_Name_Buffer'Length loop 391 Double_File_Name_Buffer; 392 end loop; 393 394 File_Name_Buffer (Last + 1 + Offset .. New_Len) := 395 File_Name_Buffer (Last + 1 .. Len); 396 Len := New_Len; 397 Last := Last + Offset; 398 File_Name_Buffer (First .. Last) := 399 Name_Buffer (1 .. Name_Len); 400 end; 401 end if; 402 403 exit; 404 end if; 405 end loop; 406 407 -- Skip over the symbol name or its value: we are not checking 408 -- for another symbol name in the value. 409 410 First := Last + 1; 411 412 else 413 First := First + 1; 414 end if; 415 end loop; 416 417 -- We now have the output file name in the buffer. Get the output 418 -- path and put it in Outfile_Name. 419 420 Get_Name_String (Output_Directory); 421 Add_Char_To_Name_Buffer (Directory_Separator); 422 Add_Str_To_Name_Buffer (File_Name_Buffer (1 .. Len)); 423 Outfile_Name := Name_Find; 424 end Preprocess_Infile_Name; 425 426 -------------------------------------------- 427 -- Process_Command_Line_Symbol_Definition -- 428 -------------------------------------------- 429 430 procedure Process_Command_Line_Symbol_Definition (S : String) is 431 Data : Symbol_Data; 432 Symbol : Symbol_Id; 433 434 begin 435 -- Check the symbol definition and get the symbol and its value. 436 -- Fail if symbol definition is illegal. 437 438 Check_Command_Line_Symbol_Definition (S, Data); 439 440 Symbol := Index_Of (Data.Symbol); 441 442 -- If symbol does not already exist, create a new entry in the mapping 443 -- table. 444 445 if Symbol = No_Symbol then 446 Symbol_Table.Increment_Last (Mapping); 447 Symbol := Symbol_Table.Last (Mapping); 448 end if; 449 450 Mapping.Table (Symbol) := Data; 451 end Process_Command_Line_Symbol_Definition; 452 453 ------------------- 454 -- Process_Files -- 455 ------------------- 456 457 procedure Process_Files is 458 459 procedure Process_One_File; 460 -- Process input file Infile_Name and put the result in file 461 -- Outfile_Name. 462 463 procedure Recursive_Process (In_Dir : String; Out_Dir : String); 464 -- Process recursively files in In_Dir. Results go to Out_Dir 465 466 ---------------------- 467 -- Process_One_File -- 468 ---------------------- 469 470 procedure Process_One_File is 471 Infile : Source_File_Index; 472 473 Modified : Boolean; 474 pragma Warnings (Off, Modified); 475 476 begin 477 -- Create the output file (fails if this does not work) 478 479 begin 480 Create 481 (File => Text_Outfile, 482 Mode => Out_File, 483 Name => Get_Name_String (Outfile_Name), 484 Form => "Text_Translation=" & 485 Yes_No (Unix_Line_Terminators).all); 486 487 exception 488 when others => 489 Fail 490 ("unable to create output file """ 491 & Get_Name_String (Outfile_Name) 492 & """"); 493 end; 494 495 -- Load the input file 496 497 Infile := Sinput.C.Load_File (Get_Name_String (Infile_Name)); 498 499 if Infile = No_Source_File then 500 Fail ("unable to find input file """ 501 & Get_Name_String (Infile_Name) 502 & """"); 503 end if; 504 505 -- Set Main_Source_File to the input file for the benefit of 506 -- Errutil.Finalize. 507 508 Sinput.Main_Source_File := Infile; 509 510 Scanner.Initialize_Scanner (Infile); 511 512 -- Output the pragma Source_Reference if asked to 513 514 if Source_Ref_Pragma then 515 Put_Line 516 (Outfile.all, 517 "pragma Source_Reference (1, """ & 518 Get_Name_String (Sinput.Full_File_Name (Infile)) & """);"); 519 end if; 520 521 -- Preprocess the input file 522 523 Prep.Preprocess (Modified); 524 525 -- In verbose mode, if there is no error, report it 526 527 if Opt.Verbose_Mode and then Total_Errors_Detected = 0 then 528 Errutil.Finalize (Source_Type => "input"); 529 end if; 530 531 -- If we had some errors, delete the output file, and report them 532 533 if Total_Errors_Detected > 0 then 534 if Outfile /= Standard_Output then 535 Delete (Text_Outfile); 536 end if; 537 538 Errutil.Finalize (Source_Type => "input"); 539 540 OS_Exit (0); 541 542 -- Otherwise, close the output file, and we are done 543 544 elsif Outfile /= Standard_Output then 545 Close (Text_Outfile); 546 end if; 547 end Process_One_File; 548 549 ----------------------- 550 -- Recursive_Process -- 551 ----------------------- 552 553 procedure Recursive_Process (In_Dir : String; Out_Dir : String) is 554 Dir_In : Dir_Type; 555 Name : String (1 .. 255); 556 Last : Natural; 557 In_Dir_Name : Name_Id; 558 Out_Dir_Name : Name_Id; 559 560 procedure Set_Directory_Names; 561 -- Establish or reestablish the current input and output directories 562 563 ------------------------- 564 -- Set_Directory_Names -- 565 ------------------------- 566 567 procedure Set_Directory_Names is 568 begin 569 Input_Directory := In_Dir_Name; 570 Output_Directory := Out_Dir_Name; 571 end Set_Directory_Names; 572 573 -- Start of processing for Recursive_Process 574 575 begin 576 -- Open the current input directory 577 578 begin 579 Open (Dir_In, In_Dir); 580 581 exception 582 when Directory_Error => 583 Fail ("could not read directory " & In_Dir); 584 end; 585 586 -- Set the new input and output directory names 587 588 Name_Len := In_Dir'Length; 589 Name_Buffer (1 .. Name_Len) := In_Dir; 590 In_Dir_Name := Name_Find; 591 Name_Len := Out_Dir'Length; 592 Name_Buffer (1 .. Name_Len) := Out_Dir; 593 Out_Dir_Name := Name_Find; 594 595 Set_Directory_Names; 596 597 -- Traverse the input directory 598 loop 599 Read (Dir_In, Name, Last); 600 exit when Last = 0; 601 602 if Name (1 .. Last) /= "." and then Name (1 .. Last) /= ".." then 603 declare 604 Input : constant String := 605 In_Dir & Directory_Separator & Name (1 .. Last); 606 Output : constant String := 607 Out_Dir & Directory_Separator & Name (1 .. Last); 608 609 begin 610 -- If input is an ordinary file, process it 611 612 if Is_Regular_File (Input) then 613 -- First get the output file name 614 615 Name_Len := Last; 616 Name_Buffer (1 .. Name_Len) := Name (1 .. Last); 617 Infile_Name := Name_Find; 618 Preprocess_Infile_Name; 619 620 -- Set the input file name and process the file 621 622 Name_Len := Input'Length; 623 Name_Buffer (1 .. Name_Len) := Input; 624 Infile_Name := Name_Find; 625 Process_One_File; 626 627 elsif Is_Directory (Input) then 628 -- Input is a directory. If the corresponding output 629 -- directory does not already exist, create it. 630 631 if not Is_Directory (Output) then 632 begin 633 Make_Dir (Dir_Name => Output); 634 635 exception 636 when Directory_Error => 637 Fail ("could not create directory """ 638 & Output 639 & """"); 640 end; 641 end if; 642 643 -- And process this new input directory 644 645 Recursive_Process (Input, Output); 646 647 -- Reestablish the input and output directory names 648 -- that have been modified by the recursive call. 649 650 Set_Directory_Names; 651 end if; 652 end; 653 end if; 654 end loop; 655 end Recursive_Process; 656 657 -- Start of processing for Process_Files 658 659 begin 660 if Output_Directory = No_Name then 661 662 -- If the output is not a directory, fail if the input is 663 -- an existing directory, to avoid possible problems. 664 665 if Is_Directory (Get_Name_String (Infile_Name)) then 666 Fail ("input file """ & Get_Name_String (Infile_Name) & 667 """ is a directory"); 668 end if; 669 670 -- Just process the single input file 671 672 Process_One_File; 673 674 elsif Input_Directory = No_Name then 675 676 -- Get the output file name from the input file name, and process 677 -- the single input file. 678 679 Preprocess_Infile_Name; 680 Process_One_File; 681 682 else 683 -- Recursively process files in the directory tree rooted at the 684 -- input directory. 685 686 Recursive_Process 687 (In_Dir => Get_Name_String (Input_Directory), 688 Out_Dir => Get_Name_String (Output_Directory)); 689 end if; 690 end Process_Files; 691 692 ------------------------- 693 -- Put_Char_To_Outfile -- 694 ------------------------- 695 696 procedure Put_Char_To_Outfile (C : Character) is 697 begin 698 Put (Outfile.all, C); 699 end Put_Char_To_Outfile; 700 701 ----------------------- 702 -- Scan_Command_Line -- 703 ----------------------- 704 705 procedure Scan_Command_Line is 706 Switch : Character; 707 708 procedure Check_Version_And_Help is new Check_Version_And_Help_G (Usage); 709 710 -- Start of processing for Scan_Command_Line 711 712 begin 713 -- First check for --version or --help 714 715 Check_Version_And_Help ("GNATPREP", "1996"); 716 717 -- Now scan the other switches 718 719 GNAT.Command_Line.Initialize_Option_Scan; 720 721 loop 722 begin 723 Switch := GNAT.Command_Line.Getopt ("D: a b c C r s T u v"); 724 725 case Switch is 726 727 when ASCII.NUL => 728 exit; 729 730 when 'D' => 731 Process_Command_Line_Symbol_Definition 732 (S => GNAT.Command_Line.Parameter); 733 734 when 'a' => 735 Opt.No_Deletion := True; 736 Opt.Undefined_Symbols_Are_False := True; 737 738 when 'b' => 739 Opt.Blank_Deleted_Lines := True; 740 741 when 'c' => 742 Opt.Comment_Deleted_Lines := True; 743 744 when 'C' => 745 Opt.Replace_In_Comments := True; 746 747 when 'r' => 748 Source_Ref_Pragma := True; 749 750 when 's' => 751 Opt.List_Preprocessing_Symbols := True; 752 753 when 'T' => 754 Unix_Line_Terminators := True; 755 756 when 'u' => 757 Opt.Undefined_Symbols_Are_False := True; 758 759 when 'v' => 760 Opt.Verbose_Mode := True; 761 762 when others => 763 Fail ("Invalid Switch: -" & Switch); 764 end case; 765 766 exception 767 when GNAT.Command_Line.Invalid_Switch => 768 Write_Str ("Invalid Switch: -"); 769 Write_Line (GNAT.Command_Line.Full_Switch); 770 Usage; 771 OS_Exit (1); 772 end; 773 end loop; 774 775 -- Get the file names 776 777 loop 778 declare 779 S : constant String := GNAT.Command_Line.Get_Argument; 780 781 begin 782 exit when S'Length = 0; 783 784 Name_Len := S'Length; 785 Name_Buffer (1 .. Name_Len) := S; 786 787 if Infile_Name = No_Name then 788 Infile_Name := Name_Find; 789 elsif Outfile_Name = No_Name then 790 Outfile_Name := Name_Find; 791 elsif Deffile_Name = No_Name then 792 Deffile_Name := Name_Find; 793 else 794 Fail ("too many arguments specified"); 795 end if; 796 end; 797 end loop; 798 end Scan_Command_Line; 799 800 ----------- 801 -- Usage -- 802 ----------- 803 804 procedure Usage is 805 begin 806 Display_Copyright; 807 Write_Line ("Usage: gnatprep [-bcrsuv] [-Dsymbol=value] " & 808 "infile outfile [deffile]"); 809 Write_Eol; 810 Write_Line (" infile Name of the input file"); 811 Write_Line (" outfile Name of the output file"); 812 Write_Line (" deffile Name of the definition file"); 813 Write_Eol; 814 Write_Line ("gnatprep switches:"); 815 Display_Usage_Version_And_Help; 816 Write_Line (" -b Replace preprocessor lines by blank lines"); 817 Write_Line (" -c Keep preprocessor lines as comments"); 818 Write_Line (" -C Do symbol replacements within comments"); 819 Write_Line (" -D Associate symbol with value"); 820 Write_Line (" -r Generate Source_Reference pragma"); 821 Write_Line (" -s Print a sorted list of symbol names and values"); 822 Write_Line (" -T Use LF as line terminators"); 823 Write_Line (" -u Treat undefined symbols as FALSE"); 824 Write_Line (" -v Verbose mode"); 825 Write_Eol; 826 end Usage; 827 828end GPrep; 829