DataMuseum.dk

top - download

    Length: 4673 (0x1241)
    Types: TextFile
    Names: »V«

└─⟦516dceb10⟧ Bits:30000751 8mm tape, Rational 1000, RCI_VADS
    └─ ⟦9a14c9417⟧ »DATA« 
        └─⟦this⟧ 

TextFile

-- Copyright 1986,1987,1988 Verdix Corporation

------------------------------------------------------------------------------
-- User interface to the binary semaphore data structure and subprograms
------------------------------------------------------------------------------
WITH System;
WITH V_I_Types;
WITH Unchecked_Conversion;
PACKAGE V_I_Sema IS

   PRAGMA Suppress (All_Checks);
   PRAGMA Suppress (Exception_Tables);
   PRAGMA Not_Elaborated;

   --------------------------------------------------------------------------
   -- Semaphore data structure. An object of this type must be declared
   -- and initialized before calling any of the semaphore subprograms.
   --
   -- For example:
   --  declare
   --      my_semaphore: v_i_sema.semaphore_rec := (
   --          queue => v_i_types.null_task,
   --          flag => v_i_types.test_and_set_false,
   --          others_waiting => v_i_types.test_and_set_false,
   --			enter_task => v_i_types.null_task,
   --			enter_priority => system.priority'first
   --      );
   --  begin
   --      v_i_sema.enter(v_i_sema.to_a_semaphore(my_semaphore'address));
   --  end;
   --------------------------------------------------------------------------
   TYPE Semaphore_Rec IS
      RECORD
         Queue          : V_I_Types.A_Task_T;
         Flag           : V_I_Types.Test_And_Set_T;
         Others_Waiting : V_I_Types.Test_And_Set_T;
         Enter_Task     : V_I_Types.A_Task_T;
         Enter_Priority : System.Priority;
      END RECORD;
   TYPE A_Semaphore IS ACCESS Semaphore_Rec;
   FUNCTION To_A_Semaphore IS NEW Unchecked_Conversion
                                     (System.Address, A_Semaphore);

   -- Note: above enter_task and enter_priority fields are only updated if
   -- PRIORITY_INHERITANCE_ENABLED configuration parameter is set.

   --------------------------------------------------------------------------
   -- 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);
   FUNCTION  Conditional_Enter (S : A_Semaphore) RETURN Boolean;
   FUNCTION  Timed_Enter (S : A_Semaphore; Timeout : Duration) RETURN Boolean;

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

   --------------------------------------------------------------------------
   -- 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
   --------------------------------------------------------------------------
   PROCEDURE Suspend (S : A_Semaphore);
   FUNCTION Timed_Suspend (S : A_Semaphore; Timeout : Duration) RETURN Boolean;

   --------------------------------------------------------------------------
   -- Resumes all tasks previously suspended on semaphore queue
   --------------------------------------------------------------------------
   PROCEDURE Resume (S : A_Semaphore);

PRIVATE
   PRAGMA Interface (Ada, Enter);
   PRAGMA Interface_Name (Enter, "__ENTER");
   PRAGMA Interface (Ada, Conditional_Enter);
   PRAGMA Interface_Name (Conditional_Enter, "__CONDITIONAL_ENTER");
   PRAGMA Interface (Ada, Timed_Enter);
   PRAGMA Interface_Name (Timed_Enter, "__TIMED_ENTER");
   PRAGMA Interface (Ada, Leave);
   PRAGMA Interface_Name (Leave, "__LEAVE");
   PRAGMA Interface (Ada, Suspend);
   PRAGMA Interface_Name (Suspend, "__SUSPEND");
   PRAGMA Interface (Ada, Timed_Suspend);
   PRAGMA Interface_Name (Timed_Suspend, "__TIMED_SUSPEND");
   PRAGMA Interface (Ada, Resume);
   PRAGMA Interface_Name (Resume, "__RESUME");
END V_I_Sema;