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