dwww Home | Show directory contents | Find package


                                   Annex E
                                 (normative)

                             Distributed Systems


1   This Annex defines facilities for supporting the implementation of
distributed systems using multiple partitions working cooperatively as part of
a single Ada program.


                           Post-Compilation Rules

2   A distributed system is an interconnection of one or more processing nodes
(a system resource that has both computational and storage capabilities), and
zero or more storage nodes (a system resource that has only storage
capabilities, with the storage addressable by one or more processing nodes).

3   A distributed program comprises one or more partitions that execute
independently (except when they communicate) in a distributed system.

4   The process of mapping the partitions of a program to the nodes in a
distributed system is called configuring the partitions of the program.


                         Implementation Requirements

5   The implementation shall provide means for explicitly assigning library
units to a partition and for the configuring and execution of a program
consisting of multiple partitions on a distributed system; the means are
implementation defined.


                         Implementation Permissions

6   An implementation may require that the set of processing nodes of a
distributed system be homogeneous.

        NOTES

7       1  The partitions comprising a program may be executed on differently
        configured distributed systems or on a non-distributed system without
        requiring recompilation. A distributed program may be partitioned
        differently from the same set of library units without recompilation.
        The resulting execution is semantically equivalent.

8       2  A distributed program retains the same type safety as the
        equivalent single partition program.


E.1 Partitions


1   The partitions of a distributed program are classified as either active or
passive.


                           Post-Compilation Rules

2   An active partition is a partition as defined in 10.2. A passive partition
is a partition that has no thread of control of its own, whose library units
are all preelaborated, and whose data and subprograms are accessible to one or
more active partitions.

3   A passive partition shall include only library_items that either are
declared pure or are shared passive (see 10.2.1 and E.2.1).

4   An active partition shall be configured on a processing node. A passive
partition shall be configured either on a storage node or on a processing node.

5   The configuration of the partitions of a program onto a distributed system
shall be consistent with the possibility for data references or calls between
the partitions implied by their semantic dependences. Any reference to data or
call of a subprogram across partitions is called a remote access.


                              Dynamic Semantics

6   A library_item is elaborated as part of the elaboration of each partition
that includes it. If a normal library unit (see E.2) has state, then a
separate copy of the state exists in each active partition that elaborates it.
The state evolves independently in each such partition.

7   An active partition terminates when its environment task terminates. A
partition becomes inaccessible if it terminates or if it is aborted. An active
partition is aborted when its environment task is aborted. In addition, if a
partition fails during its elaboration, it becomes inaccessible to other
partitions. Other implementation-defined events can also result in a partition
becoming inaccessible.

8/1 For a prefix D that denotes a library-level declaration, excepting a
declaration of or within a declared-pure library unit, the following attribute
is defined:

9   D'Partition_Id
                Denotes a value of the type universal_integer that identifies
                the partition in which D was elaborated. If D denotes the
                declaration of a remote call interface library unit (see
                E.2.3) the given partition is the one where the body of D was
                elaborated.


                          Bounded (Run-Time) Errors

10  It is a bounded error for there to be cyclic elaboration dependences
between the active partitions of a single distributed program. The possible
effects, in each of the partitions involved, are deadlock during elaboration,
or the raising of Communication_Error or Program_Error.


                         Implementation Permissions

11  An implementation may allow multiple active or passive partitions to be
configured on a single processing node, and multiple passive partitions to be
configured on a single storage node. In these cases, the scheduling policies,
treatment of priorities, and management of shared resources between these
partitions are implementation defined.

12  An implementation may allow separate copies of an active partition to be
configured on different processing nodes, and to provide appropriate
interactions between the copies to present a consistent state of the partition
to other active partitions.

13  In an implementation, the partitions of a distributed program need not be
loaded and elaborated all at the same time; they may be loaded and elaborated
one at a time over an extended period of time. An implementation may provide
facilities to abort and reload a partition during the execution of a
distributed program.

14  An implementation may allow the state of some of the partitions of a
distributed program to persist while other partitions of the program terminate
and are later reinvoked.

        NOTES

15      3  Library units are grouped into partitions after compile time, but
        before run time. At compile time, only the relevant library unit
        properties are identified using categorization pragmas.

16      4  The value returned by the Partition_Id attribute can be used as a
        parameter to implementation-provided subprograms in order to query
        information about the partition.


E.2 Categorization of Library Units


1   Library units can be categorized according to the role they play in a
distributed program. Certain restrictions are associated with each category to
ensure that the semantics of a distributed program remain close to the
semantics for a nondistributed program.

2   A categorization pragma is a library unit pragma (see 10.1.5) that
restricts the declarations, child units, or semantic dependences of the
library unit to which it applies. A categorized library unit is a library unit
to which a categorization pragma applies.

3   The pragmas Shared_Passive, Remote_Types, and Remote_Call_Interface are
categorization pragmas. In addition, for the purposes of this Annex, the
pragma Pure (see 10.2.1) is considered a categorization pragma.

4/1 A library package or generic library package is called a shared passive
library unit if a Shared_Passive pragma applies to it. A library package or
generic library package is called a remote types library unit if a
Remote_Types pragma applies to it. A library unit is called a remote call
interface if a Remote_Call_Interface pragma applies to it. A normal library
unit is one to which no categorization pragma applies.

5   The various categories of library units and the associated restrictions
are described in this clause and its subclauses. The categories are related
hierarchically in that the library units of one category can depend
semantically only on library units of that category or an earlier one, except
that the body of a remote types or remote call interface library unit is
unrestricted.

6   The overall hierarchy (including declared pure) is as follows:

7   Declared Pure
                Can depend only on other declared pure library units;

8   Shared Passive
                Can depend only on other shared passive or declared pure
                library units;

9   Remote Types
                The declaration of the library unit can depend only on other
                remote types library units, or one of the above; the body of
                the library unit is unrestricted;

10  Remote Call Interface
                The declaration of the library unit can depend only on other
                remote call interfaces, or one of the above; the body of the
                library unit is unrestricted;

11  Normal      Unrestricted.

12  Declared pure and shared passive library units are preelaborated. The
declaration of a remote types or remote call interface library unit is
required to be preelaborable.


                         Implementation Requirements

13/1 This paragraph was deleted.


                         Implementation Permissions

14  Implementations are allowed to define other categorization pragmas.


E.2.1 Shared Passive Library Units


1   A shared passive library unit is used for managing global data shared
between active partitions. The restrictions on shared passive library units
prevent the data or tasks of one active partition from being accessible to
another active partition through references implicit in objects declared in
the shared passive library unit.


                                   Syntax

2       The form of a pragma Shared_Passive is as follows:

3         pragma Shared_Passive[(library_unit_name)];


                               Legality Rules

4   A shared passive library unit is a library unit to which a Shared_Passive
pragma applies. The following restrictions apply to such a library unit:

5     * it shall be preelaborable (see 10.2.1);

6     * it shall depend semantically only upon declared pure or shared passive
        library units;

7/1   * it shall not contain a library-level declaration of an access type
        that designates a class-wide type, task type, or protected type with
        entry_declarations.

8   Notwithstanding the definition of accessibility given in 3.10.2, the
declaration of a library unit P1 is not accessible from within the declarative
region of a shared passive library unit P2, unless the shared passive library
unit P2 depends semantically on P1.


                              Static Semantics

9   A shared passive library unit is preelaborated.


                           Post-Compilation Rules

10  A shared passive library unit shall be assigned to at most one partition
within a given program.

11  Notwithstanding the rule given in 10.2, a compilation unit in a given
partition does not need (in the sense of 10.2) the shared passive library
units on which it depends semantically to be included in that same partition;
they will typically reside in separate passive partitions.


E.2.2 Remote Types Library Units


1   A remote types library unit supports the definition of types intended for
use in communication between active partitions.


                                   Syntax

2       The form of a pragma Remote_Types is as follows:

3         pragma Remote_Types[(library_unit_name)];


                               Legality Rules

4   A remote types library unit is a library unit to which the pragma
Remote_Types applies. The following restrictions apply to the declaration of
such a library unit:

5     * it shall be preelaborable;

6     * it shall depend semantically only on declared pure, shared passive, or
        other remote types library units;

7     * it shall not contain the declaration of any variable within the
        visible part of the library unit;

8/2   * the full view of each type declared in the visible part of the library
        unit that has any available stream attributes shall support external
        streaming (see 13.13.2).

9/1 An access type declared in the visible part of a remote types or remote
call interface library unit is called a remote access type. Such a type shall
be:

9.1/1   * an access-to-subprogram type, or

9.2/1   * a general access type that designates a class-wide limited private
        type or a class-wide private type extension all of whose ancestors are
        either private type extensions or limited private types.

9.3/1 A type that is derived from a remote access type is also a remote access
type.

10  The following restrictions apply to the use of a remote
access-to-subprogram type:

11/2   * A value of a remote access-to-subprogram type shall be converted only
        to or from another (subtype-conformant) remote access-to-subprogram
        type;

12    * The prefix of an Access attribute_reference that yields a value of a
        remote access-to-subprogram type shall statically denote a
        (subtype-conformant) remote subprogram.

13  The following restrictions apply to the use of a remote
access-to-class-wide type:

14/2   * The primitive subprograms of the corresponding specific limited
        private type shall only have access parameters if they are controlling
        formal parameters; each non-controlling formal parameter shall support
        external streaming (see 13.13.2);

15    * A value of a remote access-to-class-wide type shall be explicitly
        converted only to another remote access-to-class-wide type;

16/1   * A value of a remote access-to-class-wide type shall be dereferenced
        (or implicitly converted to an anonymous access type) only as part of
        a dispatching call where the value designates a controlling operand of
        the call (see E.4, "Remote Subprogram Calls").

17/2   * The Storage_Pool attribute is not defined for a remote
        access-to-class-wide type; the expected type for an allocator shall
        not be a remote access-to-class-wide type. A remote
        access-to-class-wide type shall not be an actual parameter for a
        generic formal access type. The Storage_Size attribute of a remote
        access-to-class-wide type yields 0; it is not allowed in an
        attribute_definition_clause.

        NOTES

18      5  A remote types library unit need not be pure, and the types it
        defines may include levels of indirection implemented by using access
        types. User-specified Read and Write attributes (see 13.13.2) provide
        for sending values of such a type between active partitions, with
        Write marshalling the representation, and Read unmarshalling any
        levels of indirection.


E.2.3 Remote Call Interface Library Units


1   A remote call interface library unit can be used as an interface for
remote procedure calls (RPCs) (or remote function calls) between active
partitions.


                                   Syntax

2       The form of a pragma Remote_Call_Interface is as follows:

3         pragma Remote_Call_Interface[(library_unit_name)];

4       The form of a pragma All_Calls_Remote is as follows:

5         pragma All_Calls_Remote[(library_unit_name)];

6       A pragma All_Calls_Remote is a library unit pragma.


                               Legality Rules

7/1 A remote call interface (RCI) is a library unit to which the pragma
Remote_Call_Interface applies. A subprogram declared in the visible part of
such a library unit, or declared by such a library unit, is called a remote
subprogram.

8   The declaration of an RCI library unit shall be preelaborable (see
10.2.1), and shall depend semantically only upon declared pure, shared
passive, remote types, or other remote call interface library units.

9/1 In addition, the following restrictions apply to an RCI library unit:

10/1   * its visible part shall not contain the declaration of a variable;

11/1   * its visible part shall not contain the declaration of a limited type;

12/1   * its visible part shall not contain a nested generic_declaration;

13/1   * it shall not be, nor shall its visible part contain, the declaration
        of a subprogram to which a pragma Inline applies;

14/2   * it shall not be, nor shall its visible part contain, a subprogram (or
        access-to-subprogram) declaration whose profile has an access
        parameter or a parameter of a type that does not support external
        streaming (see 13.13.2);

15    * any public child of the library unit shall be a remote call interface
        library unit.

16  If a pragma All_Calls_Remote applies to a library unit, the library unit
shall be a remote call interface.


                           Post-Compilation Rules

17  A remote call interface library unit shall be assigned to at most one
partition of a given program. A remote call interface library unit whose
parent is also an RCI library unit shall be assigned only to the same
partition as its parent.

18  Notwithstanding the rule given in 10.2, a compilation unit in a given
partition that semantically depends on the declaration of an RCI library unit,
needs (in the sense of 10.2) only the declaration of the RCI library unit, not
the body, to be included in that same partition. Therefore, the body of an RCI
library unit is included only in the partition to which the RCI library unit
is explicitly assigned.


                         Implementation Requirements

19/1 If a pragma All_Calls_Remote applies to a given RCI library unit, then
the implementation shall route any call to a subprogram of the RCI unit from
outside the declarative region of the unit through the Partition Communication
Subsystem (PCS); see E.5. Calls to such subprograms from within the
declarative region of the unit are defined to be local and shall not go
through the PCS.


                         Implementation Permissions

20  An implementation need not support the Remote_Call_Interface pragma nor
the All_Calls_Remote pragma. Explicit message-based communication between
active partitions can be supported as an alternative to RPC.


E.3 Consistency of a Distributed System


1   This clause defines attributes and rules associated with verifying the
consistency of a distributed program.


                              Static Semantics

2/1 For a prefix P that statically denotes a program unit, the following
attributes are defined:

3   P'Version   Yields a value of the predefined type String that identifies
                the version of the compilation unit that contains the
                declaration of the program unit.

4   P'Body_Version
                Yields a value of the predefined type String that identifies
                the version of the compilation unit that contains the body
                (but not any subunits) of the program unit.

5/1 The version of a compilation unit changes whenever the compilation unit
changes in a semantically significant way. This International Standard does
not define the exact meaning of "semantically significant". It is unspecified
whether there are other events (such as recompilation) that result in the
version of a compilation unit changing.

5.1/1 If P is not a library unit, and P has no completion, then P'Body_Version
returns the Body_Version of the innermost program unit enclosing the
declaration of P. If P is a library unit, and P has no completion, then
P'Body_Version returns a value that is different from Body_Version of any
version of P that has a completion.


                          Bounded (Run-Time) Errors

6   In a distributed program, a library unit is consistent if the same version
of its declaration is used throughout. It is a bounded error to elaborate a
partition of a distributed program that contains a compilation unit that
depends on a different version of the declaration of a shared passive or RCI
library unit than that included in the partition to which the shared passive
or RCI library unit was assigned. As a result of this error, Program_Error can
be raised in one or both partitions during elaboration; in any case, the
partitions become inaccessible to one another.


E.4 Remote Subprogram Calls


1   A remote subprogram call is a subprogram call that invokes the execution
of a subprogram in another partition. The partition that originates the remote
subprogram call is the calling partition, and the partition that executes the
corresponding subprogram body is the called partition. Some remote procedure
calls are allowed to return prior to the completion of subprogram execution.
These are called asynchronous remote procedure calls.

2   There are three different ways of performing a remote subprogram call:

3     * As a direct call on a (remote) subprogram explicitly declared in a
        remote call interface;

4     * As an indirect call through a value of a remote access-to-subprogram
        type;

5     * As a dispatching call with a controlling operand designated by a value
        of a remote access-to-class-wide type.

6   The first way of calling corresponds to a static binding between the
calling and the called partition. The latter two ways correspond to a dynamic
binding between the calling and the called partition.

7   A remote call interface library unit (see E.2.3) defines the remote
subprograms or remote access types used for remote subprogram calls.


                               Legality Rules

8   In a dispatching call with two or more controlling operands, if one
controlling operand is designated by a value of a remote access-to-class-wide
type, then all shall be.


                              Dynamic Semantics

9   For the execution of a remote subprogram call, subprogram parameters (and
later the results, if any) are passed using a stream-oriented representation
(see 13.13.1) which is suitable for transmission between partitions. This
action is called marshalling. Unmarshalling is the reverse action of
reconstructing the parameters or results from the stream-oriented
representation. Marshalling is performed initially as part of the remote
subprogram call in the calling partition; unmarshalling is done in the called
partition. After the remote subprogram completes, marshalling is performed in
the called partition, and finally unmarshalling is done in the calling
partition.

10  A calling stub is the sequence of code that replaces the subprogram body
of a remotely called subprogram in the calling partition. A receiving stub is
the sequence of code (the "wrapper") that receives a remote subprogram call on
the called partition and invokes the appropriate subprogram body.

11  Remote subprogram calls are executed at most once, that is, if the
subprogram call returns normally, then the called subprogram's body was
executed exactly once.

12  The task executing a remote subprogram call blocks until the subprogram in
the called partition returns, unless the call is asynchronous. For an
asynchronous remote procedure call, the calling task can become ready before
the procedure in the called partition returns.

13  If a construct containing a remote call is aborted, the remote subprogram
call is cancelled. Whether the execution of the remote subprogram is
immediately aborted as a result of the cancellation is implementation defined.

14  If a remote subprogram call is received by a called partition before the
partition has completed its elaboration, the call is kept pending until the
called partition completes its elaboration (unless the call is cancelled by
the calling partition prior to that).

15  If an exception is propagated by a remotely called subprogram, and the
call is not an asynchronous call, the corresponding exception is reraised at
the point of the remote subprogram call. For an asynchronous call, if the
remote procedure call returns prior to the completion of the remotely called
subprogram, any exception is lost.

16  The exception Communication_Error (see E.5) is raised if a remote call
cannot be completed due to difficulties in communicating with the called
partition.

17  All forms of remote subprogram calls are potentially blocking operations
(see 9.5.1).

18/1 In a remote subprogram call with a formal parameter of a class-wide type,
a check is made that the tag of the actual parameter identifies a tagged type
declared in a declared-pure or shared passive library unit, or in the visible
part of a remote types or remote call interface library unit. Program_Error is
raised if this check fails. In a remote function call which returns a
class-wide type, the same check is made on the function result.

19  In a dispatching call with two or more controlling operands that are
designated by values of a remote access-to-class-wide type, a check is made
(in addition to the normal Tag_Check - see 11.5) that all the remote
access-to-class-wide values originated from Access attribute_references that
were evaluated by tasks of the same active partition. Constraint_Error is
raised if this check fails.


                         Implementation Requirements

20  The implementation of remote subprogram calls shall conform to the PCS
interface as defined by the specification of the language-defined package
System.RPC (see E.5). The calling stub shall use the Do_RPC procedure unless
the remote procedure call is asynchronous in which case Do_APC shall be used.
On the receiving side, the corresponding receiving stub shall be invoked by
the RPC-receiver.

20.1/1 With respect to shared variables in shared passive library units, the
execution of the corresponding subprogram body of a synchronous remote
procedure call is considered to be part of the execution of the calling task.
The execution of the corresponding subprogram body of an asynchronous remote
procedure call proceeds in parallel with the calling task and does not signal
the next action of the calling task (see 9.10).

        NOTES

21      6  A given active partition can both make and receive remote
        subprogram calls. Thus, an active partition can act as both a client
        and a server.

22      7  If a given exception is propagated by a remote subprogram call, but
        the exception does not exist in the calling partition, the exception
        can be handled by an others choice or be propagated to and handled by
        a third partition.


E.4.1 Pragma Asynchronous


1   This subclause introduces the pragma Asynchronous which allows a remote
subprogram call to return prior to completion of the execution of the
corresponding remote subprogram body.


                                   Syntax

2       The form of a pragma Asynchronous is as follows:

3         pragma Asynchronous(local_name);


                               Legality Rules

4   The local_name of a pragma Asynchronous shall denote either:

5     * One or more remote procedures; the formal parameters of the
        procedure(s) shall all be of mode in;

6     * The first subtype of a remote access-to-procedure type; the formal
        parameters of the designated profile of the type shall all be of mode
        in;

7     * The first subtype of a remote access-to-class-wide type.


                              Static Semantics

8   A pragma Asynchronous is a representation pragma. When applied to a type,
it specifies the type-related asynchronous aspect of the type.


                              Dynamic Semantics

9   A remote call is asynchronous if it is a call to a procedure, or a call
through a value of an access-to-procedure type, to which a pragma Asynchronous
applies. In addition, if a pragma Asynchronous applies to a remote
access-to-class-wide type, then a dispatching call on a procedure with a
controlling operand designated by a value of the type is asynchronous if the
formal parameters of the procedure are all of mode in.


                         Implementation Requirements

10  Asynchronous remote procedure calls shall be implemented such that the
corresponding body executes at most once as a result of the call.


E.4.2 Example of Use of a Remote Access-to-Class-Wide Type



                                  Examples

1   Example of using a remote access-to-class-wide type to achieve dynamic
binding across active partitions:

2       package Tapes is
           pragma Pure(Tapes);
           type Tape is abstract tagged limited private;
           -- Primitive dispatching operations where
           -- Tape is controlling operand
           procedure Copy (From, To : access Tape; Num_Recs : in Natural) is abstract;
           procedure Rewind (T : access Tape) is abstract;
           -- More operations
        private
           type Tape is ...
        end Tapes;

3       with Tapes;
        package Name_Server is
           pragma Remote_Call_Interface;
           -- Dynamic binding to remote operations is achieved
           -- using the access-to-limited-class-wide type Tape_Ptr
           type Tape_Ptr is access all Tapes.Tape'Class;
           -- The following statically bound remote operations
           -- allow for a name-server capability in this example
           function  Find     (Name : String) return Tape_Ptr;
           procedure Register (Name : in String; T : in Tape_Ptr);
           procedure Remove   (T : in Tape_Ptr);
           -- More operations
        end Name_Server;

4       package Tape_Driver is
          -- Declarations are not shown, they are irrelevant here
        end Tape_Driver;

5       with Tapes, Name_Server;
        package body Tape_Driver is
           type New_Tape is new Tapes.Tape with ...
           procedure Copy
            (From, To : access New_Tape; Num_Recs: in Natural) is
           begin
             . . .
           end Copy;
           procedure Rewind (T : access New_Tape) is
           begin
              . . .
           end Rewind;
           -- Objects remotely accessible through use
           -- of Name_Server operations
           Tape1, Tape2 : aliased New_Tape;
        begin
           Name_Server.Register ("NINE-TRACK",  Tape1'Access);
           Name_Server.Register ("SEVEN-TRACK", Tape2'Access);
        end Tape_Driver;

6       with Tapes, Name_Server;
        -- Tape_Driver is not needed and thus not mentioned in the with_clause
        procedure Tape_Client is
           T1, T2 : Name_Server.Tape_Ptr;
        begin
           T1 := Name_Server.Find ("NINE-TRACK");
           T2 := Name_Server.Find ("SEVEN-TRACK");
           Tapes.Rewind (T1);
           Tapes.Rewind (T2);
           Tapes.Copy (T1, T2, 3);
        end Tape_Client;

7   Notes on the example:

8/1 This paragraph was deleted.

9     * The package Tapes provides the necessary declarations of the type and
        its primitive operations.

10    * Name_Server is a remote call interface package and is elaborated in a
        separate active partition to provide the necessary naming services
        (such as Register and Find) to the entire distributed program through
        remote subprogram calls.

11    * Tape_Driver is a normal package that is elaborated in a partition
        configured on the processing node that is connected to the tape
        device(s). The abstract operations are overridden to support the
        locally declared tape devices (Tape1, Tape2). The package is not
        visible to its clients, but it exports the tape devices (as remote
        objects) through the services of the Name_Server. This allows for tape
        devices to be dynamically added, removed or replaced without requiring
        the modification of the clients' code.

12    * The Tape_Client procedure references only declarations in the Tapes
        and Name_Server packages. Before using a tape for the first time, it
        needs to query the Name_Server for a system-wide identity for that
        tape. From then on, it can use that identity to access the tape device.

13    * Values of remote access type Tape_Ptr include the necessary
        information to complete the remote dispatching operations that result
        from dereferencing the controlling operands T1 and T2.


E.5 Partition Communication Subsystem


1/2 The Partition Communication Subsystem (PCS) provides facilities for
supporting communication between the active partitions of a distributed
program. The package System.RPC is a language-defined interface to the PCS.


                              Static Semantics

2   The following language-defined library package exists:

3       with Ada.Streams; -- see 13.13.1
        package System.RPC is

4          type Partition_Id is range 0 .. implementation-defined;

5          Communication_Error : exception;

6          type Params_Stream_Type (
              Initial_Size : Ada.Streams.Stream_Element_Count) is new
              Ada.Streams.Root_Stream_Type with private;

7          procedure Read(
              Stream : in out Params_Stream_Type;
              Item : out Ada.Streams.Stream_Element_Array;
              Last : out Ada.Streams.Stream_Element_Offset);

8          procedure Write(
              Stream : in out Params_Stream_Type;
              Item : in Ada.Streams.Stream_Element_Array);

9          -- Synchronous call
           procedure Do_RPC(
              Partition  : in Partition_Id;
              Params     : access Params_Stream_Type;
              Result     : access Params_Stream_Type);

10         -- Asynchronous call
           procedure Do_APC(
              Partition  : in Partition_Id;
              Params     : access Params_Stream_Type);

11         -- The handler for incoming RPCs
           type RPC_Receiver is access procedure(
              Params     : access Params_Stream_Type;
              Result     : access Params_Stream_Type);

12         procedure Establish_RPC_Receiver(
              Partition : in Partition_Id;
              Receiver  : in RPC_Receiver);

13      private
           ... -- not specified by the language
        end System.RPC;

14  A value of the type Partition_Id is used to identify a partition.

15  An object of the type Params_Stream_Type is used for identifying the
particular remote subprogram that is being called, as well as marshalling and
unmarshalling the parameters or result of a remote subprogram call, as part of
sending them between partitions.

16  The Read and Write procedures override the corresponding abstract
operations for the type Params_Stream_Type.


                              Dynamic Semantics

17  The Do_RPC and Do_APC procedures send a message to the active partition
identified by the Partition parameter.

18  After sending the message, Do_RPC blocks the calling task until a reply
message comes back from the called partition or some error is detected by the
underlying communication system in which case Communication_Error is raised at
the point of the call to Do_RPC.

19  Do_APC operates in the same way as Do_RPC except that it is allowed to
return immediately after sending the message.

20  Upon normal return, the stream designated by the Result parameter of
Do_RPC contains the reply message.

21  The procedure System.RPC.Establish_RPC_Receiver is called once,
immediately after elaborating the library units of an active partition (that
is, right after the elaboration of the partition) if the partition includes an
RCI library unit, but prior to invoking the main subprogram, if any. The
Partition parameter is the Partition_Id of the active partition being
elaborated. The Receiver parameter designates an implementation-provided
procedure called the RPC-receiver which will handle all RPCs received by the
partition from the PCS. Establish_RPC_Receiver saves a reference to the
RPC-receiver; when a message is received at the called partition, the
RPC-receiver is called with the Params stream containing the message. When the
RPC-receiver returns, the contents of the stream designated by Result is
placed in a message and sent back to the calling partition.

22  If a call on Do_RPC is aborted, a cancellation message is sent to the
called partition, to request that the execution of the remotely called
subprogram be aborted.

23  The subprograms declared in System.RPC are potentially blocking
operations.


                         Implementation Requirements

24  The implementation of the RPC-receiver shall be reentrant, thereby
allowing concurrent calls on it from the PCS to service concurrent remote
subprogram calls into the partition.

24.1/1 An implementation shall not restrict the replacement of the body of
System.RPC. An implementation shall not restrict children of System.RPC. The
related implementation permissions in the introduction to Annex A do not
apply.

24.2/1 If the implementation of System.RPC is provided by the user, an
implementation shall support remote subprogram calls as specified.


                         Documentation Requirements

25  The implementation of the PCS shall document whether the RPC-receiver is
invoked from concurrent tasks. If there is an upper limit on the number of
such tasks, this limit shall be documented as well, together with the
mechanisms to configure it (if this is supported).


                         Implementation Permissions

26  The PCS is allowed to contain implementation-defined interfaces for
explicit message passing, broadcasting, etc. Similarly, it is allowed to
provide additional interfaces to query the state of some remote partition
(given its partition ID) or of the PCS itself, to set timeouts and retry
parameters, to get more detailed error status, etc. These additional
interfaces should be provided in child packages of System.RPC.

27  A body for the package System.RPC need not be supplied by the
implementation.

27.1/2 An alternative declaration is allowed for package System.RPC as long as
it provides a set of operations that is substantially equivalent to the
specification defined in this clause.


                            Implementation Advice

28  Whenever possible, the PCS on the called partition should allow for
multiple tasks to call the RPC-receiver with different messages and should
allow them to block until the corresponding subprogram body returns.

29  The Write operation on a stream of type Params_Stream_Type should raise
Storage_Error if it runs out of space trying to write the Item into the
stream.

        NOTES

30      8  The package System.RPC is not designed for direct calls by user
        programs. It is instead designed for use in the implementation of
        remote subprograms calls, being called by the calling stubs generated
        for a remote call interface library unit to initiate a remote call,
        and in turn calling back to an RPC-receiver that dispatches to the
        receiving stubs generated for the body of a remote call interface, to
        handle a remote call received from elsewhere.

Generated by dwww version 1.15 on Sat May 18 08:17:20 CEST 2024.