Mr. Lamkin's implementation of Edsgar Dijkstra's famous [http://en.wikipedia.org/wiki/Dining_philosophers dining philosophers] problem uses [http://www.openmcl.org/openmcl-wiki/DigiTool DigiTool] MCL-style processes and locks, which are implemented differently in OpenMCL.

{{{
DigiTool MCL-style processes and locks, which are implemented differently in OpenMCL.

;;;
;;;   Dining Philosophers, from David B. Lamkin's book "Successful Lisp"
;;;   Publisher: bookfix.com (December 8, 2004)
;;;   ISBN: 3937526005
;;;
;;;   Converted to work under OpenMCL by Brent Fulgham (10/2006)
;;;
(defstruct philosopher
  (amount-eaten 0)
  (task nil))

(defmacro acquire-lock-or-skip (lock post-acquire pre-release &body body)
  `(progn
     ;; Random sleep makes the output more interesting 
     ;; by introducing variability into the order of 
     ;; execution.  This is a simple way of simulating 
     ;; the nondeterminacy that would result from having 
     ;; additional processes compete for CPU cycles. 
     (sleep (random 5))
     (unless (ccl::%%lock-owner ,lock)
       (grab-lock ,lock)
       ,post-acquire
       (unwind-protect
         (progn ,@body)
         ,pre-release
         (release-lock ,lock)))))

(let ((philosophers #())
      (philosophers-output t))

  (defun dining-philosophers (number-of-philosophers &optional (stream t))
    (unless (equalp philosophers #())
      (stop-philosophers))
    (assert (> number-of-philosophers 1) (number-of-philosophers))
    (setq philosophers-output stream)
    (format philosophers-output
            "~2&Seating ~D philosophers for dinner.~%"
            number-of-philosophers)
    (force-output philosophers-output)
    (flet ((announce-acquire-fork (who fork)
             (format philosophers-output 
                     "~&Philosopher ~A has picked up ~A.~%" 
                     who (lock-name fork)))
           (announce-release-fork (who fork)
             (format philosophers-output 
                     "~&Philosopher ~A is putting down ~A.~%" 
                     who (lock-name fork)))
           (eat (who)
             (format philosophers-output 
                     "~&Philosopher ~A is EATING bite ~D.~%"
                     who (incf (philosopher-amount-eaten (aref philosophers who))))))
      (flet ((philosopher-task (who left-fork right-fork)
               (loop
                 (acquire-lock-or-skip left-fork
                                       (announce-acquire-fork who left-fork)
                                       (announce-release-fork who left-fork)
                   (acquire-lock-or-skip right-fork 
                                         (announce-acquire-fork who right-fork)
                                         (announce-release-fork who right-fork)
                     (eat who)))
                 (force-output stream)
                 (process-allow-schedule))))
        (let ((forks (make-sequence 'vector number-of-philosophers)))
          (dotimes (i number-of-philosophers)
            (setf (aref forks i) (make-lock (format nil "fork ~D" i))))
          (flet ((left-fork (who)
                   (aref forks who))
                 (right-fork (who)
                   (aref forks (mod (1+ who) number-of-philosophers))))
            (setq philosophers (make-sequence 'vector number-of-philosophers))
            (dotimes (i number-of-philosophers)
              (setf (aref philosophers i)
                    (make-philosopher
                     :task (process-run-function (format nil "Philosopher-~D" i)
                                                 #'philosopher-task
                                                 i 
                                                 (left-fork i) 
                                                 (right-fork i)))))))))
    (values))

  (defun stop-philosophers ()
    (dotimes (i (length philosophers))
      (process-kill (philosopher-task (aref philosophers i))))
    (format philosophers-output 
            "~&Dinner is finished. Amounts eaten: {~{~D~^, ~}}~2%" 
            (map 'list #'philosopher-amount-eaten philosophers))
    (force-output philosophers-output)
    (setq philosophers #())
    (values))
  )
}}}