;;;; synch test

(use srfi-18 srfi-69 synch miscmacros)

;;

(define-syntax define-thread
	(syntax-rules ()
	  ((_ ?ident ?body ...)
	    (define ?ident
        (make-thread
          (lambda () ?body ...)
          '?ident) ) ) ) )

;;;

(define-record-type <foo>
  (make-<foo> x y mtx)
  <foo>?
  (x <foo>-x)
  (y <foo>-y)
  (mtx <foo>-mutex))

(define tfoo (make-<foo> 1 2 (make-mutex)))
(print "*** prints 1 2 ***")
(record/synch <foo> tfoo (print (<foo>-x tfoo) " " (<foo>-y tfoo)))
(newline)

;;; Synchronize thread access to an object

;;

(define (hash-table-count ht)
  (##sys#check-structure ht 'hash-table 'hash-table-count)
  (hash-table-fold ht (lambda (k v a) (fx+ a 1)) 0) )

;;

(define-constructor/synch make-hash-table hash-table/synch:)
(define-predicate/synch hash-table?)
(define-operation/synch hash-table-count)
(define-operation/synch hash-table-set!)

;;

(define +tht+ (make-hash-table/synch = number-hash))

(define-constant READER-THREAD-LIMIT 20)

(define-constant THREAD-SLEEP-MS 0 #;2000)

;; Greedy Reader

(define-thread reader-thread
  (do ((n (hash-table-count/synch +tht+) (hash-table-count/synch +tht+)))
      ((fx= READER-THREAD-LIMIT n)
        (print "test hash-table count = " n " so quit"))
    (print "test hash-table count = " n)
    (thread-sleep! THREAD-SLEEP-MS) ) )

;; Cooperative Writer

(define-thread writer-thread
  (repeat* 10
    (hash-table-set!/synch +tht+ it (number->string it))
    (hash-table-set!/synch +tht+ (* it 11) (number->string it))
    (thread-sleep! THREAD-SLEEP-MS)
    (thread-yield!) ) )

;;

(thread-start! writer-thread)
(thread-start! reader-thread)

(thread-join! writer-thread)
(thread-join! reader-thread)