phil.l (5659B)
1 # Chandy / Misra solution to Dining Philosophers Problem (no locking) 2 # http://en.wikipedia.org/wiki/Dining_philosophers_problem 3 # phil.l -- 07feb2009 Tomas Hlavaty 4 # credits: picolisp related improvements by Alexander Burger 5 # running: $ ~/picolisp/p phil.l 6 7 # *Philosophers List of PIDs (process IDs) 8 # *LeftNeighbor PID of left neighbor 9 # *RightNeighbor PID of right neighbor 10 # *LeftFork Left fork (NIL, dirty or clean) 11 # *RightFork Right fork (NIL, dirty or clean) 12 # *Monitor PID of the animation process 13 # *Pending Queue of defered requests 14 15 # algorithm from http://www.cs.wustl.edu/~joeh/IPL-ChandyMisra.ps 16 # 17 # State Behavior 18 # ----------------------------------------------------------------------- 19 # Trying (Hungry) Request all forks that the philosopher doesn't 20 # currently have. 21 # Grant all requests for dirty forks. 22 # (Forks will be cleaned when sent.) 23 # >> ask back for handed over forks << 24 # Defer all requests for clean forks. 25 # May move to Critical state when all forks are 26 # present. 27 # ----------------------------------------------------------------------- 28 # Critical (Eating) Defer all requests for forks clean or dirty. 29 # Make all forks dirty. 30 # May move to Exit state at any time. 31 # ----------------------------------------------------------------------- 32 # Exit (Finished Eating) May move to Remainder state when all deferred 33 # requests have been granted. 34 # ----------------------------------------------------------------------- 35 # Remainder (Thinking) Grant all requests. 36 # (Forks will be cleaned when sent.) 37 # May move to Trying state at any time. 38 # ----------------------------------------------------------------------- 39 # 40 # pros: 41 # - scales 42 # - no need for locks 43 # cons: 44 # - IPC must be reliable, no message can get lost 45 46 (de log @ 47 (pass println *Pid) 48 (flush) ) 49 50 (de idle () 51 (wait (rand 100 10000)) ) 52 53 (de obtain (P) 54 (cond 55 ((= P *LeftNeighbor) 56 (if *LeftFork 57 (quit "Already have the left fork") 58 (setq *LeftFork 'clean) ) ) 59 ((= P *RightNeighbor) 60 (if *RightFork 61 (quit "Already have the right fork") 62 (setq *RightFork 'clean) ) ) 63 (T (quit "Wrong pid")) ) 64 (draw) ) 65 66 (de handOver (P Var) 67 (ifn (val Var) 68 (quit "No fork to hand over") 69 (set Var NIL) 70 (tell 'pid P 'obtain *Pid) ) 71 (changed) ) 72 73 (de giveNow (P) 74 (cond 75 ((= P *LeftNeighbor) 76 (handOver P '*LeftFork) ) 77 ((= P *RightNeighbor) 78 (handOver P '*RightFork) ) 79 (T (quit "Wrong pid")) ) ) 80 81 (de defer (P) 82 (fifo '*Pending (list 'giveNow P)) ) 83 84 (de give (P) 85 (case *State 86 (thinking 87 (giveNow P) ) 88 (hungry 89 (cond 90 ((= P *LeftNeighbor) 91 (if (== 'clean *LeftFork) 92 (defer P) 93 (handOver P '*LeftFork) 94 (tell 'pid P 'give *Pid) ) ) 95 ((= P *RightNeighbor) 96 (if (== 'clean *RightFork) 97 (defer P) 98 (handOver P '*RightFork) 99 (tell 'pid P 'give *Pid) ) ) 100 (T (quit "Wrong pid")) ) ) 101 ((eating finished) 102 (defer P) ) 103 (T (quit "Wrong state")) ) ) 104 105 (de think () 106 (setq *State 'thinking) 107 (draw) 108 (idle) ) 109 110 (de grab () 111 (setq *State 'hungry) 112 (draw) 113 (unless *LeftFork 114 (tell 'pid *LeftNeighbor 'give *Pid) ) 115 (unless *RightFork 116 (tell 'pid *RightNeighbor 'give *Pid) ) 117 (wait NIL (and *LeftFork *RightFork)) ) 118 119 (de eat () 120 (setq *State 'eating) 121 (setq *LeftFork (setq *RightFork 'dirty)) 122 (draw) 123 (idle) ) 124 125 (de finish () 126 (setq *State 'finished) 127 (draw) 128 (while (fifo '*Pending) 129 (eval @) ) ) 130 131 (de phil () 132 (wait NIL (and *LeftNeighbor *RightNeighbor)) 133 (setq *LeftFork 'dirty) 134 (seed (in "/dev/urandom" (rd 3))) 135 (loop 136 (think) 137 (grab) 138 (eat) 139 (finish) ) ) 140 141 (de changed (S) 142 (tell 'pid *Monitor 'update (philState)) ) 143 144 (de update (S) 145 (if (assoc (car S) *State) 146 (con @ (cdr S)) 147 (push '*State S) ) ) 148 149 (de draw () 150 (tell 'pid *Monitor 'drawAll (philState)) ) 151 152 (de drawFork (F) 153 (prin (case F 154 (dirty ":") 155 (clean "|") 156 (NIL ".") 157 (T (quit "Bad fork")) )) ) 158 159 (de philState () 160 (list *Pid *State *LeftFork *RightFork) ) 161 162 (de drawState (S) 163 (drawFork (caddr S)) 164 (prin (case (cadr S) 165 (thinking "?") 166 (hungry "=") 167 (eating "o") 168 (finished "x") 169 (T (quit "Bad state")) )) 170 (drawFork (cadddr S)) ) 171 172 (de drawAll (S) 173 (update S) 174 (for P *Philosophers 175 (prin " ") 176 (if (assoc P *State) 177 (drawState @) 178 (prin "___") ) ) 179 (prinl) 180 (flush) ) 181 182 (de main (N) 183 (ifn (fork) 184 (wait) 185 (setq *Monitor @) 186 (push '*Bye '(kill *Monitor)) ) 187 (setq *Philosophers # Build a list of PIDs 188 (make 189 (do N 190 (if (fork) (link @) (phil)) ) ) ) 191 (push '*Bye '(mapc kill *Philosophers)) 192 (tell 'pid *Monitor 'setq '*Philosophers *Philosophers) 193 (do N # Send to each philosopher the PIDs of his neighbors 194 (tell 'pid (car *Philosophers) 195 'setq 196 '*Monitor *Monitor 197 '*LeftNeighbor (last *Philosophers) 198 '*RightNeighbor (cadr *Philosophers) ) 199 (rot *Philosophers) ) ) 200 201 (main 5)