From caad910a9fcf8e98336a90dec0e5f09af002cc65 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 30 Jan 2012 10:32:44 +0000 Subject: 2012-01-30 Vincent Pucci * sem_dim.adb (Expand_Put_Call_With_Dimension_Symbol): Minor code clean up. * s-diflio.ads: Minor change. 2012-01-30 Javier Miranda * exp_ch9.adb (Build_Dispatching_Requeue): Add missing call to Get_Entry_Index. Required to generate code which provides the correct value of Entry_Index in the target entry. 2012-01-30 Nicolas Roche * system-vxworks-ppc.ads: Add pragma Linker_Options -crtbe to fix issue with zcx on VxWorks5. 2012-01-30 Pascal Obry * prj.ads, prj.adb (For_Every_Project_Imported): Remove In_Aggregate_Lib. (For_Every_Project_Imported_Context): New generic routine with a context parameter. * prj-nmsc.adb: Revert to use For_Every_Project_Imported Avoid distributed complexity. * prj-env.adb, prj-conf.adb, makeutl.adb, gnatcmd.adb: Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183702 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/exp_ch9.adb | 58 ++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 42 insertions(+), 16 deletions(-) (limited to 'gcc/ada/exp_ch9.adb') diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index a20254b49d6..e61ba1366ec 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -9022,42 +9022,68 @@ package body Exp_Ch9 is -- Process the entry wrapper's position in the primary dispatch -- table parameter. Generate: - -- Ada.Tags.Get_Offset_Index - -- (Ada.Tags.Tag (Concval), - -- ) + -- Ada.Tags.Get_Entry_Index + -- (T => To_Tag_Ptr (Obj'Address).all, + -- Position => Ada.Tags.Get_Offset_Index + -- (Ada.Tags.Tag (Concval), + -- i )); + + -- Note that Obj'Address is recursively expanded into a call to + -- Base_Address (Obj) if Tagged_Type_Expansion then Prepend_To (Params, Make_Function_Call (Loc, - Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc), + Name => New_Reference_To (RTE (RE_Get_Entry_Index), Loc), Parameter_Associations => New_List ( - Unchecked_Convert_To (RTE (RE_Tag), Concval), - Make_Integer_Literal (Loc, DT_Position (Entity (Ename)))))); + + Make_Explicit_Dereference (Loc, + Unchecked_Convert_To (RTE (RE_Tag_Ptr), + Make_Attribute_Reference (Loc, + Prefix => New_Copy_Tree (Concval), + Attribute_Name => Name_Address))), + + Make_Function_Call (Loc, + Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc), + Parameter_Associations => New_List ( + Unchecked_Convert_To (RTE (RE_Tag), Concval), + Make_Integer_Literal (Loc, + DT_Position (Entity (Ename)))))))); -- VM targets else Prepend_To (Params, - Make_Function_Call (Loc, - Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc), + Make_Function_Call (Loc, + Name => New_Reference_To (RTE (RE_Get_Entry_Index), Loc), Parameter_Associations => New_List ( - -- Obj_Typ - Make_Attribute_Reference (Loc, Prefix => Concval, Attribute_Name => Name_Tag), - -- Tag_Typ + Make_Function_Call (Loc, + Name => New_Reference_To (RTE (RE_Get_Offset_Index), Loc), - Make_Attribute_Reference (Loc, - Prefix => New_Reference_To (Etype (Concval), Loc), - Attribute_Name => Name_Tag), + Parameter_Associations => New_List ( + + -- Obj_Tag + + Make_Attribute_Reference (Loc, + Prefix => Concval, + Attribute_Name => Name_Tag), + + -- Tag_Typ + + Make_Attribute_Reference (Loc, + Prefix => New_Reference_To (Etype (Concval), Loc), + Attribute_Name => Name_Tag), - -- Position + -- Position - Make_Integer_Literal (Loc, DT_Position (Entity (Ename)))))); + Make_Integer_Literal (Loc, + DT_Position (Entity (Ename)))))))); end if; -- Specific actuals for protected to XXX requeue -- cgit v1.2.1