Changes between Initial Version and Version 1 of DiningPhilosophers


Ignore:
Timestamp:
04/28/07 07:27:11 (8 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}}}