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

⟦caa72de77⟧ Ada Source

    Length: 9216 (0x2400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, seg_03bdb7

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



-- Copyright 1988 Verdix Corporation

------------------------------------------------------------------------------
-- User interface to the mailbox data structures and subprograms
------------------------------------------------------------------------------
WITH V_I_Types;
WITH V_I_Sema;
WITH System;
USE System;
PACKAGE V_I_Mbox IS

   PRAGMA Suppress (All_Checks);
   PRAGMA Suppress (Exception_Tables);
   PRAGMA Not_Elaborated;

   SUBTYPE Semaphore_Rec IS V_I_Sema.Semaphore_Rec;
   SUBTYPE Intr_Status_T IS V_I_Types.Intr_Status_T;
   Disable_Intr_Status : CONSTANT Intr_Status_T :=
      V_I_Types.Disable_Intr_Status;

   -- Predefined wait_time values
   Wait_Forever : CONSTANT Duration := -1.0;
   Do_Not_Wait  : CONSTANT Duration := 0.0;

   --------------------------------------------------------------------------
   -- "read_write" function parameter types
   --------------------------------------------------------------------------
   TYPE Access_T IS (Read_A, Write_A);
   FOR Access_T USE (Read_A => 1, Write_A => 2);
   FOR Access_T'Size USE 32;

   --------------------------------------------------------------------------
   -- The following types are used to define the mailbox data structure
   --------------------------------------------------------------------------

   TYPE Unit_T IS RANGE -2 ** (Storage_Unit - 1) ..
                           2 ** (Storage_Unit - 1) - 1;
   FOR Unit_T'Size USE Storage_Unit;
   TYPE Slots_T   IS ARRAY (Positive RANGE <>, Positive RANGE <>) OF Unit_T;
   TYPE A_Slots_T IS ACCESS Slots_T;

   TYPE Current_T   IS ARRAY (Access_T) OF Positive;
   TYPE Entry_Array IS ARRAY (Access_T) OF Address;

   TYPE Mbox_Record_T IS
      RECORD
         Enter_S        : Semaphore_Rec;
         Wait_S         : Semaphore_Rec;
         Resume_Entries : Entry_Array;
         Intr_Flag      : Boolean;
         Intr_Status    : Intr_Status_T;
         Slots_Cnt      : Natural;
         Slot_Len       : Natural;
         Current        : Current_T;
         Message_Cnt    : Natural;
         Slots          : A_Slots_T;
      END RECORD;
   TYPE A_Mbox_T IS ACCESS Mbox_Record_T;

   --------------------------------------------------------------------------
   -- Create a new mailbox. A mailbox consists of n fixed length slots.
   -- The slot_len parameter specifies the length in units of
   -- system.storage_unit (normally bytes).
   --
   -- Normally, a mailbox's critical region is protected by a
   -- semaphore.
   --
   -- However, if the intr_flag is TRUE, then,
   -- its critical region is protected by disabling interrupts. This
   -- allows the mailbox to be accessed from an ISR.
   --
   -- STORAGE_ERROR exception is raised if not enough memory for mailbox.
   --------------------------------------------------------------------------
   FUNCTION Create (Slots_Cnt   : Positive;
                    Slot_Len    : Natural;
                    Intr_Flag   : Boolean       := False;
                    Intr_Status : Intr_Status_T := Disable_Intr_Status)
                   RETURN A_Mbox_T;

   --------------------------------------------------------------------------
   -- Deletes a previously created mailbox. Returns TRUE if mailbox
   -- was successfully deleted.
   --
   -- If conditional_delete_flag parameter is TRUE, then, mailbox
   -- is not deleted if any of the following are TRUE:
   --  - task is waiting to read/write
   --  - unread messages
   -- Otherwise, mailbox is always deleted, and tasks waiting to read/write
   -- are resumed.
   --------------------------------------------------------------------------
   FUNCTION Delete (Mbox : A_Mbox_T; Conditional_Delete_Flag : Boolean)
                   RETURN Boolean;

   --------------------------------------------------------------------------
   -- Reads/writes a message from/to a mailbox. The access_type parameter
   -- indicates the type of access. Returns TRUE if message was
   -- successfully read/written.
   --
   -- If no message is available for reading, or if no slot is available
   -- for writing, then, returns according to the wait_time parameter:
   --  < 0.0           - returns when message was successfully read/written.
   --                    This may necessitate suspension of current task
   --                    until another task does mailbox write/read.
   --  = 0.0           - returns FALSE immediately if unable to do
   --                    mailbox operation
   --  > 0.0           - if the mailbox operation cannot be completed
   --                    within "wait_time" amount of time, returns FALSE.
   --
   -- Note: returns FALSE for any wait_time, if mailbox was deleted.
   --
   --------------------------------------------------------------------------
   FUNCTION Read_Write (Access_Type : Access_T;
                        Mbox        : A_Mbox_T;
                        Msg_Addr    : Address;
                        Msg_Len     : Natural;
                        Wait_Time   : Duration) RETURN Boolean;

   --------------------------------------------------------------------------
   -- Returns number of unread messages in mailbox
   --------------------------------------------------------------------------
   FUNCTION Get_Message_Count (Mbox : A_Mbox_T) RETURN Natural;

PRIVATE
   PRAGMA Interface (Ada, Create);
   PRAGMA Interface_Name (Create, "__CREATE_MAILBOX");
   PRAGMA Interface (Ada, Delete);
   PRAGMA Interface_Name (Delete, "__DELETE_MAILBOX");
   PRAGMA Interface (Ada, Read_Write);
   PRAGMA Interface_Name (Read_Write, "__READ_WRITE_MAILBOX");
   PRAGMA Interface (Ada, Get_Message_Count);
   PRAGMA Interface_Name (Get_Message_Count, "__GET_MAILBOX_MESSAGE_COUNT");
END V_I_Mbox;

E3 Meta Data

    nblk1=8
    nid=0
    hdr6=10
        [0x00] rec0=1d rec1=00 rec2=01 rec3=00a
        [0x01] rec0=18 rec1=00 rec2=08 rec3=034
        [0x02] rec0=01 rec1=00 rec2=02 rec3=030
        [0x03] rec0=17 rec1=00 rec2=07 rec3=03a
        [0x04] rec0=00 rec1=00 rec2=03 rec3=02e
        [0x05] rec0=14 rec1=00 rec2=04 rec3=078
        [0x06] rec0=13 rec1=00 rec2=05 rec3=020
        [0x07] rec0=12 rec1=00 rec2=06 rec3=001
    tail 0x215347efa856574568db1 0x489e0066482863c01