DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦f64240ec1⟧ Ada Source

    Length: 15360 (0x3c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package Mail, seg_020b4d

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

E3 Source Code



--| @SUMMARY Provides Interprocess Communication (IPC) for Ada tasks.
--| @DESCRIPTION Provide mechanisms for Ada subprograms to send and
--|   receive messages.
--|
--|   Mailbox:  Messages are sent to mailboxes.  Mailboxes must be
--|             registered before they can receive messages.
--|
--|   List:     List of mailboxes.  Supports sending a message
--|             to a list of mailboxes.
--|
--|   Kind:     Used to identify what type of message has been
--|             received.
--|
--|   Transaction_Id: Transaction identifier that uniquely identifies
--|                   a send/reply message transaction.
--|
--|   Raw_Message: Raw form of a message.  Used to represent any
--|                kind of message.
--|
--|   Basic Usage:
--|
--|     Clients that wish to communicate by passing messages generally
--|     define Ada type declarations that represent each type of message
--|     that will be sent.  Once the message type is declared, the project
--|     assigns a unique KIND to the type.  Mail.Operations is then
--|     instantiated with the message type/message kind pair.
--|
--|     To send a message, the client calls Look_Up to locate the
--|     address of the destination and Sends the message
--|     to the destination mailbox.  If a Reply to the message
--|     is required, the Reply_Operations subpackage is
--|     instantiated with the reply message type and Kind identifier.
--|
--|     To receive a message, the client waits for a raw message to arrive
--|     on its mailbox.  Based on the kind of the raw message that
--|     was received, the client may then 'receive' the message into
--|     the strongly typed Ada declaration.
--|
--|     Typically, one client will wait on a mailbox at a time.  Testing
--|     has done been done with multiple waiters.
--|
--|   Communication Taxonomy:
--|
--|   Send_With_Delivery_Completion - block until the message
--|     arrives at the destination mailbox.  No reply.
--|
--|   Send_Blocked_With_Application_Reply - Block until the
--|     reply is received from the application who received
--|     the message from the destination mailbox.
--|
--|   Send_Nonblocked_With_Application_Reply - Block only until
--|     the local postmaster copies the message to be forwarded.
--|     A unique transaction identifier is returned.  The application
--|     reply that later appears in the source mailbox will have
--|     the same transaction id.
--|
--|   Nonblocked_Reply - Reply to a message.  Block only until
--|     the local postmaster copies the message.
--|
--|   Multicast - Send a message to a list of destination mailboxes.
--|     Block only until the local postmaster copies the message.
--|
--|   Broadcast - Send a message to all subscribers.
--|     Block only until the local postmaster copies the message.
--|
--| @SPECIAL_NOTES
--| Unimplemented features:  The priority is currently ignored.
--|   All messages are presented FIFO.
--|
--| Documentation:  The documentation directory in this view contains
--|   an example application of mail.  MAIL_EXAMPLE_MAIN is the main
--|   program that initiates two producers and one consumer.
--|
--| Future Enhancements: The body of mail should be implemented with
--|   !IO.PIPE to support intra-job communication and inter-job communiction.
--|
--| @INDICES (IPC, MAIL, MESSAGE_PASSING, COMMUNICATION)
with System;
with String_Map_Generic;
with List_Generic;
package Mail is

    type Mailbox is private;

    type List is private;

    --| @SUMMARY Add a mailbox to a list of addresses.
    procedure Add (Box : Mailbox; To : in out List);

    --| @DESCRIPTION Mailbox was not registered.
    Undefined_Mailbox : exception;

    --| @DESCRIPTION Attempt to register a mailbox with the same
    --|   name (address) as another previously registered mailbox.
    Duplicate_Mailbox : exception;

    --| @SUMMARY Create a mailbox and give it a dynamic name to be used
    --| by sender and receiver. A more interesting addressing mechanism
    --| would be more efficient.
    --|
    --| @RAISES [Duplicate_Mailbox]
    function Register (Name : String) return Mailbox;


    --| @SUMMARY Identify a mailbox based on address.
    --| @RAISES [Undefined_Mailbox]
    function Look_Up (Name : String) return Mailbox;

    --| Uniquely identify the type of message to be known to the
    --|   mail system.
    type Kind is new Integer;

    --| establish a priority for messags.  Higher priority numbers
    --| mean higher priority messages.  A more descriptive mechanism
    --| would be desirable.
    type Priority is new Natural range 0 .. 32;

    Default_Priority : constant Priority := 16;

    --| Uniquely identify a Send Message/Reply transaction for an
    --|   asynchronous Send_With_Reply transaction.
    type Transaction_Id is private;

    --| Representation of any kind of message that was received
    --|   on a mailbox.
    type Raw_Message (Length : Natural) is private;

    --------------------------------------------------
    -- various properties of raw_messages
    --------------------------------------------------

    --| @SUMMARY Return the unique type identifier of the
    --|   message that was received on the mailbox.
    function Get_Kind (The_Message : Raw_Message) return Kind;

    --| @SUMMARY Return the unique transaction identifier
    --|   associated with the message if a reply is expected.
    function Get_Transaction_Id
                (The_Message : Raw_Message) return Transaction_Id;

    function Is_A_Reply (The_Message : Raw_Message) return Boolean;

    function Is_Empty (The_Message : Raw_Message) return Boolean;

    --| @SUMMARY The message was sent expecting a reply.
    function Response_Is_Required (The_Message : Raw_Message) return Boolean;

    --| @SUMMARY If Response_Is_Required return the kind of reply that
    --|   is expected.
    function Get_Response_Kind (The_Message : Raw_Message) return Kind;

    function Get_Priority (The_Message : Raw_Message) return Priority;

    --------------------------------------------------

    --| @SUMMARY Wait for a message to arrive on the mailbox.
    --| @DESCRIPTION Block until receive a message on this mailbox.
    --|   Return highest priority message for this mailbox.
    --|   Wait call should be followed by Receive based on the message kind.
    function Wait (Box : Mailbox) return Raw_Message;


    --| @SUMMARY Check the mailbox for incoming messages.
    --| @DESCRIPTION Read the highest priority message from the mailbox.
    --|    If no mail messages in the mailbox, return an empty message.
    function Conditional_Read (Box : Mailbox) return Raw_Message;

    --------------------------------------------------

    --| @SUMMARY Send messages to mailboxes.
    generic
        type Message is private;

        --| @DESCRIPTION Project-wide unique identifier for this
        --|    message type.
        Message_Kind : Kind;
    package Operations is


        --| @SUMMARY Send message to a destination mailbox.
        --| @DESCRIPTION Block until msg is delivered to destination
        --|   mailbox.
        procedure Send_With_Delivery_Completion
                     (The_Message      : Message;
                      Message_Priority : Priority := Default_Priority;
                      Destination      : Mailbox);


        --| @SUMMARY Transaction communication.
        generic
            type Reply is private;
            Reply_Kind : Kind;
        package Reply_Operations is

            --| @SUMMARY Originate a synchronous transaction.
            --| @DESCRIPTION Send a message and block until
            --|   the reply is received.
            function Send_Blocked_With_Application_Reply
                        (The_Message      : Message;
                         Message_Priority : Priority := Default_Priority;
                         Destination      : Mailbox) return Reply;

            --| @SUMMARY Originate an asynchronous transaction.
            --| @DESCRIPTION Send a message that requests for a reply.
            --|   The transaction id should be saved and later compared
            --|   with a reply that later is received in the source
            --|   mailbox.
            function Send_Nonblocked_With_Application_Reply
                        (The_Message      : Message;
                         Message_Priority : Priority := Default_Priority;
                         Source           : Mailbox;
                         Destination      : Mailbox) return Transaction_Id;

            --| @SUMMARY Receive a raw message into the reply.
            function Receive (The_Message : Raw_Message) return Reply;


            --------------------------------------------------

            --| @SUMMARY Reply to a message.
            --| @DESCRIPTION Send the reply to a transaction.
            procedure Nonblocked_Reply (The_Reply   : Reply;
                                        Transaction : Transaction_Id);

        end Reply_Operations;


        --| @SUMMARY Send a message to a list of mailboxes.
        --| @DESCRIPTION Non-blocked send to a set of mailboxes.
        procedure Multicast (The_Message      : Message;
                             Message_Priority : Priority := Default_Priority;
                             Destinations     : List);

        --| @SUMMARY Send a message to all subscribers.
        --| @DESCRIPTION The message is sent to all mailboxes that
        --|   have previously subscribed.
        procedure Broadcast (The_Message      : Message;
                             Message_Priority : Priority := Default_Priority);

        --| @SUMMARY Add the mailbox to the list of subscribers.
        --| @DESCRIPTION Box will receive all messages sent using the
        --|   Broadcast subprogram.
        procedure Subscribe (Box : Mailbox);

        --| @SUMMARY Remove mailbox from the subscription list.
        procedure Cancel_Subscription (Box : Mailbox);


        --------------------------------------------------

        --| @SUMMARY Receive a raw message into the strongly typed message.
        function Receive (The_Message : Raw_Message) return Message;

    end Operations;

private

    type Transaction_Id is
        record
            Id              : Integer := Integer'Last;
            Source_Box      : Mailbox;
            Destination_Box : Mailbox;
        end record;

    type Raw_Message (Length : Natural) is
        record
            Msg_Kind : Kind;
            Response_Kind : Kind;
            Msg_Priority : Priority;
            Msg_Transaction_Id : Transaction_Id;
            Is_Empty : Boolean := True;
            Is_A_Reply : Boolean := False;
            Response_Is_Required : Boolean := False;
            Msg : System.Byte_String (1 .. Length);
        end record;

    type Message_Pointer is access Raw_Message;

    Mailbox_Empty : exception;

    subtype Response_Ids is Integer range 1 .. 20;

    --| @DESCRIPTION One task will own each mailbox.
    task type Box is

        --| @SUMMARY Add a message to the mailbox.
        entry Deliver (Message : Raw_Message);

        ----------------------------------------

        --| @SUMMARY Add a message to the mailbox and return reply token.
        --| @DESCRIPTION Response id is the handled that should be used
        --|   to wait for the reply.
        entry Deliver_With_Reply (Message     :     Raw_Message;
                                  Response_Id : out Response_Ids);

        --| @SUMMARY Return a reply to the originator of the transaction.
        entry Accept_Response (Response_Ids) (Message : out Message_Pointer);

        --| @SUMMARY Reply to a message.
        entry Respond (Message : Raw_Message);

        ----------------------------------------

        --| @SUMMARY Wait for the first message to arrive at the mailbox.
        entry Retrieve (Message : out Message_Pointer);

        --| @SUMMARY Check mailbox for any mail.
        --| @DESCRIPTION Returns first message in mailbox if one exists,
        --|   else raises Mailbox_Empty.
        --| @RAISES [Mailbox_Empty]
        entry Conditional_Retrieve (Message : out Message_Pointer);
    end Box;

    type Mailbox is access Box;

    package Post_Office is new String_Map_Generic (10, Mailbox);

    package Box_List is new List_Generic (Mailbox);

    type List is new Box_List.List;

    Null_Transaction : constant Transaction_Id := (Integer'Last, null, null);


end Mail;

E3 Meta Data

    nblk1=e
    nid=0
    hdr6=1c
        [0x00] rec0=19 rec1=00 rec2=01 rec3=088
        [0x01] rec0=15 rec1=00 rec2=02 rec3=048
        [0x02] rec0=17 rec1=00 rec2=03 rec3=018
        [0x03] rec0=1d rec1=00 rec2=04 rec3=02e
        [0x04] rec0=1b rec1=00 rec2=05 rec3=02e
        [0x05] rec0=18 rec1=00 rec2=06 rec3=040
        [0x06] rec0=17 rec1=00 rec2=07 rec3=016
        [0x07] rec0=1c rec1=00 rec2=08 rec3=022
        [0x08] rec0=13 rec1=00 rec2=09 rec3=05c
        [0x09] rec0=16 rec1=00 rec2=0a rec3=080
        [0x0a] rec0=20 rec1=00 rec2=0b rec3=006
        [0x0b] rec0=00 rec1=00 rec2=0e rec3=024
        [0x0c] rec0=1a rec1=00 rec2=0c rec3=08c
        [0x0d] rec0=1d rec1=00 rec2=0d rec3=000
    tail 0x2171d2c50838d44989513 0x42a00088462061e03