home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ckscripts / dining-philosophers-1 < prev    next >
Lisp/Scheme  |  2020-01-01  |  6KB  |  221 lines
  1. # From: Dat Thuc Nguyen
  2. # Date: Sun, 02 May 2004 18:09:41 -0400
  3. # Subject: The Art of Programming in C-Kermit
  4. #
  5. # From time to time I sent in C-Kermit scripts that solve some problems people
  6. # also solved in other programming languages.
  7. #
  8. # Today I am sending in a program that's difficult since it requires
  9. # the notions of semaphore, process, timer and concurrency.
  10. #
  11. # The "dinning philosophers" problem is stated in Operating System Concepts by
  12. # Peterson and Silberschatz, 1985, pp. 347-348.
  13. #
  14. take class
  15.  
  16. define randnum {
  17. # \%1 random seed
  18.     while true {
  19.         if {\fsexpr(> (let rd \frandom(\%1)) 0)} return \m(rd)
  20.     }
  21. }
  22.  
  23. class Semaphore
  24.  
  25. define Semaphore::new: {
  26.     (setq \%1.Semaphore.stat -1)
  27.     _asg \%1.Semaphore.Queue |
  28.     (\%1)
  29. }
  30.  
  31. define Semaphore>>acquire {
  32.     local s
  33.     (setq s (++ \%1.Semaphore.stat))
  34.     if > s 0 {
  35.         _asg \%1.Semaphore.Queue \m(\%1.Semaphore.Queue)\%2|
  36.         echo \%2 waits for \m(\%2.\%1.ChopStick)
  37.     } else {
  38.         echo \%2 grabs \m(\%2.\%1.ChopStick)
  39.     }
  40.     (! s)
  41. }
  42.  
  43. define Semaphore>>release {
  44.     (-- \%1.Semaphore.stat)
  45.     local \&w[] 
  46.     if > \fsplit(\m(\%1.Semaphore.Queue),&w,|) 0 {
  47.         _asg \%1.Semaphore.Queue \freplace(\m(\%1.Semaphore.Queue),|\&w[1]|,|)
  48.         DiningPhilosophers add: \&w[1]
  49.         echo \&w[1] grabs \m(\&w[1].\%1.ChopStick)
  50.     }
  51.     (\%1)
  52. }
  53.  
  54. define Semaphore>>inspect {
  55.     echo \%1 \m(\%1.Semaphore.stat)
  56.     echo \%1 \m(\%1.Semaphore.Queue)
  57. }
  58.  
  59. class Philosopher
  60.  
  61. define Philosopher::new:leftChopStick:rightChopStick:number: {
  62. # \%2 leftChopStick
  63. # \%3 rightChopStick
  64.     (setq \%1.leftChopStick \%2)
  65.     (setq \%1.rightChopStick \%3)
  66.     (setq \%1.Philosopher.Number \%4)
  67.     _asg \%1.\%2.ChopStick left ChopStick
  68.     _asg \%1.\%3.ChopStick right ChopStick
  69.     _asg \%1.Philosopher.act Philosopher>>thinking
  70.     (setq \%1.Philosopher.timeRepeat (randnum 15))
  71.     (\%1)
  72. }
  73.  
  74. define Philosopher>>act {
  75.     (-- \%1.Philosopher.timeRepeat)
  76.     if == \m(\%1.Philosopher.timeRepeat) 0 {
  77.         (setq \%1.Philosopher.timeRepeat (randnum 50))
  78.         return \fsexpr(\%1 '\m(\%1.Philosopher.act))
  79.     } else {
  80.         return 1    # line up in the process queue
  81.     }
  82. }
  83.  
  84. define Philosopher>>thinking {
  85.     echo \%1 is thinking
  86.     _asg \%1.Philosopher.act Philosopher>>getFirstChopStick
  87.     (1)     # line up in the process queue
  88. }
  89.  
  90. define Philosopher>>getFirstChopStick {
  91.     local gotChopStick
  92.     if {\fsexpr(mod \%1.Philosopher.Number 2)} {    # odd
  93.         (setq gotChopStick (\m(\%1.leftChopStick) 'acquire \%1))
  94.         if gotChopStick {
  95.             _asg \%1.Philosopher.act Philosopher>>eat
  96.             (setq gotChopStick (\m(\%1.rightChopStick) 'acquire \%1))
  97.             if gotChopStick {
  98.                 return 1
  99.             } else {
  100.                 return 0
  101.             }
  102.         }
  103.     } else {    # even
  104.         (setq gotChopStick (\m(\%1.rightChopStick) 'acquire \%1))
  105.         if gotChopStick {
  106.             _asg \%1.Philosopher.act Philosopher>>eat
  107.             (setq gotChopStick (\m(\%1.leftChopStick) 'acquire \%1))
  108.             if gotChopStick {
  109.                 return 1
  110.             } else {
  111.                 return 0
  112.             }
  113.         }
  114.     }
  115.     _asg \%1.Philosopher.act Philosopher>>getSecondChopStick
  116.     return 0    # wait for semaphore
  117. }
  118.  
  119. define Philosopher>>getSecondChopStick {
  120.     local gotChopStick
  121.     _asg \%1.Philosopher.act Philosopher>>eat
  122.     if {\fsexpr(mod \%1.Philosopher.Number 2)} {    # odd
  123.         (setq gotChopStick (\m(\%1.rightChopStick) 'acquire \%1))
  124.         if gotChopStick {
  125.             return 1
  126.         } else {
  127.             return 0
  128.         }
  129.     } else {    # even
  130.         (setq gotChopStick (\m(\%1.leftChopStick) 'acquire \%1))
  131.         if gotChopStick {
  132.             return 1
  133.         } else {
  134.             return 0
  135.         }
  136.     }
  137. }
  138.  
  139. define Philosopher>>eat {
  140.     echo \%1 is eating
  141.     _asg \%1.Philosopher.act Philosopher>>release_ChopSticks
  142.     (1)
  143. }
  144.  
  145. define Philosopher>>release_ChopSticks {
  146.     _asg \%1.Philosopher.act Philosopher>>sleep
  147.     (\m(\%1.leftChopStick) 'release)
  148.     (\m(\%1.rightChopStick) 'release)
  149.     (1)
  150. }
  151.  
  152. define Philosopher>>sleep {
  153.     echo \%1 is sleeping
  154.     _asg \%1.Philosopher.act Philosopher>>wakeup
  155.     (1)     # 
  156. }
  157.  
  158. define Philosopher>>wakeup {
  159.     echo \%1 wakes up
  160.     _asg \%1.Philosopher.act Philosopher>>thinking
  161.     (1)
  162. }
  163.  
  164. define Philosopher>>inspect {
  165.     echo \fsexp(\m(\%1.leftChopStick) 'inspect) and \fsexp(\m(\%1.rightChopStick) 'inspect)
  166.     (\%1)
  167. }
  168.  
  169. class Process
  170. define Process::new: {
  171.     _asg \%1.Process.Queue |
  172.     (\%1)
  173. }
  174.  
  175. define Process>>run {
  176.     while true {
  177.         local \&w[] \%n
  178.         asg \%n \fsplit(\m(\%1.Process.Queue),&w,|)
  179.         if = 0 \%n break
  180.         \%1 remove: \&w[1]
  181.         (if (\&w[1] 'act) (\%1 'add: \&w[1]))
  182.     }
  183. }
  184.  
  185. define Process>>add: {
  186.     _asg \%1.Process.Queue \m(\%1.Process.Queue)\%2|
  187.     (\%1)
  188. }
  189.  
  190. define Process>>remove: {
  191.     _asg \%1.Process.Queue \freplace(\m(\%1.Process.Queue),|\%2|,|)
  192.     (\%1)
  193. }
  194.  
  195. define Process>>inspect {
  196.     echo \m(\%1.Process.Queue)
  197.     (\%1)
  198. }
  199.  
  200. # Create five ChopSticks:
  201. Semaphore new: chopstk_1_2      # ChopStick between p1 and p2
  202. Semaphore new: chopstk_2_3      # ChopStick between p2 and p3
  203. Semaphore new: chopstk_3_4      # ChopStick between p3 and p4
  204. Semaphore new: chopstk_4_5      # ChopStick between p4 and p5
  205. Semaphore new: chopstk_5_1      # ChopStick between p5 and p1
  206.  
  207. # Create five Philosophers:
  208. Philosopher new: Philosopher_1 leftChopStick: chopstk_5_1 rightChopStick: chopstk_1_2 number: 1
  209. Philosopher new: Philosopher_2 leftChopStick: chopstk_1_2 rightChopStick: chopstk_2_3 number: 2 
  210. Philosopher new: Philosopher_3 leftChopStick: chopstk_2_3 rightChopStick: chopstk_3_4 number: 3
  211. Philosopher new: Philosopher_4 leftChopStick: chopstk_3_4 rightChopStick: chopstk_4_5 number: 4
  212. Philosopher new: Philosopher_5 leftChopStick: chopstk_4_5 rightChopStick: chopstk_5_1 number: 5
  213.  
  214. Process new: DiningPhilosophers
  215. for \%i 1 5 1 {
  216.     DiningPhilosophers add: Philosopher_\%i
  217. }
  218. DiningPhilosophers run
  219.  
  220. # end
  221.