commit 7ec2fc2bc1f87e1ae58bd9ca6809282c16ea7069 parent 1c6a5bb4a22201bcd875b7285dad6beadc63a41b Author: Tomas Hlavaty <tom@logand.com> Date: Tue, 27 Aug 2019 23:02:31 +0200 content added Diffstat:
| A | phil.l | | | 201 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
1 file changed, 201 insertions(+), 0 deletions(-)
diff --git a/phil.l b/phil.l @@ -0,0 +1,201 @@ +# Chandy / Misra solution to Dining Philosophers Problem (no locking) +# http://en.wikipedia.org/wiki/Dining_philosophers_problem +# phil.l -- 07feb2009 Tomas Hlavaty +# credits: picolisp related improvements by Alexander Burger +# running: $ ~/picolisp/p phil.l + +# *Philosophers List of PIDs (process IDs) +# *LeftNeighbor PID of left neighbor +# *RightNeighbor PID of right neighbor +# *LeftFork Left fork (NIL, dirty or clean) +# *RightFork Right fork (NIL, dirty or clean) +# *Monitor PID of the animation process +# *Pending Queue of defered requests + +# algorithm from http://www.cs.wustl.edu/~joeh/IPL-ChandyMisra.ps +# +# State Behavior +# ----------------------------------------------------------------------- +# Trying (Hungry) Request all forks that the philosopher doesn't +# currently have. +# Grant all requests for dirty forks. +# (Forks will be cleaned when sent.) +# >> ask back for handed over forks << +# Defer all requests for clean forks. +# May move to Critical state when all forks are +# present. +# ----------------------------------------------------------------------- +# Critical (Eating) Defer all requests for forks clean or dirty. +# Make all forks dirty. +# May move to Exit state at any time. +# ----------------------------------------------------------------------- +# Exit (Finished Eating) May move to Remainder state when all deferred +# requests have been granted. +# ----------------------------------------------------------------------- +# Remainder (Thinking) Grant all requests. +# (Forks will be cleaned when sent.) +# May move to Trying state at any time. +# ----------------------------------------------------------------------- +# +# pros: +# - scales +# - no need for locks +# cons: +# - IPC must be reliable, no message can get lost + +(de log @ + (pass println *Pid) + (flush) ) + +(de idle () + (wait (rand 100 10000)) ) + +(de obtain (P) + (cond + ((= P *LeftNeighbor) + (if *LeftFork + (quit "Already have the left fork") + (setq *LeftFork 'clean) ) ) + ((= P *RightNeighbor) + (if *RightFork + (quit "Already have the right fork") + (setq *RightFork 'clean) ) ) + (T (quit "Wrong pid")) ) + (draw) ) + +(de handOver (P Var) + (ifn (val Var) + (quit "No fork to hand over") + (set Var NIL) + (tell 'pid P 'obtain *Pid) ) + (changed) ) + +(de giveNow (P) + (cond + ((= P *LeftNeighbor) + (handOver P '*LeftFork) ) + ((= P *RightNeighbor) + (handOver P '*RightFork) ) + (T (quit "Wrong pid")) ) ) + +(de defer (P) + (fifo '*Pending (list 'giveNow P)) ) + +(de give (P) + (case *State + (thinking + (giveNow P) ) + (hungry + (cond + ((= P *LeftNeighbor) + (if (== 'clean *LeftFork) + (defer P) + (handOver P '*LeftFork) + (tell 'pid P 'give *Pid) ) ) + ((= P *RightNeighbor) + (if (== 'clean *RightFork) + (defer P) + (handOver P '*RightFork) + (tell 'pid P 'give *Pid) ) ) + (T (quit "Wrong pid")) ) ) + ((eating finished) + (defer P) ) + (T (quit "Wrong state")) ) ) + +(de think () + (setq *State 'thinking) + (draw) + (idle) ) + +(de grab () + (setq *State 'hungry) + (draw) + (unless *LeftFork + (tell 'pid *LeftNeighbor 'give *Pid) ) + (unless *RightFork + (tell 'pid *RightNeighbor 'give *Pid) ) + (wait NIL (and *LeftFork *RightFork)) ) + +(de eat () + (setq *State 'eating) + (setq *LeftFork (setq *RightFork 'dirty)) + (draw) + (idle) ) + +(de finish () + (setq *State 'finished) + (draw) + (while (fifo '*Pending) + (eval @) ) ) + +(de phil () + (wait NIL (and *LeftNeighbor *RightNeighbor)) + (setq *LeftFork 'dirty) + (seed (in "/dev/urandom" (rd 3))) + (loop + (think) + (grab) + (eat) + (finish) ) ) + +(de changed (S) + (tell 'pid *Monitor 'update (philState)) ) + +(de update (S) + (if (assoc (car S) *State) + (con @ (cdr S)) + (push '*State S) ) ) + +(de draw () + (tell 'pid *Monitor 'drawAll (philState)) ) + +(de drawFork (F) + (prin (case F + (dirty ":") + (clean "|") + (NIL ".") + (T (quit "Bad fork")) )) ) + +(de philState () + (list *Pid *State *LeftFork *RightFork) ) + +(de drawState (S) + (drawFork (caddr S)) + (prin (case (cadr S) + (thinking "?") + (hungry "=") + (eating "o") + (finished "x") + (T (quit "Bad state")) )) + (drawFork (cadddr S)) ) + +(de drawAll (S) + (update S) + (for P *Philosophers + (prin " ") + (if (assoc P *State) + (drawState @) + (prin "___") ) ) + (prinl) + (flush) ) + +(de main (N) + (ifn (fork) + (wait) + (setq *Monitor @) + (push '*Bye '(kill *Monitor)) ) + (setq *Philosophers # Build a list of PIDs + (make + (do N + (if (fork) (link @) (phil)) ) ) ) + (push '*Bye '(mapc kill *Philosophers)) + (tell 'pid *Monitor 'setq '*Philosophers *Philosophers) + (do N # Send to each philosopher the PIDs of his neighbors + (tell 'pid (car *Philosophers) + 'setq + '*Monitor *Monitor + '*LeftNeighbor (last *Philosophers) + '*RightNeighbor (cadr *Philosophers) ) + (rot *Philosophers) ) ) + +(main 5)