|
|
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 - metrics - 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;