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