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-2008, 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    Name_Defined : Name_Id;
 123    --  defined, as a name_id
 124
 125    ---------------
 126    -- Behaviour --
 127    ---------------
 128
 129    --  Accesses to procedure specified by procedure Initialize
 130
 131    Error_Msg : Error_Msg_Proc;
 132    --  Report an error
 133
 134    Scan : Scan_Proc;
 135    --  Scan one token
 136
 137    Set_Ignore_Errors : Set_Ignore_Errors_Proc;
 138    --  Indicate if error should be taken into account
 139
 140    Put_Char : Put_Char_Proc;
 141    --  Output one character
 142
 143    New_EOL : New_EOL_Proc;
 144    --  Output an end of line indication
 145
 146    -------------------------------
 147    -- State of the Preprocessor --
 148    -------------------------------
 149
 150    type Pp_State is record
 151       If_Ptr : Source_Ptr;
 152       --  The location of the #if statement.
 153       --  Used to flag #if with no corresponding #end if, at the end.
 154
 155       Else_Ptr : Source_Ptr;
 156       --  The location of the #else statement.
 157       --  Used to detect multiple #else.
 158
 159       Deleting : Boolean;
 160       --  Set to True when the code should be deleted or commented out
 161
 162       Match_Seen : Boolean;
 163       --  Set to True when a condition in an #if or an #elsif is True.
 164       --  Also set to True if Deleting at the previous level is True.
 165       --  Used to decide if Deleting should be set to True in a following
 166       --  #elsif or #else.
 167
 168    end record;
 169
 170    type Pp_Depth is new Nat;
 171
 172    Ground : constant Pp_Depth := 0;
 173
 174    package Pp_States is new Table.Table
 175      (Table_Component_Type => Pp_State,
 176       Table_Index_Type     => Pp_Depth,
 177       Table_Low_Bound      => 1,
 178       Table_Initial        => 10,
 179       Table_Increment      => 100,
 180       Table_Name           => "Prep.Pp_States");
 181    --  A stack of the states of the preprocessor, for nested #if
 182
 183    type Operator is (None, Op_Or, Op_And);
 184
 185    -----------------
 186    -- Subprograms --
 187    -----------------
 188
 189    function Deleting return Boolean;
 190    --  Return True if code should be deleted or commented out
 191
 192    function Expression
 193      (Evaluate_It  : Boolean;
 194       Complemented : Boolean := False) 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       else
 365          return Pp_States.Table (Pp_States.Last).Deleting;
 366       end if;
 367    end Deleting;
 368
 369    ----------------
 370    -- Expression --
 371    ----------------
 372
 373    function Expression
 374      (Evaluate_It  : Boolean;
 375       Complemented : Boolean := False) return Boolean
 376    is
 377       Evaluation : Boolean := Evaluate_It;
 378       --  Is set to False after an "or else" when left term is True and
 379       --  after an "and then" when left term is False.
 380
 381       Final_Result : Boolean := False;
 382
 383       Current_Result : Boolean := False;
 384       --  Value of a term
 385
 386       Current_Operator : Operator := None;
 387       Symbol1          : Symbol_Id;
 388       Symbol2          : Symbol_Id;
 389       Symbol_Name1     : Name_Id;
 390       Symbol_Name2     : Name_Id;
 391       Symbol_Pos1      : Source_Ptr;
 392       Symbol_Pos2      : Source_Ptr;
 393       Symbol_Value1    : String_Id;
 394       Symbol_Value2    : String_Id;
 395
 396    begin
 397       --  Loop for each term
 398
 399       loop
 400          Change_Reserved_Keyword_To_Symbol;
 401
 402          Current_Result := False;
 403
 404          case Token is
 405
 406             when Tok_Left_Paren =>
 407
 408                --  ( expression )
 409
 410                Scan.all;
 411                Current_Result := Expression (Evaluation);
 412
 413                if Token = Tok_Right_Paren then
 414                   Scan.all;
 415
 416                else
 417                   Error_Msg ("`)` expected", Token_Ptr);
 418                end if;
 419
 420             when Tok_Not =>
 421
 422                --  not expression
 423
 424                Scan.all;
 425                Current_Result :=
 426                  not Expression (Evaluation, Complemented => True);
 427
 428             when Tok_Identifier =>
 429                Symbol_Name1 := Token_Name;
 430                Symbol_Pos1  := Token_Ptr;
 431                Scan.all;
 432
 433                if Token = Tok_Apostrophe then
 434
 435                   --  symbol'Defined
 436
 437                   Scan.all;
 438
 439                   if Token = Tok_Identifier
 440                     and then Token_Name = Name_Defined
 441                   then
 442                      Scan.all;
 443
 444                   else
 445                      Error_Msg ("identifier `Defined` expected", Token_Ptr);
 446                   end if;
 447
 448                   if Evaluation then
 449                      Current_Result := Index_Of (Symbol_Name1) /= No_Symbol;
 450                   end if;
 451
 452                elsif Token = Tok_Equal then
 453                   Scan.all;
 454
 455                   Change_Reserved_Keyword_To_Symbol;
 456
 457                   if Token = Tok_Identifier then
 458
 459                      --  symbol = symbol
 460
 461                      Symbol_Name2 := Token_Name;
 462                      Symbol_Pos2  := Token_Ptr;
 463                      Scan.all;
 464
 465                      if Evaluation then
 466                         Symbol1 := Index_Of (Symbol_Name1);
 467
 468                         if Symbol1 = No_Symbol then
 469                            if Undefined_Symbols_Are_False then
 470                               Symbol_Value1 := String_False;
 471
 472                            else
 473                               Error_Msg_Name_1 := Symbol_Name1;
 474                               Error_Msg ("unknown symbol %", Symbol_Pos1);
 475                               Symbol_Value1 := No_String;
 476                            end if;
 477
 478                         else
 479                            Symbol_Value1 :=
 480                              Mapping.Table (Symbol1).Value;
 481                         end if;
 482
 483                         Symbol2 := Index_Of (Symbol_Name2);
 484
 485                         if Symbol2 = No_Symbol then
 486                            if Undefined_Symbols_Are_False then
 487                               Symbol_Value2 := String_False;
 488
 489                            else
 490                               Error_Msg_Name_1 := Symbol_Name2;
 491                               Error_Msg ("unknown symbol %", Symbol_Pos2);
 492                               Symbol_Value2 := No_String;
 493                            end if;
 494
 495                         else
 496                            Symbol_Value2 := Mapping.Table (Symbol2).Value;
 497                         end if;
 498
 499                         if Symbol_Value1 /= No_String
 500                           and then Symbol_Value2 /= No_String
 501                         then
 502                            Current_Result := Matching_Strings
 503                                                (Symbol_Value1, Symbol_Value2);
 504                         end if;
 505                      end if;
 506
 507                   elsif Token = Tok_String_Literal then
 508
 509                      --  symbol = "value"
 510
 511                      if Evaluation then
 512                         Symbol1 := Index_Of (Symbol_Name1);
 513
 514                         if Symbol1 = No_Symbol then
 515                            if Undefined_Symbols_Are_False then
 516                               Symbol_Value1 := String_False;
 517
 518                            else
 519                               Error_Msg_Name_1 := Symbol_Name1;
 520                               Error_Msg ("unknown symbol %", Symbol_Pos1);
 521                               Symbol_Value1 := No_String;
 522                            end if;
 523
 524                         else
 525                            Symbol_Value1 := Mapping.Table (Symbol1).Value;
 526                         end if;
 527
 528                         if Symbol_Value1 /= No_String then
 529                            Current_Result :=
 530                              Matching_Strings
 531                                (Symbol_Value1,
 532                                 String_Literal_Id);
 533                         end if;
 534                      end if;
 535
 536                      Scan.all;
 537
 538                   else
 539                      Error_Msg
 540                        ("symbol or literal string expected", Token_Ptr);
 541                   end if;
 542
 543                else
 544                   --  symbol (True or False)
 545
 546                   if Evaluation then
 547                      Symbol1 := Index_Of (Symbol_Name1);
 548
 549                      if Symbol1 = No_Symbol then
 550                         if Undefined_Symbols_Are_False then
 551                            Symbol_Value1 := String_False;
 552
 553                         else
 554                            Error_Msg_Name_1 := Symbol_Name1;
 555                            Error_Msg ("unknown symbol %", Symbol_Pos1);
 556                            Symbol_Value1 := No_String;
 557                         end if;
 558
 559                      else
 560                         Symbol_Value1 := Mapping.Table (Symbol1).Value;
 561                      end if;
 562
 563                      if Symbol_Value1 /= No_String then
 564                         String_To_Name_Buffer (Symbol_Value1);
 565
 566                         for Index in 1 .. Name_Len loop
 567                            Name_Buffer (Index) :=
 568                              Fold_Lower (Name_Buffer (Index));
 569                         end loop;
 570
 571                         if Name_Buffer (1 .. Name_Len) = "true" then
 572                            Current_Result := True;
 573
 574                         elsif Name_Buffer (1 .. Name_Len) = "false" then
 575                            Current_Result := False;
 576
 577                         else
 578                            Error_Msg_Name_1 := Symbol_Name1;
 579                            Error_Msg
 580                              ("value of symbol % is not True or False",
 581                               Symbol_Pos1);
 582                         end if;
 583                      end if;
 584                   end if;
 585                end if;
 586
 587             when others =>
 588                Error_Msg ("`(`, NOT or symbol expected", Token_Ptr);
 589          end case;
 590
 591          --  Update the cumulative final result
 592
 593          case Current_Operator is
 594             when None =>
 595                Final_Result := Current_Result;
 596
 597             when Op_Or =>
 598                Final_Result := Final_Result or Current_Result;
 599
 600             when Op_And =>
 601                Final_Result := Final_Result and Current_Result;
 602          end case;
 603
 604          --  Check the next operator
 605
 606          if Token = Tok_And then
 607             if Complemented then
 608                Error_Msg
 609                 ("mixing NOT and AND is not allowed, parentheses are required",
 610                  Token_Ptr);
 611
 612             elsif Current_Operator = Op_Or then
 613                Error_Msg ("mixing OR and AND is not allowed", Token_Ptr);
 614             end if;
 615
 616             Current_Operator := Op_And;
 617             Scan.all;
 618
 619             if Token = Tok_Then then
 620                Scan.all;
 621
 622                if Final_Result = False then
 623                   Evaluation := False;
 624                end if;
 625             end if;
 626
 627          elsif Token = Tok_Or then
 628             if Complemented then
 629                Error_Msg
 630                  ("mixing NOT and OR is not allowed, parentheses are required",
 631                   Token_Ptr);
 632
 633             elsif Current_Operator = Op_And then
 634                Error_Msg ("mixing AND and OR is not allowed", Token_Ptr);
 635             end if;
 636
 637             Current_Operator := Op_Or;
 638             Scan.all;
 639
 640             if Token = Tok_Else then
 641                Scan.all;
 642
 643                if Final_Result then
 644                   Evaluation := False;
 645                end if;
 646             end if;
 647
 648          else
 649             --  No operator: exit the term loop
 650
 651             exit;
 652          end if;
 653       end loop;
 654
 655       return Final_Result;
 656    end Expression;
 657
 658    -----------------------
 659    -- Go_To_End_Of_Line --
 660    -----------------------
 661
 662    procedure Go_To_End_Of_Line is
 663    begin
 664       --  Scan until we get an end of line or we reach the end of the buffer
 665
 666       while Token /= Tok_End_Of_Line
 667         and then Token /= Tok_EOF
 668       loop
 669          Scan.all;
 670       end loop;
 671    end Go_To_End_Of_Line;
 672
 673    --------------
 674    -- Index_Of --
 675    --------------
 676
 677    function Index_Of (Symbol : Name_Id) return Symbol_Id is
 678    begin
 679       if Mapping.Table /= null then
 680          for J in Symbol_Id range 1 .. Symbol_Table.Last (Mapping) loop
 681             if Mapping.Table (J).Symbol = Symbol then
 682                return J;
 683             end if;
 684          end loop;
 685       end if;
 686
 687       return No_Symbol;
 688    end Index_Of;
 689
 690    ----------------
 691    -- Initialize --
 692    ----------------
 693
 694    procedure Initialize
 695      (Error_Msg         : Error_Msg_Proc;
 696       Scan              : Scan_Proc;
 697       Set_Ignore_Errors : Set_Ignore_Errors_Proc;
 698       Put_Char          : Put_Char_Proc;
 699       New_EOL           : New_EOL_Proc)
 700    is
 701    begin
 702       if not Already_Initialized then
 703          Start_String;
 704          Store_String_Chars ("True");
 705          True_Value.Value := End_String;
 706
 707          Start_String;
 708          Empty_String := End_String;
 709
 710          Name_Len := 7;
 711          Name_Buffer (1 .. Name_Len) := "defined";
 712          Name_Defined := Name_Find;
 713
 714          Start_String;
 715          Store_String_Chars ("False");
 716          String_False := End_String;
 717
 718          Already_Initialized := True;
 719       end if;
 720
 721       Prep.Error_Msg         := Error_Msg;
 722       Prep.Scan              := Scan;
 723       Prep.Set_Ignore_Errors := Set_Ignore_Errors;
 724       Prep.Put_Char          := Put_Char;
 725       Prep.New_EOL           := New_EOL;
 726    end Initialize;
 727
 728    ------------------
 729    -- List_Symbols --
 730    ------------------
 731
 732    procedure List_Symbols (Foreword : String) is
 733       Order : array (0 ..  Integer (Symbol_Table.Last (Mapping)))
 734                  of Symbol_Id;
 735       --  After alphabetical sorting, this array stores the indices of
 736       --  the symbols in the order they are displayed.
 737
 738       function Lt (Op1, Op2 : Natural) return Boolean;
 739       --  Comparison routine for sort call
 740
 741       procedure Move (From : Natural; To : Natural);
 742       --  Move routine for sort call
 743
 744       --------
 745       -- Lt --
 746       --------
 747
 748       function Lt (Op1, Op2 : Natural) return Boolean is
 749          S1 : constant String :=
 750                 Get_Name_String (Mapping.Table (Order (Op1)).Symbol);
 751          S2 : constant String :=
 752                 Get_Name_String (Mapping.Table (Order (Op2)).Symbol);
 753
 754       begin
 755          return S1 < S2;
 756       end Lt;
 757
 758       ----------
 759       -- Move --
 760       ----------
 761
 762       procedure Move (From : Natural; To : Natural) is
 763       begin
 764          Order (To) := Order (From);
 765       end Move;
 766
 767       package Sort_Syms is new GNAT.Heap_Sort_G (Move, Lt);
 768
 769       Max_L : Natural;
 770       --  Maximum length of any symbol
 771
 772    --  Start of processing for List_Symbols_Case
 773
 774    begin
 775       if Symbol_Table.Last (Mapping) = 0 then
 776          return;
 777       end if;
 778
 779       if Foreword'Length > 0 then
 780          Write_Eol;
 781          Write_Line (Foreword);
 782
 783          for J in Foreword'Range loop
 784             Write_Char ('=');
 785          end loop;
 786       end if;
 787
 788       --  Initialize the order
 789
 790       for J in Order'Range loop
 791          Order (J) := Symbol_Id (J);
 792       end loop;
 793
 794       --  Sort alphabetically
 795
 796       Sort_Syms.Sort (Order'Last);
 797
 798       Max_L := 7;
 799
 800       for J in 1 .. Symbol_Table.Last (Mapping) loop
 801          Get_Name_String (Mapping.Table (J).Original);
 802          Max_L := Integer'Max (Max_L, Name_Len);
 803       end loop;
 804
 805       Write_Eol;
 806       Write_Str ("Symbol");
 807
 808       for J in 1 .. Max_L - 5 loop
 809          Write_Char (' ');
 810       end loop;
 811
 812       Write_Line ("Value");
 813
 814       Write_Str ("------");
 815
 816       for J in 1 .. Max_L - 5 loop
 817          Write_Char (' ');
 818       end loop;
 819
 820       Write_Line ("------");
 821
 822       for J in 1 .. Order'Last loop
 823          declare
 824             Data : constant Symbol_Data := Mapping.Table (Order (J));
 825
 826          begin
 827             Get_Name_String (Data.Original);
 828             Write_Str (Name_Buffer (1 .. Name_Len));
 829
 830             for K in Name_Len .. Max_L loop
 831                Write_Char (' ');
 832             end loop;
 833
 834             String_To_Name_Buffer (Data.Value);
 835
 836             if Data.Is_A_String then
 837                Write_Char ('"');
 838
 839                for J in 1 .. Name_Len loop
 840                   Write_Char (Name_Buffer (J));
 841
 842                   if Name_Buffer (J) = '"' then
 843                      Write_Char ('"');
 844                   end if;
 845                end loop;
 846
 847                Write_Char ('"');
 848
 849             else
 850                Write_Str (Name_Buffer (1 .. Name_Len));
 851             end if;
 852          end;
 853
 854          Write_Eol;
 855       end loop;
 856
 857       Write_Eol;
 858    end List_Symbols;
 859
 860    ----------------------
 861    -- Matching_Strings --
 862    ----------------------
 863
 864    function Matching_Strings (S1, S2 : String_Id) return Boolean is
 865    begin
 866       String_To_Name_Buffer (S1);
 867
 868       for Index in 1 .. Name_Len loop
 869          Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
 870       end loop;
 871
 872       declare
 873          String1 : constant String := Name_Buffer (1 .. Name_Len);
 874
 875       begin
 876          String_To_Name_Buffer (S2);
 877
 878          for Index in 1 .. Name_Len loop
 879             Name_Buffer (Index) := Fold_Lower (Name_Buffer (Index));
 880          end loop;
 881
 882          return String1 = Name_Buffer (1 .. Name_Len);
 883       end;
 884    end Matching_Strings;
 885
 886    --------------------
 887    -- Parse_Def_File --
 888    --------------------
 889
 890    procedure Parse_Def_File is
 891       Symbol        : Symbol_Id;
 892       Symbol_Name   : Name_Id;
 893       Original_Name : Name_Id;
 894       Data          : Symbol_Data;
 895       Value_Start   : Source_Ptr;
 896       Value_End     : Source_Ptr;
 897       Ch            : Character;
 898
 899       use ASCII;
 900
 901    begin
 902       Def_Line_Loop :
 903       loop
 904          Scan.all;
 905
 906          exit Def_Line_Loop when Token = Tok_EOF;
 907
 908          if Token /= Tok_End_Of_Line then
 909             Change_Reserved_Keyword_To_Symbol;
 910
 911             if Token /= Tok_Identifier then
 912                Error_Msg ("identifier expected", Token_Ptr);
 913                goto Cleanup;
 914             end if;
 915
 916             Symbol_Name := Token_Name;
 917             Name_Len := 0;
 918
 919             for Ptr in Token_Ptr .. Scan_Ptr - 1 loop
 920                Name_Len := Name_Len + 1;
 921                Name_Buffer (Name_Len) := Sinput.Source (Ptr);
 922             end loop;
 923
 924             Original_Name := Name_Find;
 925             Scan.all;
 926
 927             if Token /= Tok_Colon_Equal then
 928                Error_Msg ("`:=` expected", Token_Ptr);
 929                goto Cleanup;
 930             end if;
 931
 932             Scan.all;
 933
 934             if Token = Tok_String_Literal then
 935                Data := (Symbol              => Symbol_Name,
 936                         Original            => Original_Name,
 937                         On_The_Command_Line => False,
 938                         Is_A_String         => True,
 939                         Value               => String_Literal_Id);
 940
 941                Scan.all;
 942
 943                if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
 944                   Error_Msg ("extraneous text in definition", Token_Ptr);
 945                   goto Cleanup;
 946                end if;
 947
 948             elsif Token = Tok_End_Of_Line or Token = Tok_EOF then
 949                Data := (Symbol              => Symbol_Name,
 950                         Original            => Original_Name,
 951                         On_The_Command_Line => False,
 952                         Is_A_String         => False,
 953                         Value               => Empty_String);
 954
 955             else
 956                Value_Start := Token_Ptr;
 957                Value_End   := Token_Ptr - 1;
 958                Scan_Ptr    := Token_Ptr;
 959
 960                Value_Chars_Loop :
 961                loop
 962                   Ch := Sinput.Source (Scan_Ptr);
 963
 964                   case Ch is
 965                      when '_' | '.' | '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
 966                         Value_End := Scan_Ptr;
 967                         Scan_Ptr := Scan_Ptr + 1;
 968
 969                      when ' ' | HT | VT | CR | LF | FF =>
 970                         exit Value_Chars_Loop;
 971
 972                      when others =>
 973                         Error_Msg ("illegal character", Scan_Ptr);
 974                         goto Cleanup;
 975                   end case;
 976                end loop Value_Chars_Loop;
 977
 978                Scan.all;
 979
 980                if Token /= Tok_End_Of_Line and then Token /= Tok_EOF then
 981                   Error_Msg ("extraneous text in definition", Token_Ptr);
 982                   goto Cleanup;
 983                end if;
 984
 985                Start_String;
 986
 987                while Value_Start <= Value_End loop
 988                   Store_String_Char (Sinput.Source (Value_Start));
 989                   Value_Start := Value_Start + 1;
 990                end loop;
 991
 992                Data := (Symbol              => Symbol_Name,
 993                         Original            => Original_Name,
 994                         On_The_Command_Line => False,
 995                         Is_A_String         => False,
 996                         Value               => End_String);
 997             end if;
 998
 999             --  Now that we have the value, get the symbol index
1000
1001             Symbol := Index_Of (Symbol_Name);
1002
1003             if Symbol /= No_Symbol then
1004                --  If we already have an entry for this symbol, replace it
1005                --  with the new value, except if the symbol was declared
1006                --  on the command line.
1007
1008                if Mapping.Table (Symbol).On_The_Command_Line then
1009                   goto Continue;
1010                end if;
1011
1012             else
1013                --  As it is the first time we see this symbol, create a new
1014                --  entry in the table.
1015
1016                if Mapping.Table = null then
1017                   Symbol_Table.Init (Mapping);
1018                end if;
1019
1020                Symbol_Table.Increment_Last (Mapping);
1021                Symbol := Symbol_Table.Last (Mapping);
1022             end if;
1023
1024             Mapping.Table (Symbol) := Data;
1025             goto Continue;
1026
1027             <<Cleanup>>
1028                Set_Ignore_Errors (To => True);
1029
1030                while Token /= Tok_End_Of_Line and Token /= Tok_EOF loop
1031                   Scan.all;
1032                end loop;
1033
1034                Set_Ignore_Errors (To => False);
1035
1036             <<Continue>>
1037                null;
1038          end if;
1039       end loop Def_Line_Loop;
1040    end Parse_Def_File;
1041
1042    ----------------
1043    -- Preprocess --
1044    ----------------
1045
1046    procedure Preprocess (Source_Modified : out Boolean) is
1047       Start_Of_Processing : Source_Ptr;
1048       Cond                : Boolean;
1049       Preprocessor_Line   : Boolean := False;
1050       No_Error_Found      : Boolean := True;
1051       Modified            : Boolean := False;
1052
1053       procedure Output (From, To : Source_Ptr);
1054       --  Output the characters with indices From .. To in the buffer
1055       --  to the output file.
1056
1057       procedure Output_Line (From, To : Source_Ptr);
1058       --  Output a line or the end of a line from the buffer to the output
1059       --  file, followed by an end of line terminator. Depending on the value
1060       --  of Deleting and the switches, the line may be commented out, blank or
1061       --  not output at all.
1062
1063       ------------
1064       -- Output --
1065       ------------
1066
1067       procedure Output (From, To : Source_Ptr) is
1068       begin
1069          for J in From .. To loop
1070             Put_Char (Sinput.Source (J));
1071          end loop;
1072       end Output;
1073
1074       -----------------
1075       -- Output_Line --
1076       -----------------
1077
1078       procedure Output_Line (From, To : Source_Ptr) is
1079       begin
1080          if Deleting or Preprocessor_Line then
1081             if Blank_Deleted_Lines then
1082                New_EOL.all;
1083
1084             elsif Comment_Deleted_Lines then
1085                Put_Char ('-');
1086                Put_Char ('-');
1087                Put_Char ('!');
1088
1089                if From < To then
1090                   Put_Char (' ');
1091                   Output (From, To);
1092                end if;
1093
1094                New_EOL.all;
1095             end if;
1096
1097          else
1098             Output (From, To);
1099             New_EOL.all;
1100          end if;
1101       end Output_Line;
1102
1103    --  Start of processing for Preprocess
1104
1105    begin
1106       Start_Of_Processing := Scan_Ptr;
1107
1108       --  We need to call Scan for the first time, because Initialize_Scanner
1109       --  is no longer doing it.
1110
1111       Scan.all;
1112
1113       Input_Line_Loop : loop
1114          exit Input_Line_Loop when Token = Tok_EOF;
1115
1116          Preprocessor_Line := False;
1117
1118          if Token /= Tok_End_Of_Line then
1119
1120             --  Preprocessor line
1121
1122             if Token = Tok_Special and then Special_Character = '#' then
1123                Modified := True;
1124                Preprocessor_Line := True;
1125                Scan.all;
1126
1127                case Token is
1128
1129                   --  #if
1130
1131                   when Tok_If =>
1132                      declare
1133                         If_Ptr : constant Source_Ptr := Token_Ptr;
1134
1135                      begin
1136                         Scan.all;
1137                         Cond := Expression (not Deleting);
1138
1139                         --  Check for an eventual "then"
1140
1141                         if Token = Tok_Then then
1142                            Scan.all;
1143                         end if;
1144
1145                         --  It is an error to have trailing characters after
1146                         --  the condition or "then".
1147
1148                         if Token /= Tok_End_Of_Line
1149                           and then Token /= Tok_EOF
1150                         then
1151                            Error_Msg
1152                              ("extraneous text on preprocessor line",
1153                               Token_Ptr);
1154                            No_Error_Found := False;
1155                            Go_To_End_Of_Line;
1156                         end if;
1157
1158                         declare
1159                            --  Set the initial state of this new "#if". This
1160                            --  must be done before incrementing the Last of
1161                            --  the table, otherwise function Deleting does
1162                            --  not report the correct value.
1163
1164                            New_State : constant Pp_State :=
1165                                          (If_Ptr     => If_Ptr,
1166                                           Else_Ptr   => 0,
1167                                           Deleting   => Deleting or (not Cond),
1168                                           Match_Seen => Deleting or Cond);
1169
1170                         begin
1171                            Pp_States.Increment_Last;
1172                            Pp_States.Table (Pp_States.Last) := New_State;
1173                         end;
1174                      end;
1175
1176                   --  #elsif
1177
1178                   when Tok_Elsif =>
1179                      Cond := False;
1180
1181                      if Pp_States.Last = 0
1182                        or else Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
1183                      then
1184                         Error_Msg ("no IF for this ELSIF", Token_Ptr);
1185                         No_Error_Found := False;
1186
1187                      else
1188                         Cond :=
1189                           not Pp_States.Table (Pp_States.Last).Match_Seen;
1190                      end if;
1191
1192                      Scan.all;
1193                      Cond := Expression (Cond);
1194
1195                      --  Check for an eventual "then"
1196
1197                      if Token = Tok_Then then
1198                         Scan.all;
1199                      end if;
1200
1201                      --  It is an error to have trailing characters after
1202                      --  the condition or "then".
1203
1204                      if Token /= Tok_End_Of_Line
1205                        and then Token /= Tok_EOF
1206                      then
1207                         Error_Msg
1208                           ("extraneous text on preprocessor line",
1209                            Token_Ptr);
1210                         No_Error_Found := False;
1211
1212                         Go_To_End_Of_Line;
1213                      end if;
1214
1215                      --  Depending on the value of the condition, set the
1216                      --  new values of Deleting and Match_Seen.
1217                      if Pp_States.Last > 0 then
1218                         if Pp_States.Table (Pp_States.Last).Match_Seen then
1219                            Pp_States.Table (Pp_States.Last).Deleting := True;
1220                         else
1221                            if Cond then
1222                               Pp_States.Table (Pp_States.Last).Match_Seen :=
1223                                 True;
1224                               Pp_States.Table (Pp_States.Last).Deleting :=
1225                                 False;
1226                            end if;
1227                         end if;
1228                      end if;
1229
1230                   --  #else
1231
1232                   when Tok_Else =>
1233                      if Pp_States.Last = 0 then
1234                         Error_Msg ("no IF for this ELSE", Token_Ptr);
1235                         No_Error_Found := False;
1236
1237                      elsif
1238                        Pp_States.Table (Pp_States.Last).Else_Ptr /= 0
1239                      then
1240                         Error_Msg ("duplicate ELSE line", Token_Ptr);
1241                         No_Error_Found := False;
1242                      end if;
1243
1244                      --  Set the possibly new values of Deleting and
1245                      --  Match_Seen.
1246
1247                      if Pp_States.Last > 0 then
1248                         if Pp_States.Table (Pp_States.Last).Match_Seen then
1249                            Pp_States.Table (Pp_States.Last).Deleting :=
1250                              True;
1251
1252                         else
1253                            Pp_States.Table (Pp_States.Last).Match_Seen :=
1254                              True;
1255                            Pp_States.Table (Pp_States.Last).Deleting :=
1256                              False;
1257                         end if;
1258
1259                         --  Set the Else_Ptr to check for illegal #elsif
1260                         --  later.
1261
1262                         Pp_States.Table (Pp_States.Last).Else_Ptr :=
1263                           Token_Ptr;
1264                      end if;
1265
1266                      Scan.all;
1267
1268                      --  It is an error to have characters after "#else"
1269                      if Token /= Tok_End_Of_Line
1270                        and then Token /= Tok_EOF
1271                      then
1272                         Error_Msg
1273                           ("extraneous text on preprocessor line",
1274                            Token_Ptr);
1275                         No_Error_Found := False;
1276                         Go_To_End_Of_Line;
1277                      end if;
1278
1279                   --  #end if;
1280
1281                   when Tok_End =>
1282                      if Pp_States.Last = 0 then
1283                         Error_Msg ("no IF for this END", Token_Ptr);
1284                         No_Error_Found := False;
1285                      end if;
1286
1287                      Scan.all;
1288
1289                      if Token /= Tok_If then
1290                         Error_Msg ("IF expected", Token_Ptr);
1291                         No_Error_Found := False;
1292
1293                      else
1294                         Scan.all;
1295
1296                         if Token /= Tok_Semicolon then
1297                            Error_Msg ("`;` Expected", Token_Ptr);
1298                            No_Error_Found := False;
1299
1300                         else
1301                            Scan.all;
1302
1303                            --  It is an error to have character after
1304                            --  "#end if;".
1305                            if Token /= Tok_End_Of_Line
1306                              and then Token /= Tok_EOF
1307                            then
1308                               Error_Msg
1309                                 ("extraneous text on preprocessor line",
1310                                  Token_Ptr);
1311                               No_Error_Found := False;
1312                            end if;
1313                         end if;
1314                      end if;
1315
1316                      --  In case of one of the errors above, skip the tokens
1317                      --  until the end of line is reached.
1318
1319                      Go_To_End_Of_Line;
1320
1321                      --  Decrement the depth of the #if stack
1322
1323                      if Pp_States.Last > 0 then
1324                         Pp_States.Decrement_Last;
1325                      end if;
1326
1327                   --  Illegal preprocessor line
1328
1329                   when others =>
1330                      No_Error_Found := False;
1331
1332                      if Pp_States.Last = 0 then
1333                         Error_Msg ("IF expected", Token_Ptr);
1334
1335                      elsif
1336                        Pp_States.Table (Pp_States.Last).Else_Ptr = 0
1337                      then
1338                         Error_Msg ("IF, ELSIF, ELSE, or `END IF` expected",
1339                                    Token_Ptr);
1340
1341                      else
1342                         Error_Msg ("IF or `END IF` expected", Token_Ptr);
1343                      end if;
1344
1345                      --  Skip to the end of this illegal line
1346
1347                      Go_To_End_Of_Line;
1348                end case;
1349
1350             --  Not a preprocessor line
1351
1352             else
1353                --  Do not report errors for those lines, even if there are
1354                --  Ada parsing errors.
1355
1356                Set_Ignore_Errors (To => True);
1357
1358                if Deleting then
1359                   Go_To_End_Of_Line;
1360
1361                else
1362                   while Token /= Tok_End_Of_Line
1363                     and then Token /= Tok_EOF
1364                   loop
1365                      if Token = Tok_Special
1366                        and then Special_Character = '$'
1367                      then
1368                         Modified := True;
1369
1370                         declare
1371                            Dollar_Ptr : constant Source_Ptr := Token_Ptr;
1372                            Symbol     : Symbol_Id;
1373
1374                         begin
1375                            Scan.all;
1376                            Change_Reserved_Keyword_To_Symbol;
1377
1378                            if Token = Tok_Identifier
1379                              and then Token_Ptr = Dollar_Ptr + 1
1380                            then
1381                               --  $symbol
1382
1383                               Symbol := Index_Of (Token_Name);
1384
1385                               --  If symbol exists, replace by its value
1386
1387                               if Symbol /= No_Symbol then
1388                                  Output (Start_Of_Processing, Dollar_Ptr - 1);
1389                                  Start_Of_Processing := Scan_Ptr;
1390                                  String_To_Name_Buffer
1391                                    (Mapping.Table (Symbol).Value);
1392
1393                                  if Mapping.Table (Symbol).Is_A_String then
1394
1395                                     --  Value is an Ada string
1396
1397                                     Put_Char ('"');
1398
1399                                     for J in 1 .. Name_Len loop
1400                                        Put_Char (Name_Buffer (J));
1401
1402                                        if Name_Buffer (J) = '"' then
1403                                           Put_Char ('"');
1404                                        end if;
1405                                     end loop;
1406
1407                                     Put_Char ('"');
1408
1409                                  else
1410                                     --  Value is a sequence of characters, not
1411                                     --  an Ada string.
1412
1413                                     for J in 1 .. Name_Len loop
1414                                        Put_Char (Name_Buffer (J));
1415                                     end loop;
1416                                  end if;
1417                               end if;
1418                            end if;
1419                         end;
1420                      end if;
1421
1422                      Scan.all;
1423                   end loop;
1424                end if;
1425
1426                Set_Ignore_Errors (To => False);
1427             end if;
1428          end if;
1429
1430          pragma Assert (Token = Tok_End_Of_Line or Token = Tok_EOF);
1431
1432          --  At this point, the token is either end of line or EOF.
1433          --  The line to possibly output stops just before the token.
1434
1435          Output_Line (Start_Of_Processing, Token_Ptr - 1);
1436
1437          --  If we are at the end of a line, the scan pointer is at the first
1438          --  non blank character, not necessarily the first character of the
1439          --  line; so, we have to deduct Start_Of_Processing from the token
1440          --  pointer.
1441
1442          if Token = Tok_End_Of_Line then
1443             if (Sinput.Source (Token_Ptr) = ASCII.CR
1444                   and then Sinput.Source (Token_Ptr + 1) = ASCII.LF)
1445               or else
1446                (Sinput.Source (Token_Ptr) = ASCII.CR
1447                   and then Sinput.Source (Token_Ptr + 1) = ASCII.LF)
1448             then
1449                Start_Of_Processing := Token_Ptr + 2;
1450             else
1451                Start_Of_Processing := Token_Ptr + 1;
1452             end if;
1453          end if;
1454
1455          --  Now, scan the first token of the next line. If the token is EOF,
1456          --  the scan pointer will not move, and the token will still be EOF.
1457
1458          Set_Ignore_Errors (To => True);
1459          Scan.all;
1460          Set_Ignore_Errors (To => False);
1461       end loop Input_Line_Loop;
1462
1463       --  Report an error for any missing some "#end if;"
1464
1465       for Level in reverse 1 .. Pp_States.Last loop
1466          Error_Msg ("no `END IF` for this IF", Pp_States.Table (Level).If_Ptr);
1467          No_Error_Found := False;
1468       end loop;
1469
1470       Source_Modified := No_Error_Found and Modified;
1471    end Preprocess;
1472
1473 end Prep;