Implement `check-and-clean-up-input-channel' in runtime system --

microcode no longer provides this service.

diff --git a/v7/src/runtime/emacs.scm b/v7/src/runtime/emacs.scm
index 3948af54e44460c45325c727d3bd0cad11c953de..d43c8b8f7f12eb72c3c1eab4f8786e7a0df194a5 100644 (file)
--- 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)
 \f
 (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!))
 \f
@@ -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 3e5bc683509f17d8248dddc274f09f6744a55fa6..9002c2f3016ad1d65184c9b521d824a8a4950e9d 100644 (file)
--- 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)
 \f
 (define (^B-interrupt-handler character interrupt-enables)
   character

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 2a265820850aba66b0d419fce1d1011a47ec6c63..6d59bd61d2e74d2bea9f2d26a2d5713e9881c7e2 100644 (file)
--- 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 cc0a8dec4141ae69ca31fb92d259575ad611f20f..9b293d58efbdc2853fa0fe3fd7c867d1969ec75a 100644 (file)
--- 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 074e826c8b6a3289ae46494325d7765ecf7d6d9a..b86049c44204a0eabe9827d783eaf53212aad4e3 100644 (file)
--- 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)