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

⟦ea35093b9⟧ Ada Source

    Length: 8192 (0x2000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package V_I_Sema, seg_0509cc

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 1986,1987,1988,1992 Verdix Corporation

------------------------------------------------------------------------------
-- User interface to the binary semaphore data structure 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 semaphore data structures and
-- subprograms found in ada_krn_defs.a and ada_krn_i.a.
--
-- Differences from earlier releases:
--  [1] Semaphore must be initialized by calling the newly added routine,
--      init_sema().
--  [2] For VADS_MICRO, only FIFO queueing is supported. For priority
--      queueing use the mutex and condition variable services provided
--\x09\x09in ada_krn_i.a.
--  [3] The following services aren't supported: suspend(), timed_suspend()
--\x09\x09or resume().
------------------------------------------------------------------------------
with System;
with Ada_Krn_Defs;
with Unchecked_Conversion;
package V_I_Sema is

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

    V_I_Sema_Not_Supported : exception;

    --------------------------------------------------------------------------
    -- Semaphore data structure. An object of this type must be declared
    -- and initialized via init_sema() before calling any of the semaphore
    -- subprograms.
    --
    -- For example:
    --  declare
    --      my_semaphore: v_i_sema.semaphore_rec;
    --\x09\x09result: boolean;
    --  begin
    --\x09\x09result := v_i_sema.init_sema(
    --\x09\x09\x09v_i_sema.to_a_semaphore(my_semaphore'address),
    --\x09\x09\x09v_i_sema.SEMAPHORE_EMPTY);
    --
    --\x09\x09...
    --
    --      v_i_sema.enter(v_i_sema.to_a_semaphore(my_semaphore'address));
    --  end;
    --------------------------------------------------------------------------

    type Semaphore_Rec is new Ada_Krn_Defs.Semaphore_T;
    type A_Semaphore is new Ada_Krn_Defs.A_Semaphore_T;
    function To_A_Semaphore is new Unchecked_Conversion
                                      (System.Address, A_Semaphore);

    type Semaphore_State_T is new Ada_Krn_Defs.Semaphore_State_T;
    Semaphore_Full : constant Semaphore_State_T :=
       Semaphore_State_T (Ada_Krn_Defs.Semaphore_Full);
    Semaphore_Empty : constant Semaphore_State_T :=
       Semaphore_State_T (Ada_Krn_Defs.Semaphore_Empty);

    --------------------------------------------------------------------------
    -- Subprogram to initialize the semaphore record. Returns TRUE if the
    -- semaphore was successfully initialized.
    --
    -- Newly added subprogram. Since the semaphore record content
    -- depends on the underlying kernel (VADS_MICRO, SUN_THREADS, SGI_THREADS),
    -- you can no longer explicitly initialize the record fields as was
    -- done in earlier VADS releases.
    --------------------------------------------------------------------------
    function Init_Sema (S : A_Semaphore;
                        Init_State : Semaphore_State_T := Semaphore_Empty)
                       return Boolean;
    pragma Inline_Only (Init_Sema);

    --------------------------------------------------------------------------
    -- Subprograms to enter a critical region guarded by a semaphore.
    --  enter               - returns when in critical region. This may
    --                        necessitate suspension of current task until
    --                        another task leaves the critical region.
    --  conditional_enter   - like "enter" except that it returns immediately
    --                        with a return value of FALSE, if the critical
    --                        region cannot be entered right away
    --  timed_enter         - like "enter" except that if it cannot enter within
    --                        a specified amount of time, it returns a value =
    --                        FALSE
    --------------------------------------------------------------------------
    procedure Enter (S : A_Semaphore);
    pragma Inline_Only (Enter);
    function Conditional_Enter (S : A_Semaphore) return Boolean;
    pragma Inline_Only (Conditional_Enter);
    function Timed_Enter (S : A_Semaphore; Timeout : Duration) return Boolean;
    pragma Inline_Only (Timed_Enter);

    --------------------------------------------------------------------------
    -- Leaves a critical region previously entered. Resumes next task
    -- suspended on waiting to enter.
    --------------------------------------------------------------------------
    procedure Leave (S : A_Semaphore);
    pragma Inline_Only (Leave);

    --------------------------------------------------------------------------
    -- Subprograms to suspend the current task on semaphore queue
    --  suspend         - task is suspended until semaphore is resumed
    --  timed_suspend   - like "suspend" except that if task is not resumed
    --                    within a specified amount of time, it returns a
    --                    value = FALSE
    --
    -- Not Supported. If called, raise the exception, V_I_SEMA_NOT_SUPPORTED.
    --------------------------------------------------------------------------
    procedure Suspend (S : A_Semaphore);
    pragma Inline_Only (Suspend);
    function Timed_Suspend (S : A_Semaphore; Timeout : Duration) return Boolean;
    pragma Inline_Only (Timed_Suspend);

    --------------------------------------------------------------------------
    -- Resumes all tasks previously suspended on semaphore queue
    --
    -- Not Supported. If called, raises the exception, V_I_SEMA_NOT_SUPPORTED.
    --------------------------------------------------------------------------
    procedure Resume (S : A_Semaphore);
    pragma Inline_Only (Resume);
nd V_I_Sema;

E3 Meta Data

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=17 rec1=00 rec2=01 rec3=044
        [0x01] rec0=1e rec1=00 rec2=02 rec3=084
        [0x02] rec0=14 rec1=00 rec2=03 rec3=022
        [0x03] rec0=10 rec1=00 rec2=04 rec3=032
        [0x04] rec0=13 rec1=00 rec2=05 rec3=03a
        [0x05] rec0=14 rec1=00 rec2=06 rec3=002
        [0x06] rec0=02 rec1=00 rec2=07 rec3=000
    tail 0x2154af6d2878e7a04aa80 0x42a00088462060003