Changes between Initial Version and Version 1 of DiningPhilosophers


Ignore:
Timestamp:
Apr 28, 2007, 7:27:11 AM (13 years ago)
Author:
bfulgham
Comment:

--

Legend:

Unmodified
Added
Removed
Modified
  • DiningPhilosophers

    v1 v1  
     1Mr. 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.
     2
     3{{{
     4DigiTool MCL-style processes and locks, which are implemented differently in OpenMCL.
     5
     6;;;
     7;;;   Dining Philosophers, from David B. Lamkin's book "Successful Lisp"
     8;;;   Publisher: bookfix.com (December 8, 2004)
     9;;;   ISBN: 3937526005
     10;;;
     11;;;   Converted to work under OpenMCL by Brent Fulgham (10/2006)
     12;;;
     13(defstruct philosopher
     14  (amount-eaten 0)
     15  (task nil))
     16
     17(defmacro acquire-lock-or-skip (lock post-acquire pre-release &body body)
     18  `(progn
     19     ;; Random sleep makes the output more interesting
     20     ;; by introducing variability into the order of
     21     ;; execution.  This is a simple way of simulating
     22     ;; the nondeterminacy that would result from having
     23     ;; additional processes compete for CPU cycles.
     24     (sleep (random 5))
     25     (unless (ccl::%%lock-owner ,lock)
     26       (grab-lock ,lock)
     27       ,post-acquire
     28       (unwind-protect
     29         (progn ,@body)
     30         ,pre-release
     31         (release-lock ,lock)))))
     32
     33(let ((philosophers #())
     34      (philosophers-output t))
     35
     36  (defun dining-philosophers (number-of-philosophers &optional (stream t))
     37    (unless (equalp philosophers #())
     38      (stop-philosophers))
     39    (assert (> number-of-philosophers 1) (number-of-philosophers))
     40    (setq philosophers-output stream)
     41    (format philosophers-output
     42            "~2&Seating ~D philosophers for dinner.~%"
     43            number-of-philosophers)
     44    (force-output philosophers-output)
     45    (flet ((announce-acquire-fork (who fork)
     46             (format philosophers-output
     47                     "~&Philosopher ~A has picked up ~A.~%"
     48                     who (lock-name fork)))
     49           (announce-release-fork (who fork)
     50             (format philosophers-output
     51                     "~&Philosopher ~A is putting down ~A.~%"
     52                     who (lock-name fork)))
     53           (eat (who)
     54             (format philosophers-output
     55                     "~&Philosopher ~A is EATING bite ~D.~%"
     56                     who (incf (philosopher-amount-eaten (aref philosophers who))))))
     57      (flet ((philosopher-task (who left-fork right-fork)
     58               (loop
     59                 (acquire-lock-or-skip left-fork
     60                                       (announce-acquire-fork who left-fork)
     61                                       (announce-release-fork who left-fork)
     62                   (acquire-lock-or-skip right-fork
     63                                         (announce-acquire-fork who right-fork)
     64                                         (announce-release-fork who right-fork)
     65                     (eat who)))
     66                 (force-output stream)
     67                 (process-allow-schedule))))
     68        (let ((forks (make-sequence 'vector number-of-philosophers)))
     69          (dotimes (i number-of-philosophers)
     70            (setf (aref forks i) (make-lock (format nil "fork ~D" i))))
     71          (flet ((left-fork (who)
     72                   (aref forks who))
     73                 (right-fork (who)
     74                   (aref forks (mod (1+ who) number-of-philosophers))))
     75            (setq philosophers (make-sequence 'vector number-of-philosophers))
     76            (dotimes (i number-of-philosophers)
     77              (setf (aref philosophers i)
     78                    (make-philosopher
     79                     :task (process-run-function (format nil "Philosopher-~D" i)
     80                                                 #'philosopher-task
     81                                                 i
     82                                                 (left-fork i)
     83                                                 (right-fork i)))))))))
     84    (values))
     85
     86  (defun stop-philosophers ()
     87    (dotimes (i (length philosophers))
     88      (process-kill (philosopher-task (aref philosophers i))))
     89    (format philosophers-output
     90            "~&Dinner is finished. Amounts eaten: {~{~D~^, ~}}~2%"
     91            (map 'list #'philosopher-amount-eaten philosophers))
     92    (force-output philosophers-output)
     93    (setq philosophers #())
     94    (values))
     95  )
     96}}}