Locks in Allegro CL 9.0 SMP

Allegro CL 9.0 on Windows, Linux, and the Mac comes with a version which supports Symmetric MultiProcessing (SMP), which means that it can utilize more than one hardware processor at the same time. (On all supported platforms, a non-SMP version of Allegro CL 9.0 is also available.) This is the third of a series of Tech Corner articles which discuss aspects of SMP.

In this article, we discuss locks, which are important tools for ensuring that different processes do not interfere with each other when modifying data. Our example will include sharable locks, which are a new feature that allows locks to be shared by appropriate processes while other processes must wait.

Like many examples of complex tools, this one is somewhat artificial, but we hope you can adapt it to your specific programming needs. The task environment is as follows:

  • There is a vector of values (of changing length)
  • There is a master thread that fills the vector
  • There are two worker threads, one of which works just on the even elements of the vector and the other of which works just on the odd elements

We will show how this can be coded using process locks and then using shared locks.

A: using process-lock

The master thread and worker threads run safely but workers fail to run in parallel because only one can hold the lock.

B: using shareable-lock

The master and workers run safely and workers can run simultaneously in SMP.

We start with example A:

(in-package :user)

(eval-when (compile load eval)
  (require :smputil)
  (use-package :mp))

;; Here are two simple functions that create the vector and do work.
;; Define your own functions for a more interesting example.

(defun make-vector-of-some-length ()
  (make-array 100000 :initial-element 0))
(defun do-something-to-vector (vec index)
  (setf (aref vec index) (get-universal-time)))

;; We define a structure that controls work for case A. See
;; make-gate and make-process-lock
(defstruct work-place-a 
   (lock (make-process-lock))
   work
   done
   (start-gate (make-gate nil)) ;; start-gate is closed
   (end-gate (make-gate t))     ;; end-gate is open
   )

;; Theses is the associated functions for case A.
(defun master-a (wp)
  (loop
    (process-wait "" #'gate-open-p (work-place-a-end-gate wp))
    (with-process-lock ((work-place-a-lock wp))
      (setf (work-place-a-work wp) (make-vector-of-some-length))
      (close-gate (work-place-a-end-gate wp))
      (setf (work-place-a-done wp) 0)
      (open-gate (work-place-a-start-gate wp)))))

(defun worker-a (wp start)
  (loop
    (process-wait "" #'gate-open-p (work-place-a-start-gate wp))
    (with-process-lock ((work-place-a-lock wp))
       (do ((i start (+ i 2)))
	   ((not (< i (length (work-place-a-work wp)))))
	 (do-something-to-vector (work-place-a-work wp) i))
       (when (eql 2 (incf (work-place-a-done wp)))
	 (close-gate (work-place-a-start-gate wp))
	 (open-gate (work-place-a-end-gate wp))))))

(defun run-a (&aux (wp (make-work-place-a)))
  (process-run-function "Worker0" #'worker-a wp 0)
  (process-run-function "Worker1" #'worker-a wp 1)
  (process-run-function "Master" #'master-a wp))

We start three processes, but the two worker processes cannot run simultaneously because there is only one lock (WORK-PLACE-A-LOCK) which can only be held by one process at a time.

Now we move to example B. We create new work-place-b structure with a sharable-lock (see make-sharable-lock), and new worker and master functions:

(defstruct work-place-b 
   (lock (make-sharable-lock))
   work
   to-start
   to-finish
   (start-gate (make-gate nil)) ;; holds up workers until there's work
   (end-gate (make-gate nil))   ;; holds workers until all are finished
   (master-gate (make-gate t))  ;; holds master until work is done
   )

(defun do-some-setup-work ()
   ;; some stuff the worker needs to do
   ;; before looking at the data,and
   ;; can profitably do in parallel with the
   ;; master setting up the data
   )

(defun master-b (wp)
  (loop
    (process-wait "" #'gate-open-p (work-place-b-master-gate wp))
    (with-sharable-lock (:exclusive (work-place-b-lock wp))
      ;; first set up the counts for synchronization
      (setf (work-place-b-to-start wp) 2
            (work-place-b-to-finish wp) 2)
      ;; then let the workers start their warm-up
      (open-gate (work-place-b-start-gate wp))
      ;; now we do our processing (in parallel with the warm-up)
      (setf (work-place-b-work wp) (make-vector-of-some-length))
      ;; and close our gate so the workers can tell us when to go again
      (close-gate (work-place-b-master-gate wp)))))


(defun worker-b (wp start)
    (loop 
      (process-wait "" #'gate-open-p (work-place-b-start-gate wp))
      (when (eq 0 (decf-atomic (work-place-b-to-start wp)))
        ;; last one has started. Make sure no one can start again
        ;; until the master says ok
        (close-gate (work-place-b-start-gate wp)))
      (do-some-setup-work) ;; in parallel with master
      (with-sharable-lock (:shared (work-place-b-lock wp))
         ;; this will be held up until the master is done with the data
         (do ((i start (+ i 2)))
             ((not (< i (length (work-place-b-work wp)))))
	   (do-something-to-vector (work-place-b-work wp) i)))
      ;; we are done with the data, so we released the lock

      ;; now we synch with the other workers
      (if* (eq 0 (decf-atomic (work-place-b-to-finish wp)))
         then ;; all the workers have made it here, so they have all
              ;; gone through the start gate. That means the last one
              ;; through has already closed the start-gate, and we
              ;; can safely all pile back and wait there.
              (open-gate (work-place-b-end-gate wp))
              ;; And the master can be told we're all done
              (open-gate (work-place-b-master-gate wp))
         else ;; still waiting on some worker to finish
              (process-wait "" #'gate-open-p (work-place-b-end-gate wp)))))


(defun run-b (&aux (wp (make-work-place-b)))
  (process-run-function "Worker0" #'worker-b wp 0)
  (process-run-function "Worker1" #'worker-b wp 1)
  (process-run-function "Master" #'master-b wp))

Because both worker processes share the sharable lock (and, by our design, work on distinct stored data), both can run simultaneously. The master process, however, must complete before either worker process can start because it hold the lock exclusively.

We have additional gates to ensure easch process knows when they can start and when others have finished.

Copyright © 2023 Franz Inc., All Rights Reserved | Privacy Statement Twitter