/* ------------------------------------------------------------------ */ /* REXX procedure to use a REXX queue to simulate a semaphore */ /* based on an idea and code of Petges Romain */ /* (see EMail Addresses) */ /* */ /* */ /* (see also Simulate a semaphore and Using a file as semaphore) */ /* */ /* Summary of routines: */ /* */ /* CreateSemaphore */ /* DeleteSemaphore */ /* RequestSemaphore */ /* ReleaseSemaphore */ /* */ /* */ /* ------------------------------------------------------------------ */ /* function: create a semaphore */ /* */ /* call: CreateSemaphore {semName} */ /* */ /* where: SemName - name of the semaphore (def.: SEMWAIT) */ /* */ /* returns: 0 - semaphore created */ /* -1 - semaphore already exist */ /* else error */ /* */ CreateSemaphore: PROCEDURE parse arg SemName /* init the return code */ thisRC = -255 /* check the parameter */ semName = CheckSemaphoreName( semName ) /* try to create the queue */ newSem = rxQueue( "Create", semName ) if newSem <> semName then do /* semaphore already exist */ /* delete the just created queue */ call rxqueue "Delete", newSem /* set the return code */ thisRC = -1 end /* if rxQueue( ... */ else do /* semaphore successfull created */ /* release the semaphore */ thisRC = ReleaseSemaphore( semName ) end /* else */ RETURN thisRC /* ------------------------------------------------------------------ */ /* function: delete a semaphore */ /* */ /* call: DeleteSemaphore {semName} */ /* */ /* where: SemName - name of the semaphore (def.: SEMWAIT) */ /* */ /* returns: 0 - semaphore deleted */ /* else errorcode from RXQUEUE */ /* */ DeleteSemaphore: PROCEDURE parse arg SemName semName = CheckSemaphoreName( semName ) thisRC = rxQueue( "Delete", semName ) RETURN thisRC /* ------------------------------------------------------------------ */ /* function: release a semaphore */ /* */ /* call: ReleaseSemaphore {semName} */ /* */ /* where: SemName - name of the semaphore (def.: SEMWAIT) */ /* */ /* returns: 0 - semaphore released */ /* -1 - semaphore does not exist */ /* else error */ /* */ ReleaseSemaphore: PROCEDURE action = 'push "RELEASE"' signal RR_Semaphore /* ------------------------------------------------------------------ */ /* function: request a semaphore */ /* */ /* call: RequestSemaphore {semName} */ /* */ /* where: SemName - name of the semaphore (def.: SEMWAIT) */ /* */ /* returns: 0 - got the semaphore */ /* -1 - semaphore does not exist */ /* else error */ /* */ RequestSemaphore: PROCEDURE action = 'call LineIn "QUEUE:"' RR_Semaphore: parse arg SemName /* init the return code */ thisRC = 0 /* check the parameter */ semName = CheckSemaphoreName( semName ) /* try to create the queue */ newSem = rxQueue( "Create", semName ) /* ... and delete it */ call rxqueue "Delete", newSem if newSem <> semName then do /* semaphore exist */ /* save the current queue name */ curQueue = RxQueue( "Get" ) /* make the semaphore queue the active queue */ call rxQueue "Set", semName /* check for errors */ if rxqueue( "Get" ) = semName then interpret action /* wait for the semaphore */ /* or free it */ else thisRC = -2 /* error activating the queue */ /* restore the active queue */ call rxQueue "Set", curQueue end /* if rxQueue( ... */ else do /* semaphore does not exist */ /* set the return code */ thisRC = -1 end /* else */ RETURN thisRC /* ------------------------------------------------------------------ */ /* sub routine to check the name of the semaphore and use the default */ /* if the name is missing */ /* */ CheckSemaphoreName: PROCEDURE parse upper arg SemName if SemName = "" then semName = "SEMWAIT" RETURN semName /* ------------------------------------------------------------------ */