with Alloc;
with Atree; use Atree;
with Debug; use Debug;
with Einfo; use Einfo;
with Namet; use Namet;
with Opt;
with Osint; use Osint;
with Output; use Output;
with Scans; use Scans;
with Scn; use Scn;
with Sinfo; use Sinfo;
with System; use System;
with Unchecked_Conversion;
package body Sinput.L is
function Load_File
(N : File_Name_Type;
T : File_Type)
return Source_File_Index;
procedure Adjust_Instantiation_Sloc (N : Node_Id; A : Sloc_Adjustment) is
Loc : constant Source_Ptr := Sloc (N);
begin
if A.Lo <= Loc and then Loc <= A.Hi then
Set_Sloc (N, Loc + A.Adjust);
end if;
end Adjust_Instantiation_Sloc;
procedure Complete_Source_File_Entry is
CSF : constant Source_File_Index := Current_Source_File;
begin
Trim_Lines_Table (CSF);
Source_File.Table (CSF).Source_Checksum := Checksum;
end Complete_Source_File_Entry;
procedure Create_Instantiation_Source
(Inst_Node : Entity_Id;
Template_Id : Entity_Id;
A : out Sloc_Adjustment)
is
Dnod : constant Node_Id := Declaration_Node (Template_Id);
Xold : Source_File_Index;
Xnew : Source_File_Index;
begin
Xold := Get_Source_File_Index (Sloc (Template_Id));
A.Lo := Source_File.Table (Xold).Source_First;
A.Hi := Source_File.Table (Xold).Source_Last;
Source_File.Increment_Last;
Xnew := Source_File.Last;
Source_File.Table (Xnew) := Source_File.Table (Xold);
Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node);
Source_File.Table (Xnew).Template := Xold;
Source_File.Table (Xnew).Source_First :=
Source_File.Table (Xnew - 1).Source_Last + 1;
A.Adjust := Source_File.Table (Xnew).Source_First - A.Lo;
Source_File.Table (Xnew).Source_Last := A.Hi + A.Adjust;
Source_File.Table (Xnew).Sloc_Adjust :=
Source_File.Table (Xold).Sloc_Adjust - A.Adjust;
if Debug_Flag_L then
Write_Eol;
Write_Str ("*** Create instantiation source for ");
if Nkind (Dnod) in N_Proper_Body
and then Was_Originally_Stub (Dnod)
then
Write_Str ("subunit ");
elsif Ekind (Template_Id) = E_Generic_Package then
if Nkind (Dnod) = N_Package_Body then
Write_Str ("body of package ");
else
Write_Str ("spec of package ");
end if;
elsif Ekind (Template_Id) = E_Function then
Write_Str ("body of function ");
elsif Ekind (Template_Id) = E_Procedure then
Write_Str ("body of procedure ");
elsif Ekind (Template_Id) = E_Generic_Function then
Write_Str ("spec of function ");
elsif Ekind (Template_Id) = E_Generic_Procedure then
Write_Str ("spec of procedure ");
elsif Ekind (Template_Id) = E_Package_Body then
Write_Str ("body of package ");
else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body);
if Nkind (Dnod) = N_Procedure_Specification then
Write_Str ("body of procedure ");
else
Write_Str ("body of function ");
end if;
end if;
Write_Name (Chars (Template_Id));
Write_Eol;
Write_Str (" new source index = ");
Write_Int (Int (Xnew));
Write_Eol;
Write_Str (" copying from file name = ");
Write_Name (File_Name (Xold));
Write_Eol;
Write_Str (" old source index = ");
Write_Int (Int (Xold));
Write_Eol;
Write_Str (" old lo = ");
Write_Int (Int (A.Lo));
Write_Eol;
Write_Str (" old hi = ");
Write_Int (Int (A.Hi));
Write_Eol;
Write_Str (" new lo = ");
Write_Int (Int (Source_File.Table (Xnew).Source_First));
Write_Eol;
Write_Str (" new hi = ");
Write_Int (Int (Source_File.Table (Xnew).Source_Last));
Write_Eol;
Write_Str (" adjustment factor = ");
Write_Int (Int (A.Adjust));
Write_Eol;
Write_Str (" instantiation location: ");
Write_Location (Sloc (Inst_Node));
Write_Eol;
end if;
declare
pragma Suppress (All_Checks);
function To_Source_Buffer_Ptr is new
Unchecked_Conversion (Address, Source_Buffer_Ptr);
begin
Source_File.Table (Xnew).Source_Text :=
To_Source_Buffer_Ptr
(Source_File.Table (Xold).Source_Text (-A.Adjust)'Address);
end;
end Create_Instantiation_Source;
function Load_Config_File
(N : File_Name_Type)
return Source_File_Index
is
begin
return Load_File (N, Osint.Config);
end Load_Config_File;
function Load_File
(N : File_Name_Type;
T : File_Type)
return Source_File_Index
is
Src : Source_Buffer_Ptr;
X : Source_File_Index;
Lo : Source_Ptr;
Hi : Source_Ptr;
begin
for J in 1 .. Source_File.Last loop
if Source_File.Table (J).File_Name = N then
return J;
end if;
end loop;
Source_File.Increment_Last;
X := Source_File.Last;
if X = Source_File.First then
Lo := First_Source_Ptr;
else
Lo := Source_File.Table (X - 1).Source_Last + 1;
end if;
Read_Source_File (N, Lo, Hi, Src, T);
if Src = null then
Source_File.Decrement_Last;
return No_Source_File;
else
if Debug_Flag_L then
Write_Eol;
Write_Str ("*** Build source file table entry, Index = ");
Write_Int (Int (X));
Write_Str (", file name = ");
Write_Name (N);
Write_Eol;
Write_Str (" lo = ");
Write_Int (Int (Lo));
Write_Eol;
Write_Str (" hi = ");
Write_Int (Int (Hi));
Write_Eol;
Write_Str (" first 10 chars -->");
declare
procedure Wchar (C : Character);
procedure Wchar (C : Character) is
begin
if C < ' ' or C in ASCII.DEL .. Character'Val (16#9F#) then
Write_Char ('?');
else
Write_Char (C);
end if;
end Wchar;
begin
for J in Lo .. Lo + 9 loop
Wchar (Src (J));
end loop;
Write_Str ("<--");
Write_Eol;
Write_Str (" last 10 chars -->");
for J in Hi - 10 .. Hi - 1 loop
Wchar (Src (J));
end loop;
Write_Str ("<--");
Write_Eol;
if Src (Hi) /= EOF then
Write_Str (" error: no EOF at end");
Write_Eol;
end if;
end;
end if;
declare
S : Source_File_Record renames Source_File.Table (X);
begin
S := (Debug_Source_Name => Full_Source_Name,
File_Name => N,
First_Mapped_Line => No_Line_Number,
Full_File_Name => Full_Source_Name,
Full_Ref_Name => Full_Source_Name,
Identifier_Casing => Unknown,
Instantiation => No_Location,
Keyword_Casing => Unknown,
Last_Source_Line => 1,
License => Unknown,
Lines_Table => null,
Lines_Table_Max => 1,
Logical_Lines_Table => null,
Num_SRef_Pragmas => 0,
Reference_Name => N,
Sloc_Adjust => 0,
Source_Checksum => 0,
Source_First => Lo,
Source_Last => Hi,
Source_Text => Src,
Template => No_Source_File,
Time_Stamp => Current_Source_File_Stamp);
Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
S.Lines_Table (1) := Lo;
end;
return X;
end if;
end Load_File;
function Load_Source_File
(N : File_Name_Type)
return Source_File_Index
is
begin
return Load_File (N, Osint.Source);
end Load_Source_File;
function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
begin
Initialize_Scanner (No_Unit, X);
while Token = Tok_With
or else Token = Tok_Private
or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
loop
Scan;
end loop;
return Token = Tok_Separate;
end Source_File_Is_Subunit;
end Sinput.L;