Locking with semaphores in newLISP
Recent development version of newLISP have a new forking mechanism that makes spawning new processes and collecting the results much simpler.
However, for long-running processes that intermittently access shared data (for example, using the (share) function), semaphores are used to lock that data. Technically, newLISP semaphores are counting semaphores (semaphores that may be incremented above 1), rather than binary semaphores (which are the equivalent of mutually exclusive locks).
These functions that wrap the semaphore command. They function as binary semaphores. Included is a macro with-lock-held, which executes its body with the passed lock acquired.
(constant 'ACQUIRE -1 'RELEASE 1) ;;; Convenience functions, macros (define-macro (with-lock-held) (letex ((lock (args 0)) (body (cons 'begin (rest (args))))) (:acquire lock) (let ((res body)) (:release lock) res))) (define (getpid) (sys-info 6)) (global 'with-lock-held '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."))))
Here is a quick sample of how to use the locks to synchronize access to a page of shared memory:
;;; create a shared resource that to be protected by a lock (setq mem (share)) (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"
The same may be done more concisely using with-lock-held:
;;; create a shared resource that to be protected by a lock (setq mem (share)) (setq mem-lock (Lock)) (with-lock-held mem-lock (share mem "foo") (spawn 's (with-lock-held mem-lock (share mem "bar"))))