From: Chris Hanson Date: Sat, 16 Mar 1991 08:13:31 +0000 (+0000) Subject: Change screen object: remove operation/preempt-update? and replace it X-Git-Tag: 20090517-FFI~10841 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8b8e368b2cd71ea81f3ec45e6750c3b14711d249;p=mit-scheme.git 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 2d78be098..11cc81609 100644 --- 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 ca29c1615..cc8caafd9 100644 --- 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 663afa9a8..a52d0b622 100644 --- 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)