* (interrupt-handler) is added to handle INT signals.
* Cafes now customize the interrupt-handler to suppress the error message during read that the default interrupt handler generates.
This commit is contained in:
parent
da9518cc49
commit
4f5490039b
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -46,6 +46,16 @@ description:
|
||||||
(display ">" (console-output-port))
|
(display ">" (console-output-port))
|
||||||
(display-prompt (fx+ i 1))))))
|
(display-prompt (fx+ i 1))))))
|
||||||
|
|
||||||
|
(define my-read
|
||||||
|
(lambda (k)
|
||||||
|
(parameterize ([interrupt-handler
|
||||||
|
(lambda ()
|
||||||
|
(flush-output-port (console-output-port))
|
||||||
|
(reset-input-port! (console-input-port))
|
||||||
|
(newline (console-output-port))
|
||||||
|
(k))])
|
||||||
|
(read (console-input-port)))))
|
||||||
|
|
||||||
(define wait
|
(define wait
|
||||||
(lambda (eval escape-k)
|
(lambda (eval escape-k)
|
||||||
(call/cc
|
(call/cc
|
||||||
|
@ -57,7 +67,7 @@ description:
|
||||||
(k (void)))
|
(k (void)))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(display-prompt 0)
|
(display-prompt 0)
|
||||||
(let ([x (read (console-input-port))])
|
(let ([x (my-read k)])
|
||||||
(cond
|
(cond
|
||||||
[(eof-object? x)
|
[(eof-object? x)
|
||||||
(newline (console-output-port))
|
(newline (console-output-port))
|
||||||
|
|
|
@ -1176,19 +1176,6 @@ reference-implementation:
|
||||||
;;X (error 'make-parameter "insufficient arguments")))))
|
;;X (error 'make-parameter "insufficient arguments")))))
|
||||||
;;X
|
;;X
|
||||||
|
|
||||||
(primitive-set! 'make-parameter
|
|
||||||
(case-lambda
|
|
||||||
[(x)
|
|
||||||
(case-lambda
|
|
||||||
[() x]
|
|
||||||
[(v) (set! x v)])]
|
|
||||||
[(x guard)
|
|
||||||
(unless (procedure? guard)
|
|
||||||
(error 'make-parameter "~s is not a procedure" guard))
|
|
||||||
(set! x (guard x))
|
|
||||||
(case-lambda
|
|
||||||
[() x]
|
|
||||||
[(v) (set! x (guard v))])]))
|
|
||||||
|
|
||||||
(let ()
|
(let ()
|
||||||
(define vector-loop
|
(define vector-loop
|
||||||
|
|
|
@ -1,8 +1,34 @@
|
||||||
|
|
||||||
|
|
||||||
|
(primitive-set! 'make-parameter
|
||||||
|
(case-lambda
|
||||||
|
[(x)
|
||||||
|
(case-lambda
|
||||||
|
[() x]
|
||||||
|
[(v) (set! x v)])]
|
||||||
|
[(x guard)
|
||||||
|
(unless (procedure? guard)
|
||||||
|
(error 'make-parameter "~s is not a procedure" guard))
|
||||||
|
(set! x (guard x))
|
||||||
|
(case-lambda
|
||||||
|
[() x]
|
||||||
|
[(v) (set! x (guard v))])]))
|
||||||
|
|
||||||
|
|
||||||
(primitive-set! 'error
|
(primitive-set! 'error
|
||||||
(lambda args
|
(lambda args
|
||||||
(foreign-call "ik_error" args)))
|
(foreign-call "ik_error" args)))
|
||||||
|
|
||||||
|
(primitive-set! 'interrupt-handler
|
||||||
|
(make-parameter
|
||||||
|
(lambda ()
|
||||||
|
(flush-output-port (console-output-port))
|
||||||
|
(error #f "interrupted"))
|
||||||
|
(lambda (x)
|
||||||
|
(if (procedure? x)
|
||||||
|
x
|
||||||
|
(error 'interrupt-handler "~s is not a procedure" x)))))
|
||||||
|
|
||||||
(primitive-set! '$apply-nonprocedure-error-handler
|
(primitive-set! '$apply-nonprocedure-error-handler
|
||||||
(lambda (x)
|
(lambda (x)
|
||||||
(error 'apply "~s is not a procedure" x)))
|
(error 'apply "~s is not a procedure" x)))
|
||||||
|
@ -77,7 +103,7 @@
|
||||||
(if ($interrupted?)
|
(if ($interrupted?)
|
||||||
(begin
|
(begin
|
||||||
($unset-interrupted!)
|
($unset-interrupted!)
|
||||||
(error #f "Interrupted"))
|
((interrupt-handler)))
|
||||||
(display "Engine Expired\n" (console-output-port)))))
|
(display "Engine Expired\n" (console-output-port)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -83,6 +83,7 @@
|
||||||
quotient+remainder quotient remainder number? positive?
|
quotient+remainder quotient remainder number? positive?
|
||||||
negative? zero? number->string logand = < > <= >=
|
negative? zero? number->string logand = < > <= >=
|
||||||
make-guardian weak-cons collect
|
make-guardian weak-cons collect
|
||||||
|
interrupt-handler
|
||||||
))
|
))
|
||||||
|
|
||||||
(define system-primitives
|
(define system-primitives
|
||||||
|
|
Loading…
Reference in New Issue