DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ T V ┃
Length: 5706 (0x164a) Types: TextFile Names: »V«
└─⟦516dceb10⟧ Bits:30000751 8mm tape, Rational 1000, RCI_VADS └─ ⟦9a14c9417⟧ »DATA« └─⟦this⟧
-- 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;