home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / aijournl / aifirst.arc / CLI.PCP < prev    next >
Lisp/Scheme  |  1986-10-30  |  2KB  |  70 lines
  1.  
  2. CLI LISP Producer-Consumer Problem
  3.  
  4.  
  5. ;; The Producer-Consumer Problem
  6. ;;       (synchronized)
  7. (defun pc ()
  8.   (setf buffer nil)
  9.   (setf information '(this is a test of semaphores))
  10.   ; initializes the semaphores
  11.   (initialize-semaphores '(($ok-to-consume 0) ($ok-to-produce 1)))
  12.   ; starts concurrent reading and writing.
  13.   (cobegin (list 'producer (length information))
  14.        (list 'consumer (length information)))
  15.   )
  16. (defun producer (r)
  17.   (do ((i 0 (1+ i)))
  18.       ((= i r) (print 'end-producer))
  19.     ; start of critical region
  20.     (wait '$ok-to-produce)
  21.     (print 'read-by-producer<---)
  22.     (setf buffer (nth i information))
  23.     (princ buffer)
  24.     (signal '$ok-to-consume)
  25.     ; end of critical region
  26.     )
  27. )
  28. (defun consumer (r)
  29.   (do ((i 0 (1+ i)))
  30.       ((= i r) (print 'end-consumer))
  31.     ; start of critical region
  32.     (wait '$ok-to-consume)
  33.     (print '----print-by-consumer--->)
  34.     (princ buffer)
  35.     (setf buffer nil)
  36.     (signal '$ok-to-produce)
  37.     ; end of critical region
  38.     )
  39. )
  40. ;
  41. ;; The Producer-Consumer Problem
  42. ;;       (unsynchronized)
  43. (defun un-pc ()
  44.   (setf buffer nil)
  45.   (setf information '(this is a test of semaphores))
  46.   ;; starts concurrent reading and writing.
  47.   (cobegin (list 'un-producer (length information))
  48.        (list 'un-consumer (length information)))
  49. )
  50. (defun un-producer (r)
  51.   (do ((i 0 (1+ i)))
  52.       ((= i r) (print 'end-producer))
  53.     (print 'read-by-producer<---)
  54.     (setf buffer (nth i information))
  55.     (princ buffer)
  56.     (terpri)
  57.     )
  58. )
  59. (defun un-consumer (r)
  60.   (do ((i 0 (1+ i)))
  61.       ((= i r) (print 'end-consumer))
  62.     (print '----print-by-consumer--->)
  63.     (princ buffer)
  64.     (terpri)
  65.     (setf buffer nil)
  66.     )
  67. )
  68. ;
  69.  
  70.