From 0f1db63b62dfb9e11e659066aa744da8f8cc870b Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 17 Aug 2007 02:34:29 +0000 Subject: [PATCH] Implement BYTES-WRITTEN operation for REPL buffer ports. --- v7/src/edwin/intmod.scm | 43 +++++++++++++++++++++++++++-------------- 1 file changed, 28 insertions(+), 15 deletions(-) diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm index ec7d413d4..306c45af1 100644 --- a/v7/src/edwin/intmod.scm +++ b/v7/src/edwin/intmod.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: intmod.scm,v 1.126 2007/03/26 23:54:26 riastradh Exp $ +$Id: intmod.scm,v 1.127 2007/08/17 02:34:29 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -808,12 +808,6 @@ If this is an error, the debugger examines the error condition." (make-interface-port-state thread (mark-right-inserting-copy (buffer-end buffer)) - (make-ring (ref-variable comint-input-ring-size)) - (make-queue) - #f - #f - (make-queue) - '() (register-inferior-thread! thread (lambda () (process-output-queue port))))))) @@ -823,16 +817,20 @@ If this is an error, the debugger examines the error condition." (and (port? object) (interface-port-state? (port/state object)))) -(define-structure (interface-port-state (conc-name interface-port-state/)) +(define-structure (interface-port-state + (conc-name interface-port-state/) + (constructor make-interface-port-state + (thread mark output-registration))) (thread #f read-only #t) (mark #f read-only #t) - (input-ring #f read-only #t) - (expression-queue #f read-only #t) - current-queue-element - command-char - (output-queue #f read-only #t) - output-strings - (output-registration #f read-only #t)) + (input-ring (make-ring (ref-variable comint-input-ring-size)) read-only #t) + (expression-queue (make-queue) read-only #t) + (current-queue-element #f) + (command-char #f) + (output-queue (make-queue) read-only #t) + (output-strings '()) + (output-registration #f read-only #t) + (bytes-written 0)) (define-integrable (port/thread port) (interface-port-state/thread (port/state port))) @@ -872,6 +870,12 @@ If this is an error, the debugger examines the error condition." (define-integrable (port/output-registration port) (interface-port-state/output-registration (port/state port))) + +(define-integrable (port/bytes-written port) + (interface-port-state/bytes-written (port/state port))) + +(define-integrable (set-port/bytes-written! port n) + (set-interface-port-state/bytes-written! (port/state port) n)) ;;; Output operations @@ -919,10 +923,18 @@ If this is an error, the debugger examines the error condition." (define (enqueue-output-string! port string) (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok))) (set-port/output-strings! port (cons string (port/output-strings port))) + (set-port/bytes-written! port + (+ (port/bytes-written port) + (string-length string))) (inferior-thread-output!/unsafe (port/output-registration port)) (set-interrupt-enables! interrupt-mask) unspecific)) +;;; We assume here that none of the OPERATORs passed to this procedure +;;; generate any output in the REPL buffer, and consequently we don't +;;; need to update bytes-written here. Review of the current usage of +;;; this procedure confirms the assumption. + (define (enqueue-output-operation! port operator) (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok))) (let ((strings (port/output-strings port))) @@ -1143,6 +1155,7 @@ If this is an error, the debugger examines the error condition." (WRITE-SUBSTRING ,operation/write-substring) (BEEP ,operation/beep) (X-SIZE ,operation/x-size) + (BYTES-WRITTEN ,port/bytes-written) (DEBUGGER-FAILURE ,operation/debugger-failure) (DEBUGGER-MESSAGE ,operation/debugger-message) (DEBUGGER-PRESENTATION ,operation/debugger-presentation) -- 2.25.1