Wrapping semaphores with FOOP classes

[Jeff]

I use these functions to make semaphores simpler to use.  Included is a recursive lock, which permits the following logic:



create rlock

acquire rlock

further down in code, call function that also acquires rlock (then releases it)

release rlock



It does this by using a counting semaphore to track depth and a page of shared memory to track the current owner's pid.



Regular locks function like mutexes (binary semaphores.)  They only permit on level of locking, and are much faster than rlocks (but not as useful.)



It is an error for a process to attempt to release a lock which it does not hold.

Code Select Expand

(constant 'ACQUIRE -1 'RELEASE 1)

(define (getpid) (sys-info 6))
(global 'getpid)

;;; Locks are generic binary-style semaphores like mutexes.

(define (Lock:Lock)
  (let ((sem (semaphore)) (pid (share)))
    (semaphore sem RELEASE)
    (share pid nil)
    (list (context) sem pid)))

(define (Lock:acquire lock)
  (semaphore (lock 1) ACQUIRE)
  (share (lock 2) (getpid)))

(define (Lock:release lock)
  (if (= (getpid) (share (lock 2)))
    (begin
      (semaphore (lock 1) RELEASE)
      (share (lock 2) nil))
    (throw-error "Cannot release lock that is locked by another process.")))

;;; Recursive locks (RLocks) are locks that "owned" by a
;;; locking process and are not re-locked by subsequent code
;;; in the same process.

(define (RLock:RLock)
  (let ((sem (semaphore)) (depth (semaphore)) (pid (share)))
    (semaphore sem RELEASE)
    (semaphore depth 0)
    (share pid nil)
    (list (context) sem depth pid)))

(define (RLock:acquire lock)
  (let ((sem (lock 1)) (depth (lock 2)) (pid (lock 3)))
    (if (= (share pid) (getpid))
      (semaphore depth 1)
      (begin
        (semaphore sem ACQUIRE)
        (semaphore depth 1)
        (share pid (getpid))))))

(define (RLock:release lock)
  (let ((sem (lock 1)) (depth (lock 2)) (pid (lock 3)))
    (if (= (share pid) (getpid))
      (begin
        (semaphore depth -1)
        (when (= 0 (semaphore depth))
          (share pid nil)
          (semaphore sem RELEASE)))
      (throw-error "Cannot release rlock that is locked by another process."))))

Sample lock usage:

Code Select Expand

(setq mem (share)) ; shared resource that needs to be protected by a lock
(setq mem-lock (Lock))

(:acquire mem-lock)
(share mem "foo")
(spawn 's
  (begin
    (:acquire mem-lock)
    (share mem "bar")
    (:release mem-lock)))
;;; at this point, the spawned process is blocking, waiting for us
;;; to release mem-lock. mem still holds "foo"
(:release mem-lock)
;;; now, the spawned process continues, and sets mem to "bar"

[Jeff]

Now that my site is back after suffering a two day outage due to a Texan explosion, I've posted this:



http://www.artfulcode.net/articles/locking-semaphores-newlisp/">http://www.artfulcode.net/articles/lock ... s-newlisp/">http://www.artfulcode.net/articles/locking-semaphores-newlisp/