(use srfi-18 extras)

(define proc-under-test (cut read-string 2)) ; Read one character plus newline.
;(define proc-under-test read-char)


(define (count!)
  (let ((me (thread-name (current-thread))))
    (let loop ((n 0))
      (printf "~S: ~S\n" me n)
      (thread-sleep! 1)
      (loop (add1 n)))))

(define (test-proc)
  (let ((me (thread-name (current-thread))))
    (thread-sleep! 5)
    (printf "~S: Enter Character\n" me)
    (printf "~S: read ~S\n"
	    me
	    (proc-under-test))))


(thread-start!
  (make-thread
    count!))

; Test the behaviour in the primordial thread
(test-proc)

; Test the behaviour in a srfi-18 thread
(thread-start!
  (make-thread
    test-proc))

(count!)

$ ./thread 
thread0: 0
thread0: 1
thread0: 2
thread0: 3
thread0: 4
primordial: Enter Character
primordial: read j
"j\n"
primordial: 0
thread0: 5
primordial: 1
thread0: 6
primordial: 2
thread0: 7
primordial: 3
thread0: 8
primordial: 4
thread0: 9
thread1: Enter Character
thread1: read j
"j\n"
primordial: 5
thread0: 10
primordial: 6
thread0: 11
primordial: 7
thread0: 12
primordial: 8
thread0: 13
primordial: 9
thread0: 14
^C

(use srfi-18 extras ports posix)

;(define proc-under-test (cut read-string 2)) ; Read one character plus newline.
;(define proc-under-test read-char)

;(define (srfi-18-read-char #!optional (port (current-input-port)))
;  (thread-wait-for-i/o!
;    (port->fileno port)
;    #:input)
;  (read-char port))
;
;(define proc-under-test srfi-18-read-char)


(let* ((orig read-char)
       (new
	 (lambda (#!optional (port (current-input-port)))
	   (thread-wait-for-i/o!
	     (port->fileno port)
	     #:input)
	   (orig port))))
  (set!
    read-char
    new))

(define proc-under-test read-char)



(define (count!)
  (let ((me (thread-name (current-thread))))
    (let loop ((n 0))
      (printf "~S: ~S\n" me n)
      (thread-sleep! 1)
      (loop (add1 n)))))

(define (test-proc)
  (let ((me (thread-name (current-thread))))
    (thread-sleep! 5)
    (printf "~S: Enter Character\n" me)
    (printf "~S: read ~S\n"
	    me
	    (proc-under-test))))


(thread-start!
  (make-thread
    count!))

; Test the behaviour in the primordial thread
(test-proc)

; Test the behaviour in a srfi-18 thread
(thread-start!
  (make-thread
    test-proc))

(count!)