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

⟦66c469269⟧ Ada Source

    Length: 15360 (0x3c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package V_Semaphores, seg_03bda4

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



with V_Interrupts;
package V_Semaphores is

    pragma Suppress (All_Checks);

--   PURPOSE : V_SEMAPHORES provides binary or counting semaphores.
--
--             The following operations are overloaded and applicable to
--             either binary or counting semaphores.
--
--             The operation CREATE_SEMAPHORE creates a semaphore
--             with an initial semaphore count.  The semaphore count
--             indicates the number of available resources; i.e., an
--             initial value of one would allow only one task at a
--             time to access the semaphore.
--
--             For binary semaphores, the initial semaphore count is restricted
--             to 0 or 1. A count of 1 indicates the resource is initially
--             available.
--
--             WAIT_SEMAPHORE decrements the semaphore's count, causing
--             the task to block on the semaphore if the semaphore is not
--             available (the count becomes negative).  Blocked tasks
--             are queued on the semaphore in priority order, where
--             priorities have been specified via pragma PRIORITY.
--             Within priority levels, tasks are queued on a first-in-
--             first-out basis.  The task must specify how long it is
--             willing to wait for the semaphore.
--
--             WAIT_SEMAPHORE has been declared as an overloaded procedure
--             to allow the user to select the method of error notification.
--             If a result parameter is provided in the call, a result status
--             will be returned in the parameter; otherwise, an exception
--             will be raised if an error occurs.
--
--             SIGNAL_SEMAPHORE will increment the semaphore's count,
--             awakening a task waiting on the semaphore, if any are
--             waiting.
--
--             DELETE_SEMAPHORE deletes a semaphore.  The user must
--             specify the action to be taken if there are currently
--             tasks waiting on the semaphore.
--
--     NOTES : A task awakened by a signal to a semaphore may pre-empt
--             the currently executing task if the awakened task is of
--             sufficient priority.


    -- The following type is used to identify a binary semaphore.

    type Binary_Semaphore_Id is private;

    -- The following type is used to identify a counting semaphore.

    type Count_Semaphore_Id is private;

    -- The following type restricts the range for the initial count of a
    -- binary semaphore

    subtype Binary_Count_T is Integer range 0 .. 1;


    -- Objects of the following type are used to specify the action to take
    -- during a call to DELETE_SEMAPHORE if tasks are waiting on the semaphore
    -- that is to be deleted.

    type Semaphore_Delete_Option is
       (Delete_Option_Force, Delete_Option_Warning);

    -- Where:
    --
    --   DELETE_OPTION_FORCE      delete the semaphore even though
    --                            there may be tasks waiting at the
    --                            semaphore.
    --
    --   DELETE_OPTION_WARNING    indicates that the semaphore should
    --                            only be deleted if there are no
    --                            waiting tasks.


    -- The following constants may be used with WAIT_SEMAPHORE to specify
    -- that the semaphore should either be waited on indefinitely or not
    -- at all, respectively.

    Wait_Forever : constant Duration := -1.0;
    Do_Not_Wait : constant Duration := 0.0;


    -- The following exceptions may be raised by the semaphore services:

    No_Memory_For_Semaphore : exception;

    -- NO_MEMORY_FOR_SEMAPHORE is raised if an attempt is made to
    -- create a semaphore and there is not sufficient memory for
    -- the semaphore object in the system pool.

    Semaphore_In_Use : exception;

    -- SEMAPHORE_IN_USE is raised if an attempt is made to delete
    -- a semaphore when tasks are waiting on the semaphore and
    -- delete_option_warning has been specified.

    Semaphore_Deleted : exception;

    -- SEMAPHORE_DELETED is raised by WAIT_SEMAPHORE if the semaphore
    -- was deleted while the task was waiting.

    Semaphore_Not_Available : exception;

    -- SEMAPHORE_NOT_AVAILABLE is raised by WAIT_SEMAPHORE if a non-waited
    -- attempt was made to obtain the semaphore, and the semaphore was
    -- not available.

    Semaphore_Timed_Out : exception;

    -- SEMAPHORE_TIMED_OUT is raised by WAIT_SEMAPHORE if a timed wait
    -- was attempted and the semaphore did not become available in the
    -- given time interval.

    Unexpected_V_Semaphore_Error : exception;

    -- UNEXPECTED_V_SEMAPHORE_ERROR may be raised if an unexpected
    -- error occurs during an V_SEMAPHORES operation.


    -- The following type declares the result codes which may be returned
    -- by the non-exception-raising version of the WAIT_SEMAPHORE
    -- routine.

    type Semaphore_Result is (Obtained, Timed_Out, Not_Available, Deleted);

    -- WAIT_SEMAPHORE returns OBTAINED if the semaphore was obtained,
    -- TIMED_OUT if a timed wait was performed and the semaphore was
    -- not obtained in the specified interval, NOT_AVAILABLE if a
    -- non-waited access was attempted and the semaphore was not
    -- available, or DELETED if the semaphore was deleted while
    -- the current task was waiting for it.


    procedure Create_Semaphore (Initial_Count : in Binary_Count_T := 1;
                                Semaphore : out Binary_Semaphore_Id);


    function Create_Semaphore (Initial_Count : in Binary_Count_T := 1)
                              return Binary_Semaphore_Id;

    procedure Create_Semaphore
                 (Initial_Count : in Integer := 1;
                  Semaphore : out Count_Semaphore_Id;
                  Interrupt_Flag : in Boolean := False;
                  Interrupt_Status : in V_Interrupts.Interrupt_Status_T :=
                     V_Interrupts.Disable_Interrupt);

    function Create_Semaphore
                (Initial_Count : in Integer := 1;
                 Interrupt_Flag : in Boolean := False;
                 Interrupt_Status : in V_Interrupts.Interrupt_Status_T :=
                    V_Interrupts.Disable_Interrupt) return Count_Semaphore_Id;

    --  Purpose:   CREATE_SEMAPHORE creates and initializes a binary
    --             or counting semaphore. Two versions are supplied for
    --             each semaphore type, a procedure
    --             that returns semaphore id as an out parameter or a function
    --             returning the semaphore id.
    --
    --  Where:
    --
    --    initial_count     indicates the initial value of the semaphore
    --                      counter (initial number of resources allocated   --                      to the semaphore). A binary semaphore is restricted
    --                      to an initial value of 0 or 1.
    --
    --    semaphore         identifies the semaphore created.
    --
    --    interrupt_flag    normally, the critical region for updating the
    --                      semaphore's count is protected by a binary
    --                      semaphore.  However, if INTERRUPT_FLAG is TRUE,
    --                      then its critical region is protected by disabling
    --                      interrupts using the INTERRUPT_STATUS parameter.
    --                      INTERRUPT_FLAG must be set to TRUE if the
    --                      counting semaphore is accessed from an ISR.
    --                      Defaults to FALSE.  Not applicable to binary
    --                      semaphores.
    --
    --    interrupt_status  if above INTERRUPT_FLAG is TRUE, then this value
    --                      is used to disable interrupts. Defaults to
    --                      disabling all interrupt levels.  Not applicable
    --                      to binary semaphores.
    --
    --  Exceptions:
    --
    --    NO_MEMORY_FOR_SEMAPHORE is raised if the semaphore could not
    --    be created due to insufficient memory.



    procedure Delete_Semaphore (Semaphore : in Binary_Semaphore_Id;
                                Delete_Option : in Semaphore_Delete_Option);

    procedure Delete_Semaphore (Semaphore : in Count_Semaphore_Id;
                                Delete_Option : in Semaphore_Delete_Option);

    --  Purpose:  DELETE_SEMAPHORE deletes a semaphore.
    --
    --  Where:
    --
    --    semaphore       identifies the semaphore to be deleted.
    --
    --    delete_option   specifies the action to be taken if the
    --                    semaphore is in use:
    --
    --                    when delete_option_force =>
    --
    --                      Ready all waiting tasks.  These tasks' calls
    --                      to WAIT_SEMAPHORE will raise the exception
    --                      SEMAPHORE_DELETED, or return the result value
    --                      DELETED.
    --
    --                      The semaphore is deleted.
    --
    --                    when delete_option_warning =>
    --
    --                      Raise the exception SEMAPHORE_IN_USE in the
    --                      calling task.
    --
    --                      The semaphore is not deleted.
    --
    --  Exceptions:
    --
    --    SEMAPHORE_IN_USE is raised if delete_option_warning was
    --    specified and tasks were waiting on the semaphore.

    procedure Signal_Semaphore (Semaphore : in Binary_Semaphore_Id);

    procedure Signal_Semaphore (Semaphore : in Count_Semaphore_Id);


    --  Purpose:   SIGNAL_SEMAPHORE performs a signal operation on
    --             a semaphore.
    --
    --  Where:
    --
    --    semaphore   identifies the semaphore to be signaled.
    --
    --  Notes:     If there are any tasks waiting on the semaphore, the
    --             signal operation will cause the waiting task to be
    --             readied.  If the readied task has a priority higher
    --             than the currently running task, then the waiting
    --             task will pre-empt the currently running task.
    --
    --             This service may be called from an interrupt
    --             service routine.
    --
    --  Exceptions:
    --
    --    None.


    procedure Wait_Semaphore (Semaphore : in Binary_Semaphore_Id;
                              Wait_Time : in Duration);
    procedure Wait_Semaphore (Semaphore : in Binary_Semaphore_Id;
                              Wait_Time : in Duration;
                              Result : out Semaphore_Result);
    procedure Wait_Semaphore (Semaphore : in Count_Semaphore_Id;
                              Wait_Time : in Duration);
    procedure Wait_Semaphore (Semaphore : in Count_Semaphore_Id;
                              Wait_Time : in Duration;
                              Result : out Semaphore_Result);

    --  Purpose:   WAIT_SEMAPHORE performs a wait operation on a
    --             semaphore.
    --
    --             WAIT_SEMAPHORE should not be called from an
    --             interrupt service routine.
    --
    --  Where:
    --
    --    semaphore   identifies the semaphore on which to wait.
    --
    --    wait_time   specifies the amount of time the user is
    --                willing to wait for the resource governed by
    --                the semaphore.  Wait_time options are:
    --
    --                if wait_time = WAIT_FOREVER then
    --                  willing to wait forever
    --                elsif wait_time = DO_NOT_WAIT
    --                  do not wait if semaphore is not available
    --                else
    --                  wait wait_time seconds for
    --                  the semaphore to become available.
    --                end if
    --
    --  Exceptions/Results:
    --
    --    SEMAPHORE_DELETED is raised (or result value DELETED is returned)
    --    if the semaphore was deleted while the task was waiting.
    --
    --    SEMAPHORE_NOT_AVAILABLE is raised (or result value NOT_AVAILABLE
    --    is returned) if DO_NOT_WAIT was specified and the semaphore was
    --    not available.
    --
    --    SEMAPHORE_TIMED_OUT is raised (or result value TIMED_OUT is returned)
    --    if the semaphore could not be obtained within the specified time
    --    interval.
    --
    --    The result value OBTAINED is returned if the semaphore is obtained.


private
    type Binary_Semaphore_Rec;
    type Binary_Semaphore_Id is access Binary_Semaphore_Rec;

    type Count_Semaphore_Rec;
    type Count_Semaphore_Id is access Count_Semaphore_Rec;
end V_Semaphores;



E3 Meta Data

    nblk1=e
    nid=0
    hdr6=1c
        [0x00] rec0=18 rec1=00 rec2=01 rec3=054
        [0x01] rec0=12 rec1=00 rec2=02 rec3=042
        [0x02] rec0=1f rec1=00 rec2=03 rec3=02a
        [0x03] rec0=1b rec1=00 rec2=04 rec3=014
        [0x04] rec0=1b rec1=00 rec2=05 rec3=064
        [0x05] rec0=17 rec1=00 rec2=06 rec3=066
        [0x06] rec0=15 rec1=00 rec2=07 rec3=002
        [0x07] rec0=10 rec1=00 rec2=08 rec3=06c
        [0x08] rec0=1c rec1=00 rec2=09 rec3=03e
        [0x09] rec0=1c rec1=00 rec2=0a rec3=008
        [0x0a] rec0=17 rec1=00 rec2=0b rec3=02a
        [0x0b] rec0=17 rec1=00 rec2=0c rec3=02c
        [0x0c] rec0=1a rec1=00 rec2=0d rec3=06e
        [0x0d] rec0=04 rec1=00 rec2=0e rec3=000
    tail 0x215347ed685657433e022 0x42a00088462060003