Wrapping semaphores with FOOP classes

Pondering the philosophy behind the language
Locked
Jeff
Posts: 604
Joined: Sat Apr 07, 2007 2:23 pm
Location: Ohio
Contact:

Wrapping semaphores with FOOP classes

Post by 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 all

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

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

Artful code

Jeff
Posts: 604
Joined: Sat Apr 07, 2007 2:23 pm
Location: Ohio
Contact:

Post by 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/lock ... s-newlisp/
Jeff
=====
Old programmers don't die. They just parse on...

Artful code

Locked