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