|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 8134 (0x1fc6)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦f879a875b⟧
└─⟦this⟧
-- Copyright 1988, 1992 Verdix Corporation
------------------------------------------------------------------------------
-- User interface to the mailbox data structures and subprograms
--
-- Provides backward compatibility with earlier releases of VADS.
--
-- The interface to ALL the low kernel services is now provided in
-- ada_krn_i.a. Types used by these services is defined in ada_krn_defs.a.
--
-- This package simply layers upon the mailbox data structures and
-- subprograms found in ada_krn_defs.a and ada_krn_i.a.
--
-- Differences from earlier releases:
-- [1] The intr_flag and intr_status are only applicable to the
-- VADS_MICRO RTS.
-- [2] For the delete() service, if the conditional_delete_flag is TRUE,
-- the mailbox might not be deleted even though no tasks are
-- waiting to read. This caveat isn't applicable to the VADS_MICRO RTS.
-- [3] For mailbox write, only the DO_NOT_WAIT option is supported.
-- Earlier releases also supported timed and WAIT_FOREVER
-- write options.
------------------------------------------------------------------------------
with system;
with ada_krn_defs;
with ada_krn_i;
package v_i_mbox is
pragma suppress(ALL_CHECKS);
pragma suppress(EXCEPTION_TABLES);
pragma not_elaborated;
type intr_status_t is new ada_krn_defs.intr_status_t;
-- DISABLE_INTR_STATUS : constant intr_status_t :=
-- intr_status_t(ada_krn_defs.DISABLE_INTR_STATUS);
function DISABLE_INTR_STATUS return intr_status_t;
pragma inline_only(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 integer'size;
--------------------------------------------------------------------------
-- The following types are used to define the mailbox data structure
--------------------------------------------------------------------------
type mbox_record_t is new ada_krn_defs.mailbox_t;
type a_mbox_t is new ada_krn_defs.a_mailbox_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.
--
-- Use of the intr_flag and intr_status fields is only applicable
-- to the VADS_MICRO.
--------------------------------------------------------------------------
function create(slots_cnt: positive;
slot_len: natural;
intr_flag: boolean := FALSE;
intr_status: intr_status_t := DISABLE_INTR_STATUS
) return a_mbox_t;
pragma inline_only(create);
--------------------------------------------------------------------------
-- 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.
--
-- Note: if the conditional_delete_flag is TRUE, the mailbox might not
-- be deleted even though no tasks are waiting to read. This caveat isn't
-- applicable to the VADS_MICRO.
--------------------------------------------------------------------------
function delete(mbox: a_mbox_t; conditional_delete_flag: boolean)
return boolean;
pragma inline_only(delete);
--------------------------------------------------------------------------
-- 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.
--
-- For mailbox write, only the DO_NOT_WAIT option is supported.
-- In earlier releases, also supported timed and WAIT_FOREVER
-- write options.
--------------------------------------------------------------------------
function read_write(access_type: access_t; mbox: a_mbox_t;
msg_addr: system.address; msg_len: natural; wait_time: duration)
return boolean;
pragma inline_only(read_write);
--------------------------------------------------------------------------
-- Returns number of unread messages in mailbox
--------------------------------------------------------------------------
function get_message_count(mbox: a_mbox_t) return natural;
pragma inline_only(get_message_count);
end v_i_mbox;
with system;
with ada_krn_defs;
with ada_krn_i;
with unchecked_deallocation;
package body v_i_mbox is
pragma suppress(ALL_CHECKS);
pragma suppress(EXCEPTION_TABLES);
function create(slots_cnt: positive;
slot_len: natural;
intr_flag: boolean := FALSE;
intr_status: intr_status_t := DISABLE_INTR_STATUS
) return a_mbox_t
is
m: ada_krn_defs.a_mailbox_t := new ada_krn_defs.mailbox_t;
begin
if intr_flag then
declare
attr_rec: ada_krn_defs.mailbox_attr_t;
begin
ada_krn_defs.mailbox_intr_attr_init(
ada_krn_defs.to_a_mailbox_attr_t(attr_rec'address),
ada_krn_defs.intr_status_t(intr_status));
if not ada_krn_i.mailbox_init(m, slots_cnt, slot_len,
ada_krn_defs.to_a_mailbox_attr_t(attr_rec'address))
then
raise STORAGE_ERROR;
end if;
end;
else
if not ada_krn_i.mailbox_init(m, slots_cnt, slot_len,
ada_krn_defs.DEFAULT_MAILBOX_ATTR)
then
raise STORAGE_ERROR;
end if;
end if;
return a_mbox_t(m);
end;
procedure free is new unchecked_deallocation(
ada_krn_defs.mailbox_t,
ada_krn_defs.a_mailbox_t);
function delete(mbox: a_mbox_t; conditional_delete_flag: boolean)
return boolean
is
m: ada_krn_defs.a_mailbox_t :=
ada_krn_defs.a_mailbox_t(mbox);
begin
if conditional_delete_flag and then
(ada_krn_i.mailbox_get_in_use(m) or else
(ada_krn_i.mailbox_get_count(m) > 0))
then
return FALSE;
end if;
ada_krn_i.mailbox_destroy(m);
free(m);
return TRUE;
end;
function read_write(access_type: access_t; mbox: a_mbox_t;
msg_addr: system.address; msg_len: natural; wait_time: duration)
return boolean
is
begin
case access_type is
when READ_A =>
return ada_krn_i.mailbox_read(
ada_krn_defs.a_mailbox_t(mbox), msg_addr, wait_time);
when WRITE_A =>
return ada_krn_i.mailbox_write(
ada_krn_defs.a_mailbox_t(mbox), msg_addr);
end case;
end;
function get_message_count(mbox: a_mbox_t) return natural
is
begin
return ada_krn_i.mailbox_get_count(ada_krn_defs.a_mailbox_t(mbox));
end;
function DISABLE_INTR_STATUS return intr_status_t is
begin
return intr_status_t(ada_krn_defs.DISABLE_INTR_STATUS);
end;
end v_i_mbox