IPC

[Tomas Hlavaty]

Hi Alex,

I am struggling to understand picolisp IPC functions (hear, tell, rpc,
sync...).  I have attached code for the Dining Philosophers problem
which gets stuck after calling 'hear' in the philosopher (child)
process.  The idea is that each philosopher is a process which opens a
fifo and all philosophers talk to their neighbours via those fifos.

'hear' in the following snippet seems to block the whole process:

   ...
   (log 'before)
   (hear (mailbox I))
   (log 'after)
   ...

outputs

$ ~/picolisp/p phil.l
0 -1 0 before
1 -1 0 before
2 -1 0 before
3 -1 0 before
4 -1 0 before
: 

..only and does nothing afterwards.  I would expect 'hear' to install
some kind of event handler which would evaluate incoming messages and
then carry on immediately with the next (log 'after) line.  Is my
understanding correct?  I though that 'hear' was working in the
background so why the code blocks?

Thank you,

Tomas


# ~/picolisp/p phil.l
# http://en.wikipedia.org/wiki/Dining_philosophers_problem
# Chandy / Misra solution
# philosophers: N = total, I = current, P = other
# forks: L = left, R = right; lt0 ~ dirty, =0 none, gt0 ~ clean

(de log @
   (pass println I L R)
   (flush) )

(de idle ()
   (wait (rand 1000 3000)) )

(de left ()
   (% (+ N (- I 1)) N) )
   
(de right ()
   (% (+ I 1) N) )

(de mailbox (P)
   (pack "phil" P) )

(de obtain (P)
   (log 'obtain P)
   (when (= P (left))
      (if (=0 L)
         (setq L 1)
         (quit "Already have the left fork") ) )
   (when (= P (right))
      (if (=0 R)
         (setq R 1)
         (quit "Already have the right fork") ) ) )

(de give (P)
   (log 'give P)
   (when (and (= P (left)) (lt0 L))
      (out (mailbox P)
         (rpc 'obtain I) )
      (setq L 0) )
   (when (and (= P (right)) (lt0 R))
      (out (mailbox P)
         (rpc 'obtain I) )
      (setq R 0) ) )
   
(de grab ()
   (while (or (=0 L) (=0 R))
      (when (lt0 L)
         (setq L 1) )
      (when (lt0 R)
         (setq R 1) )
      (when (=0 L)
         (out (mailbox (left))
            (rpc 'give I) ) )
      (when (=0 R)
         (out (mailbox (right))
            (rpc 'give I) ) )
      (wait 500) ) )

(de phil (I N L R)
   (unless (info (mailbox I))
      (call 'mkfifo (mailbox I)) )
   (log 'before)
   (hear (mailbox I))
   (log 'after)
   (loop
      (log 'thinking)
      (idle) # think
      (log 'hungry)
      (grab)
      (log 'eating)
      (idle) # eat
      (setq L -1 R -1) ) ) # dirty

(de main (N)
   (push '*Bye '(mapc 'kill *C))
   (for (I 0 (< I N) (inc I))
      (if (fork)
         (push '*C @)
         (phil I N -1 0) ) ) )

(main 5)