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-2003 Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 2, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27with Alloc; 28with Atree; use Atree; 29with Debug; use Debug; 30with Einfo; use Einfo; 31with Errout; use Errout; 32with Namet; use Namet; 33with 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 Sinfo; use Sinfo; 41with System; use System; 42 43with Unchecked_Conversion; 44 45package body Sinput.L is 46 47 Prep_Buffer : Text_Buffer_Ptr := null; 48 -- A buffer to temporarily stored the result of preprocessing a source. 49 -- It is only allocated if there is at least one source to preprocess. 50 51 Prep_Buffer_Last : Text_Ptr := 0; 52 -- Index of the last significant character in Prep_Buffer 53 54 Initial_Size_Of_Prep_Buffer : constant := 10_000; 55 -- Size of Prep_Buffer when it is first allocated 56 57 -- When a file is to be preprocessed and the options to list symbols 58 -- has been selected (switch -s), Prep.List_Symbols is called with a 59 -- "foreword", a single line indicationg what source the symbols apply to. 60 -- The following two constant String are the start and the end of this 61 -- foreword. 62 63 Foreword_Start : constant String := 64 "Preprocessing Symbols for source """; 65 66 Foreword_End : constant String := """"; 67 68 ----------------- 69 -- Subprograms -- 70 ----------------- 71 72 procedure Put_Char_In_Prep_Buffer (C : Character); 73 -- Add one character in Prep_Buffer, extending Prep_Buffer if need be. 74 -- Used to initialize the preprocessor. 75 76 procedure New_EOL_In_Prep_Buffer; 77 -- Add an LF to Prep_Buffer. 78 -- Used to initialize the preprocessor. 79 80 function Load_File 81 (N : File_Name_Type; 82 T : Osint.File_Type) 83 return Source_File_Index; 84 -- Load a source file, a configuration pragmas file or a definition file 85 -- Coding also allows preprocessing file, but not a library file ??? 86 87 ------------------------------- 88 -- Adjust_Instantiation_Sloc -- 89 ------------------------------- 90 91 procedure Adjust_Instantiation_Sloc (N : Node_Id; A : Sloc_Adjustment) is 92 Loc : constant Source_Ptr := Sloc (N); 93 94 begin 95 -- We only do the adjustment if the value is between the appropriate 96 -- low and high values. It is not clear that this should ever not be 97 -- the case, but in practice there seem to be some nodes that get 98 -- copied twice, and this is a defence against that happening. 99 100 if A.Lo <= Loc and then Loc <= A.Hi then 101 Set_Sloc (N, Loc + A.Adjust); 102 end if; 103 end Adjust_Instantiation_Sloc; 104 105 -------------------------------- 106 -- Complete_Source_File_Entry -- 107 -------------------------------- 108 109 procedure Complete_Source_File_Entry is 110 CSF : constant Source_File_Index := Current_Source_File; 111 112 begin 113 Trim_Lines_Table (CSF); 114 Source_File.Table (CSF).Source_Checksum := Checksum; 115 end Complete_Source_File_Entry; 116 117 --------------------------------- 118 -- Create_Instantiation_Source -- 119 --------------------------------- 120 121 procedure Create_Instantiation_Source 122 (Inst_Node : Entity_Id; 123 Template_Id : Entity_Id; 124 Inlined_Body : Boolean; 125 A : out Sloc_Adjustment) 126 is 127 Dnod : constant Node_Id := Declaration_Node (Template_Id); 128 Xold : Source_File_Index; 129 Xnew : Source_File_Index; 130 131 begin 132 Xold := Get_Source_File_Index (Sloc (Template_Id)); 133 A.Lo := Source_File.Table (Xold).Source_First; 134 A.Hi := Source_File.Table (Xold).Source_Last; 135 136 Source_File.Increment_Last; 137 Xnew := Source_File.Last; 138 139 Source_File.Table (Xnew) := Source_File.Table (Xold); 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 Set_Source_File_Index_Table (Xnew); 153 154 Source_File.Table (Xnew).Sloc_Adjust := 155 Source_File.Table (Xold).Sloc_Adjust - A.Adjust; 156 157 if Debug_Flag_L then 158 Write_Eol; 159 Write_Str ("*** Create instantiation source for "); 160 161 if Nkind (Dnod) in N_Proper_Body 162 and then Was_Originally_Stub (Dnod) 163 then 164 Write_Str ("subunit "); 165 166 elsif Ekind (Template_Id) = E_Generic_Package then 167 if Nkind (Dnod) = N_Package_Body then 168 Write_Str ("body of package "); 169 else 170 Write_Str ("spec of package "); 171 end if; 172 173 elsif Ekind (Template_Id) = E_Function then 174 Write_Str ("body of function "); 175 176 elsif Ekind (Template_Id) = E_Procedure then 177 Write_Str ("body of procedure "); 178 179 elsif Ekind (Template_Id) = E_Generic_Function then 180 Write_Str ("spec of function "); 181 182 elsif Ekind (Template_Id) = E_Generic_Procedure then 183 Write_Str ("spec of procedure "); 184 185 elsif Ekind (Template_Id) = E_Package_Body then 186 Write_Str ("body of package "); 187 188 else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body); 189 190 if Nkind (Dnod) = N_Procedure_Specification then 191 Write_Str ("body of procedure "); 192 else 193 Write_Str ("body of function "); 194 end if; 195 end if; 196 197 Write_Name (Chars (Template_Id)); 198 Write_Eol; 199 200 Write_Str (" new source index = "); 201 Write_Int (Int (Xnew)); 202 Write_Eol; 203 204 Write_Str (" copying from file name = "); 205 Write_Name (File_Name (Xold)); 206 Write_Eol; 207 208 Write_Str (" old source index = "); 209 Write_Int (Int (Xold)); 210 Write_Eol; 211 212 Write_Str (" old lo = "); 213 Write_Int (Int (A.Lo)); 214 Write_Eol; 215 216 Write_Str (" old hi = "); 217 Write_Int (Int (A.Hi)); 218 Write_Eol; 219 220 Write_Str (" new lo = "); 221 Write_Int (Int (Source_File.Table (Xnew).Source_First)); 222 Write_Eol; 223 224 Write_Str (" new hi = "); 225 Write_Int (Int (Source_File.Table (Xnew).Source_Last)); 226 Write_Eol; 227 228 Write_Str (" adjustment factor = "); 229 Write_Int (Int (A.Adjust)); 230 Write_Eol; 231 232 Write_Str (" instantiation location: "); 233 Write_Location (Sloc (Inst_Node)); 234 Write_Eol; 235 end if; 236 237 -- For a given character in the source, a higher subscript will be 238 -- used to access the instantiation, which means that the virtual 239 -- origin must have a corresponding lower value. We compute this 240 -- new origin by taking the address of the appropriate adjusted 241 -- element in the old array. Since this adjusted element will be 242 -- at a negative subscript, we must suppress checks. 243 244 declare 245 pragma Suppress (All_Checks); 246 247 function To_Source_Buffer_Ptr is new 248 Unchecked_Conversion (Address, Source_Buffer_Ptr); 249 250 begin 251 Source_File.Table (Xnew).Source_Text := 252 To_Source_Buffer_Ptr 253 (Source_File.Table (Xold).Source_Text (-A.Adjust)'Address); 254 end; 255 end Create_Instantiation_Source; 256 257 ---------------------- 258 -- Load_Config_File -- 259 ---------------------- 260 261 function Load_Config_File 262 (N : File_Name_Type) 263 return Source_File_Index 264 is 265 begin 266 return Load_File (N, Osint.Config); 267 end Load_Config_File; 268 269 -------------------------- 270 -- Load_Definition_File -- 271 -------------------------- 272 273 function Load_Definition_File 274 (N : File_Name_Type) 275 return Source_File_Index 276 is 277 begin 278 return Load_File (N, Osint.Definition); 279 end Load_Definition_File; 280 281 --------------- 282 -- Load_File -- 283 --------------- 284 285 function Load_File 286 (N : File_Name_Type; 287 T : Osint.File_Type) 288 return Source_File_Index 289 is 290 Src : Source_Buffer_Ptr; 291 X : Source_File_Index; 292 Lo : Source_Ptr; 293 Hi : Source_Ptr; 294 295 Preprocessing_Needed : Boolean := False; 296 297 begin 298 for J in 1 .. Source_File.Last loop 299 if Source_File.Table (J).File_Name = N then 300 return J; 301 end if; 302 end loop; 303 304 -- Here we must build a new entry in the file table 305 306 -- But first, we must check if a source needs to be preprocessed, 307 -- because we may have to load and parse a definition file, and we want 308 -- to do that before we load the source, so that the buffer of the 309 -- source will be the last created, and we will be able to replace it 310 -- and modify Hi without stepping on another buffer. 311 312 if T = Osint.Source then 313 Prepare_To_Preprocess 314 (Source => N, Preprocessing_Needed => Preprocessing_Needed); 315 end if; 316 317 Source_File.Increment_Last; 318 X := Source_File.Last; 319 320 if X = Source_File.First then 321 Lo := First_Source_Ptr; 322 else 323 Lo := Source_File.Table (X - 1).Source_Last + 1; 324 end if; 325 326 Osint.Read_Source_File (N, Lo, Hi, Src, T); 327 328 if Src = null then 329 Source_File.Decrement_Last; 330 return No_Source_File; 331 332 else 333 if Debug_Flag_L then 334 Write_Eol; 335 Write_Str ("*** Build source file table entry, Index = "); 336 Write_Int (Int (X)); 337 Write_Str (", file name = "); 338 Write_Name (N); 339 Write_Eol; 340 Write_Str (" lo = "); 341 Write_Int (Int (Lo)); 342 Write_Eol; 343 Write_Str (" hi = "); 344 Write_Int (Int (Hi)); 345 Write_Eol; 346 347 Write_Str (" first 10 chars -->"); 348 349 declare 350 procedure Wchar (C : Character); 351 -- Writes character or ? for control character 352 353 procedure Wchar (C : Character) is 354 begin 355 if C < ' ' or C in ASCII.DEL .. Character'Val (16#9F#) then 356 Write_Char ('?'); 357 else 358 Write_Char (C); 359 end if; 360 end Wchar; 361 362 begin 363 for J in Lo .. Lo + 9 loop 364 Wchar (Src (J)); 365 end loop; 366 367 Write_Str ("<--"); 368 Write_Eol; 369 370 Write_Str (" last 10 chars -->"); 371 372 for J in Hi - 10 .. Hi - 1 loop 373 Wchar (Src (J)); 374 end loop; 375 376 Write_Str ("<--"); 377 Write_Eol; 378 379 if Src (Hi) /= EOF then 380 Write_Str (" error: no EOF at end"); 381 Write_Eol; 382 end if; 383 end; 384 end if; 385 386 declare 387 S : Source_File_Record renames Source_File.Table (X); 388 File_Type : Type_Of_File; 389 390 begin 391 case T is 392 when Osint.Source => 393 File_Type := Sinput.Src; 394 395 when Osint.Library => 396 raise Program_Error; 397 398 when Osint.Config => 399 File_Type := Sinput.Config; 400 401 when Osint.Definition => 402 File_Type := Def; 403 404 when Osint.Preprocessing_Data => 405 File_Type := Preproc; 406 end case; 407 408 S := (Debug_Source_Name => N, 409 File_Name => N, 410 File_Type => File_Type, 411 First_Mapped_Line => No_Line_Number, 412 Full_Debug_Name => Osint.Full_Source_Name, 413 Full_File_Name => Osint.Full_Source_Name, 414 Full_Ref_Name => Osint.Full_Source_Name, 415 Identifier_Casing => Unknown, 416 Inlined_Body => False, 417 Instantiation => No_Location, 418 Keyword_Casing => Unknown, 419 Last_Source_Line => 1, 420 License => Unknown, 421 Lines_Table => null, 422 Lines_Table_Max => 1, 423 Logical_Lines_Table => null, 424 Num_SRef_Pragmas => 0, 425 Reference_Name => N, 426 Sloc_Adjust => 0, 427 Source_Checksum => 0, 428 Source_First => Lo, 429 Source_Last => Hi, 430 Source_Text => Src, 431 Template => No_Source_File, 432 Time_Stamp => Osint.Current_Source_File_Stamp); 433 434 Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial); 435 S.Lines_Table (1) := Lo; 436 end; 437 438 -- Preprocess the source if it needs to be preprocessed 439 440 if Preprocessing_Needed then 441 if Opt.List_Preprocessing_Symbols then 442 Get_Name_String (N); 443 444 declare 445 Foreword : String (1 .. Foreword_Start'Length + 446 Name_Len + Foreword_End'Length); 447 448 begin 449 Foreword (1 .. Foreword_Start'Length) := Foreword_Start; 450 Foreword (Foreword_Start'Length + 1 .. 451 Foreword_Start'Length + Name_Len) := 452 Name_Buffer (1 .. Name_Len); 453 Foreword (Foreword'Last - Foreword_End'Length + 1 .. 454 Foreword'Last) := Foreword_End; 455 Prep.List_Symbols (Foreword); 456 end; 457 end if; 458 459 declare 460 T : constant Nat := Total_Errors_Detected; 461 -- Used to check if there were errors during preprocessing 462 463 begin 464 -- If this is the first time we preprocess a source, allocate 465 -- the preprocessing buffer. 466 467 if Prep_Buffer = null then 468 Prep_Buffer := 469 new Text_Buffer (1 .. Initial_Size_Of_Prep_Buffer); 470 end if; 471 472 -- Make sure the preprocessing buffer is empty 473 474 Prep_Buffer_Last := 0; 475 476 -- Initialize the preprocessor 477 478 Prep.Initialize 479 (Error_Msg => Errout.Error_Msg'Access, 480 Scan => Scn.Scanner.Scan'Access, 481 Set_Ignore_Errors => Errout.Set_Ignore_Errors'Access, 482 Put_Char => Put_Char_In_Prep_Buffer'Access, 483 New_EOL => New_EOL_In_Prep_Buffer'Access); 484 485 -- Initialize the scanner and set its behavior for 486 -- preprocessing, then preprocess. 487 488 Scn.Scanner.Initialize_Scanner (No_Unit, X); 489 490 Scn.Scanner.Set_Special_Character ('#'); 491 Scn.Scanner.Set_Special_Character ('$'); 492 Scn.Scanner.Set_End_Of_Line_As_Token (True); 493 494 Preprocess; 495 496 -- Reset the scanner to its standard behavior 497 498 Scn.Scanner.Reset_Special_Characters; 499 Scn.Scanner.Set_End_Of_Line_As_Token (False); 500 501 -- If there were errors during preprocessing, record an 502 -- error at the start of the file, and do not change the 503 -- source buffer. 504 505 if T /= Total_Errors_Detected then 506 Errout.Error_Msg 507 ("file could not be successfully preprocessed", Lo); 508 return No_Source_File; 509 510 else 511 -- Set the new value of Hi 512 513 Hi := Lo + Source_Ptr (Prep_Buffer_Last); 514 515 -- Create the new source buffer 516 517 declare 518 subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi); 519 -- Physical buffer allocated 520 521 type Actual_Source_Ptr is access Actual_Source_Buffer; 522 -- This is the pointer type for the physical buffer 523 -- allocated. 524 525 Actual_Ptr : constant Actual_Source_Ptr := 526 new Actual_Source_Buffer; 527 -- And this is the actual physical buffer 528 529 begin 530 Actual_Ptr (Lo .. Hi - 1) := 531 Prep_Buffer (1 .. Prep_Buffer_Last); 532 Actual_Ptr (Hi) := EOF; 533 534 -- Now we need to work out the proper virtual origin 535 -- pointer to return. This is exactly 536 -- Actual_Ptr (0)'Address, but we have to be careful to 537 -- suppress checks to compute this address. 538 539 declare 540 pragma Suppress (All_Checks); 541 542 function To_Source_Buffer_Ptr is new 543 Unchecked_Conversion (Address, Source_Buffer_Ptr); 544 545 begin 546 Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address); 547 548 -- Record in the table the new source buffer and the 549 -- new value of Hi. 550 551 Source_File.Table (X).Source_Text := Src; 552 Source_File.Table (X).Source_Last := Hi; 553 554 -- Reset Last_Line to 1, because the lines do not 555 -- have neccessarily the same starts and lengths. 556 557 Source_File.Table (X).Last_Source_Line := 1; 558 end; 559 end; 560 end if; 561 end; 562 end if; 563 564 Set_Source_File_Index_Table (X); 565 return X; 566 end if; 567 end Load_File; 568 569 ---------------------------------- 570 -- Load_Preprocessing_Data_File -- 571 ---------------------------------- 572 573 function Load_Preprocessing_Data_File 574 (N : File_Name_Type) 575 return Source_File_Index 576 is 577 begin 578 return Load_File (N, Osint.Preprocessing_Data); 579 end Load_Preprocessing_Data_File; 580 581 ---------------------- 582 -- Load_Source_File -- 583 ---------------------- 584 585 function Load_Source_File 586 (N : File_Name_Type) 587 return Source_File_Index 588 is 589 begin 590 return Load_File (N, Osint.Source); 591 end Load_Source_File; 592 593 ---------------------------- 594 -- New_EOL_In_Prep_Buffer -- 595 ---------------------------- 596 597 procedure New_EOL_In_Prep_Buffer is 598 begin 599 Put_Char_In_Prep_Buffer (ASCII.LF); 600 end New_EOL_In_Prep_Buffer; 601 602 ----------------------------- 603 -- Put_Char_In_Prep_Buffer -- 604 ----------------------------- 605 606 procedure Put_Char_In_Prep_Buffer (C : Character) is 607 begin 608 -- If preprocessing buffer is not large enough, double it 609 610 if Prep_Buffer_Last = Prep_Buffer'Last then 611 declare 612 New_Prep_Buffer : constant Text_Buffer_Ptr := 613 new Text_Buffer (1 .. 2 * Prep_Buffer_Last); 614 615 begin 616 New_Prep_Buffer (Prep_Buffer'Range) := Prep_Buffer.all; 617 Free (Prep_Buffer); 618 Prep_Buffer := New_Prep_Buffer; 619 end; 620 end if; 621 622 Prep_Buffer_Last := Prep_Buffer_Last + 1; 623 Prep_Buffer (Prep_Buffer_Last) := C; 624 end Put_Char_In_Prep_Buffer; 625 626 ---------------------------- 627 -- Source_File_Is_Subunit -- 628 ---------------------------- 629 630 function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is 631 begin 632 Initialize_Scanner (No_Unit, X); 633 634 -- We scan past junk to the first interesting compilation unit 635 -- token, to see if it is SEPARATE. We ignore WITH keywords during 636 -- this and also PRIVATE. The reason for ignoring PRIVATE is that 637 -- it handles some error situations, and also it is possible that 638 -- a PRIVATE WITH feature might be approved some time in the future. 639 640 while Token = Tok_With 641 or else Token = Tok_Private 642 or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF) 643 loop 644 Scan; 645 end loop; 646 647 return Token = Tok_Separate; 648 end Source_File_Is_Subunit; 649 650end Sinput.L; 651