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-2018, 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
41 pragma Elaborate_Body
;
43 type DSA_Implementation_Name
is (No_DSA
, GARLIC_DSA
, PolyORB_DSA
);
44 DSA_Implementation
: constant DSA_Implementation_Name
:= No_DSA
;
45 -- Identification of this DSA implementation variant
47 PCS_Version
: constant := 1;
48 -- Version of the PCS API (for Exp_Dist consistency check)
50 -- This version number is matched against corresponding element of
51 -- Exp_Dist.PCS_Version_Number to ensure that the versions of Exp_Dist
52 -- and the PCS are consistent.
54 -- RCI receiving stubs contain a table of descriptors for all user
55 -- subprograms exported by the unit.
57 type Subprogram_Id
is new Natural;
58 First_RCI_Subprogram_Id
: constant := 2;
60 type RCI_Subp_Info
is record
61 Addr
: System
.Address
;
62 -- Local address of the proxy object
65 type RCI_Subp_Info_Access
is access all RCI_Subp_Info
;
66 type RCI_Subp_Info_Array
is array (Integer range <>) of
67 aliased RCI_Subp_Info
;
69 subtype Unit_Name
is String;
72 type Main_Subprogram_Type
is access procedure;
74 type RACW_Stub_Type
is tagged record
75 Origin
: RPC
.Partition_ID
;
76 Receiver
: Interfaces
.Unsigned_64
;
77 Addr
: Interfaces
.Unsigned_64
;
78 Asynchronous
: Boolean;
81 type RACW_Stub_Type_Access
is access RACW_Stub_Type
;
82 -- This type is used by the expansion to implement distributed objects.
83 -- Do not change its definition or its layout without updating
86 type RAS_Proxy_Type
is tagged limited record
87 All_Calls_Remote
: Boolean;
88 Receiver
: System
.Address
;
89 Subp_Id
: Subprogram_Id
;
92 type RAS_Proxy_Type_Access
is access RAS_Proxy_Type
;
93 pragma No_Strict_Aliasing
(RAS_Proxy_Type_Access
);
94 -- This type is used by the expansion to implement distributed objects.
95 -- Do not change its definition or its layout without updating
96 -- Exp_Dist.Build_Remote_Subprogram_Proxy_Type.
98 -- The Request_Access type is used for communication between the PCS
99 -- and the RPC receiver generated by the compiler: it contains all the
100 -- necessary information for the receiver to process an incoming call.
102 type RST_Access
is access all Ada
.Streams
.Root_Stream_Type
'Class;
103 type Request_Access
is record
105 -- A stream describing the called subprogram and its parameters
108 -- A stream where the result, raised exception, or out values,
115 RCI
: Boolean := True);
116 -- Use by the main subprogram to check that a remote receiver
117 -- unit has the same version than the caller's one.
119 function Same_Partition
120 (Left
: not null access RACW_Stub_Type
;
121 Right
: not null access RACW_Stub_Type
) return Boolean;
122 -- Determine whether Left and Right correspond to objects instantiated
123 -- on the same partition, for enforcement of E.4(19).
125 function Get_Active_Partition_ID
(Name
: Unit_Name
) return RPC
.Partition_ID
;
126 -- Similar in some respects to RCI_Locator.Get_Active_Partition_ID
128 function Get_Active_Version
(Name
: Unit_Name
) return String;
129 -- Similar in some respects to Get_Active_Partition_ID
131 function Get_Local_Partition_ID
return RPC
.Partition_ID
;
132 -- Return the Partition_ID of the current partition
134 function Get_Passive_Partition_ID
135 (Name
: Unit_Name
) return RPC
.Partition_ID
;
136 -- Return the Partition_ID of the given shared passive partition
138 function Get_Passive_Version
(Name
: Unit_Name
) return String;
139 -- Return the version corresponding to a shared passive unit
141 function Get_RCI_Package_Receiver
142 (Name
: Unit_Name
) return Interfaces
.Unsigned_64
;
143 -- Similar in some respects to RCI_Locator.Get_RCI_Package_Receiver
145 procedure Get_Unique_Remote_Pointer
146 (Handler
: in out RACW_Stub_Type_Access
);
147 -- Get a unique pointer on a remote object
149 procedure Raise_Program_Error_Unknown_Tag
150 (E
: Ada
.Exceptions
.Exception_Occurrence
);
151 pragma No_Return
(Raise_Program_Error_Unknown_Tag
);
152 -- Raise Program_Error with the same message as E one
154 type RPC_Receiver
is access procedure (R
: Request_Access
);
155 procedure Register_Receiving_Stub
157 Receiver
: RPC_Receiver
;
158 Version
: String := "";
159 Subp_Info
: System
.Address
;
160 Subp_Info_Len
: Integer);
161 -- Register the fact that the Name receiving stub is now elaborated.
162 -- Register the access value to the package RPC_Receiver procedure.
164 procedure Get_RAS_Info
166 Subp_Id
: Subprogram_Id
;
167 Proxy_Address
: out Interfaces
.Unsigned_64
);
168 -- Look up the address of the proxy object for the given subprogram
169 -- in the named unit, or Null_Address if not present on the local
172 procedure Register_Passive_Package
174 Version
: String := "");
175 -- Register a passive package
180 package RCI_Locator
is
181 pragma Unreferenced
(Version
);
183 function Get_RCI_Package_Receiver
return Interfaces
.Unsigned_64
;
184 function Get_Active_Partition_ID
return RPC
.Partition_ID
;
186 -- RCI package information caching
188 procedure Run
(Main
: Main_Subprogram_Type
:= null);
189 -- Run the main subprogram
191 end System
.Partition_Interface
;