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

⟦7d9e727ef⟧ Ada Source

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

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

-- 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,
   --\x09\x09\x09enter_task => v_i_types.null_task,
   --\x09\x09\x09enter_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;

    nblk1=7
    nid=0
    hdr6=e
        [0x00] rec0=1a rec1=00 rec2=01 rec3=048
        [0x01] rec0=17 rec1=00 rec2=02 rec3=050
        [0x02] rec0=00 rec1=00 rec2=07 rec3=02e
        [0x03] rec0=10 rec1=00 rec2=03 rec3=01e
        [0x04] rec0=00 rec1=00 rec2=06 rec3=004
        [0x05] rec0=11 rec1=00 rec2=04 rec3=048
        [0x06] rec0=13 rec1=00 rec2=05 rec3=000
    tail 0x21739b9328565745e9d66 0x489e0066482863c01