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