Wrapping semaphores with FOOP classes

Started by Jeff, June 03, 2008, 07:47:09 AM

Previous topic - Next topic

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.


(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:


(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

=====

Old programmers don\'t die. They just parse on...



http://artfulcode.net\">Artful code

Jeff

#1
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/
Jeff

=====

Old programmers don\'t die. They just parse on...



http://artfulcode.net\">Artful code