exp_dist.adb (Add_RACW_TypeCode, [...]): Do not generate dummy access formal for RACW/RAS TypeCode TSS.
2005-09-01 Thomas Quinot <quinot@adacore.com> * 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. From-SVN: r103863
This commit is contained in:
parent
04efc8a196
commit
3eb8fddca9
|
@ -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);
|
||||
|
|
Loading…
Reference in New Issue