;;; (thanks to Martin Gasbichler) ;;; ;;; This procedure executes a subprocedure in a separate thread in a ;;; given time period. If the subprocedure hasn't completed ;;; by the time the number of seconds given as the second argument ;;; have elapsed it returns 'timeout. For example ;;; ;;; (execute/timeout ;;; (lambda () (run/strings (rsh phz-4 uptime))) ;;; 5) (define (execute/timeout proc sec) (let ((lock (make-lock)) (done? #f) (result (make-placeholder))) (define (maybe-set-result! val) (obtain-lock lock) (cond ((not done?) (set! done? #t) (placeholder-set! result val))) (release-lock lock)) (spawn (lambda () (sleep (* sec 1000)) (maybe-set-result! 'timeout))) (spawn (lambda () (maybe-set-result! (proc)))) (placeholder-value result)))