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