diff options
Diffstat (limited to 'gcc/ada/sinput-l.adb')
| -rw-r--r-- | gcc/ada/sinput-l.adb | 245 |
1 files changed, 156 insertions, 89 deletions
diff --git a/gcc/ada/sinput-l.adb b/gcc/ada/sinput-l.adb index 52f3a713b..59d2aed4f 100644 --- a/gcc/ada/sinput-l.adb +++ b/gcc/ada/sinput-l.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -38,6 +38,8 @@ with Prep; use Prep; with Prepcomp; use Prepcomp; with Scans; use Scans; with Scn; use Scn; +with Sem_Aux; use Sem_Aux; +with Sem_Util; use Sem_Util; with Sinfo; use Sinfo; with Snames; use Snames; with System; use System; @@ -138,127 +140,191 @@ package body Sinput.L is Source_File.Append (Source_File.Table (Xold)); Xnew := Source_File.Last; - Source_File.Table (Xnew).Inlined_Body := Inlined_Body; - Source_File.Table (Xnew).Instantiation := Sloc (Inst_Node); - Source_File.Table (Xnew).Template := Xold; + declare + Sold : Source_File_Record renames Source_File.Table (Xold); + Snew : Source_File_Record renames Source_File.Table (Xnew); - -- Now we need to compute the new values of Source_First, Source_Last - -- and adjust the source file pointer to have the correct virtual - -- origin for the new range of values. + Inst_Spec : Node_Id; - 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; + begin + Snew.Inlined_Body := Inlined_Body; + Snew.Template := Xold; - Set_Source_File_Index_Table (Xnew); + -- For a genuine generic instantiation, assign new instance id. + -- For inlined bodies, we retain that of the template, but we + -- save the call location. - Source_File.Table (Xnew).Sloc_Adjust := - Source_File.Table (Xold).Sloc_Adjust - A.Adjust; + if Inlined_Body then + Snew.Inlined_Call := Sloc (Inst_Node); - if Debug_Flag_L then - Write_Eol; - Write_Str ("*** Create instantiation source for "); + else - if Nkind (Dnod) in N_Proper_Body - and then Was_Originally_Stub (Dnod) - then - Write_Str ("subunit "); + -- If the spec has been instantiated already, and we are now + -- creating the instance source for the corresponding body now, + -- retrieve the instance id that was assigned to the spec, which + -- corresponds to the same instantiation sloc. + + Inst_Spec := Instance_Spec (Inst_Node); + if Present (Inst_Spec) then + declare + Inst_Spec_Ent : Entity_Id; + -- Instance spec entity + + Inst_Spec_Sloc : Source_Ptr; + -- Virtual sloc of the spec instance source + + Inst_Spec_Inst_Id : Instance_Id; + -- Instance id assigned to the instance spec + + begin + Inst_Spec_Ent := Defining_Entity (Inst_Spec); + + -- For a subprogram instantiation, we want the subprogram + -- instance, not the wrapper package. + + if Present (Related_Instance (Inst_Spec_Ent)) then + Inst_Spec_Ent := Related_Instance (Inst_Spec_Ent); + end if; + + -- The specification of the instance entity has a virtual + -- sloc within the instance sloc range. + -- ??? But the Unit_Declaration_Node has the sloc of the + -- instantiation, which is somewhat of an oddity. + + Inst_Spec_Sloc := + Sloc (Specification (Unit_Declaration_Node + (Inst_Spec_Ent))); + Inst_Spec_Inst_Id := + Source_File.Table + (Get_Source_File_Index (Inst_Spec_Sloc)).Instance; + + pragma Assert + (Sloc (Inst_Node) = Instances.Table (Inst_Spec_Inst_Id)); + Snew.Instance := Inst_Spec_Inst_Id; + end; - 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 "); + Instances.Append (Sloc (Inst_Node)); + Snew.Instance := Instances.Last; end if; + end if; - elsif Ekind (Template_Id) = E_Function then - Write_Str ("body of function "); + -- Now we need to compute the new values of Source_First, + -- Source_Last and adjust the source file pointer to have the + -- correct virtual origin for the new range of values. - elsif Ekind (Template_Id) = E_Procedure then - Write_Str ("body of procedure "); + Snew.Source_First := Source_File.Table (Xnew - 1).Source_Last + 1; + A.Adjust := Snew.Source_First - A.Lo; + Snew.Source_Last := A.Hi + A.Adjust; - elsif Ekind (Template_Id) = E_Generic_Function then - Write_Str ("spec of function "); + Set_Source_File_Index_Table (Xnew); - elsif Ekind (Template_Id) = E_Generic_Procedure then - Write_Str ("spec of procedure "); + Snew.Sloc_Adjust := Sold.Sloc_Adjust - A.Adjust; - elsif Ekind (Template_Id) = E_Package_Body then - Write_Str ("body of package "); + if Debug_Flag_L then + Write_Eol; + Write_Str ("*** Create instantiation source for "); - else pragma Assert (Ekind (Template_Id) = E_Subprogram_Body); + if Nkind (Dnod) in N_Proper_Body + and then Was_Originally_Stub (Dnod) + then + Write_Str ("subunit "); - if Nkind (Dnod) = N_Procedure_Specification then - Write_Str ("body of procedure "); - else + 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; - end if; - Write_Name (Chars (Template_Id)); - Write_Eol; + Write_Name (Chars (Template_Id)); + Write_Eol; - Write_Str (" new source index = "); - Write_Int (Int (Xnew)); - 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 (" 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 source index = "); + Write_Int (Int (Xold)); + Write_Eol; - Write_Str (" old lo = "); - Write_Int (Int (A.Lo)); - 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 (" 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 lo = "); + Write_Int (Int (Snew.Source_First)); + Write_Eol; - Write_Str (" new hi = "); - Write_Int (Int (Source_File.Table (Xnew).Source_Last)); - Write_Eol; + Write_Str (" new hi = "); + Write_Int (Int (Snew.Source_Last)); + Write_Eol; - Write_Str (" adjustment factor = "); - Write_Int (Int (A.Adjust)); - 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; + Write_Str (" instantiation location: "); + Write_Location (Sloc (Inst_Node)); + Write_Eol; + end if; - -- For a given character in the source, a higher subscript will be used - -- to access the instantiation, which means that the virtual origin must - -- have a corresponding lower value. We compute this new origin by - -- taking the address of the appropriate adjusted element in the old - -- array. Since this adjusted element will be at a negative subscript, - -- we must suppress checks. + -- For a given character in the source, a higher subscript will be + -- used to access the instantiation, which means that the virtual + -- origin must have a corresponding lower value. We compute this new + -- origin by taking the address of the appropriate adjusted element + -- in the old array. Since this adjusted element will be at a + -- negative subscript, we must suppress checks. - declare - pragma Suppress (All_Checks); + declare + pragma Suppress (All_Checks); - pragma Warnings (Off); - -- This unchecked conversion is aliasing safe, since it is never used - -- to create improperly aliased pointer values. + pragma Warnings (Off); + -- This unchecked conversion is aliasing safe, since it is never + -- used to create improperly aliased pointer values. - function To_Source_Buffer_Ptr is new - Unchecked_Conversion (Address, Source_Buffer_Ptr); + function To_Source_Buffer_Ptr is new + Unchecked_Conversion (Address, Source_Buffer_Ptr); - pragma Warnings (On); + pragma Warnings (On); - begin - Source_File.Table (Xnew).Source_Text := - To_Source_Buffer_Ptr - (Source_File.Table (Xold).Source_Text (-A.Adjust)'Address); + begin + Snew.Source_Text := + To_Source_Buffer_Ptr + (Sold.Source_Text (-A.Adjust)'Address); + end; end; end Create_Instantiation_Source; @@ -433,9 +499,10 @@ package body Sinput.L is Full_Debug_Name => Osint.Full_Source_Name, Full_File_Name => Osint.Full_Source_Name, Full_Ref_Name => Osint.Full_Source_Name, + Instance => No_Instance_Id, Identifier_Casing => Unknown, + Inlined_Call => No_Location, Inlined_Body => False, - Instantiation => No_Location, Keyword_Casing => Unknown, Last_Source_Line => 1, License => Unknown, |