Skip to content

R
riscv-gcc-1
Commit c6f39437 by Arnaud Charlet
Options

[multiple changes] 

2009-07-13  Thomas Quinot  <quinot@adacore.com>

	* exp_dist.adb (Add_RACW_Primitive_Declarations_And_Bodies):
	Do not attempt to generate stubs for predefined primitives of
	synchronized interfaces.
	(Add_Stub_Type): Factor some code from the PCS-specific variants of
	Build_Stub_Type.

2009-07-13  Ed Schonberg  <schonberg@adacore.com>

	* sem_disp.adb (Override_Dispatching_Operation): Functions inherit the
	Controlling_Result flag from the operation they override.

From-SVN: r149553
parent d97a04d0
Showing with 178 additions and 153 deletions
gcc/ada/ChangeLog
2009-07-13 Thomas Quinot <quinot@adacore.com>
* exp_dist.adb (Add_RACW_Primitive_Declarations_And_Bodies):
Do not attempt to generate stubs for predefined primitives of
synchronized interfaces.
(Add_Stub_Type): Factor some code from the PCS-specific variants of
Build_Stub_Type.
2009-07-13 Ed Schonberg <schonberg@adacore.com>
* sem_disp.adb (Override_Dispatching_Operation): Functions inherit the
Controlling_Result flag from the operation they override.
2009-07-13 Arnaud Charlet <charlet@adacore.com> 2009-07-13 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Make-lang.in: Update dependencies * gcc-interface/Make-lang.in: Update dependencies
......
gcc/ada/exp_dist.adb
...@@ -27,6 +27,7 @@ with Atree; use Atree; ...@@ -27,6 +27,7 @@ with Atree; use Atree;
with Einfo; use Einfo; with Einfo; use Einfo;
with Elists; use Elists; with Elists; use Elists;
with Exp_Atag; use Exp_Atag; with Exp_Atag; use Exp_Atag;
with Exp_Disp; use Exp_Disp;
with Exp_Strm; use Exp_Strm; with Exp_Strm; use Exp_Strm;
with Exp_Tss; use Exp_Tss; with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util; with Exp_Util; use Exp_Util;
...@@ -55,8 +56,7 @@ with GNAT.HTable; use GNAT.HTable; ...@@ -55,8 +56,7 @@ with GNAT.HTable; use GNAT.HTable;
package body Exp_Dist is package body Exp_Dist is
-- The following model has been used to implement distributed objects: -- The following model has been used to implement distributed objects:
-- given a designated type D and a RACW type R, then a record of the -- given a designated type D and a RACW type R, then a record of the form:
-- form:
-- type Stub is tagged record -- type Stub is tagged record
-- [...declaration similar to s-parint.ads RACW_Stub_Type...] -- [...declaration similar to s-parint.ads RACW_Stub_Type...]
...@@ -64,8 +64,8 @@ package body Exp_Dist is ...@@ -64,8 +64,8 @@ package body Exp_Dist is
-- is built. This type has two properties: -- is built. This type has two properties:
-- 1) Since it has the same structure than RACW_Stub_Type, it can be -- 1) Since it has the same structure than RACW_Stub_Type, it can
-- converted to and from this type to make it suitable for -- be converted to and from this type to make it suitable for
-- System.Partition_Interface.Get_Unique_Remote_Pointer in order -- System.Partition_Interface.Get_Unique_Remote_Pointer in order
-- to avoid memory leaks when the same remote object arrive on the -- to avoid memory leaks when the same remote object arrive on the
-- same partition through several paths; -- same partition through several paths;
...@@ -82,11 +82,10 @@ package body Exp_Dist is ...@@ -82,11 +82,10 @@ package body Exp_Dist is
-- RCI subprograms are numbered starting at 2. The RCI receiver for -- RCI subprograms are numbered starting at 2. The RCI receiver for
-- an RCI package can thus identify calls received through remote -- an RCI package can thus identify calls received through remote
-- access-to-subprogram dereferences by the fact that they have a -- access-to-subprogram dereferences by the fact that they have a
-- (primitive) subprogram id of 0, and 1 is used for the internal -- (primitive) subprogram id of 0, and 1 is used for the internal RAS
-- RAS information lookup operation. (This is for the Garlic code -- information lookup operation. (This is for the Garlic code generation,
-- generation, where subprograms are identified by numbers; in the -- where subprograms are identified by numbers; in the PolyORB version,
-- PolyORB version, they are identified by name, with a numeric suffix -- they are identified by name, with a numeric suffix for homonyms.)
-- for homonyms.)
type Hash_Index is range 0 .. 50; type Hash_Index is range 0 .. 50;
...@@ -95,13 +94,13 @@ package body Exp_Dist is ...@@ -95,13 +94,13 @@ package body Exp_Dist is
----------------------- -----------------------
function Hash (F : Entity_Id) return Hash_Index; function Hash (F : Entity_Id) return Hash_Index;
-- DSA expansion associates stubs to distributed object types using -- DSA expansion associates stubs to distributed object types using a hash
-- a hash table on entity ids. -- table on entity ids.
function Hash (F : Name_Id) return Hash_Index; function Hash (F : Name_Id) return Hash_Index;
-- The generation of subprogram identifiers requires an overload counter -- The generation of subprogram identifiers requires an overload counter
-- to be associated with each remote subprogram names. These counters -- to be associated with each remote subprogram names. These counters are
-- are maintained in a hash table on name ids. -- maintained in a hash table on name ids.
type Subprogram_Identifiers is record type Subprogram_Identifiers is record
Str_Identifier : String_Id; Str_Identifier : String_Id;
...@@ -115,8 +114,8 @@ package body Exp_Dist is ...@@ -115,8 +114,8 @@ package body Exp_Dist is
Key => Entity_Id, Key => Entity_Id,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- Mapping between a remote subprogram and the corresponding -- Mapping between a remote subprogram and the corresponding subprogram
-- subprogram identifiers. -- identifiers.
package Overload_Counter_Table is package Overload_Counter_Table is
new Simple_HTable (Header_Num => Hash_Index, new Simple_HTable (Header_Num => Hash_Index,
...@@ -125,9 +124,9 @@ package body Exp_Dist is ...@@ -125,9 +124,9 @@ package body Exp_Dist is
Key => Name_Id, Key => Name_Id,
Hash => Hash, Hash => Hash,
Equal => "="); Equal => "=");
-- Mapping between a subprogram name and an integer that -- Mapping between a subprogram name and an integer that counts the number
-- counts the number of defining subprogram names with that -- of defining subprogram names with that Name_Id encountered so far in a
-- Name_Id encountered so far in a given context (an interface). -- given context (an interface).
function Get_Subprogram_Ids (Def : Entity_Id) return Subprogram_Identifiers; function Get_Subprogram_Ids (Def : Entity_Id) return Subprogram_Identifiers;
function Get_Subprogram_Id (Def : Entity_Id) return String_Id; function Get_Subprogram_Id (Def : Entity_Id) return String_Id;
...@@ -264,8 +263,8 @@ package body Exp_Dist is ...@@ -264,8 +263,8 @@ package body Exp_Dist is
(Loc : Source_Ptr; (Loc : Source_Ptr;
Prefix : Entity_Id; Prefix : Entity_Id;
Selector_Name : Name_Id) return Node_Id; Selector_Name : Name_Id) return Node_Id;
-- Return a selected_component whose prefix denotes the given entity, -- Return a selected_component whose prefix denotes the given entity, and
-- and with the given Selector_Name. -- with the given Selector_Name.
function Scope_Of_Spec (Spec : Node_Id) return Entity_Id; function Scope_Of_Spec (Spec : Node_Id) return Entity_Id;
-- Return the scope represented by a given spec -- Return the scope represented by a given spec
...@@ -274,8 +273,8 @@ package body Exp_Dist is ...@@ -274,8 +273,8 @@ package body Exp_Dist is
(Typ : Entity_Id; (Typ : Entity_Id;
Nam : Entity_Id; Nam : Entity_Id;
TSS_Nam : TSS_Name_Type); TSS_Nam : TSS_Name_Type);
-- Create a renaming declaration of subprogram Nam, -- Create a renaming declaration of subprogram Nam, and register it as a
-- and register it as a TSS for Typ with name TSS_Nam. -- TSS for Typ with name TSS_Nam.
function Need_Extra_Constrained (Parameter : Node_Id) return Boolean; function Need_Extra_Constrained (Parameter : Node_Id) return Boolean;
-- Return True if the current parameter needs an extra formal to reflect -- Return True if the current parameter needs an extra formal to reflect
...@@ -563,11 +562,10 @@ package body Exp_Dist is ...@@ -563,11 +562,10 @@ package body Exp_Dist is
procedure Specific_Build_Stub_Type procedure Specific_Build_Stub_Type
(RACW_Type : Entity_Id; (RACW_Type : Entity_Id;
Stub_Type : Entity_Id; Stub_Type_Comps : out List_Id;
Stub_Type_Decl : out Node_Id;
RPC_Receiver_Decl : out Node_Id); RPC_Receiver_Decl : out Node_Id);
-- Build a type declaration for the stub type associated with an RACW -- Build a components list for the stub type associated with an RACW type,
-- type, and the necessary RPC receiver, if applicable. PCS-specific -- and build the necessary RPC receiver, if applicable. PCS-specific
-- ancillary subprogram for Add_Stub_Type. If no RPC receiver declaration -- ancillary subprogram for Add_Stub_Type. If no RPC receiver declaration
-- is generated, then RPC_Receiver_Decl is set to Empty. -- is generated, then RPC_Receiver_Decl is set to Empty.
...@@ -616,6 +614,10 @@ package body Exp_Dist is ...@@ -616,6 +614,10 @@ package body Exp_Dist is
Stmts : List_Id); Stmts : List_Id);
-- Add receiving stubs to the declarative part of an RCI unit -- Add receiving stubs to the declarative part of an RCI unit
--------------------
-- GARLIC_Support --
--------------------
package GARLIC_Support is package GARLIC_Support is
-- Support for generating DSA code that uses the GARLIC PCS -- Support for generating DSA code that uses the GARLIC PCS
...@@ -657,8 +659,7 @@ package body Exp_Dist is ...@@ -657,8 +659,7 @@ package body Exp_Dist is
procedure Build_Stub_Type procedure Build_Stub_Type
(RACW_Type : Entity_Id; (RACW_Type : Entity_Id;
Stub_Type : Entity_Id; Stub_Type_Comps : out List_Id;
Stub_Type_Decl : out Node_Id;
RPC_Receiver_Decl : out Node_Id); RPC_Receiver_Decl : out Node_Id);
function Build_Subprogram_Receiving_Stubs function Build_Subprogram_Receiving_Stubs
...@@ -690,6 +691,10 @@ package body Exp_Dist is ...@@ -690,6 +691,10 @@ package body Exp_Dist is
end GARLIC_Support; end GARLIC_Support;
---------------------
-- PolyORB_Support --
---------------------
package PolyORB_Support is package PolyORB_Support is
-- Support for generating DSA code that uses the PolyORB PCS -- Support for generating DSA code that uses the PolyORB PCS
...@@ -731,8 +736,7 @@ package body Exp_Dist is ...@@ -731,8 +736,7 @@ package body Exp_Dist is
procedure Build_Stub_Type procedure Build_Stub_Type
(RACW_Type : Entity_Id; (RACW_Type : Entity_Id;
Stub_Type : Entity_Id; Stub_Type_Comps : out List_Id;
Stub_Type_Decl : out Node_Id;
RPC_Receiver_Decl : out Node_Id); RPC_Receiver_Decl : out Node_Id);
function Build_Subprogram_Receiving_Stubs function Build_Subprogram_Receiving_Stubs
...@@ -769,6 +773,10 @@ package body Exp_Dist is ...@@ -769,6 +773,10 @@ package body Exp_Dist is
-- their methods to be accessed as objects, for the implementation of -- their methods to be accessed as objects, for the implementation of
-- remote access-to-subprogram types). -- remote access-to-subprogram types).
-------------
-- Helpers --
-------------
package Helpers is package Helpers is
-- Routines to build distribution helper subprograms for user-defined -- Routines to build distribution helper subprograms for user-defined
...@@ -1146,7 +1154,6 @@ package body Exp_Dist is ...@@ -1146,7 +1154,6 @@ package body Exp_Dist is
end if; end if;
else else
-- Case of declaring the RACW in another package than its designated -- Case of declaring the RACW in another package than its designated
-- type: use the private declarations list if present; otherwise -- type: use the private declarations list if present; otherwise
-- use the visible declarations. -- use the visible declarations.
...@@ -1317,11 +1324,12 @@ package body Exp_Dist is ...@@ -1317,11 +1324,12 @@ package body Exp_Dist is
Is_TSS (Current_Primitive, TSS_Stream_Input) or else Is_TSS (Current_Primitive, TSS_Stream_Input) or else
Is_TSS (Current_Primitive, TSS_Stream_Output) or else Is_TSS (Current_Primitive, TSS_Stream_Output) or else
Is_TSS (Current_Primitive, TSS_Stream_Read) or else Is_TSS (Current_Primitive, TSS_Stream_Read) or else
Is_TSS (Current_Primitive, TSS_Stream_Write)) Is_TSS (Current_Primitive, TSS_Stream_Write) or else
Is_Predefined_Interface_Primitive (Current_Primitive))
and then not Is_Hidden (Current_Primitive) and then not Is_Hidden (Current_Primitive)
then then
-- The first thing to do is build an up-to-date copy of the -- The first thing to do is build an up-to-date copy of the
-- spec with all the formals referencing Designated_Type -- spec with all the formals referencing Controlling_Type
-- transformed into formals referencing Stub_Type. Since this -- transformed into formals referencing Stub_Type. Since this
-- primitive may have been inherited, go back the alias chain -- primitive may have been inherited, go back the alias chain
-- until the real primitive has been found. -- until the real primitive has been found.
...@@ -1337,7 +1345,7 @@ package body Exp_Dist is ...@@ -1337,7 +1345,7 @@ package body Exp_Dist is
-- Copy the spec from the original declaration for the purpose -- Copy the spec from the original declaration for the purpose
-- of declaring an overriding subprogram: we need to replace -- of declaring an overriding subprogram: we need to replace
-- the type of each controlling formal with Stub_Type. The -- the type of each controlling formal with Stub_Type. The
-- primitive may have been declared for Designated_Type or -- primitive may have been declared for Controlling_Type or
-- inherited from some ancestor type for which we do not have -- inherited from some ancestor type for which we do not have
-- an easily determined Entity_Id. We have no systematic way -- an easily determined Entity_Id. We have no systematic way
-- of knowing which type to substitute Stub_Type for. Instead, -- of knowing which type to substitute Stub_Type for. Instead,
...@@ -1860,6 +1868,7 @@ package body Exp_Dist is ...@@ -1860,6 +1868,7 @@ package body Exp_Dist is
Stub_Elements : constant Stub_Structure := Stub_Elements : constant Stub_Structure :=
Stubs_Table.Get (Designated_Type); Stubs_Table.Get (Designated_Type);
Stub_Type_Comps : List_Id;
Stub_Type_Decl : Node_Id; Stub_Type_Decl : Node_Id;
Stub_Type_Access_Decl : Node_Id; Stub_Type_Access_Decl : Node_Id;
...@@ -1875,8 +1884,7 @@ package body Exp_Dist is ...@@ -1875,8 +1884,7 @@ package body Exp_Dist is
Existing := False; Existing := False;
Stub_Type := Stub_Type :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc, Chars => New_Internal_Name ('S'));
Chars => New_Internal_Name ('S'));
Set_Ekind (Stub_Type, E_Record_Type); Set_Ekind (Stub_Type, E_Record_Type);
Set_Is_RACW_Stub_Type (Stub_Type); Set_Is_RACW_Stub_Type (Stub_Type);
Stub_Type_Access := Stub_Type_Access :=
...@@ -1884,9 +1892,24 @@ package body Exp_Dist is ...@@ -1884,9 +1892,24 @@ package body Exp_Dist is
Chars => New_External_Name Chars => New_External_Name
(Related_Id => Chars (Stub_Type), Suffix => 'A')); (Related_Id => Chars (Stub_Type), Suffix => 'A'));
Specific_Build_Stub_Type Specific_Build_Stub_Type (RACW_Type, Stub_Type_Comps, RPC_Receiver_Decl);
(RACW_Type, Stub_Type,
Stub_Type_Decl, RPC_Receiver_Decl); Stub_Type_Decl :=
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Stub_Type,
Type_Definition =>
Make_Record_Definition (Loc,
Tagged_Present => True,
Limited_Present => True,
Component_List =>
Make_Component_List (Loc,
Component_Items => Stub_Type_Comps)));
-- Does the stub type need to explicitly implement interfaces from the
-- designated type???
-- In particular are there issues in the case where the designated type
-- is a synchronized interface???
Stub_Type_Access_Decl := Stub_Type_Access_Decl :=
Make_Full_Type_Declaration (Loc, Make_Full_Type_Declaration (Loc,
...@@ -1901,9 +1924,10 @@ package body Exp_Dist is ...@@ -1901,9 +1924,10 @@ package body Exp_Dist is
Append_To (Decls, Stub_Type_Access_Decl); Append_To (Decls, Stub_Type_Access_Decl);
Analyze (Last (Decls)); Analyze (Last (Decls));
-- This is in no way a type derivation, but we fake it to make sure that -- We can't directly derive the stub type from the designated type,
-- the dispatching table gets built with the corresponding primitive -- because we don't want any components or discriminants from the real
-- operations at the right place. -- type, so instead we manually fake a derivation to get an appropriate
-- dispatch table.
Derive_Subprograms (Parent_Type => Designated_Type, Derive_Subprograms (Parent_Type => Designated_Type,
Derived_Type => Stub_Type); Derived_Type => Stub_Type);
...@@ -1930,6 +1954,7 @@ package body Exp_Dist is ...@@ -1930,6 +1954,7 @@ package body Exp_Dist is
procedure Append_RACW_Bodies (Decls : List_Id; Spec_Id : Entity_Id) is procedure Append_RACW_Bodies (Decls : List_Id; Spec_Id : Entity_Id) is
E : Entity_Id; E : Entity_Id;
begin begin
E := First_Entity (Spec_Id); E := First_Entity (Spec_Id);
while Present (E) loop while Present (E) loop
...@@ -1960,10 +1985,9 @@ package body Exp_Dist is ...@@ -1960,10 +1985,9 @@ package body Exp_Dist is
Get_Name_String (N); Get_Name_String (N);
-- Homonym handling: as in Exp_Dbug, but much simpler, -- Homonym handling: as in Exp_Dbug, but much simpler, because the only
-- because the only entities for which we have to generate -- entities for which we have to generate names here need only to be
-- names here need only to be disambiguated within their -- disambiguated within their own scope.
-- own scope.
if Overload_Order > 1 then if Overload_Order > 1 then
Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "__"; Name_Buffer (Name_Len + 1 .. Name_Len + 2) := "__";
...@@ -1972,7 +1996,8 @@ package body Exp_Dist is ...@@ -1972,7 +1996,8 @@ package body Exp_Dist is
end if; end if;
Id := String_From_Name_Buffer; Id := String_From_Name_Buffer;
Subprogram_Identifier_Table.Set (Def, Subprogram_Identifier_Table.Set
(Def,
Subprogram_Identifiers'(Str_Identifier => Id, Int_Identifier => Spn)); Subprogram_Identifiers'(Str_Identifier => Id, Int_Identifier => Spn));
end Assign_Subprogram_Identifier; end Assign_Subprogram_Identifier;
...@@ -1988,6 +2013,7 @@ package body Exp_Dist is ...@@ -1988,6 +2013,7 @@ package body Exp_Dist is
Decls : List_Id) Decls : List_Id)
is is
Loc : constant Source_Ptr := Sloc (Object); Loc : constant Source_Ptr := Sloc (Object);
begin begin
-- Declare a temporary object for the actual, possibly initialized with -- Declare a temporary object for the actual, possibly initialized with
-- a 'Input/From_Any call. -- a 'Input/From_Any call.
...@@ -2071,7 +2097,6 @@ package body Exp_Dist is ...@@ -2071,7 +2097,6 @@ package body Exp_Dist is
end if; end if;
else else
-- General case of a regular object declaration. Object is flagged -- General case of a regular object declaration. Object is flagged
-- constant unless it has mode out or in out, to allow the backend -- constant unless it has mode out or in out, to allow the backend
-- to optimize where possible. -- to optimize where possible.
...@@ -4084,8 +4109,8 @@ package body Exp_Dist is ...@@ -4084,8 +4109,8 @@ package body Exp_Dist is
Loc : constant Source_Ptr := Sloc (Nod); Loc : constant Source_Ptr := Sloc (Nod);
Stream_Parameter : Node_Id; Stream_Parameter : Node_Id;
-- Name of the stream used to transmit parameters to the -- Name of the stream used to transmit parameters to the remote
-- remote package. -- package.
Result_Parameter : Node_Id; Result_Parameter : Node_Id;
-- Name of the result parameter (in non-APC cases) which get the -- Name of the result parameter (in non-APC cases) which get the
...@@ -4410,8 +4435,8 @@ package body Exp_Dist is ...@@ -4410,8 +4435,8 @@ package body Exp_Dist is
else else
-- Loop around parameters and assign out (or in out) -- Loop around parameters and assign out (or in out)
-- parameters. In the case of RACW, controlling arguments -- parameters. In the case of RACW, controlling arguments
-- cannot possibly have changed since they are remote, so we do -- cannot possibly have changed since they are remote, so
-- not read them from the stream. -- we do not read them from the stream.
Current_Parameter := First (Ordered_Parameters_List); Current_Parameter := First (Ordered_Parameters_List);
while Present (Current_Parameter) loop while Present (Current_Parameter) loop
...@@ -4619,25 +4644,14 @@ package body Exp_Dist is ...@@ -4619,25 +4644,14 @@ package body Exp_Dist is
procedure Build_Stub_Type procedure Build_Stub_Type
(RACW_Type : Entity_Id; (RACW_Type : Entity_Id;
Stub_Type : Entity_Id; Stub_Type_Comps : out List_Id;
Stub_Type_Decl : out Node_Id;
RPC_Receiver_Decl : out Node_Id) RPC_Receiver_Decl : out Node_Id)
is is
Loc : constant Source_Ptr := Sloc (Stub_Type); Loc : constant Source_Ptr := Sloc (RACW_Type);
Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type); Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);
begin begin
Stub_Type_Decl := Stub_Type_Comps := New_List (
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Stub_Type,
Type_Definition =>
Make_Record_Definition (Loc,
Tagged_Present => True,
Limited_Present => True,
Component_List =>
Make_Component_List (Loc,
Component_Items => New_List (
Make_Component_Declaration (Loc, Make_Component_Declaration (Loc,
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_Origin), Make_Defining_Identifier (Loc, Name_Origin),
...@@ -4645,8 +4659,7 @@ package body Exp_Dist is ...@@ -4645,8 +4659,7 @@ package body Exp_Dist is
Make_Component_Definition (Loc, Make_Component_Definition (Loc,
Aliased_Present => False, Aliased_Present => False,
Subtype_Indication => Subtype_Indication =>
New_Occurrence_Of ( New_Occurrence_Of (RTE (RE_Partition_ID), Loc))),
RTE (RE_Partition_ID), Loc))),
Make_Component_Declaration (Loc, Make_Component_Declaration (Loc,
Defining_Identifier => Defining_Identifier =>
...@@ -4673,8 +4686,7 @@ package body Exp_Dist is ...@@ -4673,8 +4686,7 @@ package body Exp_Dist is
Make_Component_Definition (Loc, Make_Component_Definition (Loc,
Aliased_Present => False, Aliased_Present => False,
Subtype_Indication => Subtype_Indication =>
New_Occurrence_Of ( New_Occurrence_Of (Standard_Boolean, Loc))));
Standard_Boolean, Loc)))))));
if Is_RAS then if Is_RAS then
RPC_Receiver_Decl := Empty; RPC_Receiver_Decl := Empty;
...@@ -5193,7 +5205,9 @@ package body Exp_Dist is ...@@ -5193,7 +5205,9 @@ package body Exp_Dist is
------------------------------- -------------------------------
function Get_And_Reset_RACW_Bodies (RACW_Type : Entity_Id) return List_Id is function Get_And_Reset_RACW_Bodies (RACW_Type : Entity_Id) return List_Id is
Desig : constant Entity_Id := Etype (Designated_Type (RACW_Type)); Desig : constant Entity_Id :=
Etype (Designated_Type (RACW_Type));
Stub_Elements : Stub_Structure := Stubs_Table.Get (Desig); Stub_Elements : Stub_Structure := Stubs_Table.Get (Desig);
Body_Decls : List_Id; Body_Decls : List_Id;
...@@ -5311,15 +5325,15 @@ package body Exp_Dist is ...@@ -5311,15 +5325,15 @@ package body Exp_Dist is
Typ : Entity_Id; Typ : Entity_Id;
begin begin
-- If the kind of the parameter is E_Void, then it is not a -- If the kind of the parameter is E_Void, then it is not a controlling
-- controlling formal (this can happen in the context of RAS). -- formal (this can happen in the context of RAS).
if Ekind (Defining_Identifier (Parameter)) = E_Void then if Ekind (Defining_Identifier (Parameter)) = E_Void then
return False; return False;
end if; end if;
-- If the parameter is not a controlling formal, then it cannot -- If the parameter is not a controlling formal, then it cannot be
-- be possibly a RACW_Controlling_Formal. -- possibly a RACW_Controlling_Formal.
if not Is_Controlling_Formal (Defining_Identifier (Parameter)) then if not Is_Controlling_Formal (Defining_Identifier (Parameter)) then
return False; return False;
...@@ -5636,7 +5650,6 @@ package body Exp_Dist is ...@@ -5636,7 +5650,6 @@ package body Exp_Dist is
is is
Loc : constant Source_Ptr := Sloc (RACW_Type); Loc : constant Source_Ptr := Sloc (RACW_Type);
Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type); Is_RAS : constant Boolean := not Comes_From_Source (RACW_Type);
Fnam : constant Entity_Id := Fnam : constant Entity_Id :=
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => New_External_Name (Chars (RACW_Type), 'F')); Chars => New_External_Name (Chars (RACW_Type), 'F'));
...@@ -5860,11 +5873,9 @@ package body Exp_Dist is ...@@ -5860,11 +5873,9 @@ package body Exp_Dist is
Make_Defining_Identifier (Loc, Name_R); Make_Defining_Identifier (Loc, Name_R);
Reference : constant Entity_Id := Reference : constant Entity_Id :=
Make_Defining_Identifier Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
(Loc, New_Internal_Name ('R'));
Any : constant Entity_Id := Any : constant Entity_Id :=
Make_Defining_Identifier Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
(Loc, New_Internal_Name ('A'));
begin begin
Func_Spec := Func_Spec :=
...@@ -5992,7 +6003,6 @@ package body Exp_Dist is ...@@ -5992,7 +6003,6 @@ package body Exp_Dist is
Func_Body : Node_Id; Func_Body : Node_Id;
begin begin
-- The spec for this subprogram has a dummy 'access RACW' argument, -- The spec for this subprogram has a dummy 'access RACW' argument,
-- which serves only for overloading purposes. -- which serves only for overloading purposes.
...@@ -6353,6 +6363,7 @@ package body Exp_Dist is ...@@ -6353,6 +6363,7 @@ package body Exp_Dist is
New_Occurrence_Of (Subp_Ref, Loc)))), New_Occurrence_Of (Subp_Ref, Loc)))),
-- Inc_Usage (A.Target); -- Inc_Usage (A.Target);
-- end if;
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Inc_Usage), Loc), Name => New_Occurrence_Of (RTE (RE_Inc_Usage), Loc),
...@@ -6365,7 +6376,6 @@ package body Exp_Dist is ...@@ -6365,7 +6376,6 @@ package body Exp_Dist is
Selector_Name => Selector_Name =>
Make_Identifier (Loc, Name_Target)))))), Make_Identifier (Loc, Name_Target)))))),
-- end if;
-- if not All_Calls_Remote then -- if not All_Calls_Remote then
-- return Fat_Type!(A); -- return Fat_Type!(A);
-- end if; -- end if;
...@@ -6669,8 +6679,8 @@ package body Exp_Dist is ...@@ -6669,8 +6679,8 @@ package body Exp_Dist is
-- Request object received from neutral layer -- Request object received from neutral layer
Subp_Id : Entity_Id; Subp_Id : Entity_Id;
-- Subprogram identifier as received from the neutral -- Subprogram identifier as received from the neutral distribution
-- distribution core. -- core.
Subp_Index : Entity_Id; Subp_Index : Entity_Id;
-- Internal index as determined by matching either the method name -- Internal index as determined by matching either the method name
...@@ -6787,9 +6797,9 @@ package body Exp_Dist is ...@@ -6787,9 +6797,9 @@ package body Exp_Dist is
begin begin
-- Building receiving stubs consist in several operations: -- Building receiving stubs consist in several operations:
-- - a package RPC receiver must be built. This subprogram -- - a package RPC receiver must be built. This subprogram will get
-- will get a Subprogram_Id from the incoming stream -- a Subprogram_Id from the incoming stream and will dispatch the
-- and will dispatch the call to the right subprogram; -- call to the right subprogram;
-- - a receiving stub for each subprogram visible in the package -- - a receiving stub for each subprogram visible in the package
-- spec. This stub will read all the parameters from the stream, -- spec. This stub will read all the parameters from the stream,
...@@ -6837,9 +6847,9 @@ package body Exp_Dist is ...@@ -6837,9 +6847,9 @@ package body Exp_Dist is
New_Occurrence_Of (Is_Local, Loc), New_Occurrence_Of (Is_Local, Loc),
New_Occurrence_Of (Local_Address, Loc)))); New_Occurrence_Of (Local_Address, Loc))));
-- For each subprogram, the receiving stub will be built and a -- For each subprogram, the receiving stub will be built and a case
-- case statement will be made on the Subprogram_Id to dispatch -- statement will be made on the Subprogram_Id to dispatch to the
-- to the right subprogram. -- right subprogram.
All_Calls_Remote_E := Boolean_Literals ( All_Calls_Remote_E := Boolean_Literals (
Has_All_Calls_Remote (Defining_Entity (Pkg_Spec))); Has_All_Calls_Remote (Defining_Entity (Pkg_Spec)));
...@@ -7615,26 +7625,13 @@ package body Exp_Dist is ...@@ -7615,26 +7625,13 @@ package body Exp_Dist is
procedure Build_Stub_Type procedure Build_Stub_Type
(RACW_Type : Entity_Id; (RACW_Type : Entity_Id;
Stub_Type : Entity_Id; Stub_Type_Comps : out List_Id;
Stub_Type_Decl : out Node_Id;
RPC_Receiver_Decl : out Node_Id) RPC_Receiver_Decl : out Node_Id)
is is
Loc : constant Source_Ptr := Sloc (Stub_Type); Loc : constant Source_Ptr := Sloc (RACW_Type);
pragma Unreferenced (RACW_Type);
begin begin
Stub_Type_Decl := Stub_Type_Comps := New_List (
Make_Full_Type_Declaration (Loc,
Defining_Identifier => Stub_Type,
Type_Definition =>
Make_Record_Definition (Loc,
Tagged_Present => True,
Limited_Present => True,
Component_List =>
Make_Component_List (Loc,
Component_Items => New_List (
Make_Component_Declaration (Loc, Make_Component_Declaration (Loc,
Defining_Identifier => Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_Target), Make_Defining_Identifier (Loc, Name_Target),
...@@ -7652,7 +7649,7 @@ package body Exp_Dist is ...@@ -7652,7 +7649,7 @@ package body Exp_Dist is
Make_Component_Definition (Loc, Make_Component_Definition (Loc,
Aliased_Present => False, Aliased_Present => False,
Subtype_Indication => Subtype_Indication =>
New_Occurrence_Of (Standard_Boolean, Loc))))))); New_Occurrence_Of (Standard_Boolean, Loc))));
RPC_Receiver_Decl := RPC_Receiver_Decl :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
...@@ -7758,8 +7755,8 @@ package body Exp_Dist is ...@@ -7758,8 +7755,8 @@ package body Exp_Dist is
Decls : constant List_Id := New_List; Decls : constant List_Id := New_List;
-- All the parameters will get declared before calling the real -- All the parameters will get declared before calling the real
-- subprograms. Also the out parameters will be declared. -- subprograms. Also the out parameters will be declared. At this
-- At this level, parameters may be unconstrained. -- level, parameters may be unconstrained.
Statements : constant List_Id := New_List; Statements : constant List_Id := New_List;
...@@ -7835,8 +7832,10 @@ package body Exp_Dist is ...@@ -7835,8 +7832,10 @@ package body Exp_Dist is
-- Controlling formals in distributed object primitive -- Controlling formals in distributed object primitive
-- operations are handled specially: -- operations are handled specially:
-- - the first controlling formal is used as the -- - the first controlling formal is used as the
-- target of the call; -- target of the call;
-- - the remaining controlling formals are transmitted -- - the remaining controlling formals are transmitted
-- as RACWs. -- as RACWs.
...@@ -7932,8 +7931,9 @@ package body Exp_Dist is ...@@ -7932,8 +7931,9 @@ package body Exp_Dist is
-- the object declaration and the variable is set using -- the object declaration and the variable is set using
-- 'Input instead of 'Read. -- 'Input instead of 'Read.
Expr := PolyORB_Support.Helpers.Build_From_Any_Call ( Expr :=
Etyp, New_Occurrence_Of (Any, Loc), Decls); PolyORB_Support.Helpers.Build_From_Any_Call
(Etyp, New_Occurrence_Of (Any, Loc), Decls);
if Constrained then if Constrained then
Append_To (Statements, Append_To (Statements,
...@@ -7941,11 +7941,12 @@ package body Exp_Dist is ...@@ -7941,11 +7941,12 @@ package body Exp_Dist is
Name => New_Occurrence_Of (Object, Loc), Name => New_Occurrence_Of (Object, Loc),
Expression => Expr)); Expression => Expr));
Expr := Empty; Expr := Empty;
else
null;
else
-- Expr will be used to initialize (and constrain) the -- Expr will be used to initialize (and constrain) the
-- parameter when it is declared. -- parameter when it is declared.
null;
end if; end if;
end if; end if;
...@@ -8006,10 +8007,7 @@ package body Exp_Dist is ...@@ -8006,10 +8007,7 @@ package body Exp_Dist is
(Defining_Identifier (Current_Parameter), Loc), (Defining_Identifier (Current_Parameter), Loc),
Explicit_Actual_Parameter => Explicit_Actual_Parameter =>
Make_Explicit_Dereference (Loc, Make_Explicit_Dereference (Loc,
Prefix => Prefix => New_Occurrence_Of (Object, Loc))));
Unchecked_Convert_To (RACW_Type,
OK_Convert_To (RTE (RE_Address),
New_Occurrence_Of (Object, Loc))))));
else else
Append_To (Parameter_List, Append_To (Parameter_List,
...@@ -8019,9 +8017,7 @@ package body Exp_Dist is ...@@ -8019,9 +8017,7 @@ package body Exp_Dist is
(Defining_Identifier (Current_Parameter), Loc), (Defining_Identifier (Current_Parameter), Loc),
Explicit_Actual_Parameter => Explicit_Actual_Parameter =>
Unchecked_Convert_To (RACW_Type, New_Occurrence_Of (Object, Loc)));
OK_Convert_To (RTE (RE_Address),
New_Occurrence_Of (Object, Loc)))));
end if; end if;
else else
...@@ -8201,10 +8197,10 @@ package body Exp_Dist is ...@@ -8201,10 +8197,10 @@ package body Exp_Dist is
Parameter_Type => Parameter_Type =>
New_Occurrence_Of (RTE (RE_Request_Access), Loc)))); New_Occurrence_Of (RTE (RE_Request_Access), Loc))));
-- An exception raised during the execution of an incoming -- An exception raised during the execution of an incoming remote
-- remote subprogram call and that needs to be sent back -- subprogram call and that needs to be sent back to the caller is
-- to the caller is propagated by the receiving stubs, and -- propagated by the receiving stubs, and will be handled by the
-- will be handled by the caller (the distribution runtime). -- caller (the distribution runtime).
if Asynchronous and then not Dynamically_Asynchronous then if Asynchronous and then not Dynamically_Asynchronous then
...@@ -8648,6 +8644,7 @@ package body Exp_Dist is ...@@ -8648,6 +8644,7 @@ package body Exp_Dist is
New_Occurrence_Of (Rec, Loc), New_Occurrence_Of (Rec, Loc),
Selector_Name => Selector_Name =>
New_Occurrence_Of (Field, Loc)), New_Occurrence_Of (Field, Loc)),
Expression => Expression =>
Build_From_Any_Call (Etype (Field), Build_From_Any_Call (Etype (Field),
Build_Get_Aggregate_Element (Loc, Build_Get_Aggregate_Element (Loc,
...@@ -9303,6 +9300,7 @@ package body Exp_Dist is ...@@ -9303,6 +9300,7 @@ package body Exp_Dist is
if No (Typ) and then Nkind (N) = N_Selected_Component then if No (Typ) and then Nkind (N) = N_Selected_Component then
Typ := Etype (Selector_Name (N)); Typ := Etype (Selector_Name (N));
end if; end if;
pragma Assert (Present (Typ)); pragma Assert (Present (Typ));
-- Get full view for private type, completion for incomplete type -- Get full view for private type, completion for incomplete type
...@@ -9731,8 +9729,8 @@ package body Exp_Dist is ...@@ -9731,8 +9729,8 @@ package body Exp_Dist is
Struct_Counter := 0; Struct_Counter := 0;
TA_Append_Record_Traversal ( TA_Append_Record_Traversal
Stmts => VP_Stmts, (Stmts => VP_Stmts,
Clist => Component_List (Variant), Clist => Component_List (Variant),
Container => Struct_Any, Container => Struct_Any,
Counter => Struct_Counter); Counter => Struct_Counter);
...@@ -9742,8 +9740,8 @@ package body Exp_Dist is ...@@ -9742,8 +9740,8 @@ package body Exp_Dist is
Append_To (VP_Stmts, Append_To (VP_Stmts,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => Name =>
New_Occurrence_Of ( New_Occurrence_Of
RTE (RE_Add_Aggregate_Element), Loc), (RTE (RE_Add_Aggregate_Element), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Occurrence_Of (Union_Any, Loc), New_Occurrence_Of (Union_Any, Loc),
New_Occurrence_Of (Struct_Any, Loc)))); New_Occurrence_Of (Struct_Any, Loc))));
...@@ -9753,8 +9751,8 @@ package body Exp_Dist is ...@@ -9753,8 +9751,8 @@ package body Exp_Dist is
Append_To (VP_Stmts, Append_To (VP_Stmts,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => Name =>
New_Occurrence_Of ( New_Occurrence_Of
RTE (RE_Add_Aggregate_Element), Loc), (RTE (RE_Add_Aggregate_Element), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Occurrence_Of (Container, Loc), New_Occurrence_Of (Container, Loc),
New_Occurrence_Of New_Occurrence_Of
...@@ -9860,8 +9858,8 @@ package body Exp_Dist is ...@@ -9860,8 +9858,8 @@ package body Exp_Dist is
Set_Expression (Any_Decl, Set_Expression (Any_Decl,
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => New_Occurrence_Of ( Name => New_Occurrence_Of
RTE (RE_Any_Aggregate_Build), Loc), (RTE (RE_Any_Aggregate_Build), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
Result_TC, Result_TC,
Make_Aggregate (Loc, Make_Aggregate (Loc,
...@@ -10993,6 +10991,7 @@ package body Exp_Dist is ...@@ -10993,6 +10991,7 @@ package body Exp_Dist is
Name => New_Occurrence_Of (RTE (RE_Get_TC), Loc), Name => New_Occurrence_Of (RTE (RE_Get_TC), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Occurrence_Of (Any, Loc))); New_Occurrence_Of (Any, Loc)));
else else
Inner_Any_TypeCode_Expr := Inner_Any_TypeCode_Expr :=
Make_Function_Call (Loc, Make_Function_Call (Loc,
...@@ -11002,6 +11001,7 @@ package body Exp_Dist is ...@@ -11002,6 +11001,7 @@ package body Exp_Dist is
New_Occurrence_Of (Any, Loc), New_Occurrence_Of (Any, Loc),
Make_Integer_Literal (Loc, Ndim))); Make_Integer_Literal (Loc, Ndim)));
end if; end if;
else else
Inner_Any_TypeCode_Expr := Inner_Any_TypeCode_Expr :=
Make_Function_Call (Loc, Make_Function_Call (Loc,
...@@ -11161,9 +11161,12 @@ package body Exp_Dist is ...@@ -11161,9 +11161,12 @@ package body Exp_Dist is
Inst := Inst :=
Make_Package_Instantiation (Loc, Make_Package_Instantiation (Loc,
Defining_Unit_Name => Defining_Unit_Name =>
Make_Defining_Identifier (Loc, New_Internal_Name ('R')), Make_Defining_Identifier (Loc,
Chars => New_Internal_Name ('R')),
Name => Name =>
New_Occurrence_Of (RTE (RE_RCI_Locator), Loc), New_Occurrence_Of (RTE (RE_RCI_Locator), Loc),
Generic_Associations => New_List ( Generic_Associations => New_List (
Make_Generic_Association (Loc, Make_Generic_Association (Loc,
Selector_Name => Selector_Name =>
...@@ -11171,6 +11174,7 @@ package body Exp_Dist is ...@@ -11171,6 +11174,7 @@ package body Exp_Dist is
Explicit_Generic_Actual_Parameter => Explicit_Generic_Actual_Parameter =>
Make_String_Literal (Loc, Make_String_Literal (Loc,
Strval => Pkg_Name)), Strval => Pkg_Name)),
Make_Generic_Association (Loc, Make_Generic_Association (Loc,
Selector_Name => Selector_Name =>
Make_Identifier (Loc, Name_Version), Make_Identifier (Loc, Name_Version),
...@@ -11181,7 +11185,8 @@ package body Exp_Dist is ...@@ -11181,7 +11185,8 @@ package body Exp_Dist is
Attribute_Name => Attribute_Name =>
Name_Version)))); Name_Version))));
RCI_Locator_Table.Set (Defining_Unit_Name (Package_Spec), RCI_Locator_Table.Set
(Defining_Unit_Name (Package_Spec),
Defining_Unit_Name (Inst)); Defining_Unit_Name (Inst));
return Inst; return Inst;
end RCI_Package_Locator; end RCI_Package_Locator;
...@@ -11292,11 +11297,11 @@ package body Exp_Dist is ...@@ -11292,11 +11297,11 @@ package body Exp_Dist is
begin begin
case Get_PCS_Name is case Get_PCS_Name is
when Name_PolyORB_DSA => when Name_PolyORB_DSA =>
PolyORB_Support.Add_Obj_RPC_Receiver_Completion (Loc, PolyORB_Support.Add_Obj_RPC_Receiver_Completion
Decls, RPC_Receiver, Stub_Elements); (Loc, Decls, RPC_Receiver, Stub_Elements);
when others => when others =>
GARLIC_Support.Add_Obj_RPC_Receiver_Completion (Loc, GARLIC_Support.Add_Obj_RPC_Receiver_Completion
Decls, RPC_Receiver, Stub_Elements); (Loc, Decls, RPC_Receiver, Stub_Elements);
end case; end case;
end Specific_Add_Obj_RPC_Receiver_Completion; end Specific_Add_Obj_RPC_Receiver_Completion;
...@@ -11470,12 +11475,14 @@ package body Exp_Dist is ...@@ -11470,12 +11475,14 @@ package body Exp_Dist is
begin begin
case Get_PCS_Name is case Get_PCS_Name is
when Name_PolyORB_DSA => when Name_PolyORB_DSA =>
return PolyORB_Support.Build_Stub_Target (Loc, return
Decls, RCI_Locator, Controlling_Parameter); PolyORB_Support.Build_Stub_Target
(Loc, Decls, RCI_Locator, Controlling_Parameter);
when others => when others =>
return GARLIC_Support.Build_Stub_Target (Loc, return
Decls, RCI_Locator, Controlling_Parameter); GARLIC_Support.Build_Stub_Target
(Loc, Decls, RCI_Locator, Controlling_Parameter);
end case; end case;
end Specific_Build_Stub_Target; end Specific_Build_Stub_Target;
...@@ -11485,24 +11492,25 @@ package body Exp_Dist is ...@@ -11485,24 +11492,25 @@ package body Exp_Dist is
procedure Specific_Build_Stub_Type procedure Specific_Build_Stub_Type
(RACW_Type : Entity_Id; (RACW_Type : Entity_Id;
Stub_Type : Entity_Id; Stub_Type_Comps : out List_Id;
Stub_Type_Decl : out Node_Id;
RPC_Receiver_Decl : out Node_Id) RPC_Receiver_Decl : out Node_Id)
is is
begin begin
case Get_PCS_Name is case Get_PCS_Name is
when Name_PolyORB_DSA => when Name_PolyORB_DSA =>
PolyORB_Support.Build_Stub_Type ( PolyORB_Support.Build_Stub_Type
RACW_Type, Stub_Type, (RACW_Type, Stub_Type_Comps, RPC_Receiver_Decl);
Stub_Type_Decl, RPC_Receiver_Decl);
when others => when others =>
GARLIC_Support.Build_Stub_Type ( GARLIC_Support.Build_Stub_Type
RACW_Type, Stub_Type, (RACW_Type, Stub_Type_Comps, RPC_Receiver_Decl);
Stub_Type_Decl, RPC_Receiver_Decl);
end case; end case;
end Specific_Build_Stub_Type; end Specific_Build_Stub_Type;
-----------------------------------------------
-- Specific_Build_Subprogram_Receiving_Stubs --
-----------------------------------------------
function Specific_Build_Subprogram_Receiving_Stubs function Specific_Build_Subprogram_Receiving_Stubs
(Vis_Decl : Node_Id; (Vis_Decl : Node_Id;
Asynchronous : Boolean; Asynchronous : Boolean;
...@@ -11514,7 +11522,8 @@ package body Exp_Dist is ...@@ -11514,7 +11522,8 @@ package body Exp_Dist is
begin begin
case Get_PCS_Name is case Get_PCS_Name is
when Name_PolyORB_DSA => when Name_PolyORB_DSA =>
return PolyORB_Support.Build_Subprogram_Receiving_Stubs return
PolyORB_Support.Build_Subprogram_Receiving_Stubs
(Vis_Decl, (Vis_Decl,
Asynchronous, Asynchronous,
Dynamically_Asynchronous, Dynamically_Asynchronous,
...@@ -11523,7 +11532,8 @@ package body Exp_Dist is ...@@ -11523,7 +11532,8 @@ package body Exp_Dist is
Parent_Primitive); Parent_Primitive);
when others => when others =>
return GARLIC_Support.Build_Subprogram_Receiving_Stubs return
GARLIC_Support.Build_Subprogram_Receiving_Stubs
(Vis_Decl, (Vis_Decl,
Asynchronous, Asynchronous,
Dynamically_Asynchronous, Dynamically_Asynchronous,
......
gcc/ada/sem_disp.adb
...@@ -1775,10 +1775,12 @@ package body Sem_Disp is ...@@ -1775,10 +1775,12 @@ package body Sem_Disp is
-- even if non-dispatching, and a call from inside calls the -- even if non-dispatching, and a call from inside calls the
-- overriding operation because it hides the implicit one. To -- overriding operation because it hides the implicit one. To
-- indicate that the body of Prev_Op is never called, set its -- indicate that the body of Prev_Op is never called, set its
-- dispatch table entity to Empty. -- dispatch table entity to Empty. If the overridden operation
-- has a dispatching result, so does the overriding one.
Set_Alias (Prev_Op, New_Op); Set_Alias (Prev_Op, New_Op);
Set_DTC_Entity (Prev_Op, Empty); Set_DTC_Entity (Prev_Op, Empty);
Set_Has_Controlling_Result (New_Op, Has_Controlling_Result (Prev_Op));
return; return;
end if; end if;
end Override_Dispatching_Operation; end Override_Dispatching_Operation;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment