gcc/ada/sinput-l.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             S I N P U T . L                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Alloc;
  27 with Atree;    use Atree;
  28 with Debug;    use Debug;
  29 with Einfo;    use Einfo;
  30 with Errout;   use Errout;
  31 with Fname;    use Fname;
  32 with Hostparm;
  33 with Opt;      use Opt;
  34 with Osint;    use Osint;
  35 with Output;   use Output;
  36 with Prep;     use Prep;
  37 with Prepcomp; use Prepcomp;
  38 with Scans;    use Scans;
  39 with Scn;      use Scn;
  40 with Sinfo;    use Sinfo;
  41 with Snames;   use Snames;
  42 with System;   use System;
  43
  44 with System.OS_Lib; use System.OS_Lib;
  45
  46 with Unchecked_Conversion;
  47
  48 package body Sinput.L is
  49
  50    Prep_Buffer : Text_Buffer_Ptr := null;
  51    --  A buffer to temporarily stored the result of preprocessing a source.
  52    --  It is only allocated if there is at least one source to preprocess.
  53
  54    Prep_Buffer_Last : Text_Ptr := 0;
  55    --  Index of the last significant character in Prep_Buffer
  56
  57    Initial_Size_Of_Prep_Buffer : constant := 10_000;
  58    --  Size of Prep_Buffer when it is first allocated
  59
  60    --  When a file is to be preprocessed and the options to list symbols
  61    --  has been selected (switch -s), Prep.List_Symbols is called with a
  62    --  "foreword", a single line indicating what source the symbols apply to.
  63    --  The following two constant String are the start and the end of this
  64    --  foreword.
  65
  66    Foreword_Start : constant String :=
  67                       "Preprocessing Symbols for source """;
  68
  69    Foreword_End : constant String := """";
  70
  71    -----------------
  72    -- Subprograms --
  73    -----------------
  74
  75    procedure Put_Char_In_Prep_Buffer (C : Character);
  76    --  Add one character in Prep_Buffer, extending Prep_Buffer if need be.
  77    --  Used to initialize the preprocessor.
  78
  79    procedure New_EOL_In_Prep_Buffer;
  80    --  Add an LF to Prep_Buffer (used to initialize the preprocessor)
  81
  82    function Load_File
  83      (N : File_Name_Type;
  84       T : Osint.File_Type) return Source_File_Index;
  85    --  Load a source file, a configuration pragmas file or a definition file
  86    --  Coding also allows preprocessing file, but not a library file ???
  87
  88    -------------------------------
  89    -- Adjust_Instantiation_Sloc --
  90    -------------------------------
  91
  92    procedure Adjust_Instantiation_Sloc (N : Node_Id; A : Sloc_Adjustment) is
  93       Loc : constant Source_Ptr := Sloc (N);
  94
  95    begin
  96       --  We only do the adjustment if the value is between the appropriate low
  97       --  and high values. It is not clear that this should ever not be the
  98       --  case, but in practice there seem to be some nodes that get copied
  99       --  twice, and this is a defence against that happening.
 100
 101       if A.Lo <= Loc and then Loc <= A.Hi then
 102          Set_Sloc (N, Loc + A.Adjust);
 103       end if;
 104    end Adjust_Instantiation_Sloc;
 105
 106    --------------------------------
 107    -- Complete_Source_File_Entry --
 108    --------------------------------
 109
 110    procedure Complete_Source_File_Entry is
 111       CSF : constant Source_File_Index := Current_Source_File;
 112
 113    begin
 114       Trim_Lines_Table (CSF);
 115       Source_File.Table (CSF).Source_Checksum := Checksum;
 116    end Complete_Source_File_Entry;
 117
 118    ---------------------------------
 119    -- Create_Instantiation_Source --
 120    ---------------------------------
 121
 122    procedure Create_Instantiation_Source
 123      (Inst_Node    : Entity_Id;
 124       Template_Id  : Entity_Id;
 125       Inlined_Body : Boolean;
 126       A            : out Sloc_Adjustment)
 127    is
 128       Dnod : constant Node_Id := Declaration_Node (Template_Id);
 129       Xold : Source_File_Index;
 130       Xnew : Source_File_Index;
 131
 132    begin
 133       Xold := Get_Source_File_Index (Sloc (Template_Id));
 134       A.Lo := Source_File.Table (Xold).Source_First;
 135       A.Hi := Source_File.Table (Xold).Source_Last;
 136
 137       Source_File.Append (Source_File.Table (Xold));
 138       Xnew := Source_File.Last;
 139
 140       Source_File.Table (Xnew).Inlined_Body  := Inlined_Body;
 141       Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node);
 142       Source_File.Table (Xnew).Template      := Xold;
 143
 144       --  Now we need to compute the new values of Source_First, Source_Last
 145       --  and adjust the source file pointer to have the correct virtual
 146       --  origin for the new range of values.
 147
 148       Source_File.Table (Xnew).Source_First :=
 149         Source_File.Table (Xnew - 1).Source_Last + 1;
 150       A.Adjust := Source_File.Table (Xnew).Source_First - A.Lo;
 151       Source_File.Table (Xnew).Source_Last := A.Hi + A.Adjust;
 152
 153       Set_Source_File_Index_Table (Xnew);
 154
 155       Source_File.Table (Xnew).Sloc_Adjust :=
 156         Source_File.Table (Xold).Sloc_Adjust - A.Adjust;
 157
 158       if Debug_Flag_L then
 159          Write_Eol;
 160          Write_Str ("*** Create instantiation source for ");
 161
 162          if Nkind (Dnod) in N_Proper_Body
 163            and then Was_Originally_Stub (Dnod)
 164          then
 165             Write_Str ("subunit ");
 166
 167          elsif Ekind (Template_Id) = E_Generic_Package then
 168             if Nkind (Dnod) = N_Package_Body then
 169                Write_Str ("body of package ");
 170             else
 171                Write_Str ("spec of package ");
 172             end if;
 173
 174          elsif Ekind (Template_Id) = E_Function then
 175             Write_Str ("body of function ");
 176
 177          elsif Ekind (Template_Id) = E_Procedure then
 178             Write_Str ("body of procedure ");
 179
 180          elsif Ekind (Template_Id) = E_Generic_Function then
 181             Write_Str ("spec of function ");
 182
 183          elsif Ekind (Template_Id) = E_Generic_Procedure then
 184             Write_Str ("spec of procedure ");
 185
 186          elsif Ekind (Template_Id) = E_Package_Body then
 187             Write_Str ("body of package ");
 188
 189          else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
 190
 191             if Nkind (Dnod) = N_Procedure_Specification then
 192                Write_Str ("body of procedure ");
 193             else
 194                Write_Str ("body of function ");
 195             end if;
 196          end if;
 197
 198          Write_Name (Chars (Template_Id));
 199          Write_Eol;
 200
 201          Write_Str ("  new source index = ");
 202          Write_Int (Int (Xnew));
 203          Write_Eol;
 204
 205          Write_Str ("  copying from file name = ");
 206          Write_Name (File_Name (Xold));
 207          Write_Eol;
 208
 209          Write_Str ("  old source index = ");
 210          Write_Int (Int (Xold));
 211          Write_Eol;
 212
 213          Write_Str ("  old lo = ");
 214          Write_Int (Int (A.Lo));
 215          Write_Eol;
 216
 217          Write_Str ("  old hi = ");
 218          Write_Int (Int (A.Hi));
 219          Write_Eol;
 220
 221          Write_Str ("  new lo = ");
 222          Write_Int (Int (Source_File.Table (Xnew).Source_First));
 223          Write_Eol;
 224
 225          Write_Str ("  new hi = ");
 226          Write_Int (Int (Source_File.Table (Xnew).Source_Last));
 227          Write_Eol;
 228
 229          Write_Str ("  adjustment factor = ");
 230          Write_Int (Int (A.Adjust));
 231          Write_Eol;
 232
 233          Write_Str ("  instantiation location: ");
 234          Write_Location (Sloc (Inst_Node));
 235          Write_Eol;
 236       end if;
 237
 238       --  For a given character in the source, a higher subscript will be used
 239       --  to access the instantiation, which means that the virtual origin must
 240       --  have a corresponding lower value. We compute this new origin by
 241       --  taking the address of the appropriate adjusted element in the old
 242       --  array. Since this adjusted element will be at a negative subscript,
 243       --  we must suppress checks.
 244
 245       declare
 246          pragma Suppress (All_Checks);
 247
 248          pragma Warnings (Off);
 249          --  This unchecked conversion is aliasing safe, since it is never used
 250          --  to create improperly aliased pointer values.
 251
 252          function To_Source_Buffer_Ptr is new
 253            Unchecked_Conversion (Address, Source_Buffer_Ptr);
 254
 255          pragma Warnings (On);
 256
 257       begin
 258          Source_File.Table (Xnew).Source_Text :=
 259            To_Source_Buffer_Ptr
 260              (Source_File.Table (Xold).Source_Text (-A.Adjust)'Address);
 261       end;
 262    end Create_Instantiation_Source;
 263
 264    ----------------------
 265    -- Load_Config_File --
 266    ----------------------
 267
 268    function Load_Config_File
 269      (N : File_Name_Type) return Source_File_Index
 270    is
 271    begin
 272       return Load_File (N, Osint.Config);
 273    end Load_Config_File;
 274
 275    --------------------------
 276    -- Load_Definition_File --
 277    --------------------------
 278
 279    function Load_Definition_File
 280      (N : File_Name_Type) return Source_File_Index
 281    is
 282    begin
 283       return Load_File (N, Osint.Definition);
 284    end Load_Definition_File;
 285
 286    ---------------
 287    -- Load_File --
 288    ---------------
 289
 290    function Load_File
 291      (N : File_Name_Type;
 292       T : Osint.File_Type) return Source_File_Index
 293    is
 294       Src : Source_Buffer_Ptr;
 295       X   : Source_File_Index;
 296       Lo  : Source_Ptr;
 297       Hi  : Source_Ptr;
 298
 299       Preprocessing_Needed : Boolean := False;
 300
 301    begin
 302       --  If already there, don't need to reload file. An exception occurs
 303       --  in multiple unit per file mode. It would be nice in this case to
 304       --  share the same source file for each unit, but this leads to many
 305       --  difficulties with assumptions (e.g. in the body of lib), that a
 306       --  unit can be found by locating its source file index. Since we do
 307       --  not expect much use of this mode, it's no big deal to waste a bit
 308       --  of space and time by reading and storing the source multiple times.
 309
 310       if Multiple_Unit_Index = 0 then
 311          for J in 1 .. Source_File.Last loop
 312             if Source_File.Table (J).File_Name = N then
 313                return J;
 314             end if;
 315          end loop;
 316       end if;
 317
 318       --  Here we must build a new entry in the file table
 319
 320       --  But first, we must check if a source needs to be preprocessed,
 321       --  because we may have to load and parse a definition file, and we want
 322       --  to do that before we load the source, so that the buffer of the
 323       --  source will be the last created, and we will be able to replace it
 324       --  and modify Hi without stepping on another buffer.
 325
 326       if T = Osint.Source and then not Is_Internal_File_Name (N) then
 327          Prepare_To_Preprocess
 328            (Source => N, Preprocessing_Needed => Preprocessing_Needed);
 329       end if;
 330
 331       Source_File.Increment_Last;
 332       X := Source_File.Last;
 333
 334       if X = Source_File.First then
 335          Lo := First_Source_Ptr;
 336       else
 337          Lo := Source_File.Table (X - 1).Source_Last + 1;
 338       end if;
 339
 340       Osint.Read_Source_File (N, Lo, Hi, Src, T);
 341
 342       if Src = null then
 343          Source_File.Decrement_Last;
 344          return No_Source_File;
 345
 346       else
 347          if Debug_Flag_L then
 348             Write_Eol;
 349             Write_Str ("*** Build source file table entry, Index = ");
 350             Write_Int (Int (X));
 351             Write_Str (", file name = ");
 352             Write_Name (N);
 353             Write_Eol;
 354             Write_Str ("  lo = ");
 355             Write_Int (Int (Lo));
 356             Write_Eol;
 357             Write_Str ("  hi = ");
 358             Write_Int (Int (Hi));
 359             Write_Eol;
 360
 361             Write_Str ("  first 10 chars -->");
 362
 363             declare
 364                procedure Wchar (C : Character);
 365                --  Writes character or ? for control character
 366
 367                -----------
 368                -- Wchar --
 369                -----------
 370
 371                procedure Wchar (C : Character) is
 372                begin
 373                   if C < ' '
 374                     or else C in ASCII.DEL .. Character'Val (16#9F#)
 375                   then
 376                      Write_Char ('?');
 377                   else
 378                      Write_Char (C);
 379                   end if;
 380                end Wchar;
 381
 382             begin
 383                for J in Lo .. Lo + 9 loop
 384                   Wchar (Src (J));
 385                end loop;
 386
 387                Write_Str ("<--");
 388                Write_Eol;
 389
 390                Write_Str ("  last 10 chars  -->");
 391
 392                for J in Hi - 10 .. Hi - 1 loop
 393                   Wchar (Src (J));
 394                end loop;
 395
 396                Write_Str ("<--");
 397                Write_Eol;
 398
 399                if Src (Hi) /= EOF then
 400                   Write_Str ("  error: no EOF at end");
 401                   Write_Eol;
 402                end if;
 403             end;
 404          end if;
 405
 406          declare
 407             S         : Source_File_Record renames Source_File.Table (X);
 408             File_Type : Type_Of_File;
 409
 410          begin
 411             case T is
 412                when Osint.Source =>
 413                   File_Type := Sinput.Src;
 414
 415                when Osint.Library =>
 416                   raise Program_Error;
 417
 418                when Osint.Config =>
 419                   File_Type := Sinput.Config;
 420
 421                when Osint.Definition =>
 422                   File_Type := Def;
 423
 424                when Osint.Preprocessing_Data =>
 425                   File_Type := Preproc;
 426             end case;
 427
 428             S := (Debug_Source_Name   => N,
 429                   File_Name           => N,
 430                   File_Type           => File_Type,
 431                   First_Mapped_Line   => No_Line_Number,
 432                   Full_Debug_Name     => Osint.Full_Source_Name,
 433                   Full_File_Name      => Osint.Full_Source_Name,
 434                   Full_Ref_Name       => Osint.Full_Source_Name,
 435                   Identifier_Casing   => Unknown,
 436                   Inlined_Body        => False,
 437                   Instantiation       => No_Location,
 438                   Keyword_Casing      => Unknown,
 439                   Last_Source_Line    => 1,
 440                   License             => Unknown,
 441                   Lines_Table         => null,
 442                   Lines_Table_Max     => 1,
 443                   Logical_Lines_Table => null,
 444                   Num_SRef_Pragmas    => 0,
 445                   Reference_Name      => N,
 446                   Sloc_Adjust         => 0,
 447                   Source_Checksum     => 0,
 448                   Source_First        => Lo,
 449                   Source_Last         => Hi,
 450                   Source_Text         => Src,
 451                   Template            => No_Source_File,
 452                   Unit                => No_Unit,
 453                   Time_Stamp          => Osint.Current_Source_File_Stamp);
 454
 455             Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
 456             S.Lines_Table (1) := Lo;
 457          end;
 458
 459          --  Preprocess the source if it needs to be preprocessed
 460
 461          if Preprocessing_Needed then
 462
 463             --  Temporarily set the Source_File_Index_Table entries for the
 464             --  source, to avoid crash when reporting an error.
 465
 466             Set_Source_File_Index_Table (X);
 467
 468             if Opt.List_Preprocessing_Symbols then
 469                Get_Name_String (N);
 470
 471                declare
 472                   Foreword : String (1 .. Foreword_Start'Length +
 473                                           Name_Len + Foreword_End'Length);
 474
 475                begin
 476                   Foreword (1 .. Foreword_Start'Length) := Foreword_Start;
 477                   Foreword (Foreword_Start'Length + 1 ..
 478                               Foreword_Start'Length + Name_Len) :=
 479                     Name_Buffer (1 .. Name_Len);
 480                   Foreword (Foreword'Last - Foreword_End'Length + 1 ..
 481                               Foreword'Last) := Foreword_End;
 482                   Prep.List_Symbols (Foreword);
 483                end;
 484             end if;
 485
 486             declare
 487                T : constant Nat := Total_Errors_Detected;
 488                --  Used to check if there were errors during preprocessing
 489
 490                Save_Style_Check : Boolean;
 491                --  Saved state of the Style_Check flag (which needs to be
 492                --  temporarily set to False during preprocessing, see below).
 493
 494                Modified : Boolean;
 495
 496             begin
 497                --  If this is the first time we preprocess a source, allocate
 498                --  the preprocessing buffer.
 499
 500                if Prep_Buffer = null then
 501                   Prep_Buffer :=
 502                     new Text_Buffer (1 .. Initial_Size_Of_Prep_Buffer);
 503                end if;
 504
 505                --  Make sure the preprocessing buffer is empty
 506
 507                Prep_Buffer_Last := 0;
 508
 509                --  Initialize the preprocessor hooks
 510
 511                Prep.Setup_Hooks
 512                  (Error_Msg         => Errout.Error_Msg'Access,
 513                   Scan              => Scn.Scanner.Scan'Access,
 514                   Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access,
 515                   Put_Char          => Put_Char_In_Prep_Buffer'Access,
 516                   New_EOL           => New_EOL_In_Prep_Buffer'Access);
 517
 518                --  Initialize scanner and set its behavior for preprocessing,
 519                --  then preprocess. Also disable style checks, since some of
 520                --  them are done in the scanner (specifically, those dealing
 521                --  with line length and line termination), and cannot be done
 522                --  during preprocessing (because the source file index table
 523                --  has not been set yet).
 524
 525                Scn.Scanner.Initialize_Scanner (X);
 526
 527                Scn.Scanner.Set_Special_Character ('#');
 528                Scn.Scanner.Set_Special_Character ('$');
 529                Scn.Scanner.Set_End_Of_Line_As_Token (True);
 530                Save_Style_Check := Opt.Style_Check;
 531                Opt.Style_Check := False;
 532
 533                --  Make sure that there will be no check of pragma Restrictions
 534                --  for obsolescent features while preprocessing the source.
 535
 536                Scn.Set_Obsolescent_Check (False);
 537                Preprocess (Modified);
 538                Scn.Set_Obsolescent_Check (True);
 539
 540                --  Reset the scanner to its standard behavior, and restore the
 541                --  Style_Checks flag.
 542
 543                Scn.Scanner.Reset_Special_Characters;
 544                Scn.Scanner.Set_End_Of_Line_As_Token (False);
 545                Opt.Style_Check := Save_Style_Check;
 546
 547                --  If there were errors during preprocessing, record an error
 548                --  at the start of the file, and do not change the source
 549                --  buffer.
 550
 551                if T /= Total_Errors_Detected then
 552                   Errout.Error_Msg
 553                     ("file could not be successfully preprocessed", Lo);
 554                   return No_Source_File;
 555
 556                else
 557                   --  Output the result of the preprocessing, if requested and
 558                   --  the source has been modified by the preprocessing.
 559
 560                   if Generate_Processed_File and then Modified then
 561                      declare
 562                         FD     : File_Descriptor;
 563                         NB     : Integer;
 564                         Status : Boolean;
 565
 566                      begin
 567                         Get_Name_String (N);
 568
 569                         if Hostparm.OpenVMS then
 570                            Add_Str_To_Name_Buffer ("_prep");
 571                         else
 572                            Add_Str_To_Name_Buffer (".prep");
 573                         end if;
 574
 575                         Delete_File (Name_Buffer (1 .. Name_Len), Status);
 576
 577                         FD :=
 578                           Create_New_File (Name_Buffer (1 .. Name_Len), Text);
 579
 580                         Status := FD /= Invalid_FD;
 581
 582                         if Status then
 583                            NB :=
 584                              Write
 585                                (FD,
 586                                 Prep_Buffer (1)'Address,
 587                                 Integer (Prep_Buffer_Last));
 588                            Status := NB = Integer (Prep_Buffer_Last);
 589                         end if;
 590
 591                         if Status then
 592                            Close (FD, Status);
 593                         end if;
 594
 595                         if not Status then
 596                            Errout.Error_Msg
 597                              ("could not write processed file """ &
 598                               Name_Buffer (1 .. Name_Len) & '"',
 599                               Lo);
 600                            return No_Source_File;
 601                         end if;
 602                      end;
 603                   end if;
 604
 605                   --  Set the new value of Hi
 606
 607                   Hi := Lo + Source_Ptr (Prep_Buffer_Last);
 608
 609                   --  Create the new source buffer
 610
 611                   declare
 612                      subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
 613                      --  Physical buffer allocated
 614
 615                      type Actual_Source_Ptr is access Actual_Source_Buffer;
 616                      --  Pointer type for the physical buffer allocated
 617
 618                      Actual_Ptr : constant Actual_Source_Ptr :=
 619                                     new Actual_Source_Buffer;
 620                      --  Actual physical buffer
 621
 622                   begin
 623                      Actual_Ptr (Lo .. Hi - 1) :=
 624                        Prep_Buffer (1 .. Prep_Buffer_Last);
 625                      Actual_Ptr (Hi) := EOF;
 626
 627                      --  Now we need to work out the proper virtual origin
 628                      --  pointer to return. This is Actual_Ptr (0)'Address, but
 629                      --  we have to be careful to suppress checks to compute
 630                      --  this address.
 631
 632                      declare
 633                         pragma Suppress (All_Checks);
 634
 635                         pragma Warnings (Off);
 636                         --  This unchecked conversion is aliasing safe, since
 637                         --  it is never used to create improperly aliased
 638                         --  pointer values.
 639
 640                         function To_Source_Buffer_Ptr is new
 641                           Unchecked_Conversion (Address, Source_Buffer_Ptr);
 642
 643                         pragma Warnings (On);
 644
 645                      begin
 646                         Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
 647
 648                         --  Record in the table the new source buffer and the
 649                         --  new value of Hi.
 650
 651                         Source_File.Table (X).Source_Text := Src;
 652                         Source_File.Table (X).Source_Last := Hi;
 653
 654                         --  Reset Last_Line to 1, because the lines do not
 655                         --  have necessarily the same starts and lengths.
 656
 657                         Source_File.Table (X).Last_Source_Line := 1;
 658                      end;
 659                   end;
 660                end if;
 661             end;
 662          end if;
 663
 664          Set_Source_File_Index_Table (X);
 665          return X;
 666       end if;
 667    end Load_File;
 668
 669    ----------------------------------
 670    -- Load_Preprocessing_Data_File --
 671    ----------------------------------
 672
 673    function Load_Preprocessing_Data_File
 674      (N : File_Name_Type) return Source_File_Index
 675    is
 676    begin
 677       return Load_File (N, Osint.Preprocessing_Data);
 678    end Load_Preprocessing_Data_File;
 679
 680    ----------------------
 681    -- Load_Source_File --
 682    ----------------------
 683
 684    function Load_Source_File
 685      (N : File_Name_Type) return Source_File_Index
 686    is
 687    begin
 688       return Load_File (N, Osint.Source);
 689    end Load_Source_File;
 690
 691    ----------------------------
 692    -- New_EOL_In_Prep_Buffer --
 693    ----------------------------
 694
 695    procedure New_EOL_In_Prep_Buffer is
 696    begin
 697       Put_Char_In_Prep_Buffer (ASCII.LF);
 698    end New_EOL_In_Prep_Buffer;
 699
 700    -----------------------------
 701    -- Put_Char_In_Prep_Buffer --
 702    -----------------------------
 703
 704    procedure Put_Char_In_Prep_Buffer (C : Character) is
 705    begin
 706       --  If preprocessing buffer is not large enough, double it
 707
 708       if Prep_Buffer_Last = Prep_Buffer'Last then
 709          declare
 710             New_Prep_Buffer : constant Text_Buffer_Ptr :=
 711               new Text_Buffer (1 .. 2 * Prep_Buffer_Last);
 712
 713          begin
 714             New_Prep_Buffer (Prep_Buffer'Range) := Prep_Buffer.all;
 715             Free (Prep_Buffer);
 716             Prep_Buffer := New_Prep_Buffer;
 717          end;
 718       end if;
 719
 720       Prep_Buffer_Last := Prep_Buffer_Last + 1;
 721       Prep_Buffer (Prep_Buffer_Last) := C;
 722    end Put_Char_In_Prep_Buffer;
 723
 724    -----------------------------------
 725    -- Source_File_Is_Pragma_No_Body --
 726    -----------------------------------
 727
 728    function Source_File_Is_No_Body (X : Source_File_Index) return Boolean is
 729    begin
 730       Initialize_Scanner (No_Unit, X);
 731
 732       if Token /= Tok_Pragma then
 733          return False;
 734       end if;
 735
 736       Scan; -- past pragma
 737
 738       if Token /= Tok_Identifier
 739         or else Chars (Token_Node) /= Name_No_Body
 740       then
 741          return False;
 742       end if;
 743
 744       Scan; -- past No_Body
 745
 746       if Token /= Tok_Semicolon then
 747          return False;
 748       end if;
 749
 750       Scan; -- past semicolon
 751
 752       return Token = Tok_EOF;
 753    end Source_File_Is_No_Body;
 754
 755    ----------------------------
 756    -- Source_File_Is_Subunit --
 757    ----------------------------
 758
 759    function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
 760    begin
 761       Initialize_Scanner (No_Unit, X);
 762
 763       --  We scan past junk to the first interesting compilation unit token, to
 764       --  see if it is SEPARATE. We ignore WITH keywords during this and also
 765       --  PRIVATE. The reason for ignoring PRIVATE is that it handles some
 766       --  error situations, and also to handle PRIVATE WITH in Ada 2005 mode.
 767
 768       while Token = Tok_With
 769         or else Token = Tok_Private
 770         or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
 771       loop
 772          Scan;
 773       end loop;
 774
 775       return Token = Tok_Separate;
 776    end Source_File_Is_Subunit;
 777
 778 end Sinput.L;