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