From 0f3718343b79a1d8e5b542e255d617412d5b8399 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 5 Sep 2005 07:53:45 +0000 Subject: [PATCH] 2005-09-01 Thomas Quinot * exp_dist.adb (Add_RACW_TypeCode, Add_RAS_TypeCode): Do not generate dummy access formal for RACW/RAS TypeCode TSS. (Build_TypeCode_Call): Do not generate dummy null access actual for calls to the TypeCode TSS. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103863 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/exp_dist.adb | 119 ++++++++++++--------------------------------------- 1 file changed, 27 insertions(+), 92 deletions(-) diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index b3801f6..d0e016d 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -483,7 +483,7 @@ package body Exp_Dist is -- Is_Known_Async... : True if we know that this is asynchronous -- Is_Known_Non_A... : True if we know that this is not asynchronous -- Spec : a node with a Parameter_Specifications and - -- a Subtype_Mark if applicable + -- a Result_Definition if applicable -- Stub_Type : in case of RACW stubs, parameters of type access -- to Stub_Type will be marshalled using the -- address of the object (the addr field) rather @@ -1480,13 +1480,13 @@ package body Exp_Dist is Make_Function_Specification (Loc, Defining_Unit_Name => Proc, Parameter_Specifications => Param_Specs, - Subtype_Mark => + Result_Definition => New_Occurrence_Of ( - Entity (Subtype_Mark (Spec)), Loc)); + Entity (Result_Definition (Spec)), Loc)); Set_Ekind (Proc, E_Function); Set_Etype (Proc, - New_Occurrence_Of (Entity (Subtype_Mark (Spec)), Loc)); + New_Occurrence_Of (Entity (Result_Definition (Spec)), Loc)); else Proc_Spec := @@ -2313,8 +2313,8 @@ package body Exp_Dist is Make_Defining_Identifier (Loc, Chars => Name_For_New_Spec), Parameter_Specifications => Parameters, - Subtype_Mark => - New_Occurrence_Of (Entity (Subtype_Mark (Spec)), Loc)); + Result_Definition => + New_Occurrence_Of (Entity (Result_Definition (Spec)), Loc)); when N_Procedure_Specification | N_Access_Procedure_Definition => return @@ -3230,7 +3230,7 @@ package body Exp_Dist is Parameter_Type => New_Occurrence_Of (Standard_Boolean, Loc))), - Subtype_Mark => + Result_Definition => New_Occurrence_Of (Fat_Type, Loc)); -- Set the kind and return type of the function to prevent @@ -3417,7 +3417,7 @@ package body Exp_Dist is True, Parameter_Type => New_Occurrence_Of (RTE (RE_Subprogram_Id), Loc))), - Subtype_Mark => + Result_Definition => New_Occurrence_Of (RTE (RE_Unsigned_64), Loc))); Append_To (Decls, Current_Declaration); Analyze (Current_Declaration); @@ -3992,7 +3992,7 @@ package body Exp_Dist is Make_Attribute_Reference (Loc, Prefix => New_Occurrence_Of ( - Etype (Subtype_Mark (Spec)), Loc), + Etype (Result_Definition (Spec)), Loc), Attribute_Name => Name_Input, @@ -4606,7 +4606,7 @@ package body Exp_Dist is declare Etyp : constant Entity_Id := - Etype (Subtype_Mark (Specification (Vis_Decl))); + Etype (Result_Definition (Specification (Vis_Decl))); Result : constant Node_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); @@ -4873,7 +4873,7 @@ package body Exp_Dist is Specification => Make_Function_Specification (Loc, Defining_Unit_Name => Make_Defining_Identifier (Loc, New_Internal_Name ('S')), - Subtype_Mark => New_Occurrence_Of (Var_Type, Loc)), + Result_Definition => New_Occurrence_Of (Var_Type, Loc)), Declarations => No_List, Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, New_List ( @@ -5413,7 +5413,7 @@ package body Exp_Dist is Any_Parameter, Parameter_Type => New_Occurrence_Of (RTE (RE_Any), Loc))), - Subtype_Mark => New_Occurrence_Of (RACW_Type, Loc)); + Result_Definition => New_Occurrence_Of (RACW_Type, Loc)); -- NOTE: The usage occurrences of RACW_Parameter must -- refer to the entity in the declaration spec, not those @@ -5727,7 +5727,7 @@ package body Exp_Dist is RACW_Parameter, Parameter_Type => New_Occurrence_Of (RACW_Type, Loc))), - Subtype_Mark => New_Occurrence_Of (RTE (RE_Any), Loc)); + Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc)); -- NOTE: The usage occurrences of RACW_Parameter must -- refer to the entity in the declaration spec, not in @@ -5771,9 +5771,6 @@ package body Exp_Dist is Func_Decl : Node_Id; Func_Body : Node_Id; - RACW_Parameter : constant Entity_Id := - Make_Defining_Identifier (Loc, Name_R); - begin Fnam := Make_Defining_Identifier (Loc, @@ -5786,15 +5783,7 @@ package body Exp_Dist is Make_Function_Specification (Loc, Defining_Unit_Name => Fnam, - Parameter_Specifications => New_List ( - Make_Parameter_Specification (Loc, - Defining_Identifier => - RACW_Parameter, - Parameter_Type => - Make_Access_Definition (Loc, - Subtype_Mark => - New_Occurrence_Of (RACW_Type, Loc)))), - Subtype_Mark => New_Occurrence_Of (RTE (RE_TypeCode), Loc)); + Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc)); -- NOTE: The usage occurrences of RACW_Parameter must -- refer to the entity in the declaration spec, not those @@ -6247,7 +6236,7 @@ package body Exp_Dist is Parameter_Type => New_Occurrence_Of (Standard_Boolean, Loc))), - Subtype_Mark => + Result_Definition => New_Occurrence_Of (Fat_Type, Loc)); -- Set the kind and return type of the function to prevent @@ -6309,7 +6298,7 @@ package body Exp_Dist is Any_Parameter, Parameter_Type => New_Occurrence_Of (RTE (RE_Any), Loc))), - Subtype_Mark => New_Occurrence_Of (RAS_Type, Loc)); + Result_Definition => New_Occurrence_Of (RAS_Type, Loc)); Discard_Node ( Make_Subprogram_Body (Loc, @@ -6383,7 +6372,7 @@ package body Exp_Dist is RAS_Parameter, Parameter_Type => New_Occurrence_Of (RAS_Type, Loc))), - Subtype_Mark => New_Occurrence_Of (RTE (RE_Any), Loc)); + Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc)); Discard_Node ( Make_Subprogram_Body (Loc, @@ -6410,25 +6399,12 @@ package body Exp_Dist is Decls : constant List_Id := New_List; Name_String, Repo_Id_String : String_Id; - RAS_Parameter : constant Entity_Id := - Make_Defining_Identifier (Loc, Name_R); - begin - -- The spec for this subprogram has a dummy 'access RAS' - -- argument, which serves only for overloading purposes. - Func_Spec := Make_Function_Specification (Loc, Defining_Unit_Name => Fnam, - Parameter_Specifications => New_List ( - Make_Parameter_Specification (Loc, - Defining_Identifier => - RAS_Parameter, - Parameter_Type => - Make_Access_Definition (Loc, - Subtype_Mark => New_Occurrence_Of (RAS_Type, Loc)))), - Subtype_Mark => New_Occurrence_Of (RTE (RE_TypeCode), Loc)); + Result_Definition => New_Occurrence_Of (RTE (RE_TypeCode), Loc)); PolyORB_Support.Helpers.Build_Name_And_Repository_Id (RAS_Type, Name_Str => Name_String, Repo_Id_Str => Repo_Id_String); @@ -7018,7 +6994,7 @@ package body Exp_Dist is if Is_Function then Result_TC := PolyORB_Support.Helpers.Build_TypeCode_Call (Loc, - Etype (Subtype_Mark (Spec)), Decls); + Etype (Result_Definition (Spec)), Decls); else Result_TC := New_Occurrence_Of (RTE (RE_TC_Void), Loc); end if; @@ -7315,7 +7291,7 @@ package body Exp_Dist is Make_Tag_Check (Loc, Make_Return_Statement (Loc, PolyORB_Support.Helpers.Build_From_Any_Call ( - Etype (Subtype_Mark (Spec)), + Etype (Result_Definition (Spec)), Make_Selected_Component (Loc, Prefix => Result, Selector_Name => Name_Argument), @@ -7892,7 +7868,7 @@ package body Exp_Dist is declare Etyp : constant Entity_Id := - Etype (Subtype_Mark (Specification (Vis_Decl))); + Etype (Result_Definition (Specification (Vis_Decl))); Result : constant Node_Id := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); @@ -8271,7 +8247,7 @@ package body Exp_Dist is Any_Parameter, Parameter_Type => New_Occurrence_Of (RTE (RE_Any), Loc))), - Subtype_Mark => New_Occurrence_Of (Typ, Loc)); + Result_Definition => New_Occurrence_Of (Typ, Loc)); -- The following is taken care of by Exp_Dist.Add_RACW_From_Any @@ -9062,7 +9038,7 @@ package body Exp_Dist is Expr_Parameter, Parameter_Type => New_Occurrence_Of (Typ, Loc))), - Subtype_Mark => New_Occurrence_Of (RTE (RE_Any), Loc)); + Result_Definition => New_Occurrence_Of (RTE (RE_Any), Loc)); Set_Etype (Expr_Parameter, Typ); Any_Decl := @@ -9571,9 +9547,6 @@ package body Exp_Dist is -- if Typ is incomplete. Fnam : Entity_Id := Empty; - Tnam : Entity_Id := Empty; - Pnam : Entity_Id := Empty; - Args : List_Id := Empty_List; Lib_RE : RE_Id := RE_Null; Expr : Node_Id; @@ -9590,43 +9563,6 @@ package body Exp_Dist is -- in the type's TSS. Fnam := Find_Inherited_TSS (U_Type, TSS_TypeCode); - - if Present (Fnam) then - - -- When a TypeCode TSS exists, it has a single parameter - -- that is an anonymous access to the corresponding type. - -- This parameter is not used in any way; its purpose is - -- solely to provide overloading of the TSS. - - Tnam := - Make_Defining_Identifier (Loc, New_Internal_Name ('T')); - Pnam := - Make_Defining_Identifier (Loc, New_Internal_Name ('P')); - - Append_To (Decls, - Make_Full_Type_Declaration (Loc, - Defining_Identifier => Tnam, - Type_Definition => - Make_Access_To_Object_Definition (Loc, - Subtype_Indication => - New_Occurrence_Of (U_Type, Loc)))); - Append_To (Decls, - Make_Object_Declaration (Loc, - Defining_Identifier => Pnam, - Constant_Present => True, - Object_Definition => New_Occurrence_Of (Tnam, Loc), - - -- Use a variable here to force proper freezing of Tnam - - Expression => Make_Null (Loc))); - - -- Normally, calling _TypeCode with a null access parameter - -- should raise Constraint_Error, but this check is - -- suppressed for expanded code, and we do not care anyway - -- because we do not actually ever use this value. - - Args := New_List (New_Occurrence_Of (Pnam, Loc)); - end if; end if; if No (Fnam) then @@ -9720,9 +9656,7 @@ package body Exp_Dist is -- Call the function Expr := - Make_Function_Call (Loc, - Name => New_Occurrence_Of (Fnam, Loc), - Parameter_Associations => Args); + Make_Function_Call (Loc, Name => New_Occurrence_Of (Fnam, Loc)); -- Allow Expr to be used as arg to Build_To_Any_Call immediately @@ -10089,7 +10023,8 @@ package body Exp_Dist is Make_Function_Specification (Loc, Defining_Unit_Name => Fnam, Parameter_Specifications => Empty_List, - Subtype_Mark => New_Occurrence_Of (RTE (RE_TypeCode), Loc)); + Result_Definition => + New_Occurrence_Of (RTE (RE_TypeCode), Loc)); Build_Name_And_Repository_Id (Typ, Name_Str => Type_Name_Str, Repo_Id_Str => Type_Repo_Id_Str); @@ -10633,7 +10568,7 @@ package body Exp_Dist is begin if Nkind (Spec) = N_Function_Specification then Set_Ekind (Snam, E_Function); - Set_Etype (Snam, Entity (Subtype_Mark (Spec))); + Set_Etype (Snam, Entity (Result_Definition (Spec))); else Set_Ekind (Snam, E_Procedure); Set_Etype (Snam, Standard_Void_Type); -- 2.7.4