gcc/ada/gnatprep.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             G N A T P R E P                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --                                                                          --
  10 --          Copyright (C) 1996-2002, Free Software Foundation, Inc.         --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  18 -- for  more details.  You should have  received  a copy of the GNU General --
  19 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  20 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  21 -- MA 02111-1307, USA.                                                      --
  22 --                                                                          --
  23 -- GNAT was originally developed  by the GNAT team at  New York University. --
  24 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
  25 --                                                                          --
  26 ------------------------------------------------------------------------------
  27
  28 with Ada.Characters.Handling; use Ada.Characters.Handling;
  29 with Ada.Strings.Fixed;
  30 with Ada.Command_Line;        use Ada.Command_Line;
  31 with Ada.Text_IO;             use Ada.Text_IO;
  32
  33 with GNAT.Heap_Sort_G;
  34 with GNAT.Command_Line;
  35
  36 with Gnatvsn;
  37
  38 procedure GNATprep is
  39    pragma Ident (Gnatvsn.Gnat_Version_String);
  40
  41    type Strptr is access String;
  42
  43    Usage_Error : exception;
  44    --  Raised if a usage error is detected, causes termination of processing
  45    --  with an appropriate error message and error exit status set.
  46
  47    Fatal_Error : exception;
  48    --  Exception raised if fatal error detected
  49
  50    Expression_Error : exception;
  51    --  Exception raised when an invalid boolean expression is found
  52    --  on a preprocessor line
  53
  54    ------------------------
  55    -- Argument Line Data --
  56    ------------------------
  57
  58    Outfile_Name : Strptr;
  59    Deffile_Name : Strptr;
  60    --  Names of files
  61
  62    type Input;
  63    type Input_Ptr is access Input;
  64    type Input is record
  65       File     : File_Type;
  66       Next     : Input_Ptr;
  67       Prev     : Input_Ptr;
  68       Name     : Strptr;
  69       Line_Num : Natural := 0;
  70    end record;
  71    --  Data for the current input file (main input file or included file
  72    --  or definition file).
  73
  74    Infile  : Input_Ptr := new Input;
  75    Outfile : File_Type;
  76    Deffile : File_Type;
  77
  78    Opt_Comment_Deleted_Lines : Boolean := False;  -- Set if -c switch set
  79    Blank_Deleted_Lines       : Boolean := False;  -- Set if -b switch set
  80    List_Symbols              : Boolean := False;  -- Set if -s switch set
  81    Source_Ref_Pragma         : Boolean := False;  -- Set if -r switch set
  82    Undefined_Is_False        : Boolean := False;  -- Set if -u switch set
  83    --  Record command line options
  84
  85    ---------------------------
  86    -- Definitions File Data --
  87    ---------------------------
  88
  89    Num_Syms : Natural := 0;
  90    --  Number of symbols defined in definitions file
  91
  92    Symbols : array (0 .. 10_000) of Strptr;
  93    Values  : array (0 .. 10_000) of Strptr;
  94    --  Symbol names and values. Note that the zero'th element is used only
  95    --  during the call to Sort (to hold a temporary value, as required by
  96    --  the GNAT.Heap_Sort_G interface).
  97
  98    ---------------------
  99    -- Input File Data --
 100    ---------------------
 101
 102    Current_File_Name : Strptr;
 103    --  Holds name of file being read (definitions file or input file)
 104
 105    Line_Buffer : String (1 .. 20_000);
 106    --  Hold one line
 107
 108    Line_Length : Natural;
 109    --  Length of line in Line_Buffer
 110
 111    Ptr : Natural;
 112    --  Input scan pointer for line in Line_Buffer
 113
 114    type Keyword is (K_Not, K_Then, K_If, K_Else, K_End, K_Elsif,
 115                     K_And, K_Or, K_Open_Paren, K_Close_Paren,
 116                     K_Defined, K_Andthen, K_Orelse, K_Equal, K_Include,
 117                     K_None);
 118    --  Keywords that are recognized on preprocessor lines. K_None indicates
 119    --  that no keyword was present.
 120
 121    K : Keyword;
 122    --  Scanned keyword
 123
 124    Start_Sym, End_Sym : Natural;
 125    --  First and last positions of scanned symbol
 126
 127    Num_Errors : Natural := 0;
 128    --  Number of errors detected
 129
 130    -----------------------
 131    -- Preprocessor Data --
 132    -----------------------
 133
 134    --  The following record represents the state of an #if structure:
 135
 136    type PP_Rec is record
 137       If_Line : Positive;
 138       --  Line number for #if line
 139
 140       If_Name : Strptr;
 141       --  File name of #if line
 142
 143       Else_Line : Natural;
 144       --  Line number for #else line, zero = no else seen yet
 145
 146       Deleting : Boolean;
 147       --  True if lines currently being deleted
 148
 149       Match_Seen : Boolean;
 150       --  True if either the #if condition or one of the previously seen
 151       --  #elsif lines was true, meaning that any future #elsif sections
 152       --  or the #else section, is to be deleted.
 153
 154    end record;
 155
 156    PP_Depth : Natural;
 157    --  Preprocessor #if nesting level. A value of zero means that we are
 158    --  outside any #if structure.
 159
 160    PP : array (0 .. 100) of PP_Rec;
 161    --  Stack of records showing state of #if structures. PP (1) is the
 162    --  outer level entry, and PP (PP_Depth) is the active entry. PP (0)
 163    --  contains a dummy entry whose Deleting flag is always set to False.
 164
 165    -----------------
 166    -- Subprograms --
 167    -----------------
 168
 169    function At_End_Of_Line return Boolean;
 170    --  First advances Ptr using Skip_Spaces. Then returns True if Ptr is
 171    --  either at the end of the line, or at a -- comment sequence.
 172
 173    procedure Error (Msg : String);
 174    --  Post error message with given text. The line number is taken from
 175    --  Infile.Line_Num, and the column number from Ptr.
 176
 177    function Eval_Condition
 178      (Parenthesis : Natural := 0;
 179       Do_Eval     : Boolean := True)
 180       return        Boolean;
 181    --  Eval the condition found in the current Line. The condition can
 182    --  include any of the 'and', 'or', 'not', and parenthesis subexpressions.
 183    --  If Line is an invalid expression, then Expression_Error is raised,
 184    --  after an error message has been printed. Line can include 'then'
 185    --  followed by a comment, which is automatically ignored. If Do_Eval
 186    --  is False, then the expression is not evaluated at all, and symbols
 187    --  are just skipped.
 188
 189    function Eval_Symbol (Do_Eval : Boolean) return Boolean;
 190    --  Read and evaluate the next symbol or expression (A,  A'Defined,  A=...)
 191    --  If it is followed by 'Defined or an equality test, read as many symbols
 192    --  as needed. Do_Eval has the same meaning as in Eval_Condition
 193
 194    procedure Help_Page;
 195    --  Print a help page to summarize the usage of gnatprep
 196
 197    function Image (N : Natural) return String;
 198    --  Returns Natural'Image (N) without the initial space
 199
 200    function Is_Preprocessor_Line return Boolean;
 201    --  Tests if current line is a preprocessor line, i.e. that its first
 202    --  non-blank character is a # character. If so, then a result of True
 203    --  is returned, and Ptr is set to point to the character following the
 204    --  # character. If not, False is returned and Ptr is undefined.
 205
 206    procedure No_Junk;
 207    --  Make sure no junk is present on a preprocessor line. Ptr points past
 208    --  the scanned preprocessor syntax.
 209
 210    function OK_Identifier (S : String) return Boolean;
 211    --  Tests if given referenced string is valid Ada identifier
 212
 213    function Matching_Strings (S1, S2 : String) return Boolean;
 214    --  Check if S1 and S2 are the same string (this is a case independent
 215    --  comparison, lower and upper case letters are considered to match).
 216    --  Duplicate quotes in S2 are considered as a single quote ("" => ")
 217
 218    procedure Parse_Def_File;
 219    --  Parse the deffile given by the user
 220
 221    function Scan_Keyword return Keyword;
 222    --  Advances Ptr to end of line or next non-blank using Skip_Spaces. Then
 223    --  attempts to scan out a recognized keyword. if a recognized keyword is
 224    --  found, sets Ptr past it, and returns the code for the keyword, if not,
 225    --  then Ptr is left unchanged pointing to a non-blank character or to the
 226    --  end of the line.
 227
 228    function Symbol_Scanned return Boolean;
 229    --  On entry, Start_Sym is set to the first character of an identifier
 230    --  symbol to be scanned out. On return, End_Sym is set to the last
 231    --  character of the identifier, and the result indicates if the scanned
 232    --  symbol is a valid identifier (True = valid). Ptr is not changed.
 233
 234    procedure Skip_Spaces;
 235    --  Skips Ptr past tabs and spaces to next non-blank, or one character
 236    --  past the end of line.
 237
 238    function Variable_Index (Name : String) return Natural;
 239    --  Returns the index of the variable in the table. If the variable is not
 240    --  found, returns Natural'Last
 241
 242    --------------------
 243    -- At_End_Of_Line --
 244    --------------------
 245
 246    function At_End_Of_Line return Boolean is
 247    begin
 248       Skip_Spaces;
 249
 250       return Ptr > Line_Length
 251         or else
 252           (Ptr < Line_Length and then Line_Buffer (Ptr .. Ptr + 1) = "--");
 253    end At_End_Of_Line;
 254
 255    -----------
 256    -- Error --
 257    -----------
 258
 259    procedure Error (Msg : String) is
 260       L : constant String := Natural'Image (Infile.Line_Num);
 261       C : constant String := Natural'Image (Ptr);
 262
 263    begin
 264       Put (Standard_Error, Current_File_Name.all);
 265       Put (Standard_Error, ':');
 266       Put (Standard_Error, L (2 .. L'Length));
 267       Put (Standard_Error, ':');
 268       Put (Standard_Error, C (2 .. C'Length));
 269       Put (Standard_Error, ": ");
 270
 271       Put_Line (Standard_Error, Msg);
 272       Num_Errors := Num_Errors + 1;
 273    end Error;
 274
 275    --------------------
 276    -- Eval_Condition --
 277    --------------------
 278
 279    function Eval_Condition
 280      (Parenthesis : Natural := 0;
 281       Do_Eval     : Boolean := True)
 282       return        Boolean
 283    is
 284       Symbol_Is_True : Boolean := False; -- init to avoid warning
 285       K              : Keyword;
 286
 287    begin
 288       --  Find the next subexpression
 289
 290       K := Scan_Keyword;
 291
 292       case K is
 293          when K_None =>
 294             Symbol_Is_True := Eval_Symbol (Do_Eval);
 295
 296          when K_Not =>
 297
 298             --  Not applies to the next subexpression (either a simple
 299             --  evaluation like  A or A'Defined, or a parenthesis expression)
 300
 301             K := Scan_Keyword;
 302
 303             if K = K_Open_Paren then
 304                Symbol_Is_True := not Eval_Condition (Parenthesis + 1, Do_Eval);
 305
 306             elsif K = K_None then
 307                Symbol_Is_True := not Eval_Symbol (Do_Eval);
 308
 309             else
 310                Ptr := Start_Sym;  --  Puts the keyword back
 311             end if;
 312
 313          when K_Open_Paren =>
 314             Symbol_Is_True := Eval_Condition (Parenthesis + 1, Do_Eval);
 315
 316          when others =>
 317             Ptr := Start_Sym;
 318             Error ("invalid syntax in preprocessor line");
 319             raise Expression_Error;
 320       end case;
 321
 322       --  Do we have a compound expression with AND, OR, ...
 323
 324       K := Scan_Keyword;
 325       case K is
 326          when K_None =>
 327             if not At_End_Of_Line then
 328                Error ("Invalid Syntax at end of line");
 329                raise Expression_Error;
 330             end if;
 331
 332             if Parenthesis /= 0 then
 333                Error ("Unmatched opening parenthesis");
 334                raise Expression_Error;
 335             end if;
 336
 337             return Symbol_Is_True;
 338
 339          when K_Then =>
 340             if Parenthesis /= 0 then
 341                Error ("Unmatched opening parenthesis");
 342                raise Expression_Error;
 343             end if;
 344
 345             return Symbol_Is_True;
 346
 347          when K_Close_Paren =>
 348             if Parenthesis = 0 then
 349                Error ("Unmatched closing parenthesis");
 350                raise Expression_Error;
 351             end if;
 352
 353             return Symbol_Is_True;
 354
 355          when K_And =>
 356             return Symbol_Is_True and Eval_Condition (Parenthesis, Do_Eval);
 357
 358          when K_Andthen =>
 359             if not Symbol_Is_True then
 360
 361                --  Just skip the symbols for the remaining part
 362
 363                Symbol_Is_True := Eval_Condition (Parenthesis, False);
 364                return False;
 365
 366             else
 367                return Eval_Condition (Parenthesis, Do_Eval);
 368             end if;
 369
 370          when K_Or =>
 371             return Symbol_Is_True or Eval_Condition (Parenthesis, Do_Eval);
 372
 373          when K_Orelse =>
 374             if Symbol_Is_True then
 375
 376                --  Just skip the symbols for the remaining part
 377
 378                Symbol_Is_True := Eval_Condition (Parenthesis, False);
 379                return True;
 380
 381             else
 382                return Eval_Condition (Parenthesis, Do_Eval);
 383             end if;
 384
 385          when others =>
 386             Error ("invalid syntax in preprocessor line");
 387             raise Expression_Error;
 388       end case;
 389
 390    end Eval_Condition;
 391
 392    -----------------
 393    -- Eval_Symbol --
 394    -----------------
 395
 396    function Eval_Symbol (Do_Eval : Boolean) return Boolean is
 397       Sym            : constant String := Line_Buffer (Start_Sym .. End_Sym);
 398       K              : Keyword;
 399       Index          : Natural;
 400       Symbol_Defined : Boolean := False;
 401       Symbol_Is_True : Boolean := False;
 402
 403    begin
 404       --  Read the symbol
 405
 406       Skip_Spaces;
 407       Start_Sym := Ptr;
 408
 409       if not Symbol_Scanned then
 410          Error ("invalid symbol name");
 411          raise Expression_Error;
 412       end if;
 413
 414       Ptr := End_Sym + 1;
 415
 416       --  Test if we have a simple test (A) or a more complicated one
 417       --  (A'Defined)
 418
 419       K := Scan_Keyword;
 420
 421       if K /= K_Defined and then K /= K_Equal then
 422          Ptr := Start_Sym;  --  Puts the keyword back
 423       end if;
 424
 425       Index := Variable_Index (Sym);
 426
 427       case K is
 428          when K_Defined =>
 429             Symbol_Defined := Index /= Natural'Last;
 430             Symbol_Is_True := Symbol_Defined;
 431
 432          when K_Equal =>
 433
 434             --  Read the second part of the statement
 435
 436             Skip_Spaces;
 437             Start_Sym := Ptr;
 438
 439             if not Symbol_Scanned
 440               and then End_Sym < Start_Sym
 441             then
 442                Error ("No right part for the equality test");
 443                raise Expression_Error;
 444             end if;
 445
 446             Ptr := End_Sym + 1;
 447
 448             --  If the variable was not found
 449
 450             if Do_Eval then
 451                if Index = Natural'Last then
 452                   if not Undefined_Is_False then
 453                      Error ("symbol name """ & Sym &
 454                             """ is not defined in definitions file");
 455                   end if;
 456
 457                else
 458                   declare
 459                      Right : constant String
 460                        := Line_Buffer (Start_Sym .. End_Sym);
 461                      Index_R : Natural;
 462                   begin
 463                      if Right (Right'First) = '"' then
 464                         Symbol_Is_True :=
 465                           Matching_Strings
 466                           (Values (Index).all,
 467                            Right (Right'First + 1 .. Right'Last - 1));
 468                      else
 469                         Index_R := Variable_Index (Right);
 470                         if Index_R = Natural'Last then
 471                            Error ("Variable " & Right & " in test is "
 472                                   & "not defined");
 473                            raise Expression_Error;
 474                         else
 475                            Symbol_Is_True :=
 476                              Matching_Strings (Values (Index).all,
 477                                                Values (Index_R).all);
 478                         end if;
 479                      end if;
 480                   end;
 481                end if;
 482             end if;
 483
 484          when others =>
 485
 486             if Index = Natural'Last then
 487
 488                Symbol_Defined := False;
 489                if Do_Eval and then not Symbol_Defined then
 490                   if Undefined_Is_False then
 491                      Symbol_Defined := True;
 492                      Symbol_Is_True := False;
 493
 494                   else
 495                      Error
 496                        ("symbol name """ & Sym &
 497                         """ is not defined in definitions file");
 498                   end if;
 499                end if;
 500
 501             elsif not Do_Eval then
 502                Symbol_Is_True := True;
 503
 504             elsif Matching_Strings (Values (Index).all, "True") then
 505                Symbol_Is_True := True;
 506
 507             elsif Matching_Strings (Values (Index).all, "False") then
 508                Symbol_Is_True := False;
 509
 510             else
 511                Error ("symbol value is not True or False");
 512                Symbol_Is_True := False;
 513             end if;
 514
 515       end case;
 516
 517       return Symbol_Is_True;
 518    end Eval_Symbol;
 519
 520    ---------------
 521    -- Help_Page --
 522    ---------------
 523
 524    procedure Help_Page is
 525    begin
 526       Put_Line (Standard_Error,
 527                 "GNAT Preprocessor " &
 528                 Gnatvsn.Gnat_Version_String &
 529                 " Copyright 1996-2002 Free Software Foundation, Inc.");
 530       Put_Line (Standard_Error,
 531                 "Usage: gnatprep [-bcrsu] [-Dsymbol=value] infile " &
 532                 "outfile [deffile]");
 533       New_Line (Standard_Error);
 534       Put_Line (Standard_Error, "  infile     Name of the input file");
 535       Put_Line (Standard_Error, "  outfile    Name of the output file");
 536       Put_Line (Standard_Error, "  deffile    Name of the definition file");
 537       New_Line (Standard_Error);
 538       Put_Line (Standard_Error, "gnatprep switches:");
 539       Put_Line (Standard_Error, "   -b  Replace preprocessor lines by " &
 540                 "blank lines");
 541       Put_Line (Standard_Error, "   -c  Keep preprocessor lines as comments");
 542       Put_Line (Standard_Error, "   -D  Associate symbol with value");
 543       Put_Line (Standard_Error, "   -r  Generate Source_Reference pragma");
 544       Put_Line (Standard_Error, "   -s  Print a sorted list of symbol names " &
 545                 "and values");
 546       Put_Line (Standard_Error, "   -u  Treat undefined symbols as FALSE");
 547       New_Line (Standard_Error);
 548    end Help_Page;
 549
 550    -----------
 551    -- Image --
 552    -----------
 553
 554    function Image (N : Natural) return String is
 555       Result : constant String := Natural'Image (N);
 556    begin
 557       return Result (Result'First + 1 .. Result'Last);
 558    end Image;
 559
 560    --------------------------
 561    -- Is_Preprocessor_Line --
 562    --------------------------
 563
 564    function Is_Preprocessor_Line return Boolean is
 565    begin
 566       Ptr := 1;
 567
 568       while Ptr <= Line_Length loop
 569          if Line_Buffer (Ptr) = '#' then
 570             Ptr := Ptr + 1;
 571             return True;
 572
 573          elsif Line_Buffer (Ptr) > ' ' then
 574             return False;
 575
 576          else
 577             Ptr := Ptr + 1;
 578          end if;
 579       end loop;
 580
 581       return False;
 582    end Is_Preprocessor_Line;
 583
 584    ----------------------
 585    -- Matching_Strings --
 586    ----------------------
 587
 588    function Matching_Strings (S1, S2 : String) return Boolean is
 589       S2_Index : Integer := S2'First;
 590
 591    begin
 592       for S1_Index in S1'Range loop
 593
 594          if To_Upper (S1 (S1_Index)) /= To_Upper (S2 (S2_Index)) then
 595             return False;
 596
 597          else
 598             if S2 (S2_Index) = '"'
 599               and then S2_Index < S2'Last
 600               and then S2 (S2_Index + 1) = '"'
 601             then
 602                S2_Index := S2_Index + 2;
 603             else
 604                S2_Index := S2_Index + 1;
 605             end if;
 606
 607             --  If S2 was too short then
 608
 609             if S2_Index > S2'Last and then S1_Index < S1'Last then
 610                return False;
 611             end if;
 612          end if;
 613       end loop;
 614
 615       return S2_Index = S2'Last + 1;
 616    end Matching_Strings;
 617
 618    -------------
 619    -- No_Junk --
 620    -------------
 621
 622    procedure No_Junk is
 623    begin
 624       Skip_Spaces;
 625
 626       if Ptr = Line_Length
 627         or else (Ptr < Line_Length
 628                    and then Line_Buffer (Ptr .. Ptr + 1) /= "--")
 629       then
 630          Error ("extraneous text on preprocessor line ignored");
 631       end if;
 632    end No_Junk;
 633
 634    -------------------
 635    -- OK_Identifier --
 636    -------------------
 637
 638    function OK_Identifier (S : String) return Boolean is
 639       P : Natural := S'First;
 640
 641    begin
 642       if S'Length /= 0 and then S (P) = Character'Val (39) then -- '''
 643          P := P + 1;
 644       end if;
 645
 646       if S'Length = 0
 647         or else not Is_Letter (S (P))
 648       then
 649          return False;
 650
 651       else
 652          while P <= S'Last loop
 653             if Is_Letter (S (P)) or Is_Digit (S (P)) then
 654                null;
 655
 656             elsif S (P) = '_'
 657               and then P < S'Last
 658               and then S (P + 1) /= '_'
 659             then
 660                null;
 661
 662             else
 663                return False;
 664             end if;
 665
 666             P := P + 1;
 667          end loop;
 668
 669          return True;
 670       end if;
 671    end OK_Identifier;
 672
 673    --------------------
 674    -- Parse_Def_File --
 675    --------------------
 676
 677    procedure Parse_Def_File is
 678    begin
 679       Open (Deffile, In_File, Deffile_Name.all);
 680
 681       --  Initialize data for procedure Error
 682
 683       Infile.Line_Num := 0;
 684       Current_File_Name := Deffile_Name;
 685
 686       --  Loop through lines in symbol definitions file
 687
 688       while not End_Of_File (Deffile) loop
 689          Get_Line (Deffile, Line_Buffer, Line_Length);
 690          Infile.Line_Num := Infile.Line_Num + 1;
 691
 692          Ptr := 1;
 693          Skip_Spaces;
 694
 695          if Ptr > Line_Length
 696            or else (Ptr < Line_Length
 697                     and then
 698                     Line_Buffer (Ptr .. Ptr + 1) = "--")
 699          then
 700             goto Continue;
 701          end if;
 702
 703          Start_Sym := Ptr;
 704
 705          if not Symbol_Scanned then
 706             Error ("invalid symbol identifier """ &
 707                    Line_Buffer (Start_Sym .. End_Sym) &
 708                    '"');
 709             goto Continue;
 710          end if;
 711
 712          Ptr := End_Sym + 1;
 713          Skip_Spaces;
 714
 715          if Ptr >= Line_Length
 716            or else Line_Buffer (Ptr .. Ptr + 1) /= ":="
 717          then
 718             Error ("missing "":="" in symbol definition line");
 719             goto Continue;
 720          end if;
 721
 722          Ptr := Ptr + 2;
 723          Skip_Spaces;
 724
 725          Num_Syms := Num_Syms + 1;
 726          Symbols (Num_Syms) := new String'(Line_Buffer (Start_Sym .. End_Sym));
 727
 728          Start_Sym := Ptr;
 729          End_Sym := Ptr - 1;
 730
 731          if At_End_Of_Line then
 732             null;
 733
 734          elsif Line_Buffer (Start_Sym) = '"' then
 735             End_Sym := End_Sym + 1;
 736             loop
 737                End_Sym := End_Sym + 1;
 738
 739                if End_Sym > Line_Length then
 740                   Error ("no closing quote for string constant");
 741                   goto Continue;
 742
 743                elsif End_Sym < Line_Length
 744                  and then Line_Buffer (End_Sym .. End_Sym + 1) = """"""
 745                then
 746                   End_Sym := End_Sym + 1;
 747
 748                elsif Line_Buffer (End_Sym) = '"' then
 749                   exit;
 750                end if;
 751             end loop;
 752
 753          else
 754             End_Sym := Ptr - 1;
 755
 756             while End_Sym < Line_Length
 757               and then (Is_Alphanumeric (Line_Buffer (End_Sym + 1))
 758                         or else
 759                         Line_Buffer (End_Sym + 1) = '_'
 760                         or else
 761                         Line_Buffer (End_Sym + 1) = '.')
 762             loop
 763                End_Sym := End_Sym + 1;
 764             end loop;
 765
 766             Ptr := End_Sym + 1;
 767
 768             if not At_End_Of_Line then
 769                Error ("incorrect symbol value syntax");
 770                goto Continue;
 771             end if;
 772          end if;
 773
 774          Values (Num_Syms) := new String'(Line_Buffer (Start_Sym .. End_Sym));
 775
 776          <<Continue>>
 777          null;
 778       end loop;
 779
 780    exception
 781       --  Could not open the file
 782
 783       when Name_Error =>
 784          Put_Line (Standard_Error, "cannot open " & Deffile_Name.all);
 785          raise Fatal_Error;
 786    end Parse_Def_File;
 787
 788    ------------------
 789    -- Scan_Keyword --
 790    ------------------
 791
 792    function Scan_Keyword return Keyword is
 793       Kptr : constant Natural := Ptr;
 794
 795    begin
 796       Skip_Spaces;
 797       Start_Sym := Ptr;
 798
 799       if Symbol_Scanned then
 800
 801          --  If the symbol was the last thing on the line, End_Sym will
 802          --  point too far in Line_Buffer
 803
 804          if End_Sym > Line_Length then
 805             End_Sym := Line_Length;
 806          end if;
 807
 808          Ptr  := End_Sym + 1;
 809
 810          declare
 811             Sym : constant String := Line_Buffer (Start_Sym .. End_Sym);
 812
 813          begin
 814             if    Matching_Strings (Sym, "not") then
 815                return K_Not;
 816
 817             elsif Matching_Strings (Sym, "then") then
 818                return K_Then;
 819
 820             elsif Matching_Strings (Sym, "if") then
 821                return K_If;
 822
 823             elsif Matching_Strings (Sym, "else") then
 824                return K_Else;
 825
 826             elsif Matching_Strings (Sym, "end") then
 827                return K_End;
 828
 829             elsif Matching_Strings (Sym, "elsif") then
 830                return K_Elsif;
 831
 832             elsif Matching_Strings (Sym, "and") then
 833                if Scan_Keyword = K_Then then
 834                   Start_Sym := Kptr;
 835                   return K_Andthen;
 836                else
 837                   Ptr := Start_Sym;  --  Put back the last keyword read
 838                   Start_Sym := Kptr;
 839                   return K_And;
 840                end if;
 841
 842             elsif Matching_Strings (Sym, "or") then
 843                if Scan_Keyword = K_Else then
 844                   Start_Sym := Kptr;
 845                   return K_Orelse;
 846                else
 847                   Ptr := Start_Sym;  --  Put back the last keyword read
 848                   Start_Sym := Kptr;
 849                   return K_Or;
 850                end if;
 851
 852             elsif Matching_Strings (Sym, "'defined") then
 853                return K_Defined;
 854
 855             elsif Matching_Strings (Sym, "include") then
 856                return K_Include;
 857
 858             elsif Sym = "(" then
 859                return K_Open_Paren;
 860
 861             elsif Sym = ")" then
 862                return K_Close_Paren;
 863
 864             elsif Sym = "=" then
 865                return K_Equal;
 866             end if;
 867          end;
 868       end if;
 869
 870       Ptr := Kptr;
 871       return K_None;
 872    end Scan_Keyword;
 873
 874    -----------------
 875    -- Skip_Spaces --
 876    -----------------
 877
 878    procedure Skip_Spaces is
 879    begin
 880       while Ptr <= Line_Length loop
 881          if Line_Buffer (Ptr) /= ' '
 882            and then Line_Buffer (Ptr) /= ASCII.HT
 883          then
 884             return;
 885          else
 886             Ptr := Ptr + 1;
 887          end if;
 888       end loop;
 889    end Skip_Spaces;
 890
 891    --------------------
 892    -- Symbol_Scanned --
 893    --------------------
 894
 895    function Symbol_Scanned return Boolean is
 896    begin
 897       End_Sym := Start_Sym - 1;
 898
 899       case Line_Buffer (End_Sym + 1) is
 900
 901          when '(' | ')' | '=' =>
 902             End_Sym := End_Sym + 1;
 903             return True;
 904
 905          when '"' =>
 906             End_Sym := End_Sym + 1;
 907             while End_Sym < Line_Length loop
 908
 909                if Line_Buffer (End_Sym + 1) = '"' then
 910
 911                   if End_Sym + 2 < Line_Length
 912                     and then Line_Buffer (End_Sym + 2) = '"'
 913                   then
 914                      End_Sym := End_Sym + 2;
 915                   else
 916                      exit;
 917                   end if;
 918                else
 919                   End_Sym := End_Sym + 1;
 920                end if;
 921             end loop;
 922
 923             if End_Sym >= Line_Length then
 924                Error ("Invalid string ");
 925                raise Expression_Error;
 926             end if;
 927
 928             End_Sym := End_Sym + 1;
 929             return False;
 930
 931          when ''' =>
 932             End_Sym := End_Sym + 1;
 933
 934          when others =>
 935             null;
 936       end case;
 937
 938       while End_Sym < Line_Length
 939         and then (Is_Alphanumeric (Line_Buffer (End_Sym + 1))
 940                    or else Line_Buffer (End_Sym + 1) = '_')
 941       loop
 942          End_Sym := End_Sym + 1;
 943       end loop;
 944
 945       return OK_Identifier (Line_Buffer (Start_Sym .. End_Sym));
 946    end Symbol_Scanned;
 947
 948    --------------------
 949    -- Variable_Index --
 950    --------------------
 951
 952    function Variable_Index (Name : String) return Natural is
 953    begin
 954       for J in 1 .. Num_Syms loop
 955          if Matching_Strings (Symbols (J).all, Name) then
 956             return J;
 957          end if;
 958       end loop;
 959
 960       return Natural'Last;
 961    end Variable_Index;
 962
 963 --  Start of processing for GNATprep
 964
 965 begin
 966
 967    --  Parse the switches
 968
 969    loop
 970       case GNAT.Command_Line.Getopt ("D: b c r s u") is
 971          when ASCII.NUL =>
 972             exit;
 973
 974          when 'D' =>
 975             declare
 976                S : String := GNAT.Command_Line.Parameter;
 977                Index : Natural;
 978
 979             begin
 980                Index := Ada.Strings.Fixed.Index (S, "=");
 981
 982                if Index = 0 then
 983                   Num_Syms := Num_Syms + 1;
 984                   Symbols (Num_Syms) := new String'(S);
 985                   Values (Num_Syms) := new String'("True");
 986
 987                else
 988                   Num_Syms := Num_Syms + 1;
 989                   Symbols (Num_Syms) := new String'(S (S'First .. Index - 1));
 990                   Values (Num_Syms) := new String'(S (Index + 1 .. S'Last));
 991                end if;
 992             end;
 993
 994          when 'b' =>
 995             Blank_Deleted_Lines := True;
 996
 997          when 'c' =>
 998             Opt_Comment_Deleted_Lines := True;
 999
1000          when 'r' =>
1001             Source_Ref_Pragma := True;
1002
1003          when 's' =>
1004             List_Symbols := True;
1005
1006          when 'u' =>
1007             Undefined_Is_False := True;
1008
1009          when others =>
1010             raise Usage_Error;
1011       end case;
1012    end loop;
1013
1014    --  Get the file names
1015
1016    loop
1017       declare
1018          S : constant String := GNAT.Command_Line.Get_Argument;
1019
1020       begin
1021          exit when S'Length = 0;
1022
1023          if Infile.Name = null then
1024             Infile.Name := new String'(S);
1025          elsif Outfile_Name = null then
1026             Outfile_Name := new String'(S);
1027          elsif Deffile_Name = null then
1028             Deffile_Name := new String'(S);
1029          else
1030             raise Usage_Error;
1031          end if;
1032       end;
1033    end loop;
1034
1035    --  Test we had all the arguments needed
1036
1037    if Infile.Name = null
1038      or else Outfile_Name = null
1039    then
1040       raise Usage_Error;
1041    end if;
1042
1043    if Source_Ref_Pragma and (not Opt_Comment_Deleted_Lines) then
1044       Blank_Deleted_Lines := True;
1045    end if;
1046
1047    --  Get symbol definitions
1048
1049    if Deffile_Name /= null then
1050       Parse_Def_File;
1051    end if;
1052
1053    if Num_Errors > 0 then
1054       raise Fatal_Error;
1055
1056    elsif List_Symbols and then Num_Syms > 0 then
1057       List_Symbols_Case : declare
1058
1059          function Lt (Op1, Op2 : Natural) return Boolean;
1060          --  Comparison routine for sort call
1061
1062          procedure Move (From : Natural; To : Natural);
1063          --  Move routine for sort call
1064
1065          function Lt (Op1, Op2 : Natural) return Boolean is
1066             L1   : constant Natural := Symbols (Op1)'Length;
1067             L2   : constant Natural := Symbols (Op2)'Length;
1068             MinL : constant Natural := Natural'Min (L1, L2);
1069
1070             C1, C2 : Character;
1071
1072          begin
1073             for J in 0 .. MinL - 1 loop
1074                C1 := To_Upper (Symbols (Op1).all (Symbols (Op1)'First + J));
1075                C2 := To_Upper (Symbols (Op2).all (Symbols (Op2)'First + J));
1076
1077                if C1 < C2 then
1078                   return True;
1079
1080                elsif C1 > C2 then
1081                   return False;
1082                end if;
1083             end loop;
1084
1085             return L1 < L2;
1086          end Lt;
1087
1088          procedure Move (From : Natural; To : Natural) is
1089          begin
1090             Symbols (To) := Symbols (From);
1091             Values  (To) := Values  (From);
1092          end Move;
1093
1094          package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt);
1095
1096          Max_L : Natural;
1097          --  Maximum length of any symbol
1098
1099       --  Start of processing for List_Symbols_Case
1100
1101       begin
1102          Sort_Syms.Sort (Num_Syms);
1103
1104          Max_L := 7;
1105          for J in 1 .. Num_Syms loop
1106             Max_L := Natural'Max (Max_L, Symbols (J)'Length);
1107          end loop;
1108
1109          New_Line;
1110          Put ("Symbol");
1111
1112          for J in 1 .. Max_L - 5 loop
1113             Put (' ');
1114          end loop;
1115
1116          Put_Line ("Value");
1117
1118          Put ("------");
1119
1120          for J in 1 .. Max_L - 5 loop
1121             Put (' ');
1122          end loop;
1123
1124          Put_Line ("------");
1125
1126          for J in 1 .. Num_Syms loop
1127             Put (Symbols (J).all);
1128
1129             for K in 1 .. Max_L - Symbols (J)'Length + 1 loop
1130                Put (' ');
1131             end loop;
1132
1133             Put_Line (Values (J).all);
1134          end loop;
1135
1136          New_Line;
1137       end List_Symbols_Case;
1138    end if;
1139
1140    --  Open files and initialize preprocessing
1141
1142    begin
1143       Open (Infile.File,  In_File,  Infile.Name.all);
1144
1145    exception
1146       when Name_Error =>
1147          Put_Line (Standard_Error, "cannot open " & Infile.Name.all);
1148          raise Fatal_Error;
1149    end;
1150
1151    begin
1152       Create (Outfile, Out_File, Outfile_Name.all);
1153
1154    exception
1155       when Name_Error =>
1156          Put_Line (Standard_Error, "cannot create " & Outfile_Name.all);
1157          raise Fatal_Error;
1158    end;
1159
1160    Infile.Line_Num := 0;
1161    Current_File_Name := Infile.Name;
1162
1163    PP_Depth := 0;
1164    PP (0).Deleting := False;
1165
1166    --  We return here after we start reading an include file and after
1167    --  we have finished reading an include file.
1168
1169    <<Read_In_File>>
1170
1171    --  If we generate Source_Reference pragmas, then generate one
1172    --  either with line number 1 for a newly included file, or
1173    --  with the number of the next line when we have returned to the
1174    --  including file.
1175
1176    if Source_Ref_Pragma then
1177       Put_Line
1178         (Outfile, "pragma Source_Reference (" &
1179            Image (Infile.Line_Num + 1) &
1180            ", """ & Infile.Name.all & """);");
1181    end if;
1182
1183    --  Loop through lines in input file
1184
1185    while not End_Of_File (Infile.File) loop
1186       Get_Line (Infile.File, Line_Buffer, Line_Length);
1187       Infile.Line_Num := Infile.Line_Num + 1;
1188
1189       --  Handle preprocessor line
1190
1191       if Is_Preprocessor_Line then
1192          K := Scan_Keyword;
1193
1194          case K is
1195
1196             --  Include file
1197
1198             when K_Include =>
1199                --  Ignore if Deleting is True
1200
1201                if PP (PP_Depth).Deleting then
1202                   goto Output;
1203                end if;
1204
1205                Skip_Spaces;
1206
1207                if Ptr >= Line_Length then
1208                   Error ("no file to include");
1209
1210                elsif Line_Buffer (Ptr) /= '"' then
1211                   Error
1212                     ("file to include must be specified as a literal string");
1213
1214                else
1215                   declare
1216                      Start_File : constant Positive := Ptr + 1;
1217
1218                   begin
1219                      Ptr := Line_Length;
1220
1221                      while Line_Buffer (Ptr) = ' '
1222                        or else Line_Buffer (Ptr) = ASCII.HT
1223                      loop
1224                         Ptr := Ptr - 1;
1225                      end loop;
1226
1227                      if Ptr <= Start_File
1228                        or else Line_Buffer (Ptr) /= '"'
1229                      then
1230                         Error ("no string literal for included file");
1231
1232                      else
1233                         if Infile.Next = null then
1234                            Infile.Next := new Input;
1235                            Infile.Next.Prev := Infile;
1236                         end if;
1237
1238                         Infile := Infile.Next;
1239                         Infile.Name :=
1240                           new String'(Line_Buffer (Start_File .. Ptr - 1));
1241
1242                         --  Check for circularity: an file including itself,
1243                         --  either directly or indirectly.
1244
1245                         declare
1246                            File : Input_Ptr := Infile.Prev;
1247
1248                         begin
1249                            while File /= null
1250                              and then File.Name.all /= Infile.Name.all
1251                            loop
1252                               File := File.Prev;
1253                            end loop;
1254
1255                            if File /= null then
1256                               Infile := Infile.Prev;
1257                               Error ("circularity in included files");
1258
1259                               while File.Prev /= null loop
1260                                  File := File.Prev;
1261                               end loop;
1262
1263                               while File /= Infile.Next loop
1264                                  Error ('"' & File.Name.all &
1265                                           """ includes """ &
1266                                           File.Next.Name.all & '"');
1267                                  File := File.Next;
1268                               end loop;
1269
1270                            else
1271                               --  We have a file name and no circularity.
1272                               --  Open the file and record an error if the
1273                               --  file cannot be opened.
1274
1275                               begin
1276                                  Open (Infile.File, In_File, Infile.Name.all);
1277                                  Current_File_Name := Infile.Name;
1278                                  Infile.Line_Num := 0;
1279
1280                                  --  If we use Source_Reference pragma,
1281                                  --  we need to output one for this new file.
1282                                  goto Read_In_File;
1283
1284                               exception
1285                                  when Name_Error =>
1286
1287                                     --  We need to set the input file to
1288                                     --  the including file, so that the
1289                                     --  line number is correct when reporting
1290                                     --  the error.
1291
1292                                     Infile := Infile.Prev;
1293                                     Error ("cannot open """ &
1294                                              Infile.Next.Name.all & '"');
1295                               end;
1296                            end if;
1297                         end;
1298                      end if;
1299                   end;
1300                end if;
1301
1302             --  If/Elsif processing
1303
1304             when K_If | K_Elsif =>
1305
1306                --  If differs from elsif only in that an initial stack entry
1307                --  must be made for the new if range. We set the match seen
1308                --  entry to a copy of the deleting status in the range above
1309                --  us. If we are deleting in the range above us, then we want
1310                --  all the branches of the nested #if to delete.
1311
1312                if K = K_If then
1313                   PP_Depth := PP_Depth + 1;
1314                   PP (PP_Depth) :=
1315                     (If_Line    => Infile.Line_Num,
1316                      If_Name    => Infile.Name,
1317                      Else_Line  => 0,
1318                      Deleting   => False,
1319                      Match_Seen => PP (PP_Depth - 1).Deleting);
1320
1321                elsif PP_Depth = 0 then
1322                   Error ("no matching #if for this #elsif");
1323                   goto Output;
1324
1325                end if;
1326
1327                PP (PP_Depth).Deleting := True;
1328
1329                if not PP (PP_Depth).Match_Seen
1330                  and then Eval_Condition = True
1331                then
1332
1333                   --  Case of match and no match yet in this #if
1334
1335                   PP (PP_Depth).Deleting := False;
1336                   PP (PP_Depth).Match_Seen := True;
1337                   No_Junk;
1338                end if;
1339
1340             --  Processing for #else
1341
1342             when K_Else =>
1343
1344                if PP_Depth = 0 then
1345                   Error ("no matching #if for this #else");
1346
1347                elsif PP (PP_Depth).Else_Line /= 0 then
1348                   Error ("duplicate #else line (previous was on line" &
1349                           Natural'Image (PP (PP_Depth).Else_Line)     &
1350                           ")");
1351
1352                else
1353                   PP (PP_Depth).Else_Line := Infile.Line_Num;
1354                   PP (PP_Depth).Deleting := PP (PP_Depth).Match_Seen;
1355                end if;
1356
1357                No_Junk;
1358
1359             --  Process for #end
1360
1361             when K_End =>
1362
1363                if PP_Depth = 0 then
1364                   Error ("no matching #if for this #end");
1365
1366                else
1367                   Skip_Spaces;
1368
1369                   if Scan_Keyword /= K_If then
1370                      Error ("expected if after #end");
1371                      Ptr := Line_Length + 1;
1372                   end if;
1373
1374                   Skip_Spaces;
1375
1376                   if Ptr > Line_Length
1377                     or else Line_Buffer (Ptr) /= ';'
1378                   then
1379                      Error ("missing semicolon after #end if");
1380                   else
1381                      Ptr := Ptr + 1;
1382                   end if;
1383
1384                   No_Junk;
1385
1386                   PP_Depth := PP_Depth - 1;
1387                end if;
1388
1389             when others =>
1390                Error ("invalid preprocessor keyword syntax");
1391
1392          end case;
1393
1394       --  Handle symbol substitution
1395
1396       --  Substitution is not allowed in string (which we simply skip),
1397       --  but is allowed inside character constants. The last case is
1398       --  because there is no way to know whether the user want to
1399       --  substitute the name of an attribute ('Min or 'Max for instance)
1400       --  or actually meant to substitue a character ('$name' is probably
1401       --  a character constant, but my_type'$name'Min is probably an
1402       --  attribute, with $name=Base)
1403
1404       else
1405          Ptr := 1;
1406
1407          while Ptr < Line_Length loop
1408             exit when At_End_Of_Line;
1409
1410             case Line_Buffer (Ptr) is
1411
1412                when ''' =>
1413
1414                   --  Two special cases here:
1415                   --  '"' => we don't want the " sign to appear as belonging
1416                   --     to a string.
1417                   --  '$' => this is obviously not a substitution, just skip it
1418
1419                   if Ptr < Line_Length - 1
1420                     and then Line_Buffer (Ptr + 1) = '"'
1421                   then
1422                      Ptr := Ptr + 2;
1423                   elsif Ptr < Line_Length - 2
1424                     and then Line_Buffer (Ptr + 1 .. Ptr + 2) = "$'"
1425                   then
1426                      Ptr := Ptr + 2;
1427                   end if;
1428
1429                when '"' =>
1430
1431                   --  The special case of "" inside the string is easy to
1432                   --  handle: just ignore them. The second one will be seen
1433                   --  as the beginning of a second string
1434
1435                   Ptr := Ptr + 1;
1436                   while Ptr < Line_Length
1437                     and then Line_Buffer (Ptr) /= '"'
1438                   loop
1439                      Ptr := Ptr + 1;
1440                   end loop;
1441
1442                when '$' =>
1443
1444                   --  $ found, so scan out possible following symbol
1445
1446                   Start_Sym := Ptr + 1;
1447
1448                   if Symbol_Scanned then
1449
1450                      --  Look up symbol in table and if found do replacement
1451
1452                      for J in 1 .. Num_Syms loop
1453                         if Matching_Strings
1454                           (Symbols (J).all, Line_Buffer (Start_Sym .. End_Sym))
1455                         then
1456                            declare
1457                               OldL : constant Positive :=
1458                                        End_Sym - Start_Sym + 2;
1459                               NewL : constant Positive := Values (J)'Length;
1460                               AdjL : constant Integer  := NewL - OldL;
1461                               NewP : constant Positive := Ptr + NewL - 1;
1462
1463                            begin
1464                               Line_Buffer (NewP + 1 .. Line_Length + AdjL) :=
1465                                 Line_Buffer (End_Sym + 1 .. Line_Length);
1466                               Line_Buffer (Ptr .. NewP) := Values (J).all;
1467
1468                               Ptr := NewP;
1469                               Line_Length := Line_Length + AdjL;
1470                            end;
1471
1472                            exit;
1473                         end if;
1474                      end loop;
1475                   end if;
1476
1477                when others =>
1478                   null;
1479
1480             end case;
1481             Ptr := Ptr + 1;
1482          end loop;
1483       end if;
1484
1485       --  Here after dealing with preprocessor line, output current line
1486
1487       <<Output>>
1488
1489       if Is_Preprocessor_Line or else PP (PP_Depth).Deleting then
1490          if Blank_Deleted_Lines then
1491             New_Line (Outfile);
1492
1493          elsif Opt_Comment_Deleted_Lines then
1494             if Line_Length = 0 then
1495                Put_Line (Outfile, "--!");
1496             else
1497                Put (Outfile, "--! ");
1498                Put_Line (Outfile, Line_Buffer (1 .. Line_Length));
1499             end if;
1500          end if;
1501
1502       else
1503          Put_Line (Outfile, Line_Buffer (1 .. Line_Length));
1504       end if;
1505    end loop;
1506
1507    --  If we have finished reading an included file, close it and continue
1508    --  with the next line of the including file.
1509
1510    if Infile.Prev /= null then
1511       Close (Infile.File);
1512       Infile := Infile.Prev;
1513       Current_File_Name := Infile.Name;
1514       goto Read_In_File;
1515    end if;
1516
1517    for J in 1 .. PP_Depth loop
1518       if PP (J).If_Name = Infile.Name then
1519          Error ("no matching #end for #if at line" &
1520                 Natural'Image (PP (J).If_Line));
1521       else
1522          Error ("no matching #end for #if at line" &
1523                 Natural'Image (PP (J).If_Line) &
1524                 " of file """ & PP (J).If_Name.all & '"');
1525       end if;
1526    end loop;
1527
1528    if Num_Errors = 0 then
1529       Close (Outfile);
1530       Set_Exit_Status (0);
1531    else
1532       Delete (Outfile);
1533       Set_Exit_Status (1);
1534    end if;
1535
1536 exception
1537    when Usage_Error =>
1538       Help_Page;
1539       Set_Exit_Status (1);
1540
1541    when GNAT.Command_Line.Invalid_Parameter =>
1542       Put_Line (Standard_Error, "No parameter given for -"
1543                 & GNAT.Command_Line.Full_Switch);
1544       Help_Page;
1545       Set_Exit_Status (1);
1546
1547    when  GNAT.Command_Line.Invalid_Switch =>
1548       Put_Line (Standard_Error, "Invalid Switch: -"
1549                 & GNAT.Command_Line.Full_Switch);
1550       Help_Page;
1551       Set_Exit_Status (1);
1552
1553    when Fatal_Error =>
1554       Set_Exit_Status (1);
1555
1556    when Expression_Error =>
1557       Set_Exit_Status (1);
1558
1559 end GNATprep;