From cf427f02bb7cc5a0103f5821e7b4f042c9275320 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 1 Oct 2012 11:21:46 +0200 Subject: [multiple changes] 2012-10-01 Vincent Pucci * s-gearop.adb (Vector_Matrix_Product): Dimensions check fixed. Index of Left in S evaluation fixed. 2012-10-01 Javier Miranda * sem_ch3.adb (Analyze_Declarations): Avoid premature freezing caused by the internally generated subprogram _postconditions. * checks.adb (Expr_Known_Valid): Float literals are assumed to be valid in VM targets. 2012-10-01 Thomas Quinot * sinput.ads, sinput.adb, sinput-l.adb sinput-c.adb (Sinput): New Instances table, tracking all generic instantiations. Source file attribute Instance replaces previous Instantiation attribute with an index into the Instances table. (Iterate_On_Instances): New generic procedure. (Create_Instantiation_Source): Record instantiations in Instances. (Tree_Read, Tree_Write): Read/write the instance table. * scils.ads, scos.adb (SCO_Instance_Table): New table, contains information copied from Sinput.Instance_Table, but self-contained within the SCO data structures. * par_sco.ads, par_sco.adb (To_Source_Location): Move to library level. (Record_Instance): New subprogram, used by... (Populate_SCO_Instance_Table): New subprogram to fill the SCO instance table from the Sinput one (called by SCO_Output). * opt.ads (Generate_SCO_Instance_Table): New option. * put_scos.adb (Write_Instance_Table): New subprogram, used by... (Put_SCOs): Dump the instance table at the end of SCO information if requested. * get_scos.adb (Get_SCOs): Read SCO_Instance_Table. * types.h: Add declaration for Instance_Id. * back_end.adb (Call_Back_End): Pass instance ids in source file information table. (Scan_Back_End_Switches): -fdebug-instances sets Opt.Generate_SCO_Instance_Table. * gcc-interface/gigi.h: File_Info_Type includes instance id. * gcc-interface/trans.c: Under -fdebug-instances, set instance id in line map from same in file info. 2012-10-01 Thomas Quinot * sem_elab.adb: Minor reformatting (Check_Elab_Call): Minor fix to debugging code (add special circuit for the valid case where a 'Access attribute reference is passed to Check_Elab_Call). 2012-10-01 Thomas Quinot * exp_ch3.adb: Minor reformatting. From-SVN: r191904 --- gcc/ada/sinput.adb | 50 +++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 43 insertions(+), 7 deletions(-) (limited to 'gcc/ada/sinput.adb') diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 5e1ac44..29be59a 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -477,8 +477,26 @@ package body Sinput is First_Time_Around := True; Source_File.Init; + + Instances.Init; + Instances.Append (No_Location); + pragma Assert (Instances.Last = No_Instance_Id); end Initialize; + ------------------- + -- Instantiation -- + ------------------- + + function Instantiation (S : SFI) return Source_Ptr is + SIE : Source_File_Record renames Source_File.Table (S); + begin + if SIE.Inlined_Body then + return SIE.Inlined_Call; + else + return Instances.Table (SIE.Instance); + end if; + end Instantiation; + ------------------------- -- Instantiation_Depth -- ------------------------- @@ -511,6 +529,17 @@ package body Sinput is return Instantiation (Get_Source_File_Index (S)); end Instantiation_Location; + -------------------------- + -- Iterate_On_Instances -- + -------------------------- + + procedure Iterate_On_Instances is + begin + for J in 1 .. Instances.Last loop + Process (J, Instances.Table (J)); + end loop; + end Iterate_On_Instances; + ---------------------- -- Last_Source_File -- ---------------------- @@ -852,7 +881,7 @@ package body Sinput is Tmp1 : Source_Buffer_Ptr; begin - if S.Instantiation /= No_Location then + if S.Instance /= No_Instance_Id then null; else @@ -887,9 +916,10 @@ package body Sinput is Source_Cache_First := 1; Source_Cache_Last := 0; - -- Read in source file table + -- Read in source file table and instance table Source_File.Tree_Read; + Instances.Tree_Read; -- The pointers we read in there for the source buffer and lines -- table pointers are junk. We now read in the actual data that @@ -904,7 +934,7 @@ package body Sinput is -- we share the data for the generic template entry. Since the -- template always occurs first, we can safely refer to its data. - if S.Instantiation /= No_Location then + if S.Instance /= No_Instance_Id then declare ST : Source_File_Record renames Source_File.Table (S.Template); @@ -1004,6 +1034,7 @@ package body Sinput is procedure Tree_Write is begin Source_File.Tree_Write; + Instances.Tree_Write; -- The pointers we wrote out there for the source buffer and lines -- table pointers are junk, we now write out the actual data that @@ -1018,7 +1049,7 @@ package body Sinput is -- shared with the generic template. When the tree is read, the -- pointers must be set, but no extra data needs to be written. - if S.Instantiation /= No_Location then + if S.Instance /= No_Instance_Id then null; -- For the normal case, write out the data of the tables @@ -1131,6 +1162,11 @@ package body Sinput is return Source_File.Table (S).Debug_Source_Name; end Debug_Source_Name; + function Instance (S : SFI) return Instance_Id is + begin + return Source_File.Table (S).Instance; + end Instance; + function File_Name (S : SFI) return File_Name_Type is begin return Source_File.Table (S).File_Name; @@ -1171,10 +1207,10 @@ package body Sinput is return Source_File.Table (S).Inlined_Body; end Inlined_Body; - function Instantiation (S : SFI) return Source_Ptr is + function Inlined_Call (S : SFI) return Source_Ptr is begin - return Source_File.Table (S).Instantiation; - end Instantiation; + return Source_File.Table (S).Inlined_Call; + end Inlined_Call; function Keyword_Casing (S : SFI) return Casing_Type is begin -- cgit v1.1