From 35ef5fde7828d0f2af876fec55665343f71369e7 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 22 Jun 1990 01:04:48 +0000 Subject: [PATCH] Implement `check-and-clean-up-input-channel' in runtime system -- microcode no longer provides this service. --- v7/src/runtime/emacs.scm | 13 ++++++++++++- v7/src/runtime/intrpt.scm | 24 ++++++++++++------------ v7/src/runtime/runtime.pkg | 5 +++-- v7/src/runtime/version.scm | 4 ++-- v8/src/runtime/runtime.pkg | 5 +++-- 5 files changed, 32 insertions(+), 19 deletions(-) diff --git a/v7/src/runtime/emacs.scm b/v7/src/runtime/emacs.scm index 3948af54e..d43c8b8f7 100644 --- a/v7/src/runtime/emacs.scm +++ b/v7/src/runtime/emacs.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/emacs.scm,v 14.4 1990/06/20 20:28:56 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/emacs.scm,v 14.5 1990/06/22 01:04:32 cph Exp $ Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology @@ -177,6 +177,13 @@ MIT in each case. |# (define (emacs/set-working-directory-pathname! pathname) (transmit-signal-with-argument #\w (pathname->string pathname))) + +(define (emacs/clean-input/flush-typeahead character) + character + (let loop () + (if (not (char=? #\NUL (input-port/read-char console-input-port))) + (loop))) + true) (define normal/gc-start) (define normal/gc-finish) @@ -193,6 +200,7 @@ MIT in each case. |# (define normal/^G-interrupt) (define normal/set-working-directory-pathname!) (define normal/presentation) +(define normal/clean-input/flush-typeahead) (define (initialize-package!) (set! normal/gc-start hook/gc-start) @@ -211,6 +219,7 @@ MIT in each case. |# (set! normal/set-working-directory-pathname! hook/set-working-directory-pathname!) ;;(set! normal/presentation hook/presentation) + (set! normal/clean-input/flush-typeahead hook/clean-input/flush-typeahead) (add-event-receiver! event:after-restore install!) (install!)) @@ -236,6 +245,7 @@ MIT in each case. |# (set! hook/set-working-directory-pathname! emacs/set-working-directory-pathname!) ;;(set! hook/presentation (lambda (thunk) (thunk))) + (set! hook/clean-input/flush-typeahead emacs/clean-input/flush-typeahead) unspecific) (define (install-normal-hooks!) @@ -255,4 +265,5 @@ MIT in each case. |# (set! hook/set-working-directory-pathname! normal/set-working-directory-pathname!) ;;(set! hook/presentation normal/presentation) + (set! hook/clean-input/flush-typeahead normal/clean-input/flush-typeahead) unspecific) \ No newline at end of file diff --git a/v7/src/runtime/intrpt.scm b/v7/src/runtime/intrpt.scm index 3e5bc6835..9002c2f30 100644 --- a/v7/src/runtime/intrpt.scm +++ b/v7/src/runtime/intrpt.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/intrpt.scm,v 14.3 1988/10/21 00:18:13 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/intrpt.scm,v 14.4 1990/06/22 01:04:36 cph Exp $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1990 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -59,6 +59,8 @@ MIT in each case. |# #| (#\P ,(flush-typeahead ^P-interrupt-handler)) |# #| (#\Z ,(flush-typeahead ^Z-interrupt-handler)) |#)) table)) + (set! hook/clean-input/flush-typeahead default/clean-input) + (set! hook/clean-input/keep-typeahead default/clean-input) (set! hook/^B-interrupt default/^B-interrupt) (set! hook/^G-interrupt default/^G-interrupt) (set! hook/^U-interrupt default/^U-interrupt) @@ -71,8 +73,7 @@ MIT in each case. |# (define-primitives (clear-interrupts! 1) - check-and-clean-up-input-channel - get-next-interrupt-character + (tty-next-interrupt-char 0) set-fixed-objects-vector! (setup-timer-interrupt 2)) @@ -123,7 +124,7 @@ MIT in each case. |# (define (external-interrupt-handler interrupt-code interrupt-enables) interrupt-code (clear-interrupts! interrupt-bit/kbd) - (external-interrupt (get-next-interrupt-character) interrupt-enables)) + (external-interrupt (tty-next-interrupt-char) interrupt-enables)) (define (with-external-interrupts-handler handler thunk) (fluid-let ((external-interrupt (flush-typeahead handler))) @@ -139,18 +140,17 @@ MIT in each case. |# (define keyboard-interrupts) -;;; The following definitions must match the microcode. -(define until-most-recent-interrupt-character 0) -(define multiple-copies-only 1) - (define ((flush-typeahead kernel) character interrupt-enables) - (if (check-and-clean-up-input-channel until-most-recent-interrupt-character - character) + (if (hook/clean-input/flush-typeahead character) (kernel character interrupt-enables))) (define ((keep-typeahead kernel) character interrupt-enables) - (if (check-and-clean-up-input-channel multiple-copies-only character) + (if (hook/clean-input/keep-typeahead character) (kernel character interrupt-enables))) + +(define hook/clean-input/flush-typeahead) +(define hook/clean-input/keep-typeahead) +(define (default/clean-input character) character true) (define (^B-interrupt-handler character interrupt-enables) character diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 2a2658208..6d59bd61d 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.68 1990/06/21 22:11:42 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.69 1990/06/22 01:04:42 cph Exp $ Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology @@ -757,7 +757,8 @@ MIT in each case. |# timer-interrupt with-external-interrupts-handler) (export (runtime emacs-interface) - hook/^g-interrupt) + hook/^g-interrupt + hook/clean-input/flush-typeahead) (initialization (initialize-package!))) (define-package (runtime lambda-abstraction) diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm index cc0a8dec4..9b293d58e 100644 --- a/v7/src/runtime/version.scm +++ b/v7/src/runtime/version.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.83 1990/06/21 22:11:52 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.84 1990/06/22 01:04:48 cph Exp $ Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology @@ -45,7 +45,7 @@ MIT in each case. |# '())) (add-system! microcode-system) (add-event-receiver! event:after-restore snarf-microcode-version!) - (add-identification! "Runtime" 14 83)) + (add-identification! "Runtime" 14 84)) (define microcode-system) diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 074e826c8..b86049c44 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.68 1990/06/21 22:11:42 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.69 1990/06/22 01:04:42 cph Exp $ Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology @@ -757,7 +757,8 @@ MIT in each case. |# timer-interrupt with-external-interrupts-handler) (export (runtime emacs-interface) - hook/^g-interrupt) + hook/^g-interrupt + hook/clean-input/flush-typeahead) (initialization (initialize-package!))) (define-package (runtime lambda-abstraction) -- 2.25.1