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

⟦cc755a126⟧ Ada Source

    Length: 14336 (0x3800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package V_Mailboxes, seg_03bda2

Derivation

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

E3 Source Code



with V_Interrupts;
generic
    type Message_Type is private;
package V_Mailboxes is

    pragma Suppress (All_Checks);

--   PURPOSE : V_MAILBOXES is a generic package which provides mailbox
--             operations.  Mailboxes may be used for unsyncronized
--             passing of data between tasks, or between an interrupt
--             handler and a task.
--
--             The operation CREATE_MAILBOX creates a mailbox for
--             passing objects of the type used to instantiate the
--             generic package.
--
--             READ_MAILBOX reads messages from a mailbox in a first-in-
--             first-out basis.  A parameter may be used to specify how
--             long the task is willing to wait for a message, if one is
--             not immediately available.  Waiting tasks are queued on
--             the mailbox in priority order (as specified by pragma
--             PRIORITY), and first-in-first-out within priorities.
--
--             WRITE_MAILBOX writes a message to the mailbox, awakening a
--             task waiting on the mailbox, if any are waiting.
--
--             CURRENT_MESSAGE_COUNT returns the number of unread messages
--             in the mailbox.
--
--             DELETE_MAILBOX deletes a mailbox.  The user must specify
--             the action to be taken if there are currently tasks
--             waiting on the mailbox.
--
--     WHERE : MESSAGE_TYPE is the type of object which may be passed
--             using the operations provided by an instantiation.
--
--   EXAMPLE : The following declaration creates a package providing
--             operations to pass characters via mailboxes.
--
--             package CHAR_BOX is new V_MAILBOXES
--               (MESSAGE_TYPE => CHARACTER);
--
--             The following declaration creates a package providing
--             signal operations via mailboxes (ie messages of null
--             length).
--
--             type signal_t is array(integer 1..0) of integer;
--             package signal is new V_MAILBOXES(MESSAGE_TYPE => signal_t);


    -- The following type is used to identify mailboxes.

    type Mailbox_Id is private;


    -- Objects of the following type are used to specify the action to
    -- take during a call to DELETE_MAILBOX if tasks are waiting on the
    -- mailbox that is to be deleted.

    type Mailbox_Delete_Option is (Delete_Option_Force, Delete_Option_Warning);

    -- Where:
    --   DELETE_OPTION_FORCE      delete the mailbox even though
    --                            there may be tasks waiting at the
    --                            mailbox.
    --
    --   DELETE_OPTION_WARNING    indicates that the mailbox should
    --                            only be deleted if there are no
    --                            waiting tasks.


    -- The following constants may be used with READ_MAILBOX to specify
    -- that the mailbox either should either be waited on indefinitely
    -- or not at all, respectively.

    Wait_Forever : constant Duration := -1.0;
    Do_Not_Wait : constant Duration := 0.0;


    -- The following exceptions may be raised by the mailbox services:

    No_Memory_For_Mailbox : exception;

    -- NO_MEMORY_FOR_MAILBOX is raised by CREATE_MAILBOX if there was not
    -- sufficient memory available to create the mailbox.

    Invalid_Mailbox : exception;

    -- INVALID_MAILBOX is raised if the mailbox id passed to a mailbox
    -- operation does not identify an existing mailbox.

    Mailbox_Timed_Out : exception;

    -- MAILBOX_TIMED_OUT is raised by READ_MAILBOX if a timed wait was
    -- performed and a message did not arrive in the specified time
    -- interval.

    Mailbox_Empty : exception;

    -- MAILBOX_EMPTY is raised by READ_MAILBOX if an unwaited read was
    -- performed and there was not a message in the mailbox.

    Mailbox_Deleted : exception;

    -- MAILBOX_DELETED is raised by READ_MAILBOX if the mailbox was
    -- deleted during the read operation.

    Mailbox_Full : exception;

    -- MAILBOX_FULL is raised by WRITE_MAILBOX if an attempt was made to
    -- write to a full mailbox.

    Mailbox_Not_Empty : exception;

    -- MAILBOX_NOT_EMPTY is raised by DELETE_MAILBOX if an attempt was
    -- made to delete a non-empty mailbox and the delete option was
    -- delete_option_warning.

    Mailbox_In_Use : exception;

    -- MAILBOX_IN_USE is raised by DELETE_MAILBOX if an attempt was
    -- made to delete a mailbox on which a task was waiting and the
    -- delete option was delete_option_warning.

    Unexpected_V_Mailbox_Error : exception;

    -- UNEXPECTED_V_MAILBOX_ERROR may be raised if an unexpected
    -- error occurs during a V_MAILBOX operation.


    -- The following type declares the result codes which may be returned
    -- by the non-exception-raising versions of the READ_MAILBOX and
    -- WRITE_MAILBOX routines.

    type Mailbox_Result is (Sent, Received, Timed_Out, Full, Empty, Deleted);

    -- READ_MAILBOX returns RECEIVED if the message was received,
    -- TIMED_OUT if a timed wait was performed and a message did
    -- not arrive in the specified interval, EMPTY if a non-waited
    -- read was performed and the mailbox was EMPTY, or DELETED if
    -- the mailbox was deleted while the current task was waiting
    -- on it.
    --
    -- WRITE_MAILBOX returns SENT if the message was sent, or FULL
    -- if the message could not be sent because the mailbox was
    -- full.


    procedure Create_Mailbox
                 (Numberslots : in Positive := 1;
                  Mailbox : out Mailbox_Id;
                  Interrupt_Flag : in Boolean := False;
                  Interrupt_Status : in V_Interrupts.Interrupt_Status_T :=
                     V_Interrupts.Disable_Interrupt);

    function Create_Mailbox
                (Numberslots : in Positive := 1;
                 Interrupt_Flag : in Boolean := False;
                 Interrupt_Status : in V_Interrupts.Interrupt_Status_T :=
                    V_Interrupts.Disable_Interrupt) return Mailbox_Id;


    --  Purpose:   CREATE_MAILBOX creates and initializes a mailbox.
    --             Two versions are supplied for doing the create,
    --             a procedure that returns mailbox id as an out parameter or
    --             a function returning the mailbox id.
    --
    --  Where:
    --
    --    numberslots       indicates the number of slots to have in the
    --                      mailbox.
    --
    --    mailbox           identifies the mailbox created.
    --
    --    interrupt_flag    normally, a mailbox's critical region is protected
    --                      by a binary semaphore.  However, if INTERRUPT_FLAG
    --                      is TRUE, then its critical region is protected by
    --                      disabling interrupts using the INTERRUPT_STATUS
    --                      parameter.  INTERRUPT_FLAG must be set to TRUE if
    --                      the mailbox is accessed from an ISR.
    --                      Defaults to FALSE.
    --
    --    interrupt_status  if above INTERRUPT_FLAG is TRUE, then this value
    --                      is used to disable interrupts. Defaults to
    --                      disabling all interrupt levels.
    --
    -- Exceptions:
    --
    --   NO_MEMORY_FOR_MAILBOX is raised if there was not sufficient
    --   memory available to create the mailbox.


    procedure Read_Mailbox (Mailbox : in Mailbox_Id;
                            Waittime : in Duration;
                            Message : out Message_Type);

    procedure Read_Mailbox (Mailbox : in Mailbox_Id;
                            Waittime : in Duration;
                            Message : out Message_Type;
                            Result : out Mailbox_Result);

    --  Purpose:   READ_MAILBOX retrieves a message from a mailbox.
    --
    --             If READ_MAILBOX is called from an interrupt
    --             service routine then waittime should be set to
    --             DO_NOT_WAIT.
    --
    --  Where:
    --
    --    mailbox              identifies the mailbox to be read.
    --
    --    waittime             indicates the time the caller wishes to
    --                         wait (in seconds) for the read to
    --                         complete.  A value of WAIT_FOREVER
    --                         indicates the caller will wait forever
    --                         for a message.
    --
    --    message              is the message retrieved from the mailbox.
    --
    --  Exceptions/Results:
    --
    --    INVALID_MAILBOX is raised if the mailbox id does not identify
    --    an existing mailbox.
    --
    --    MAILBOX_TIMED_OUT is raised (or the result value TIMED_OUT is
    --    returned) if a timed wait was performed and a message did not
    --    arrive in the specified time interval.
    --
    --    MAILBOX_EMPTY is raised (or the result value EMPTY is returned)
    --    if an unwaited read was performed and there was not a message
    --    in the mailbox.
    --
    --    MAILBOX_DELETED is raised (or the result value DELETED is returned)
    --    if the mailbox was deleted during the read operation.
    --
    --    The result value RECEIVED is returned if a message is read.


    procedure Write_Mailbox (Mailbox : in Mailbox_Id;
                             Message : in Message_Type);

    procedure Write_Mailbox (Mailbox : in Mailbox_Id;
                             Message : in Message_Type;
                             Result : out Mailbox_Result);

    --  Purpose:  WRITE_MAILBOX writes a message into a mailbox.
    --
    --  Where:
    --
    --    mailbox         identifies the mailbox to write to.
    --
    --    message         is the message to write into the mailbox.
    --
    --  Exceptions/Results:
    --
    --    INVALID_MAILBOX is raised if the mailbox id does not identify
    --    an existing mailbox.
    --
    --    MAILBOX_FULL is raised (or the result value FULL is returned)
    --    if an attempt was made to write to a full mailbox.
    --
    --    The result value SENT is returned if the message is sent.


    function Current_Message_Count (Mailbox : in Mailbox_Id) return Natural;

    --  Purpose:  CURRENT_MESSAGE_COUNT returns the number of unread messages
    --            in the mailbox.
    --
    --  Where:
    --
    --    mailbox         identifies the mailbox to get message count for.
    --
    --  Exceptions/Results:
    --
    --    INVALID_MAILBOX is raised if the mailbox id does not identify
    --    an existing mailbox.


    procedure Delete_Mailbox (Mailbox : in Mailbox_Id;
                              Delete_Option : in Mailbox_Delete_Option);

    --  Purpose:  DELETE_MAILBOX deletes the given mailbox.
    --
    --  Where:
    --
    --    mailbox         identifies the mailbox to delete.
    --
    --    delete_option   specifies the action to be taken if the mailbox
    --                    contains messages or tasks are waiting on the
    --                    mailbox:
    --
    --                    when delete_option_force =>
    --
    --                      Ready all waiting tasks.  These tasks' calls
    --                      to READ_MAILBOX will raise the exception
    --                      MAILBOX_DELETED or return the value DELETED.
    --
    --                      The mailbox is deleted.
    --
    --                    when delete_option_warning =>
    --
    --                      If there are messages in the mailbox, then
    --                      raise the exception MAILBOX_NOT_EMPTY in the
    --                      calling task.
    --
    --                      If there are tasks waiting at the mailbox, then
    --                      raise the exception MAILBOX_IN_USE in the calling
    --                      task.
    --
    --                      The mailbox is not deleted.
    --
    --  Exceptions:
    --
    --    INVALID_MAILBOX is raised if the mailbox id does not identify
    --    an existing mailbox.
    --
    --    MAILBOX_NOT_EMPTY is raised if an attempt was made to delete a
    --    non-empty mailbox and the delete option was delete_option_warning.
    --
    --    MAILBOX_IN_USE is raised if an attempt was made to delete a
    --    mailbox on which tasks were waiting and the delete option was
    --    delete_option_warning.


private
    type Mailbox_Rec;
    type Mailbox_Id is access Mailbox_Rec;
end V_Mailboxes;
pragma Share_Body (V_Mailboxes, False);



E3 Meta Data

    nblk1=d
    nid=0
    hdr6=1a
        [0x00] rec0=19 rec1=00 rec2=01 rec3=008
        [0x01] rec0=17 rec1=00 rec2=02 rec3=012
        [0x02] rec0=1a rec1=00 rec2=03 rec3=02e
        [0x03] rec0=1e rec1=00 rec2=04 rec3=01e
        [0x04] rec0=1d rec1=00 rec2=05 rec3=040
        [0x05] rec0=18 rec1=00 rec2=06 rec3=01c
        [0x06] rec0=15 rec1=00 rec2=07 rec3=08a
        [0x07] rec0=17 rec1=00 rec2=08 rec3=008
        [0x08] rec0=19 rec1=00 rec2=09 rec3=02e
        [0x09] rec0=19 rec1=00 rec2=0a rec3=01c
        [0x0a] rec0=1e rec1=00 rec2=0b rec3=03e
        [0x0b] rec0=18 rec1=00 rec2=0c rec3=066
        [0x0c] rec0=1d rec1=00 rec2=0d rec3=000
    tail 0x215347ed28565742e0ec9 0x42a00088462060003