1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
|
;;; -*-Scheme-*-
;;;
;;; Demonstrate signals and alarm
;;;
;;; (timeout-read fdescr seconds) -- read with timeout
(require 'unix)
;;; Read a string from file descriptor fd and return it (maximum length
;;; 1000 characters). Return #f on timeout (2nd arg, in seconds).
(define (timeout-read fd sec)
(let ((str (make-string 1000))
(old-handler 'default))
(call/cc
(lambda (tmo)
(dynamic-wind
(lambda ()
(set! old-handler (unix-signal 'sigalrm (lambda _ (tmo #f))))
(unix-alarm sec))
(lambda ()
(substring str 0 (unix-read-string-fill! fd str)))
(lambda ()
(unix-alarm 0)
(unix-signal 'sigalrm old-handler)))))))
;;; Test
(display "Enter a line (timeout 5 seconds): ")
(let ((ret (timeout-read 0 5)))
(if ret
(format #t "Got ~s~%" ret)
(format #t "~%Got timeout~%")))
|
