OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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:
Thomas Quinot 2005-09-05 09:53:45 +02:00 committed by Arnaud Charlet
parent 04efc8a196
commit 3eb8fddca9
1 changed files with 27 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
gcc/ada/exp_dist.adb
View File

@ -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);