|
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: 6946 (0x1b22) 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« └─⟦d1707af99⟧ └─⟦this⟧
-- 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 -- in ada_krn_i.a. -- [3] The following services aren't supported: suspend(), timed_suspend() -- or 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; -- result: boolean; -- begin -- result := v_i_sema.init_sema( -- v_i_sema.to_a_semaphore(my_semaphore'address), -- v_i_sema.SEMAPHORE_EMPTY); -- -- ... -- -- 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); end v_i_sema; with system; with ada_krn_defs; with ada_krn_i; package body v_i_sema is function init_sema( s : a_semaphore; init_state : semaphore_state_t := SEMAPHORE_EMPTY) return boolean is begin return ada_krn_i.semaphore_init(ada_krn_defs.a_semaphore_t(s), ada_krn_defs.semaphore_state_t(init_state), ada_krn_defs.DEFAULT_SEMAPHORE_ATTR); end; procedure enter(s: a_semaphore) is begin ada_krn_i.semaphore_wait(ada_krn_defs.a_semaphore_t(s)); end; function conditional_enter(s: a_semaphore) return boolean is begin return ada_krn_i.semaphore_trywait(ada_krn_defs.a_semaphore_t(s)); end; function timed_enter(s: a_semaphore; timeout: duration) return boolean is begin return ada_krn_i.semaphore_timed_wait(ada_krn_defs.a_semaphore_t(s), timeout); end; procedure leave(s: a_semaphore) is begin ada_krn_i.semaphore_signal(ada_krn_defs.a_semaphore_t(s)); end; procedure suspend(s: a_semaphore) is begin raise V_I_SEMA_NOT_SUPPORTED; end; function timed_suspend(s: a_semaphore; timeout: duration) return boolean is begin raise V_I_SEMA_NOT_SUPPORTED; return FALSE; end; procedure resume(s: a_semaphore) is begin raise V_I_SEMA_NOT_SUPPORTED; end; end v_i_sema