1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- S Y S T E M . P A R T I T I O N _ I N T E R F A C E --
9 -- Copyright (C) 1995-2009, Free Software Foundation, Inc. --
11 -- GNARL is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 -- This unit may be used directly from an application program by providing
33 -- an appropriate WITH, and the interface can be expected to remain stable.
40 package System
.Partition_Interface
is
42 pragma Elaborate_Body
;
44 type DSA_Implementation_Name
is (No_DSA
, GARLIC_DSA
, PolyORB_DSA
);
45 DSA_Implementation
: constant DSA_Implementation_Name
:= No_DSA
;
46 -- Identification of this DSA implementation variant
48 PCS_Version
: constant := 1;
49 -- Version of the PCS API (for Exp_Dist consistency check).
50 -- This version number is matched against Gnatvsn.PCS_Version_Number to
51 -- ensure that the versions of Exp_Dist and the PCS are consistent.
53 -- RCI receiving stubs contain a table of descriptors for
54 -- all user subprograms exported by the unit.
56 type Subprogram_Id
is new Natural;
57 First_RCI_Subprogram_Id
: constant := 2;
59 type RCI_Subp_Info
is record
60 Addr
: System
.Address
;
61 -- Local address of the proxy object
64 type RCI_Subp_Info_Access
is access all RCI_Subp_Info
;
65 type RCI_Subp_Info_Array
is array (Integer range <>) of
66 aliased RCI_Subp_Info
;
68 subtype Unit_Name
is String;
71 type Main_Subprogram_Type
is access procedure;
73 type RACW_Stub_Type
is tagged record
74 Origin
: RPC
.Partition_ID
;
75 Receiver
: Interfaces
.Unsigned_64
;
76 Addr
: Interfaces
.Unsigned_64
;
77 Asynchronous
: Boolean;
80 type RACW_Stub_Type_Access
is access RACW_Stub_Type
;
81 -- This type is used by the expansion to implement distributed objects.
82 -- Do not change its definition or its layout without updating
85 type RAS_Proxy_Type
is tagged limited record
86 All_Calls_Remote
: Boolean;
87 Receiver
: System
.Address
;
88 Subp_Id
: Subprogram_Id
;
91 type RAS_Proxy_Type_Access
is access RAS_Proxy_Type
;
92 pragma No_Strict_Aliasing
(RAS_Proxy_Type_Access
);
93 -- This type is used by the expansion to implement distributed objects.
94 -- Do not change its definition or its layout without updating
95 -- Exp_Dist.Build_Remote_Subprogram_Proxy_Type.
97 -- The Request_Access type is used for communication between the PCS
98 -- and the RPC receiver generated by the compiler: it contains all the
99 -- necessary information for the receiver to process an incoming call.
101 type RST_Access
is access all Ada
.Streams
.Root_Stream_Type
'Class;
102 type Request_Access
is record
104 -- A stream describing the called subprogram and its parameters
107 -- A stream where the result, raised exception, or out values,
114 RCI
: Boolean := True);
115 -- Use by the main subprogram to check that a remote receiver
116 -- unit has the same version than the caller's one.
118 function Same_Partition
119 (Left
: not null access RACW_Stub_Type
;
120 Right
: not null access RACW_Stub_Type
) return Boolean;
121 -- Determine whether Left and Right correspond to objects instantiated
122 -- on the same partition, for enforcement of E.4(19).
124 function Get_Active_Partition_ID
(Name
: Unit_Name
) return RPC
.Partition_ID
;
125 -- Similar in some respects to RCI_Locator.Get_Active_Partition_ID
127 function Get_Active_Version
(Name
: Unit_Name
) return String;
128 -- Similar in some respects to Get_Active_Partition_ID
130 function Get_Local_Partition_ID
return RPC
.Partition_ID
;
131 -- Return the Partition_ID of the current partition
133 function Get_Passive_Partition_ID
134 (Name
: Unit_Name
) return RPC
.Partition_ID
;
135 -- Return the Partition_ID of the given shared passive partition
137 function Get_Passive_Version
(Name
: Unit_Name
) return String;
138 -- Return the version corresponding to a shared passive unit
140 function Get_RCI_Package_Receiver
141 (Name
: Unit_Name
) return Interfaces
.Unsigned_64
;
142 -- Similar in some respects to RCI_Locator.Get_RCI_Package_Receiver
144 procedure Get_Unique_Remote_Pointer
145 (Handler
: in out RACW_Stub_Type_Access
);
146 -- Get a unique pointer on a remote object
148 procedure Raise_Program_Error_Unknown_Tag
149 (E
: Ada
.Exceptions
.Exception_Occurrence
);
150 pragma No_Return
(Raise_Program_Error_Unknown_Tag
);
151 -- Raise Program_Error with the same message as E one
153 type RPC_Receiver
is access procedure (R
: Request_Access
);
154 procedure Register_Receiving_Stub
156 Receiver
: RPC_Receiver
;
157 Version
: String := "";
158 Subp_Info
: System
.Address
;
159 Subp_Info_Len
: Integer);
160 -- Register the fact that the Name receiving stub is now elaborated.
161 -- Register the access value to the package RPC_Receiver procedure.
163 procedure Get_RAS_Info
165 Subp_Id
: Subprogram_Id
;
166 Proxy_Address
: out Interfaces
.Unsigned_64
);
167 -- Look up the address of the proxy object for the given subprogram
168 -- in the named unit, or Null_Address if not present on the local
171 procedure Register_Passive_Package
173 Version
: String := "");
174 -- Register a passive package
179 package RCI_Locator
is
180 pragma Unreferenced
(Version
);
182 function Get_RCI_Package_Receiver
return Interfaces
.Unsigned_64
;
183 function Get_Active_Partition_ID
return RPC
.Partition_ID
;
185 -- RCI package information caching
187 procedure Run
(Main
: Main_Subprogram_Type
:= null);
188 -- Run the main subprogram
190 end System
.Partition_Interface
;