# 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)