gcc/ada/prep.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                                 P R E P                                  --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2002-2010, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Csets;    use Csets;
  27 with Err_Vars; use Err_Vars;
  28 with Opt;      use Opt;
  29 with Osint;    use Osint;
  30 with Output;   use Output;
  31 with Scans;    use Scans;
  32 with Snames;   use Snames;
  33 with Sinput;
  34 with Stringt;  use Stringt;
  35 with Table;
  36
  37 with GNAT.Heap_Sort_G;
  38
  39 package body Prep is
  40
  41    use Symbol_Table;
  42
  43    type Token_Name_Array is array (Token_Type) of Name_Id;
  44    Token_Names : constant Token_Name_Array :=
  45      (Tok_Abort     => Name_Abort,
  46       Tok_Abs       => Name_Abs,
  47       Tok_Abstract  => Name_Abstract,
  48       Tok_Accept    => Name_Accept,
  49       Tok_Aliased   => Name_Aliased,
  50       Tok_All       => Name_All,
  51       Tok_Array     => Name_Array,
  52       Tok_And       => Name_And,
  53       Tok_At        => Name_At,
  54       Tok_Begin     => Name_Begin,
  55       Tok_Body      => Name_Body,
  56       Tok_Case      => Name_Case,
  57       Tok_Constant  => Name_Constant,
  58       Tok_Declare   => Name_Declare,
  59       Tok_Delay     => Name_Delay,
  60       Tok_Delta     => Name_Delta,
  61       Tok_Digits    => Name_Digits,
  62       Tok_Else      => Name_Else,
  63       Tok_Elsif     => Name_Elsif,
  64       Tok_End       => Name_End,
  65       Tok_Entry     => Name_Entry,
  66       Tok_Exception => Name_Exception,
  67       Tok_Exit      => Name_Exit,
  68       Tok_For       => Name_For,
  69       Tok_Function  => Name_Function,
  70       Tok_Generic   => Name_Generic,
  71       Tok_Goto      => Name_Goto,
  72       Tok_If        => Name_If,
  73       Tok_Is        => Name_Is,
  74       Tok_Limited   => Name_Limited,
  75       Tok_Loop      => Name_Loop,
  76       Tok_Mod       => Name_Mod,
  77       Tok_New       => Name_New,
  78       Tok_Null      => Name_Null,
  79       Tok_Of        => Name_Of,
  80       Tok_Or        => Name_Or,
  81       Tok_Others    => Name_Others,
  82       Tok_Out       => Name_Out,
  83       Tok_Package   => Name_Package,
  84       Tok_Pragma    => Name_Pragma,
  85       Tok_Private   => Name_Private,
  86       Tok_Procedure => Name_Procedure,
  87       Tok_Protected => Name_Protected,
  88       Tok_Raise     => Name_Raise,
  89       Tok_Range     => Name_Range,
  90       Tok_Record    => Name_Record,
  91       Tok_Rem       => Name_Rem,
  92       Tok_Renames   => Name_Renames,
  93       Tok_Requeue   => Name_Requeue,
  94       Tok_Return    => Name_Return,
  95       Tok_Reverse   => Name_Reverse,
  96       Tok_Select    => Name_Select,
  97       Tok_Separate  => Name_Separate,
  98       Tok_Subtype   => Name_Subtype,
  99       Tok_Tagged    => Name_Tagged,
 100       Tok_Task      => Name_Task,
 101       Tok_Terminate => Name_Terminate,
 102       Tok_Then      => Name_Then,
 103       Tok_Type      => Name_Type,
 104       Tok_Until     => Name_Until,
 105       Tok_Use       => Name_Use,
 106       Tok_When      => Name_When,
 107       Tok_While     => Name_While,
 108       Tok_With      => Name_With,
 109       Tok_Xor       => Name_Xor,
 110       others        => No_Name);
 111
 112    Already_Initialized : Boolean := False;
 113    --  Used to avoid repetition of the part of the initialisation that needs
 114    --  to be done only once.
 115
 116    Empty_String : String_Id;
 117    --  "", as a string_id
 118
 119    String_False : String_Id;
 120    --  "false", as a string_id
 121
 122    ---------------
 123    -- Behaviour --
 124    ---------------
 125
 126    --  Accesses to procedure specified by procedure Initialize
 127
 128    Error_Msg : Error_Msg_Proc;
 129    --  Report an error
 130
 131    Scan : Scan_Proc;
 132    --  Scan one token
 133
 134    Set_Ignore_Errors : Set_Ignore_Errors_Proc;
 135    --  Indicate if error should be taken into account
 136
 137    Put_Char : Put_Char_Proc;
 138    --  Output one character
 139
 140    New_EOL : New_EOL_Proc;
 141    --  Output an end of line indication
 142
 143    -------------------------------
 144    -- State of the Preprocessor --
 145    -------------------------------
 146
 147    type Pp_State is record
 148       If_Ptr : Source_Ptr;
 149       --  The location of the #if statement.
 150       --  Used to flag #if with no corresponding #end if, at the end.
 151
 152       Else_Ptr : Source_Ptr;
 153       --  The location of the #else statement.
 154       --  Used to detect multiple #else.
 155
 156       Deleting : Boolean;
 157       --  Set to True when the code should be deleted or commented out
 158
 159       Match_Seen : Boolean;
 160       --  Set to True when a condition in an #if or an #elsif is True.
 161       --  Also set to True if Deleting at the previous level is True.
 162       --  Used to decide if Deleting should be set to True in a following
 163       --  #elsif or #else.
 164
 165    end record;
 166
 167    type Pp_Depth is new Nat;
 168
 169    Ground : constant Pp_Depth := 0;
 170
 171    package Pp_States is new Table.Table
 172      (Table_Component_Type => Pp_State,
 173       Table_Index_Type     => Pp_Depth,
 174       Table_Low_Bound      => 1,
 175       Table_Initial        => 10,
 176       Table_Increment      => 100,
 177       Table_Name           => "Prep.Pp_States");
 178    --  A stack of the states of the preprocessor, for nested #if
 179
 180    type Operator is (None, Op_Or, Op_And);
 181
 182    -----------------
 183    -- Subprograms --
 184    -----------------
 185
 186    function Deleting return Boolean;
 187    --  Return True if code should be deleted or commented out
 188
 189    function Expression
 190      (Evaluate_It  : Boolean;
 191       Complemented : Boolean := False) return Boolean;
 192    --  Evaluate a condition in an #if or an #elsif statement.
 193    --  If Evaluate_It is False, the condition is effectively evaluated,
 194    --  otherwise, only the syntax is checked.
 195
 196    procedure Go_To_End_Of_Line;
 197    --  Advance the scan pointer until we reach an end of line or the end
 198    --  of the buffer.
 199
 200    function Matching_Strings (S1, S2 : String_Id) return Boolean;
 201    --  Returns True if the two string parameters are equal (case insensitive)
 202
 203    ---------------------------------------
 204    -- Change_Reserved_Keyword_To_Symbol --
 205    ---------------------------------------
 206
 207    procedure Change_Reserved_Keyword_To_Symbol
 208      (All_Keywords : Boolean := False)
 209    is
 210       New_Name : constant Name_Id := Token_Names (Token);
 211
 212    begin
 213       if New_Name /= No_Name then
 214          case Token is
 215             when Tok_If  | Tok_Else | Tok_Elsif | Tok_End |
 216                  Tok_And | Tok_Or   | Tok_Then =>
 217                if All_Keywords then
 218                   Token := Tok_Identifier;
 219                   Token_Name := New_Name;
 220                end if;
 221
 222             when others =>
 223                Token := Tok_Identifier;
 224                Token_Name := New_Name;
 225          end case;
 226       end if;
 227    end Change_Reserved_Keyword_To_Symbol;
 228
 229    ------------------------------------------
 230    -- Check_Command_Line_Symbol_Definition --
 231    ------------------------------------------
 232
 233    procedure Check_Command_Line_Symbol_Definition
 234      (Definition  : String;
 235       Data        : out Symbol_Data)
 236    is
 237       Index       : Natural := 0;
 238       Result      : Symbol_Data;
 239
 240    begin
 241       --  Look for the character '='
 242
 243       for J in Definition'Range loop
 244          if Definition (J) = '=' then
 245             Index := J;
 246             exit;
 247          end if;
 248       end loop;
 249
 250       --  If no character '=', then the value is True
 251
 252       if Index = 0 then
 253          --  Put the symbol in the name buffer
 254
 255          Name_Len := Definition'Length;
 256          Name_Buffer (1 .. Name_Len) := Definition;
 257          Result := True_Value;
 258
 259       elsif Index = Definition'First then
 260          Fail ("invalid symbol definition """ & Definition & """");
 261
 262       else
 263          --  Put the symbol in the name buffer
 264
 265          Name_Len := Index - Definition'First;
 266          Name_Buffer (1 .. Name_Len) :=
 267            String'(Definition (Definition'First .. Index - 1));
 268
 269          --  Check the syntax of the value
 270
 271          if Definition (Index + 1) /= '"'
 272            or else Definition (Definition'Last) /= '"'
 273          then
 274             for J in Index + 1 .. Definition'Last loop
 275                case Definition (J) is
 276                   when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
 277                      null;
 278
 279                   when others =>
 280                      Fail ("illegal value """
 281                            & Definition (Index + 1 .. Definition'Last)
 282                            & """");
 283                end case;
 284             end loop;
 285          end if;
 286
 287          --  And put the value in the result
 288
 289          Result.Is_A_String := False;
 290          Start_String;
 291          Store_String_Chars (Definition (Index + 1 .. Definition'Last));
 292          Result.Value := End_String;
 293       end if;
 294
 295       --  Now, check the syntax of the symbol (we don't allow accented and
 296       --  wide characters)
 297
 298       if Name_Buffer (1) not in 'a' .. 'z'
 299         and then Name_Buffer (1) not in 'A' .. 'Z'
 300       then
 301          Fail ("symbol """
 302                & Name_Buffer (1 .. Name_Len)
 303                & """ does not start with a letter");
 304       end if;
 305
 306       for J in 2 .. Name_Len loop
 307          case Name_Buffer (J) is
 308             when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' =>
 309                null;
 310
 311             when '_' =>
 312                if J = Name_Len then
 313                   Fail ("symbol """
 314                         & Name_Buffer (1 .. Name_Len)
 315                         & """ end with a '_'");
 316
 317                elsif Name_Buffer (J + 1) = '_' then
 318                   Fail ("symbol """
 319                         & Name_Buffer (1 .. Name_Len)
 320                         & """ contains consecutive '_'");
 321                end if;
 322
 323             when others =>
 324                Fail ("symbol """
 325                      & Name_Buffer (1 .. Name_Len)
 326                      & """ contains illegal character(s)");
 327          end case;
 328       end loop;
 329
 330       Result.On_The_Command_Line := True;
 331
 332       --  Put the symbol name in the result
 333
 334       declare
 335          Sym : constant String := Name_Buffer (1 .. Name_Len);
 336
 337       begin
 338          for Index in 1 .. Name_Len loop
 339             Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
 340          end loop;
 341
 342          Result.Symbol := Name_Find;
 343          Name_Len := Sym'Length;
 344          Name_Buffer (1 .. Name_Len) := Sym;
 345          Result.Original := Name_Find;
 346       end;
 347
 348       Data := Result;
 349    end Check_Command_Line_Symbol_Definition;
 350
 351    --------------
 352    -- Deleting --
 353    --------------
 354
 355    function Deleting return Boolean is
 356    begin
 357       --  Always return False when not inside an #if statement
 358
 359       if Pp_States.Last = Ground then
 360          return False;
 361       else
 362          return Pp_States.Table (Pp_States.Last).Deleting;
 363       end if;
 364    end Deleting;
 365
 366    ----------------
 367    -- Expression --
 368    ----------------
 369
 370    function Expression
 371      (Evaluate_It  : Boolean;
 372       Complemented : Boolean := False) return Boolean
 373    is
 374       Evaluation : Boolean := Evaluate_It;
 375       --  Is set to False after an "or else" when left term is True and
 376       --  after an "and then" when left term is False.
 377
 378       Final_Result : Boolean := False;
 379
 380       Current_Result : Boolean := False;
 381       --  Value of a term
 382
 383       Current_Operator : Operator := None;
 384       Symbol1          : Symbol_Id;
 385       Symbol2          : Symbol_Id;
 386       Symbol_Name1     : Name_Id;
 387       Symbol_Name2     : Name_Id;
 388       Symbol_Pos1      : Source_Ptr;
 389       Symbol_Pos2      : Source_Ptr;
 390       Symbol_Value1    : String_Id;
 391       Symbol_Value2    : String_Id;
 392
 393    begin
 394       --  Loop for each term
 395
 396       loop
 397          Change_Reserved_Keyword_To_Symbol;
 398
 399          Current_Result := False;
 400
 401          case Token is
 402
 403             when Tok_Left_Paren =>
 404
 405                --  ( expression )
 406
 407                Scan.all;
 408                Current_Result := Expression (Evaluation);
 409
 410                if Token = Tok_Right_Paren then
 411                   Scan.all;
 412
 413                else
 414                   Error_Msg -- CODEFIX
 415                     ("`)` expected", Token_Ptr);
 416                end if;
 417
 418             when Tok_Not =>
 419
 420                --  not expression
 421
 422                Scan.all;
 423                Current_Result :=
 424                  not Expression (Evaluation, Complemented => True);
 425
 426             when Tok_Identifier =>
 427                Symbol_Name1 := Token_Name;
 428                Symbol_Pos1  := Token_Ptr;
 429                Scan.all;
 430
 431                if Token = Tok_Apostrophe then
 432
 433                   --  symbol'Defined
 434
 435                   Scan.all;
 436
 437                   if Token = Tok_Identifier
 438                     and then Token_Name = Name_Defined
 439                   then
 440                      Scan.all;
 441
 442                   else
 443                      Error_Msg ("identifier `Defined` expected", Token_Ptr);
 444                   end if;
 445
 446                   if Evaluation then
 447                      Current_Result := Index_Of (Symbol_Name1) /= No_Symbol;
 448                   end if;
 449
 450                elsif Token = Tok_Equal then
 451                   Scan.all;
 452
 453                   Change_Reserved_Keyword_To_Symbol;
 454
 455                   if Token = Tok_Identifier then
 456
 457                      --  symbol = symbol
 458
 459                      Symbol_Name2 := Token_Name;
 460                      Symbol_Pos2  := Token_Ptr;
 461                      Scan.all;
 462
 463                      if Evaluation then
 464                         Symbol1 := Index_Of (Symbol_Name1);
 465
 466                         if Symbol1 = No_Symbol then
 467                            if Undefined_Symbols_Are_False then
 468                               Symbol_Value1 := String_False;
 469
 470                            else
 471                               Error_Msg_Name_1 := Symbol_Name1;
 472                               Error_Msg ("unknown symbol %", Symbol_Pos1);
 473                               Symbol_Value1 := No_String;
 474                            end if;
 475
 476                         else
 477                            Symbol_Value1 :=
 478                              Mapping.Table (Symbol1).Value;
 479                         end if;
 480
 481                         Symbol2 := Index_Of (Symbol_Name2);
 482
 483                         if Symbol2 = No_Symbol then
 484                            if Undefined_Symbols_Are_False then
 485                               Symbol_Value2 := String_False;
 486
 487                            else
 488                               Error_Msg_Name_1 := Symbol_Name2;
 489                               Error_Msg ("unknown symbol %", Symbol_Pos2);
 490                               Symbol_Value2 := No_String;
 491                            end if;
 492
 493                         else
 494                            Symbol_Value2 := Mapping.Table (Symbol2).Value;
 495                         end if;
 496
 497                         if Symbol_Value1 /= No_String
 498                           and then Symbol_Value2 /= No_String
 499                         then
 500                            Current_Result := Matching_Strings
 501                                                (Symbol_Value1, Symbol_Value2);
 502                         end if;
 503                      end if;
 504
 505                   elsif Token = Tok_String_Literal then
 506
 507                      --  symbol = "value"
 508
 509                      if Evaluation then
 510                         Symbol1 := Index_Of (Symbol_Name1);
 511
 512                         if Symbol1 = No_Symbol then
 513                            if Undefined_Symbols_Are_False then
 514                               Symbol_Value1 := String_False;
 515
 516                            else
 517                               Error_Msg_Name_1 := Symbol_Name1;
 518                               Error_Msg ("unknown symbol %", Symbol_Pos1);
 519                               Symbol_Value1 := No_String;
 520                            end if;
 521
 522                         else
 523                            Symbol_Value1 := Mapping.Table (Symbol1).Value;
 524                         end if;
 525
 526                         if Symbol_Value1 /= No_String then
 527                            Current_Result :=
 528                              Matching_Strings
 529                                (Symbol_Value1,
 530                                 String_Literal_Id);
 531                         end if;
 532                      end if;
 533
 534                      Scan.all;
 535
 536                   else
 537                      Error_Msg
 538                        ("symbol or literal string expected", Token_Ptr);
 539                   end if;
 540
 541                else
 542                   --  symbol (True or False)
 543
 544                   if Evaluation then
 545                      Symbol1 := Index_Of (Symbol_Name1);
 546
 547                      if Symbol1 = No_Symbol then
 548                         if Undefined_Symbols_Are_False then
 549                            Symbol_Value1 := String_False;
 550
 551                         else
 552                            Error_Msg_Name_1 := Symbol_Name1;
 553                            Error_Msg ("unknown symbol %", Symbol_Pos1);
 554                            Symbol_Value1 := No_String;
 555                         end if;
 556
 557                      else
 558                         Symbol_Value1 := Mapping.Table (Symbol1).Value;
 559                      end if;
 560
 561                      if Symbol_Value1 /= No_String then
 562                         String_To_Name_Buffer (Symbol_Value1);
 563
 564                         for Index in 1 .. Name_Len loop
 565                            Name_Buffer (Index) :=
 566                              Fold_Lower (Name_Buffer (Index));
 567                         end loop;
 568
 569                         if Name_Buffer (1 .. Name_Len) = "true" then
 570                            Current_Result := True;
 571
 572                         elsif Name_Buffer (1 .. Name_Len) = "false" then
 573                            Current_Result := False;
 574
 575                         else
 576                            Error_Msg_Name_1 := Symbol_Name1;
 577                            Error_Msg
 578                              ("value of symbol % is not True or False",
 579                               Symbol_Pos1);
 580                         end if;
 581                      end if;
 582                   end if;
 583                end if;
 584
 585             when others =>
 586                Error_Msg ("`(`, NOT or symbol expected", Token_Ptr);
 587          end case;
 588
 589          --  Update the cumulative final result
 590
 591          case Current_Operator is
 592             when None =>
 593                Final_Result := Current_Result;
 594
 595             when Op_Or =>
 596                Final_Result := Final_Result or Current_Result;
 597
 598             when Op_And =>
 599                Final_Result := Final_Result and Current_Result;
 600          end case;
 601
 602          --  Check the next operator
 603
 604          if Token = Tok_And then
 605             if Complemented then
 606                Error_Msg
 607                 ("mixing NOT and AND is not allowed, parentheses are required",
 608                  Token_Ptr);
 609
 610             elsif Current_Operator = Op_Or then
 611                Error_Msg ("mixing OR and AND is not allowed", Token_Ptr);
 612             end if;
 613
 614             Current_Operator := Op_And;
 615             Scan.all;
 616
 617             if Token = Tok_Then then
 618                Scan.all;
 619
 620                if Final_Result = False then
 621                   Evaluation := False;
 622                end if;
 623             end if;
 624
 625          elsif Token = Tok_Or then
 626             if Complemented then
 627                Error_Msg
 628                  ("mixing NOT and OR is not allowed, parentheses are required",
 629                   Token_Ptr);
 630
 631             elsif Current_Operator = Op_And then
 632                Error_Msg ("mixing AND and OR is not allowed", Token_Ptr);
 633             end if;
 634
 635             Current_Operator := Op_Or;
 636             Scan.all;
 637
 638             if Token = Tok_Else then
 639                Scan.all;
 640
 641                if Final_Result then
 642                   Evaluation := False;
 643                end if;
 644             end if;
 645
 646          else
 647             --  No operator: exit the term loop
 648
 649             exit;
 650          end if;
 651       end loop;
 652
 653       return Final_Result;
 654    end Expression;
 655
 656    -----------------------
 657    -- Go_To_End_Of_Line --
 658    -----------------------
 659
 660    procedure Go_To_End_Of_Line is
 661    begin
 662       --  Scan until we get an end of line or we reach the end of the buffer
 663
 664       while Token /= Tok_End_Of_Line
 665         and then Token /= Tok_EOF
 666       loop
 667          Scan.all;
 668       end loop;
 669    end Go_To_End_Of_Line;
 670
 671    --------------
 672    -- Index_Of --
 673    --------------
 674
 675    function Index_Of (Symbol : Name_Id) return Symbol_Id is
 676    begin
 677       if Mapping.Table /= null then
 678          for J in Symbol_Id range 1 .. Symbol_Table.Last (Mapping) loop
 679             if Mapping.Table (J).Symbol = Symbol then
 680                return J;
 681             end if;
 682          end loop;
 683       end if;
 684
 685       return No_Symbol;
 686    end Index_Of;
 687
 688    ----------------
 689    -- Initialize --
 690    ----------------
 691
 692    procedure Initialize is
 693    begin
 694       if not Already_Initialized then
 695          Start_String;
 696          Store_String_Chars ("True");
 697          True_Value.Value := End_String;
 698
 699          Start_String;
 700          Empty_String := End_String;
 701
 702          Start_String;
 703          Store_String_Chars ("False");
 704          String_False := End_String;
 705
 706          Already_Initialized := True;
 707       end if;
 708    end Initialize;
 709
 710    ------------------
 711    -- List_Symbols --
 712    ------------------
 713
 714    procedure List_Symbols (Foreword : String) is
 715       Order : array (0 ..  Integer (Symbol_Table.Last (Mapping)))
 716                  of Symbol_Id;
 717       --  After alphabetical sorting, this array stores the indices of
 718       --  the symbols in the order they are displayed.
 719
 720       function Lt (Op1, Op2 : Natural) return Boolean;
 721       --  Comparison routine for sort call
 722
 723       procedure Move (From : Natural; To : Natural);
 724       --  Move routine for sort call
 725
 726       --------
 727       -- Lt --
 728       --------
 729
 730       function Lt (Op1, Op2 : Natural) return Boolean is
 731          S1 : constant String :=
 732                 Get_Name_String (Mapping.Table (Order (Op1)).Symbol);
 733          S2 : constant String :=
 734                 Get_Name_String (Mapping.Table (Order (Op2)).Symbol);
 735
 736       begin
 737          return S1 < S2;
 738       end Lt;
 739
 740       ----------
 741       -- Move --
 742       ----------
 743
 744       procedure Move (From : Natural; To : Natural) is
 745       begin
 746          Order (To) := Order (From);
 747       end Move;
 748
 749       package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt);
 750
 751       Max_L : Natural;
 752       --  Maximum length of any symbol
 753
 754    --  Start of processing for List_Symbols_Case
 755
 756    begin
 757       if Symbol_Table.Last (Mapping) = 0 then
 758          return;
 759       end if;
 760
 761       if Foreword'Length > 0 then
 762          Write_Eol;
 763          Write_Line (Foreword);
 764
 765          for J in Foreword'Range loop
 766             Write_Char ('=');
 767          end loop;
 768       end if;
 769
 770       --  Initialize the order
 771
 772       for J in Order'Range loop
 773          Order (J) := Symbol_Id (J);
 774       end loop;
 775
 776       --  Sort alphabetically
 777
 778       Sort_Syms.Sort (Order'Last);
 779
 780       Max_L := 7;
 781
 782       for J in 1 .. Symbol_Table.Last (Mapping) loop
 783          Get_Name_String (Mapping.Table (J).Original);
 784          Max_L := Integer'Max (Max_L, Name_Len);
 785       end loop;
 786
 787       Write_Eol;
 788       Write_Str ("Symbol");
 789
 790       for J in 1 .. Max_L - 5 loop
 791          Write_Char (' ');
 792       end loop;
 793
 794       Write_Line ("Value");
 795
 796       Write_Str ("------");
 797
 798       for J in 1 .. Max_L - 5 loop
 799          Write_Char (' ');
 800       end loop;
 801
 802       Write_Line ("------");
 803
 804       for J in 1 .. Order'Last loop
 805          declare
 806             Data : constant Symbol_Data := Mapping.Table (Order (J));
 807
 808          begin
 809             Get_Name_String (Data.Original);
 810             Write_Str (Name_Buffer (1 .. Name_Len));
 811
 812             for K in Name_Len .. Max_L loop
 813                Write_Char (' ');
 814             end loop;
 815
 816             String_To_Name_Buffer (Data.Value);
 817
 818             if Data.Is_A_String then
 819                Write_Char ('"');
 820
 821                for J in 1 .. Name_Len loop
 822                   Write_Char (Name_Buffer (J));
 823
 824                   if Name_Buffer (J) = '"' then
 825                      Write_Char ('"');
 826                   end if;
 827                end loop;
 828
 829                Write_Char ('"');
 830
 831             else
 832                Write_Str (Name_Buffer (1 .. Name_Len));
 833             end if;
 834          end;
 835
 836          Write_Eol;
 837       end loop;
 838
 839       Write_Eol;
 840    end List_Symbols;
 841
 842    ----------------------
 843    -- Matching_Strings --
 844    ----------------------
 845
 846    function Matching_Strings (S1, S2 : String_Id) return Boolean is
 847    begin
 848       String_To_Name_Buffer (S1);
 849
 850       for Index in 1 .. Name_Len loop
 851          Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
 852       end loop;
 853
 854       declare
 855          String1 : constant String := Name_Buffer (1 .. Name_Len);
 856
 857       begin
 858          String_To_Name_Buffer (S2);
 859
 860          for Index in 1 .. Name_Len loop
 861             Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
 862          end loop;
 863
 864          return String1 = Name_Buffer (1 .. Name_Len);
 865       end;
 866    end Matching_Strings;
 867
 868    --------------------
 869    -- Parse_Def_File --
 870    --------------------
 871
 872    procedure Parse_Def_File is
 873       Symbol        : Symbol_Id;
 874       Symbol_Name   : Name_Id;
 875       Original_Name : Name_Id;
 876       Data          : Symbol_Data;
 877       Value_Start   : Source_Ptr;
 878       Value_End     : Source_Ptr;
 879       Ch            : Character;
 880
 881       use ASCII;
 882
 883    begin
 884       Def_Line_Loop :
 885       loop
 886          Scan.all;
 887
 888          exit Def_Line_Loop when Token = Tok_EOF;
 889
 890          if Token /= Tok_End_Of_Line then
 891             Change_Reserved_Keyword_To_Symbol;
 892
 893             if Token /= Tok_Identifier then
 894                Error_Msg ("identifier expected", Token_Ptr);
 895                goto Cleanup;
 896             end if;
 897
 898             Symbol_Name := Token_Name;
 899             Name_Len := 0;
 900
 901             for Ptr in Token_Ptr .. Scan_Ptr - 1 loop
 902                Name_Len := Name_Len + 1;
 903                Name_Buffer (Name_Len) := Sinput.Source (Ptr);
 904             end loop;
 905
 906             Original_Name := Name_Find;
 907             Scan.all;
 908
 909             if Token /= Tok_Colon_Equal then
 910                Error_Msg -- CODEFIX
 911                  ("`:=` expected", Token_Ptr);
 912                goto Cleanup;
 913             end if;
 914
 915             Scan.all;
 916
 917             if Token = Tok_String_Literal then
 918                Data := (Symbol              => Symbol_Name,
 919                         Original            => Original_Name,
 920                         On_The_Command_Line => False,
 921                         Is_A_String         => True,
 922                         Value               => String_Literal_Id);
 923
 924                Scan.all;
 925
 926                if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
 927                   Error_Msg ("extraneous text in definition", Token_Ptr);
 928                   goto Cleanup;
 929                end if;
 930
 931             elsif Token = Tok_End_Of_Line or else Token = Tok_EOF then
 932                Data := (Symbol              => Symbol_Name,
 933                         Original            => Original_Name,
 934                         On_The_Command_Line => False,
 935                         Is_A_String         => False,
 936                         Value               => Empty_String);
 937
 938             else
 939                Value_Start := Token_Ptr;
 940                Value_End   := Token_Ptr - 1;
 941                Scan_Ptr    := Token_Ptr;
 942
 943                Value_Chars_Loop :
 944                loop
 945                   Ch := Sinput.Source (Scan_Ptr);
 946
 947                   case Ch is
 948                      when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
 949                         Value_End := Scan_Ptr;
 950                         Scan_Ptr := Scan_Ptr + 1;
 951
 952                      when ' ' | HT | VT | CR | LF | FF =>
 953                         exit Value_Chars_Loop;
 954
 955                      when others =>
 956                         Error_Msg ("illegal character", Scan_Ptr);
 957                         goto Cleanup;
 958                   end case;
 959                end loop Value_Chars_Loop;
 960
 961                Scan.all;
 962
 963                if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
 964                   Error_Msg ("extraneous text in definition", Token_Ptr);
 965                   goto Cleanup;
 966                end if;
 967
 968                Start_String;
 969
 970                while Value_Start <= Value_End loop
 971                   Store_String_Char (Sinput.Source (Value_Start));
 972                   Value_Start := Value_Start + 1;
 973                end loop;
 974
 975                Data := (Symbol              => Symbol_Name,
 976                         Original            => Original_Name,
 977                         On_The_Command_Line => False,
 978                         Is_A_String         => False,
 979                         Value               => End_String);
 980             end if;
 981
 982             --  Now that we have the value, get the symbol index
 983
 984             Symbol := Index_Of (Symbol_Name);
 985
 986             if Symbol /= No_Symbol then
 987                --  If we already have an entry for this symbol, replace it
 988                --  with the new value, except if the symbol was declared
 989                --  on the command line.
 990
 991                if Mapping.Table (Symbol).On_The_Command_Line then
 992                   goto Continue;
 993                end if;
 994
 995             else
 996                --  As it is the first time we see this symbol, create a new
 997                --  entry in the table.
 998
 999                if Mapping.Table = null then
1000                   Symbol_Table.Init (Mapping);
1001                end if;
1002
1003                Symbol_Table.Increment_Last (Mapping);
1004                Symbol := Symbol_Table.Last (Mapping);
1005             end if;
1006
1007             Mapping.Table (Symbol) := Data;
1008             goto Continue;
1009
1010             <<Cleanup>>
1011                Set_Ignore_Errors (To => True);
1012
1013                while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop
1014                   Scan.all;
1015                end loop;
1016
1017                Set_Ignore_Errors (To => False);
1018
1019             <<Continue>>
1020                null;
1021          end if;
1022       end loop Def_Line_Loop;
1023    end Parse_Def_File;
1024
1025    ----------------
1026    -- Preprocess --
1027    ----------------
1028
1029    procedure Preprocess (Source_Modified : out Boolean) is
1030       Start_Of_Processing : Source_Ptr;
1031       Cond                : Boolean;
1032       Preprocessor_Line   : Boolean := False;
1033       No_Error_Found      : Boolean := True;
1034       Modified            : Boolean := False;
1035
1036       procedure Output (From, To : Source_Ptr);
1037       --  Output the characters with indices From .. To in the buffer
1038       --  to the output file.
1039
1040       procedure Output_Line (From, To : Source_Ptr);
1041       --  Output a line or the end of a line from the buffer to the output
1042       --  file, followed by an end of line terminator. Depending on the value
1043       --  of Deleting and the switches, the line may be commented out, blank or
1044       --  not output at all.
1045
1046       ------------
1047       -- Output --
1048       ------------
1049
1050       procedure Output (From, To : Source_Ptr) is
1051       begin
1052          for J in From .. To loop
1053             Put_Char (Sinput.Source (J));
1054          end loop;
1055       end Output;
1056
1057       -----------------
1058       -- Output_Line --
1059       -----------------
1060
1061       procedure Output_Line (From, To : Source_Ptr) is
1062       begin
1063          if Deleting or else Preprocessor_Line then
1064             if Blank_Deleted_Lines then
1065                New_EOL.all;
1066
1067             elsif Comment_Deleted_Lines then
1068                Put_Char ('-');
1069                Put_Char ('-');
1070                Put_Char ('!');
1071
1072                if From < To then
1073                   Put_Char (' ');
1074                   Output (From, To);
1075                end if;
1076
1077                New_EOL.all;
1078             end if;
1079
1080          else
1081             Output (From, To);
1082             New_EOL.all;
1083          end if;
1084       end Output_Line;
1085
1086    --  Start of processing for Preprocess
1087
1088    begin
1089       Start_Of_Processing := Scan_Ptr;
1090
1091       --  We need to call Scan for the first time, because Initialize_Scanner
1092       --  is no longer doing it.
1093
1094       Scan.all;
1095
1096       Input_Line_Loop : loop
1097          exit Input_Line_Loop when Token = Tok_EOF;
1098
1099          Preprocessor_Line := False;
1100
1101          if Token /= Tok_End_Of_Line then
1102
1103             --  Preprocessor line
1104
1105             if Token = Tok_Special and then Special_Character = '#' then
1106                Modified := True;
1107                Preprocessor_Line := True;
1108                Scan.all;
1109
1110                case Token is
1111
1112                   --  #if
1113
1114                   when Tok_If =>
1115                      declare
1116                         If_Ptr : constant Source_Ptr := Token_Ptr;
1117
1118                      begin
1119                         Scan.all;
1120                         Cond := Expression (not Deleting);
1121
1122                         --  Check for an eventual "then"
1123
1124                         if Token = Tok_Then then
1125                            Scan.all;
1126                         end if;
1127
1128                         --  It is an error to have trailing characters after
1129                         --  the condition or "then".
1130
1131                         if Token /= Tok_End_Of_Line
1132                           and then Token /= Tok_EOF
1133                         then
1134                            Error_Msg
1135                              ("extraneous text on preprocessor line",
1136                               Token_Ptr);
1137                            No_Error_Found := False;
1138                            Go_To_End_Of_Line;
1139                         end if;
1140
1141                         declare
1142                            --  Set the initial state of this new "#if". This
1143                            --  must be done before incrementing the Last of
1144                            --  the table, otherwise function Deleting does
1145                            --  not report the correct value.
1146
1147                            New_State : constant Pp_State :=
1148                                          (If_Ptr     => If_Ptr,
1149                                           Else_Ptr   => 0,
1150                                           Deleting   => Deleting
1151                                                           or else not Cond,
1152                                           Match_Seen => Deleting or else Cond);
1153
1154                         begin
1155                            Pp_States.Increment_Last;
1156                            Pp_States.Table (Pp_States.Last) := New_State;
1157                         end;
1158                      end;
1159
1160                   --  #elsif
1161
1162                   when Tok_Elsif =>
1163                      Cond := False;
1164
1165                      if Pp_States.Last = 0
1166                        or else Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
1167                      then
1168                         Error_Msg ("no IF for this ELSIF", Token_Ptr);
1169                         No_Error_Found := False;
1170
1171                      else
1172                         Cond :=
1173                           not Pp_States.Table (Pp_States.Last).Match_Seen;
1174                      end if;
1175
1176                      Scan.all;
1177                      Cond := Expression (Cond);
1178
1179                      --  Check for an eventual "then"
1180
1181                      if Token = Tok_Then then
1182                         Scan.all;
1183                      end if;
1184
1185                      --  It is an error to have trailing characters after
1186                      --  the condition or "then".
1187
1188                      if Token /= Tok_End_Of_Line
1189                        and then Token /= Tok_EOF
1190                      then
1191                         Error_Msg
1192                           ("extraneous text on preprocessor line",
1193                            Token_Ptr);
1194                         No_Error_Found := False;
1195
1196                         Go_To_End_Of_Line;
1197                      end if;
1198
1199                      --  Depending on the value of the condition, set the
1200                      --  new values of Deleting and Match_Seen.
1201                      if Pp_States.Last > 0 then
1202                         if Pp_States.Table (Pp_States.Last).Match_Seen then
1203                            Pp_States.Table (Pp_States.Last).Deleting := True;
1204                         else
1205                            if Cond then
1206                               Pp_States.Table (Pp_States.Last).Match_Seen :=
1207                                 True;
1208                               Pp_States.Table (Pp_States.Last).Deleting :=
1209                                 False;
1210                            end if;
1211                         end if;
1212                      end if;
1213
1214                   --  #else
1215
1216                   when Tok_Else =>
1217                      if Pp_States.Last = 0 then
1218                         Error_Msg ("no IF for this ELSE", Token_Ptr);
1219                         No_Error_Found := False;
1220
1221                      elsif
1222                        Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
1223                      then
1224                         Error_Msg -- CODEFIX
1225                           ("duplicate ELSE line", Token_Ptr);
1226                         No_Error_Found := False;
1227                      end if;
1228
1229                      --  Set the possibly new values of Deleting and
1230                      --  Match_Seen.
1231
1232                      if Pp_States.Last > 0 then
1233                         if Pp_States.Table (Pp_States.Last).Match_Seen then
1234                            Pp_States.Table (Pp_States.Last).Deleting :=
1235                              True;
1236
1237                         else
1238                            Pp_States.Table (Pp_States.Last).Match_Seen :=
1239                              True;
1240                            Pp_States.Table (Pp_States.Last).Deleting :=
1241                              False;
1242                         end if;
1243
1244                         --  Set the Else_Ptr to check for illegal #elsif
1245                         --  later.
1246
1247                         Pp_States.Table (Pp_States.Last).Else_Ptr :=
1248                           Token_Ptr;
1249                      end if;
1250
1251                      Scan.all;
1252
1253                      --  It is an error to have characters after "#else"
1254                      if Token /= Tok_End_Of_Line
1255                        and then Token /= Tok_EOF
1256                      then
1257                         Error_Msg
1258                           ("extraneous text on preprocessor line",
1259                            Token_Ptr);
1260                         No_Error_Found := False;
1261                         Go_To_End_Of_Line;
1262                      end if;
1263
1264                   --  #end if;
1265
1266                   when Tok_End =>
1267                      if Pp_States.Last = 0 then
1268                         Error_Msg ("no IF for this END", Token_Ptr);
1269                         No_Error_Found := False;
1270                      end if;
1271
1272                      Scan.all;
1273
1274                      if Token /= Tok_If then
1275                         Error_Msg -- CODEFIX
1276                           ("IF expected", Token_Ptr);
1277                         No_Error_Found := False;
1278
1279                      else
1280                         Scan.all;
1281
1282                         if Token /= Tok_Semicolon then
1283                            Error_Msg -- CODEFIX
1284                              ("`;` Expected", Token_Ptr);
1285                            No_Error_Found := False;
1286
1287                         else
1288                            Scan.all;
1289
1290                            --  It is an error to have character after
1291                            --  "#end if;".
1292                            if Token /= Tok_End_Of_Line
1293                              and then Token /= Tok_EOF
1294                            then
1295                               Error_Msg
1296                                 ("extraneous text on preprocessor line",
1297                                  Token_Ptr);
1298                               No_Error_Found := False;
1299                            end if;
1300                         end if;
1301                      end if;
1302
1303                      --  In case of one of the errors above, skip the tokens
1304                      --  until the end of line is reached.
1305
1306                      Go_To_End_Of_Line;
1307
1308                      --  Decrement the depth of the #if stack
1309
1310                      if Pp_States.Last > 0 then
1311                         Pp_States.Decrement_Last;
1312                      end if;
1313
1314                   --  Illegal preprocessor line
1315
1316                   when others =>
1317                      No_Error_Found := False;
1318
1319                      if Pp_States.Last = 0 then
1320                         Error_Msg -- CODEFIX
1321                           ("IF expected", Token_Ptr);
1322
1323                      elsif
1324                        Pp_States.Table (Pp_States.Last).Else_Ptr = 0
1325                      then
1326                         Error_Msg
1327                           ("IF, ELSIF, ELSE, or `END IF` expected",
1328                            Token_Ptr);
1329
1330                      else
1331                         Error_Msg ("IF or `END IF` expected", Token_Ptr);
1332                      end if;
1333
1334                      --  Skip to the end of this illegal line
1335
1336                      Go_To_End_Of_Line;
1337                end case;
1338
1339             --  Not a preprocessor line
1340
1341             else
1342                --  Do not report errors for those lines, even if there are
1343                --  Ada parsing errors.
1344
1345                Set_Ignore_Errors (To => True);
1346
1347                if Deleting then
1348                   Go_To_End_Of_Line;
1349
1350                else
1351                   while Token /= Tok_End_Of_Line
1352                     and then Token /= Tok_EOF
1353                   loop
1354                      if Token = Tok_Special
1355                        and then Special_Character = '$'
1356                      then
1357                         Modified := True;
1358
1359                         declare
1360                            Dollar_Ptr : constant Source_Ptr := Token_Ptr;
1361                            Symbol     : Symbol_Id;
1362
1363                         begin
1364                            Scan.all;
1365                            Change_Reserved_Keyword_To_Symbol;
1366
1367                            if Token = Tok_Identifier
1368                              and then Token_Ptr = Dollar_Ptr + 1
1369                            then
1370                               --  $symbol
1371
1372                               Symbol := Index_Of (Token_Name);
1373
1374                               --  If symbol exists, replace by its value
1375
1376                               if Symbol /= No_Symbol then
1377                                  Output (Start_Of_Processing, Dollar_Ptr - 1);
1378                                  Start_Of_Processing := Scan_Ptr;
1379                                  String_To_Name_Buffer
1380                                    (Mapping.Table (Symbol).Value);
1381
1382                                  if Mapping.Table (Symbol).Is_A_String then
1383
1384                                     --  Value is an Ada string
1385
1386                                     Put_Char ('"');
1387
1388                                     for J in 1 .. Name_Len loop
1389                                        Put_Char (Name_Buffer (J));
1390
1391                                        if Name_Buffer (J) = '"' then
1392                                           Put_Char ('"');
1393                                        end if;
1394                                     end loop;
1395
1396                                     Put_Char ('"');
1397
1398                                  else
1399                                     --  Value is a sequence of characters, not
1400                                     --  an Ada string.
1401
1402                                     for J in 1 .. Name_Len loop
1403                                        Put_Char (Name_Buffer (J));
1404                                     end loop;
1405                                  end if;
1406                               end if;
1407                            end if;
1408                         end;
1409                      end if;
1410
1411                      Scan.all;
1412                   end loop;
1413                end if;
1414
1415                Set_Ignore_Errors (To => False);
1416             end if;
1417          end if;
1418
1419          pragma Assert (Token = Tok_End_Of_Line or else Token = Tok_EOF);
1420
1421          --  At this point, the token is either end of line or EOF.
1422          --  The line to possibly output stops just before the token.
1423
1424          Output_Line (Start_Of_Processing, Token_Ptr - 1);
1425
1426          --  If we are at the end of a line, the scan pointer is at the first
1427          --  non blank character, not necessarily the first character of the
1428          --  line; so, we have to deduct Start_Of_Processing from the token
1429          --  pointer.
1430
1431          if Token = Tok_End_Of_Line then
1432             if (Sinput.Source (Token_Ptr) = ASCII.CR
1433                   and then Sinput.Source (Token_Ptr + 1) = ASCII.LF)
1434               or else
1435                (Sinput.Source (Token_Ptr) = ASCII.CR
1436                   and then Sinput.Source (Token_Ptr + 1) = ASCII.LF)
1437             then
1438                Start_Of_Processing := Token_Ptr + 2;
1439             else
1440                Start_Of_Processing := Token_Ptr + 1;
1441             end if;
1442          end if;
1443
1444          --  Now, scan the first token of the next line. If the token is EOF,
1445          --  the scan pointer will not move, and the token will still be EOF.
1446
1447          Set_Ignore_Errors (To => True);
1448          Scan.all;
1449          Set_Ignore_Errors (To => False);
1450       end loop Input_Line_Loop;
1451
1452       --  Report an error for any missing some "#end if;"
1453
1454       for Level in reverse 1 .. Pp_States.Last loop
1455          Error_Msg ("no `END IF` for this IF", Pp_States.Table (Level).If_Ptr);
1456          No_Error_Found := False;
1457       end loop;
1458
1459       Source_Modified := No_Error_Found and Modified;
1460    end Preprocess;
1461
1462    -----------------
1463    -- Setup_Hooks --
1464    -----------------
1465
1466    procedure Setup_Hooks
1467      (Error_Msg         : Error_Msg_Proc;
1468       Scan              : Scan_Proc;
1469       Set_Ignore_Errors : Set_Ignore_Errors_Proc;
1470       Put_Char          : Put_Char_Proc;
1471       New_EOL           : New_EOL_Proc)
1472    is
1473    begin
1474       pragma Assert (Already_Initialized);
1475
1476       Prep.Error_Msg         := Error_Msg;
1477       Prep.Scan              := Scan;
1478       Prep.Set_Ignore_Errors := Set_Ignore_Errors;
1479       Prep.Put_Char          := Put_Char;
1480       Prep.New_EOL           := New_EOL;
1481    end Setup_Hooks;
1482
1483 end Prep;