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