⟦ce54e268f⟧

E3 Source Code



-- Copyright 1992  Verdix Corporation

with System;
use System;
with Ada_Krn_Defs;
with V_I_Cifo;
with Unchecked_Conversion;
package V_I_Mutex is

    pragma Suppress (All_Checks);
    pragma Suppress (Exception_Tables);
    pragma Not_Elaborated;
    pragma Local_Access;

    --------------------------------------------------------------------------
    -- Ada tasking ABORT_SAFE mutex and condition variable services
    --
    -- After locking a mutex the task is inhibited from being completed
    -- by an Ada abort until it unlocks the mutex.
    --
    -- However, if a task is aborted while waiting at a condition variable
    -- (after an implicit mutex unlock), then, it is completed.
    --
    -- These services also address the case where multiple ABORT_SAFE
    -- mutexes can be locked. The task is inhibited from being completed
    -- until all the mutexes are unlocked or it does a condition variable
    -- wait with only one mutex locked.
    --------------------------------------------------------------------------

    subtype Safe_Mutex_Attr_T is Ada_Krn_Defs.Mutex_Attr_T;
    subtype A_Safe_Mutex_Attr_T is Ada_Krn_Defs.A_Mutex_Attr_T;
    function To_A_Safe_Mutex_Attr_T is
       new Unchecked_Conversion (Address, A_Safe_Mutex_Attr_T);

--    DEFAULT_SAFE_MUTEX_ATTR: constant a_safe_mutex_attr_t := null;
    function Default_Safe_Mutex_Attr return A_Safe_Mutex_Attr_T;
    pragma Inline_Only (Default_Safe_Mutex_Attr);

    type Safe_Mutex_T;
    type A_Safe_Mutex_T is access Safe_Mutex_T;
    type Safe_Mutex_T is
        record
            Q_Next : A_Safe_Mutex_T;
-- PRIORITY_INHERITANCE
            Owner : Task_Id; -- updated for priority_inheritance to
            -- inhibit relock of the task's
            -- mutex
-- PRIORITY_INHERITANCE
            Mutex : Ada_Krn_Defs.Mutex_T;
        end record;
    function To_A_Safe_Mutex_T is
       new Unchecked_Conversion (Address, A_Safe_Mutex_T);

    type Safe_Cond_T;
    type A_Safe_Cond_T is access Safe_Cond_T;
    type Safe_Cond_T is
        record
            Queuing : V_I_Cifo.Queuing_T;
            Abort_Callout_Proc : Address;
            Abort_Arg : Address;
            Entryq_Head : Task_Id;
            Entryq_Tail : Task_Id;
        end record;
    function To_A_Safe_Cond_T is
       new Unchecked_Conversion (Address, A_Safe_Cond_T);

    --------------------------------------------------------------------------
    -- ABORT_SAFE mutex services
    --------------------------------------------------------------------------

    -- Returns TRUE if mutex was successfully initialized.
    function Ts_Mutex_Init
                (Safe_Mutex : A_Safe_Mutex_T;
                 Safe_Attr : A_Safe_Mutex_Attr_T := Default_Safe_Mutex_Attr)
                return Boolean;

    procedure Ts_Mutex_Destroy (Safe_Mutex : A_Safe_Mutex_T);

    -- If the safe_mutex is lockable from an ISR, then,
    -- these safe mutex lock/unlock services can be called from an ISR.
    procedure Ts_Mutex_Lock (Safe_Mutex : A_Safe_Mutex_T);
    function Ts_Mutex_Trylock (Safe_Mutex : A_Safe_Mutex_T) return Boolean;
    procedure Ts_Mutex_Unlock (Safe_Mutex : A_Safe_Mutex_T);

    --------------------------------------------------------------------------
    -- ABORT_SAFE condition variable services
    --------------------------------------------------------------------------

    -- Returns TRUE if cond variable was successfully initialized and the
    -- specified queuing type is supported.
    --
    -- Supports FIFO or PRIORITY queuing when the task waits on
    -- a condition variable.
    --
    -- Note: PRIORITY queuing is only supported in the CIFO add-on
    -- product.
    function Ts_Cond_Init (Safe_Cond : A_Safe_Cond_T;
                           Queuing : V_I_Cifo.Queuing_T :=
                              V_I_Cifo.Arbitrary_Queuing;
                           Abort_Callout_Proc : Address := No_Addr;
                           Abort_Arg : Address := No_Addr) return Boolean;
    --
    -- The abort_callout_proc callout has the following subprogram
    -- interface:
    --\x09procedure abort_callout_proc(abort_arg: address);
    --
    -- If the task is aborted while waiting on a condition variable, then,
    -- its called in the context of the task doing the condition wait
    -- with the mutex locked.
    --
    -- Setting abort_callout_proc to NO_ADDR inhibits the callout.
    --
    -- The abort_arg is passed directly to the abort_callout_proc().
    --
    -- If queuing = UNSPECIFIED_QUEUING or ARBITRARY_QUEUING, then,
    --  For CIFO add-on: uses queuing specified by the main
    --\x09procedure's SET_GLOBAL_ENTRY_CRITERIA pragma.
    --  Else: uses FIFO_QUEUING

    procedure Ts_Cond_Destroy (Safe_Cond : A_Safe_Cond_T);

    -- If the task is aborted with more than one mutex locked, then,
    -- the abort can cause ts_cond_wait() to return prematurely without
    -- ts_cond_signal() or ts_cond_broadcast being called by the
    -- application code.
    --
    -- If the task is aborted with only one mutex locked, then,
    -- ts_cond_wait() doesn't return. However, if the abort_callout_proc
    -- parameter passed to ts_cond_init() is nonzero, then, it is called
    -- before the task completes itself.
    procedure Ts_Cond_Wait (Safe_Cond : A_Safe_Cond_T;
                            Safe_Mutex : A_Safe_Mutex_T);

    -- ts_cond_timed_wait() has the same abort/complete semantics as
    -- ts_cond_wait().
    function Ts_Cond_Timed_Wait (Safe_Cond : A_Safe_Cond_T;
                                 Safe_Mutex : A_Safe_Mutex_T;
                                 Sec : Duration) return Boolean;

    -- Calling ts_cond_signal() without locking the same safe_mutex
    -- used by ts_cond_wait/ts_cond_timed_wait can lead to unexpected
    -- results.
    --
    -- If the safe_mutex is lockable from an ISR, then, ts_cond_signal can
    -- be called from an ISR.
    procedure Ts_Cond_Signal (Safe_Cond : A_Safe_Cond_T);

    -- ts_cond_broadcast() has the same comments as for ts_cond_signal().
    procedure Ts_Cond_Broadcast (Safe_Cond : A_Safe_Cond_T);

    -- If the safe_mutex is lockable from an ISR, then,
    -- ts_cond_signal_unlock() can be called from an ISR.
    procedure Ts_Cond_Signal_Unlock
                 (Safe_Cond : A_Safe_Cond_T; Safe_Mutex : A_Safe_Mutex_T);

    function Ts_Cond_Get_Wait_Head_Task
                (Safe_Cond : A_Safe_Cond_T) return Task_Id;

    -- Upon entry/exit, the safe mutex used to protect the condition
    -- variable must be locked by the caller.
    function Ts_Cond_Get_Wait_Count (Safe_Cond : A_Safe_Cond_T) return Natural;


    -------------------------------------------------------------------------
    -- ABORT_SAFE priority ceiling mutex services (CIFO augmentation)
    -------------------------------------------------------------------------

    -- Returns TRUE if underlying micro kernel supports the priority ceiling
    -- protocol and the mutex was successfully initialized.
    function Ts_Ceiling_Mutex_Init
                (Safe_Mutex : A_Safe_Mutex_T;
                 Safe_Attr : A_Safe_Mutex_Attr_T := Default_Safe_Mutex_Attr;
                 Ceiling_Prio : Priority := Priority'Last) return Boolean;

    -- Returns FALSE if not a priority ceiling mutex
    function Ts_Ceiling_Mutex_Set_Priority
                (Safe_Mutex : A_Safe_Mutex_T; Ceiling_Prio : Priority)
                return Boolean;

    -- Returns -1 if not a priority ceiling mutex
    function Ts_Ceiling_Mutex_Get_Priority
                (Safe_Mutex : A_Safe_Mutex_T) return Integer;
private
    pragma Interface (Ada, Ts_Mutex_Init);
    pragma Interface_Name (Ts_Mutex_Init, "TS_MUTEX_INIT");
    pragma Interface (Ada, Ts_Mutex_Destroy);
    pragma Interface_Name (Ts_Mutex_Destroy, "TS_MUTEX_DESTROY");
    pragma Interface (Ada, Ts_Mutex_Lock);
    pragma Interface_Name (Ts_Mutex_Lock, "TS_MUTEX_LOCK");
    pragma Interface (Ada, Ts_Mutex_Trylock);
    pragma Interface_Name (Ts_Mutex_Trylock, "TS_MUTEX_TRYLOCK");
    pragma Interface (Ada, Ts_Mutex_Unlock);
    pragma Interface_Name (Ts_Mutex_Unlock, "TS_MUTEX_UNLOCK");

    pragma Interface (Ada, Ts_Cond_Init);
    pragma Interface_Name (Ts_Cond_Init, "TS_COND_INIT");
    pragma Interface (Ada, Ts_Cond_Destroy);
    pragma Interface_Name (Ts_Cond_Destroy, "TS_COND_DESTROY");
    pragma Interface (Ada, Ts_Cond_Wait);
    pragma Interface_Name (Ts_Cond_Wait, "TS_COND_WAIT");
    pragma Interface (Ada, Ts_Cond_Timed_Wait);
    pragma Interface_Name (Ts_Cond_Timed_Wait, "TS_COND_TIMED_WAIT");
    pragma Interface (Ada, Ts_Cond_Signal);
    pragma Interface_Name (Ts_Cond_Signal, "TS_COND_SIGNAL");
    pragma Interface (Ada, Ts_Cond_Broadcast);
    pragma Interface_Name (Ts_Cond_Broadcast, "TS_COND_BROADCAST");
    pragma Interface (Ada, Ts_Cond_Signal_Unlock);
    pragma Interface_Name (Ts_Cond_Signal_Unlock, "TS_COND_SIGNAL_UNLOCK");
    pragma Interface (Ada, Ts_Cond_Get_Wait_Head_Task);
    pragma Interface_Name (Ts_Cond_Get_Wait_Head_Task,
                           "TS_COND_GET_WAIT_HEAD_TASK");
    pragma Interface (Ada, Ts_Cond_Get_Wait_Count);
    pragma Interface_Name (Ts_Cond_Get_Wait_Count, "TS_COND_GET_WAIT_COUNT");

    pragma Interface (Ada, Ts_Ceiling_Mutex_Init);
    pragma Interface_Name (Ts_Ceiling_Mutex_Init, "TS_CEILING_MUTEX_INIT");
    pragma Interface (Ada, Ts_Ceiling_Mutex_Set_Priority);
    pragma Interface_Name (Ts_Ceiling_Mutex_Set_Priority,
                           "TS_CEILING_MUTEX_SET_PRIORITY");
    pragma Interface (Ada, Ts_Ceiling_Mutex_Get_Priority);
    pragma Interface_Name (Ts_Ceiling_Mutex_Get_Priority,
                           "TS_CEILING_MUTEX_GET_PRIORITY");
end V_I_Mutex;
DataMuseum.dk

Rational R1000/400

⟦ce54e268f⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
