Change screen object: remove operation/preempt-update? and replace it

with preemption-modulus and operation/discretionary-flush.  Use this
to speed up inner loop of screen-update.

diff --git a/v7/src/edwin/screen.scm b/v7/src/edwin/screen.scm
index 2d78be0981e59bea3e39dbaf72d3ef0c264b0b6e..11cc81609f84fe33a8865adec6ab97f6404ab297 100644 (file)
--- a/v7/src/edwin/screen.scm
+++ b/v7/src/edwin/screen.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.88 1991/03/16 00:02:48 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.89 1991/03/16 08:13:04 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -58,13 +58,14 @@
                                 operation/exit!
                                 operation/flush!
                                 operation/modeline-event!
-                                operation/preempt-update?
+                                operation/discretionary-flush
                                 operation/scroll-lines-down!
                                 operation/scroll-lines-up!
                                 operation/wrap-update!
                                 operation/write-char!
                                 operation/write-cursor!
                                 operation/write-substring!
+                                preemption-modulus
                                 x-size
                                 y-size)))
   (state false read-only true)
@@ -77,13 +78,14 @@
   (operation/exit! false read-only true)
   (operation/flush! false read-only true)
   (operation/modeline-event! false read-only true)
-  (operation/preempt-update? false read-only true)
+  (operation/discretionary-flush false read-only true)
   (operation/scroll-lines-down! false read-only true)
   (operation/scroll-lines-up! false read-only true)
   (operation/wrap-update! false read-only true)
   (operation/write-char! false read-only true)
   (operation/write-cursor! false read-only true)
   (operation/write-substring! false read-only true)
+  (preemption-modulus false read-only true)
   (root-window false)
   (needs-update? false)
   (in-update? false)
@@ -188,9 +190,6 @@
       ((screen-debug-trace screen) 'terminal screen 'move-cursor x y))
   ((screen-operation/write-cursor! screen) screen x y))
 
-(define-integrable (terminal-preempt-update? screen y)
-  ((screen-operation/preempt-update? screen) screen y))
-
 (define-integrable (terminal-clear-screen screen)
   (if (screen-debug-trace screen)
       ((screen-debug-trace screen) 'terminal screen 'clear-screen))
@@ -529,6 +528,8 @@
   (let ((current-matrix (screen-current-matrix screen))
        (new-matrix (screen-new-matrix screen))
        (y-size (screen-y-size screen))
+       (preemption-modulus (screen-preemption-modulus screen))
+       (discretionary-flush (screen-operation/discretionary-flush screen))
        (halt-update? (editor-halt-update? current-editor)))
     (let ((enable (matrix-enable new-matrix)))
       (let loop ((y 0))
@@ -540,9 +541,10 @@
                 (set-matrix-cursor-y! current-matrix y))
               (set-screen-needs-update?! screen false)
               true)
-             ((and (terminal-preempt-update? screen y)
-                   ;; `terminal-preempt-update?' has side-effects,
-                   ;; and it must be run regardless of `force?'.
+             ((and (fix:= 0 (fix:remainder y preemption-modulus))
+                   (begin
+                     (if discretionary-flush (discretionary-flush screen))
+                     true)
                    (not force?)
                    (or (halt-update?)
                        (eq? (screen-debug-preemption-y screen) y)))

diff --git a/v7/src/edwin/tterm.scm b/v7/src/edwin/tterm.scm
index ca29c1615a1a5f5884c3ce6387bc9bff43a06fa2..cc8caafd95957cce2bcf8affca9af6ec7851283a 100644 (file)
--- a/v7/src/edwin/tterm.scm
+++ b/v7/src/edwin/tterm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tterm.scm,v 1.5 1991/03/16 00:03:03 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/tterm.scm,v 1.6 1991/03/16 08:13:20 cph Exp $
 
 Copyright (c) 1990-91 Massachusetts Institute of Technology
 
@@ -76,31 +76,29 @@ MIT in each case. |#
          ((not (no-undesirable-characteristics? description))
           (error "terminal type has undesirable characteristics"
                  (terminal-type-name description))))
-    (make-screen (let ((baud-rate (output-port/baud-rate console-output-port)))
-                  (let ((baud-rate-index (baud-rate->index baud-rate)))
-                    (make-terminal-state
-                     description
-                     baud-rate-index
-                     baud-rate
-                     (fix:1+ (fix:quotient baud-rate 2400)))))
-                console-beep
-                console-clear-line!
-                console-clear-rectangle!
-                console-clear-screen!
-                console-discard!
-                console-enter!
-                console-exit!
-                console-flush!
-                console-modeline-event!
-                console-preempt-update?
-                console-scroll-lines-down!
-                console-scroll-lines-up!
-                console-wrap-update!
-                console-write-char!
-                console-write-cursor!
-                console-write-substring!
-                (output-port/x-size console-output-port)
-                (output-port/y-size console-output-port))))
+    (let ((baud-rate (output-port/baud-rate console-output-port)))
+      (make-screen (make-terminal-state description
+                                       (baud-rate->index baud-rate)
+                                       baud-rate)
+                  console-beep
+                  console-clear-line!
+                  console-clear-rectangle!
+                  console-clear-screen!
+                  console-discard!
+                  console-enter!
+                  console-exit!
+                  console-flush!
+                  console-modeline-event!
+                  console-discretionary-flush
+                  console-scroll-lines-down!
+                  console-scroll-lines-up!
+                  console-wrap-update!
+                  console-write-char!
+                  console-write-cursor!
+                  console-write-substring!
+                  (fix:1+ (fix:quotient baud-rate 2400))
+                  (output-port/x-size console-output-port)
+                  (output-port/y-size console-output-port)))))
 
 (define (console-termcap-description)
   (if (eq? console-description 'UNKNOWN)
@@ -283,15 +281,11 @@ MIT in each case. |#
 
 (define-structure (terminal-state
                   (constructor make-terminal-state
-                               (description
-                                baud-rate-index
-                                baud-rate
-                                preemption-modulus))
+                               (description baud-rate-index baud-rate))
                   (conc-name terminal-state/))
   (description false read-only true)
   (baud-rate-index false read-only true)
   (baud-rate false read-only true)
-  (preemption-modulus false read-only true)
   (cursor-x false)
   (cursor-y false)
   (standout-mode? false)
@@ -308,9 +302,6 @@ MIT in each case. |#
 (define-integrable (screen-baud-rate screen)
   (terminal-state/baud-rate (screen-state screen)))
 
-(define-integrable (screen-preemption-modulus screen)
-  (terminal-state/preemption-modulus (screen-state screen)))
-
 (define-integrable (screen-cursor-x screen)
   (terminal-state/cursor-x (screen-state screen)))
 
@@ -376,22 +367,19 @@ MIT in each case. |#
   (thunk)
   (output-port/flush-output console-output-port))
 
-(define (console-preempt-update? screen y)
-  (and (fix:= 0 (fix:remainder y (screen-preemption-modulus screen)))
-       (begin
-        (let ((n (output-port/buffered-chars console-output-port)))
-          (if (fix:< 20 n)
-              (begin
-                (output-port/flush-output console-output-port)
-                (let ((baud-rate (screen-baud-rate screen)))
-                  (if (fix:< baud-rate 2400)
-                      (let ((msec (quotient (* n 10000) baud-rate)))
-                        (if (>= msec 1000)
-                            (let ((t (+ (real-time-clock) msec)))
-                              (let loop ()
-                                (if (< (real-time-clock) t)
-                                    (loop)))))))))))
-        true)))
+(define (console-discretionary-flush screen)
+  (let ((n (output-port/buffered-chars console-output-port)))
+    (if (fix:< 20 n)
+       (begin
+         (output-port/flush-output console-output-port)
+         (let ((baud-rate (screen-baud-rate screen)))
+           (if (fix:< baud-rate 2400)
+               (let ((msec (quotient (* n 10000) baud-rate)))
+                 (if (>= msec 1000)
+                     (let ((t (+ (real-time-clock) msec)))
+                       (let loop ()
+                         (if (< (real-time-clock) t)
+                             (loop))))))))))))
 
 (define (console-beep screen)
   (output-1 screen (ts-audible-bell (screen-description screen))))

diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm
index 663afa9a8f9f596c0edb97ead50e756390918f79..a52d0b622840d2b8cb86cbe9da6843ca0abd7184 100644 (file)
--- a/v7/src/edwin/xterm.scm
+++ b/v7/src/edwin/xterm.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.15 1991/03/16 00:03:18 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.16 1991/03/16 08:13:31 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -105,13 +105,14 @@
                        xterm-screen/exit!
                        xterm-screen/flush!
                        xterm-screen/modeline-event!
-                       xterm-screen/preempt-update?
+                       false
                        xterm-screen/scroll-lines-down!
                        xterm-screen/scroll-lines-up!
                        xterm-screen/wrap-update!
                        xterm-screen/write-char!
                        xterm-screen/write-cursor!
                        xterm-screen/write-substring!
+                       8
                        (xterm-x-size xterm)
                        (xterm-y-size xterm)))))
     (set! screen-list (cons screen screen-list))
@@ -180,11 +181,6 @@
     (xterm-erase-cursor xterm))
   (xterm-screen/flush! screen))
 
-(define (xterm-screen/preempt-update? screen y)
-  screen                               ; ignored
-  (fix:= (fix:remainder y 8) 0))
-  
-
 (define (xterm-screen/scroll-lines-down! screen xl xu yl yu amount)
   (xterm-scroll-lines-down (screen-xterm screen) xl xu yl yu amount)
   'UNCHANGED)