* (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
	
	 Abdulaziz Ghuloum
						Abdulaziz Ghuloum