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