diff --git a/scsh/newports.scm b/scsh/newports.scm index bddd926..50fd4bc 100644 --- a/scsh/newports.scm +++ b/scsh/newports.scm @@ -545,9 +545,30 @@ (cond ((null? thunks) #f) (else - (for-each (structure-ref threads spawn) thunks) + (let loop ((threads + (map spawn-thread thunks)) + (new-threads '())) + (cond + ((not (null? threads)) + (if ((structure-ref threads-internal thread-continuation) + (car threads)) + (loop (cdr threads) + (cons (car threads) new-threads)) + (loop (cdr threads) new-threads))) + ((not (null? new-threads)) + (loop new-threads '())))) #t)))) +(define (spawn-thread thunk) + (let ((placeholder (make-placeholder))) + (spawn + (lambda () + (placeholder-set! + placeholder + ((structure-ref threads-internal current-thread))) + (thunk))) + (placeholder-value placeholder))) + ;;; Extend R4RS i/o ops to handle file descriptors. ;;; -----------------------------------------------