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