Hi Alex,
thanks for explanation.
I have attached my updated code which almost works now. The only
problem is that I seem to be loosing messages and the whole thing
comes to a deadlock.
For example:
.=: .=| .=| .=| .=|
means that all philosophers are hungry and have clean chopsticks (one
each) except the first one which should pass his stick to the one on
the right... But the request from the philosopher on the right have
been lost and the whole thing stops.
I am wondering how/when picolisp calls the asynchronous handler? Is
there a way of disabling asynchronous events temporarily for a block
of code? Do you get similar problems with db synchronisation?
...
(unless *LeftFork
(tell 'pid *LeftNeighbor 'give *Pid) )
(unless *RightFork
(tell 'pid *RightNeighbor 'give *Pid) )
(wait NIL (and *LeftFork *RightFork))
..and 'give' either hands over the chopstick straight away or defers
that until the philosopher is fed.
(de defer (P)
(fifo '*Pending (list 'giveNow P)) )
(de finish ()
(setq *State 'finished)
(draw)
(while (fifo '*Pending)
(eval @) ) )
I imagine that the problem is that 'defer' called from the IPC handler
changes '*Pending' queue while the 'while' loop is evaluated.
> It is a normal (unnamed) pipe, which is set up automatically by 'fork'.
So this unnamed pipe is works only between two picolisp processes? I
guess I need to use a named pipe if the child is a non-picolisp
program, e.g. http://logand.com/gtk/gtk.l
> The same philosophy we have when the parent is the DB and GUI server.
Do you have any document/notes describing how is the picolisp db
implemented. Maybe some high-level overview like how the db files are
accessed, the processes synchronized and data read/written?
Thank you,
Tomas
# ~/picolisp/p phil.l
# http://en.wikipedia.org/wiki/Dining_philosophers_problem
# Chandy / Misra solution
# *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
# 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.)
# 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.
#
-------------------------------------------------------------------------------
(de log @
(pass println *Pid)
(flush) )
(de idle ()
(wait (rand 100 10000)) )
(de obtain (P)
# (log '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)
# (log 'handOver P Var (val 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) ) )
((= P *RightNeighbor)
(if (== 'clean *RightFork)
(defer P)
(handOver P '*RightFork) ) )
(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) )
# (log 'waiting *LeftFork *RightFork)
(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)
# (log 'finish @)
(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)
(when (fork)
(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)
