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