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