diff options
Diffstat (limited to 'gcc/ada/exp_attr.adb')
| -rw-r--r-- | gcc/ada/exp_attr.adb | 107 |
1 files changed, 44 insertions, 63 deletions
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 4bb8d197a5a..4baf55e7e57 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -129,7 +129,7 @@ package body Exp_Attr is -- operand with overflow checking required. function Get_Index_Subtype (N : Node_Id) return Entity_Id; - -- Used for Last, Last, and Length, when the prefix is an array type, + -- Used for Last, Last, and Length, when the prefix is an array type. -- Obtains the corresponding index subtype. procedure Find_Fat_Info @@ -838,8 +838,12 @@ package body Exp_Attr is -- generate a call to a run-time subprogram that returns the base -- address of the object. + -- This processing is not needed in the VM case, where dispatching + -- issues are taken care of by the virtual machine. + elsif Is_Class_Wide_Type (Etype (Pref)) and then Is_Interface (Etype (Pref)) + and then VM_Target = No_VM and then not (Nkind (Pref) in N_Has_Entity and then Is_Subprogram (Entity (Pref))) then @@ -1923,8 +1927,27 @@ package body Exp_Attr is else Id_Kind := RTE (RO_AT_Task_Id); - Rewrite (N, - Unchecked_Convert_To (Id_Kind, Concurrent_Ref (Pref))); + -- If the prefix is a task interface, the Task_Id is obtained + -- dynamically through a dispatching call, as for other task + -- attributes applied to interfaces. + + if Ada_Version >= Ada_05 + and then Ekind (Etype (Pref)) = E_Class_Wide_Type + and then Is_Interface (Etype (Pref)) + and then Is_Task_Interface (Etype (Pref)) + then + Rewrite (N, + Unchecked_Convert_To (Id_Kind, + Make_Selected_Component (Loc, + Prefix => + New_Copy_Tree (Pref), + Selector_Name => + Make_Identifier (Loc, Name_uDisp_Get_Task_Id)))); + + else + Rewrite (N, + Unchecked_Convert_To (Id_Kind, Concurrent_Ref (Pref))); + end if; end if; Analyze_And_Resolve (N, Id_Kind); @@ -4052,13 +4075,17 @@ package body Exp_Attr is -- Note that Prefix'Address is recursively expanded into a call -- to Base_Address (Obj.Tag) - Rewrite (N, - Make_Explicit_Dereference (Loc, - Unchecked_Convert_To (RTE (RE_Tag_Ptr), - Make_Attribute_Reference (Loc, - Prefix => Relocate_Node (Pref), - Attribute_Name => Name_Address)))); - Analyze_And_Resolve (N, RTE (RE_Tag)); + -- Not needed for VM targets, since all handled by the VM + + if VM_Target = No_VM then + Rewrite (N, + Make_Explicit_Dereference (Loc, + Unchecked_Convert_To (RTE (RE_Tag_Ptr), + Make_Attribute_Reference (Loc, + Prefix => Relocate_Node (Pref), + Attribute_Name => Name_Address)))); + Analyze_And_Resolve (N, RTE (RE_Tag)); + end if; else Rewrite (N, @@ -4581,66 +4608,19 @@ package body Exp_Attr is -- Wide_Image -- ---------------- - -- We expand typ'Wide_Image (X) into - - -- String_To_Wide_String - -- (typ'Image (X), Wide_Character_Encoding_Method) + -- Wide_Image attribute is handled in separate unit Exp_Imgv - -- This works in all cases because String_To_Wide_String converts any - -- wide character escape sequences resulting from the Image call to the - -- proper Wide_Character equivalent - - -- not quite right for typ = Wide_Character ??? - - when Attribute_Wide_Image => Wide_Image : - begin - Rewrite (N, - Make_Function_Call (Loc, - Name => New_Reference_To (RTE (RE_String_To_Wide_String), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => Pref, - Attribute_Name => Name_Image, - Expressions => Exprs), - - Make_Integer_Literal (Loc, - Intval => Int (Wide_Character_Encoding_Method))))); - - Analyze_And_Resolve (N, Standard_Wide_String); - end Wide_Image; + when Attribute_Wide_Image => + Exp_Imgv.Expand_Wide_Image_Attribute (N); --------------------- -- Wide_Wide_Image -- --------------------- - -- We expand typ'Wide_Wide_Image (X) into - - -- String_To_Wide_Wide_String - -- (typ'Image (X), Wide_Character_Encoding_Method) - - -- This works in all cases because String_To_Wide_Wide_String converts - -- any wide character escape sequences resulting from the Image call to - -- the proper Wide_Character equivalent - - -- not quite right for typ = Wide_Wide_Character ??? - - when Attribute_Wide_Wide_Image => Wide_Wide_Image : - begin - Rewrite (N, - Make_Function_Call (Loc, - Name => New_Reference_To - (RTE (RE_String_To_Wide_Wide_String), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => Pref, - Attribute_Name => Name_Image, - Expressions => Exprs), - - Make_Integer_Literal (Loc, - Intval => Int (Wide_Character_Encoding_Method))))); + -- Wide_Wide_Image attribute is handled in separate unit Exp_Imgv - Analyze_And_Resolve (N, Standard_Wide_Wide_String); - end Wide_Wide_Image; + when Attribute_Wide_Wide_Image => + Exp_Imgv.Expand_Wide_Wide_Image_Attribute (N); ---------------- -- Wide_Value -- @@ -4935,6 +4915,7 @@ package body Exp_Attr is Attribute_Emax | Attribute_Enabled | Attribute_Epsilon | + Attribute_Fast_Math | Attribute_Has_Access_Values | Attribute_Has_Discriminants | Attribute_Large | |