From 7d3afd32a86e41c51bf22a405487a9760eabdc72 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Wed, 1 Jan 2003 02:27:05 +0000 Subject: [PATCH] Change GUARANTEE-*-PORT procedures to accept a second argument specifying the caller, and update all references. --- v7/src/runtime/error.scm | 6 +---- v7/src/runtime/input.scm | 22 ++++++++--------- v7/src/runtime/output.scm | 22 ++++++++--------- v7/src/runtime/port.scm | 52 +++++++++++++++++++++++---------------- v7/src/runtime/stream.scm | 6 ++--- v7/src/sicp/compat.scm | 14 +++++------ 6 files changed, 64 insertions(+), 58 deletions(-) diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm index 6f8e78a8c..ff08715a1 100644 --- a/v7/src/runtime/error.scm +++ b/v7/src/runtime/error.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: error.scm,v 14.58 2002/11/20 19:46:19 cph Exp $ +$Id: error.scm,v 14.59 2003/01/01 02:26:37 cph Exp $ Copyright (c) 1988-2002 Massachusetts Institute of Technology @@ -1245,10 +1245,6 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (if (not (continuation? object)) (error:wrong-type-argument object "continuation" operator))) -(define-integrable (guarantee-output-port object operator) - (if (not (output-port? object)) - (error:wrong-type-argument object "output port" operator))) - (define-integrable (guarantee-condition-type object operator) (if (not (condition-type? object)) (error:wrong-type-argument object "condition type" operator))) diff --git a/v7/src/runtime/input.scm b/v7/src/runtime/input.scm index dc590c838..2fff5b0cd 100644 --- a/v7/src/runtime/input.scm +++ b/v7/src/runtime/input.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: input.scm,v 14.21 2002/11/20 19:46:20 cph Exp $ +$Id: input.scm,v 14.22 2003/01/01 02:25:33 cph Exp $ -Copyright (c) 1988-1999 Massachusetts Institute of Technology +Copyright (c) 1988-1999, 2002 Massachusetts Institute of Technology This file is part of MIT Scheme. @@ -74,7 +74,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (define (char-ready? #!optional port interval) (input-port/char-ready? (if (default-object? port) (current-input-port) - (guarantee-input-port port)) + (guarantee-input-port port 'CHAR-READY?)) (if (default-object? interval) 0 (begin @@ -88,7 +88,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-input-port) - (guarantee-input-port port)))) + (guarantee-input-port port 'PEEK-CHAR)))) (let loop () (or (input-port/peek-char port) (loop))))) @@ -97,7 +97,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-input-port) - (guarantee-input-port port)))) + (guarantee-input-port port 'READ-CHAR)))) (let loop () (or (input-port/read-char port) (loop))))) @@ -106,7 +106,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-input-port) - (guarantee-input-port port)))) + (guarantee-input-port port 'READ-CHAR-NO-HANG)))) (if (input-port/char-ready? port 0) (input-port/read-char port) (let ((eof? (port/operation port 'EOF?))) @@ -117,13 +117,13 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (define (read-string delimiters #!optional port) (input-port/read-string (if (default-object? port) (current-input-port) - (guarantee-input-port port)) + (guarantee-input-port port 'READ-STRING)) delimiters)) (define (read #!optional port parser-table) (parse-object (if (default-object? port) (current-input-port) - (guarantee-input-port port)) + (guarantee-input-port port 'READ)) (if (default-object? parser-table) (current-parser-table) parser-table))) @@ -131,16 +131,16 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (define (read-line #!optional port) (input-port/read-line (if (default-object? port) (current-input-port) - (guarantee-input-port port)))) + (guarantee-input-port port 'READ-LINE)))) (define (read-string! string #!optional port) (input-port/read-string! (if (default-object? port) (current-input-port) - (guarantee-input-port port)) + (guarantee-input-port port 'READ-STRING!)) string)) (define (read-substring! string start end #!optional port) (input-port/read-substring! (if (default-object? port) (current-input-port) - (guarantee-input-port port)) + (guarantee-input-port port 'READ-SUBSTRING!)) string start end)) \ No newline at end of file diff --git a/v7/src/runtime/output.scm b/v7/src/runtime/output.scm index 24150f558..63ef69b14 100644 --- a/v7/src/runtime/output.scm +++ b/v7/src/runtime/output.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: output.scm,v 14.25 2002/12/09 05:40:26 cph Exp $ +$Id: output.scm,v 14.26 2003/01/01 02:25:54 cph Exp $ Copyright (c) 1988-2002 Massachusetts Institute of Technology @@ -72,7 +72,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-output-port) - (guarantee-output-port port)))) + (guarantee-output-port port 'NEWLINE)))) (output-port/write-char port #\newline) (output-port/discretionary-flush port))) @@ -80,7 +80,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-output-port) - (guarantee-output-port port)))) + (guarantee-output-port port 'FRESH-LINE)))) (output-port/fresh-line port) (output-port/discretionary-flush port))) @@ -88,7 +88,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-output-port) - (guarantee-output-port port)))) + (guarantee-output-port port 'WRITE-CHAR)))) (output-port/write-char port char) (output-port/discretionary-flush port))) @@ -96,7 +96,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-output-port) - (guarantee-output-port port)))) + (guarantee-output-port port 'WRITE-STRING)))) (output-port/write-string port string) (output-port/discretionary-flush port))) @@ -104,7 +104,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-output-port) - (guarantee-output-port port)))) + (guarantee-output-port port 'WRITE-SUBSTRING)))) (output-port/write-substring port string start end) (output-port/discretionary-flush port))) @@ -113,7 +113,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-output-port) - (guarantee-output-port port)))) + (guarantee-output-port port operation-name)))) (let ((operation (port/operation port operation-name))) (if operation (begin @@ -127,7 +127,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-output-port) - (guarantee-output-port port))) + (guarantee-output-port port 'DISPLAY))) (unparser-table (if (default-object? unparser-table) (current-unparser-table) @@ -141,7 +141,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-output-port) - (guarantee-output-port port))) + (guarantee-output-port port 'WRITE))) (unparser-table (if (default-object? unparser-table) (current-unparser-table) @@ -153,7 +153,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((port (if (default-object? port) (current-output-port) - (guarantee-output-port port))) + (guarantee-output-port port 'WRITE-LINE))) (unparser-table (if (default-object? unparser-table) (current-unparser-table) @@ -166,4 +166,4 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (output-port/flush-output (if (default-object? port) (current-output-port) - (guarantee-output-port port)))) \ No newline at end of file + (guarantee-output-port port 'FLUSH-OUTPUT)))) \ No newline at end of file diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm index b42912691..8d93ddb68 100644 --- a/v7/src/runtime/port.scm +++ b/v7/src/runtime/port.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: port.scm,v 1.24 2002/11/20 19:46:22 cph Exp $ +$Id: port.scm,v 1.25 2003/01/01 02:26:11 cph Exp $ Copyright (c) 1991-2002 Massachusetts Institute of Technology @@ -302,24 +302,24 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (and (port-type/supports-input? type) (port-type/supports-output? type))))) -(define (guarantee-port port) +(define (guarantee-port port procedure) (if (not (port? port)) - (error:wrong-type-argument port "port" #f)) + (error:wrong-type-argument port "port" procedure)) port) -(define (guarantee-input-port port) +(define (guarantee-input-port port procedure) (if (not (input-port? port)) - (error:wrong-type-argument port "input port" #f)) + (error:wrong-type-argument port "input port" procedure)) port) -(define (guarantee-output-port port) +(define (guarantee-output-port port procedure) (if (not (output-port? port)) - (error:wrong-type-argument port "output port" #f)) + (error:wrong-type-argument port "output port" procedure)) port) -(define (guarantee-i/o-port port) +(define (guarantee-i/o-port port procedure) (if (not (i/o-port? port)) - (error:wrong-type-argument port "I/O port" #f)) + (error:wrong-type-argument port "I/O port" procedure)) port) ;;;; Encapsulation @@ -334,7 +334,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (encapsulated-port-state? (%port/state object)))) (define (guarantee-encapsulated-port object procedure) - (guarantee-port object) + (guarantee-port object procedure) (if (not (encapsulated-port-state? (%port/state object))) (error:wrong-type-argument object "encapsulated port" procedure))) @@ -351,7 +351,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (set-encapsulated-port-state/state! (%port/state port) state)) (define (make-encapsulated-port port state rewrite-operation) - (guarantee-port port) + (guarantee-port port 'MAKE-ENCAPSULATED-PORT) (%make-port (let ((type (port/type port))) (make-port-type (append-map @@ -641,55 +641,65 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (or *current-input-port* (nearest-cmdl/port))) (define (set-current-input-port! port) - (set! *current-input-port* (guarantee-input-port port)) + (set! *current-input-port* + (guarantee-input-port port 'SET-CURRENT-INPUT-PORT!)) unspecific) (define (with-input-from-port port thunk) - (fluid-let ((*current-input-port* (guarantee-input-port port))) + (fluid-let ((*current-input-port* + (guarantee-input-port port 'WITH-INPUT-FROM-PORT))) (thunk))) (define (current-output-port) (or *current-output-port* (nearest-cmdl/port))) (define (set-current-output-port! port) - (set! *current-output-port* (guarantee-output-port port)) + (set! *current-output-port* + (guarantee-output-port port 'SET-CURRENT-OUTPUT-PORT!)) unspecific) (define (with-output-to-port port thunk) - (fluid-let ((*current-output-port* (guarantee-output-port port))) + (fluid-let ((*current-output-port* + (guarantee-output-port port 'WITH-OUTPUT-TO-PORT))) (thunk))) (define (notification-output-port) (or *notification-output-port* (nearest-cmdl/port))) (define (set-notification-output-port! port) - (set! *notification-output-port* (guarantee-output-port port)) + (set! *notification-output-port* + (guarantee-output-port port 'SET-NOTIFICATION-OUTPUT-PORT!)) unspecific) (define (with-notification-output-port port thunk) - (fluid-let ((*notification-output-port* (guarantee-output-port port))) + (fluid-let ((*notification-output-port* + (guarantee-output-port port 'WITH-NOTIFICATION-OUTPUT-PORT))) (thunk))) (define (trace-output-port) (or *trace-output-port* (nearest-cmdl/port))) (define (set-trace-output-port! port) - (set! *trace-output-port* (guarantee-output-port port)) + (set! *trace-output-port* + (guarantee-output-port port 'SET-TRACE-OUTPUT-PORT!)) unspecific) (define (with-trace-output-port port thunk) - (fluid-let ((*trace-output-port* (guarantee-output-port port))) + (fluid-let ((*trace-output-port* + (guarantee-output-port port 'WITH-TRACE-OUTPUT-PORT))) (thunk))) (define (interaction-i/o-port) (or *interaction-i/o-port* (nearest-cmdl/port))) (define (set-interaction-i/o-port! port) - (set! *interaction-i/o-port* (guarantee-i/o-port port)) + (set! *interaction-i/o-port* + (guarantee-i/o-port port 'SET-INTERACTION-I/O-PORT!)) unspecific) (define (with-interaction-i/o-port port thunk) - (fluid-let ((*interaction-i/o-port* (guarantee-i/o-port port))) + (fluid-let ((*interaction-i/o-port* + (guarantee-i/o-port port 'WITH-INTERACTION-I/O-PORT))) (thunk))) (define standard-port-accessors diff --git a/v7/src/runtime/stream.scm b/v7/src/runtime/stream.scm index d913a92e8..a8c0bddfe 100644 --- a/v7/src/runtime/stream.scm +++ b/v7/src/runtime/stream.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: stream.scm,v 14.13 2002/11/20 19:46:23 cph Exp $ +$Id: stream.scm,v 14.14 2003/01/01 02:26:49 cph Exp $ -Copyright (c) 1988-1999 Massachusetts Institute of Technology +Copyright (c) 1988-1999, 2002 Massachusetts Institute of Technology This file is part of MIT Scheme. @@ -233,7 +233,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. #\{ (if (default-object? port) (current-output-port) - (guarantee-output-port port)))))) + (guarantee-output-port port 'STREAM-WRITE)))))) (define (list->stream list) (if (pair? list) diff --git a/v7/src/sicp/compat.scm b/v7/src/sicp/compat.scm index 10873acc7..2d4919884 100644 --- a/v7/src/sicp/compat.scm +++ b/v7/src/sicp/compat.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: compat.scm,v 1.9 2002/11/20 19:46:25 cph Exp $ +$Id: compat.scm,v 1.10 2003/01/01 02:27:05 cph Exp $ -Copyright (c) 1987-1999 Massachusetts Institute of Technology +Copyright (c) 1987-1999, 2002 Massachusetts Institute of Technology This file is part of MIT Scheme. @@ -126,8 +126,8 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((char (read-char (if (default-object? port) - (current-output-port) - (guarantee-output-port port))))) + (current-input-port) + (guarantee-input-port port 'TYI))))) (if (char? char) (char->ascii char) char))) @@ -136,8 +136,8 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (let ((char (peek-char (if (default-object? port) - (current-output-port) - (guarantee-output-port port))))) + (current-input-port) + (guarantee-input-port port 'TYIPEEK))))) (if (char? char) (char->ascii char) char))) @@ -146,7 +146,7 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. (write-char (ascii->char ascii) (if (default-object? port) (current-output-port) - (guarantee-output-port port)))) + (guarantee-output-port port 'TYO)))) (define (print-depth #!optional newval) (let ((newval (if (default-object? newval) false newval))) -- 2.25.1