picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

dining.l (1845B)


      1 # 18mar10abu
      2 # (c) Software Lab. Alexander Burger
      3 # Dining Philosophers
      4 
      5 (de dining (Name State)
      6    (loop
      7       (prinl Name ": " State)
      8       (state 'State                       # Dispatch according to state
      9          (thinking 'hungry)               # If thinking, get hungry
     10          (hungry                          # If hungry, grab random fork
     11             (if (rand T)
     12                (and (acquire leftFork) 'leftFork)
     13                (and (acquire rightFork) 'rightFork) ) )
     14          (hungry 'hungry                  # Failed, stay hungry for a while
     15             (wait (rand 1000 3000)) )
     16          (leftFork                        # If holding left fork, try right one
     17             (and (acquire rightFork) 'eating)
     18             (wait 2000) )                 # then eat for 2 seconds
     19          (rightFork                       # If holding right fork, try left one
     20             (and (acquire leftFork) 'eating)
     21             (wait 2000) )                 # then eat for 2 seconds
     22          ((leftFork rightFork) 'hungry    # Otherwise, go back to hungry,
     23             (release (val State))         # release left or right fork
     24             (wait (rand 1000 3000)) )     # and stay hungry
     25          (eating 'thinking             # After eating, resume thinking
     26             (release leftFork)
     27             (release rightFork)
     28             (wait 6000) ) ) ) )           # for 6 seconds
     29 
     30 (setq *Philosophers
     31    (maplist
     32       '((Phils Forks)
     33          (let (leftFork (tmp (car Forks))  rightFork (tmp (cadr Forks)))
     34             (or
     35                (fork)  # Parent: Collect child process IDs
     36                (dining (car Phils) 'hungry) ) ) )  # Initially hungry
     37       '("Aristotle" "Kant" "Spinoza" "Marx" "Russell")
     38       '("ForkA" "ForkB" "ForkC" "ForkD" "ForkE" .) ) )
     39 
     40 (push '*Bye '(mapc kill *Philosophers))  # Terminate all upon exit
     41 
     42 # vi:et:ts=3:sw=3