From: Chris Hanson Date: Tue, 16 Feb 1999 18:48:47 +0000 (+0000) Subject: Don't export {IN,OUT}PUT-PORT/OPERATION/ procedures to the global X-Git-Tag: 20090517-FFI~4625 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2ab8de6247793b3dce370980d77d13ab3e09bcd4;p=mit-scheme.git Don't export {IN,OUT}PUT-PORT/OPERATION/ procedures to the global environment. --- diff --git a/v7/src/runtime/infutl.scm b/v7/src/runtime/infutl.scm index e3f9c3e59..6c2201766 100644 --- a/v7/src/runtime/infutl.scm +++ b/v7/src/runtime/infutl.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: infutl.scm,v 1.60 1999/01/02 06:06:43 cph Exp $ +$Id: infutl.scm,v 1.61 1999/02/16 18:48:42 cph Exp $ Copyright (c) 1988-1999 Massachusetts Institute of Technology @@ -50,8 +50,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let ((dbg-info (read-debugging-info old-info))) (if dbg-info (memoize-debugging-info! block dbg-info)) dbg-info)) - (else - false)))) + (else #f)))) (define (discard-debugging-info!) (without-interrupts @@ -78,8 +77,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (vector? binf) (< (cdr descriptor) (vector-length binf)) (vector-ref binf (cdr descriptor))))) - (else - false))) + (else #f))) (define (read-binf-file pathname) (let ((pathname (canonicalize-debug-info-pathname pathname))) @@ -133,7 +131,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let ((dbg-info (compiled-code-block/dbg-info block (if (default-object? demand-load?) - true + #t demand-load?)))) (and dbg-info (let ((find-procedure @@ -177,13 +175,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (compiled-code-block/filename-and-index block) (let loop ((info (compiled-code-block/debugging-info block))) (cond ((string? info) (values (canonicalize-debug-info-filename info) #f)) - ((not (pair? info)) (values false false)) + ((not (pair? info)) (values #f #f)) ((dbg-info? (car info)) (loop (cdr info))) ((string? (car info)) (values (canonicalize-debug-info-filename (car info)) (and (exact-nonnegative-integer? (cdr info)) (cdr info)))) - (else (values false false))))) + (else (values #f #f))))) (define (dbg-labels/find-offset labels offset) (vector-binary-search labels < dbg-label/offset offset)) @@ -199,7 +197,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (dbg-info-vector/purification-root info) (let ((items (dbg-info-vector/items info))) - (cond ((vector? items) false) + (cond ((vector? items) #f) ((and (pair? items) (eq? (car items) 'COMPILED-BY-PROCEDURES) (pair? (cdr items)) @@ -369,7 +367,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (symbol->string name)))))) (define load-debugging-info-on-demand? - false) + #f) (define (special-form-procedure-name? name) (let ((association (assq name special-form-procedure-names))) @@ -402,7 +400,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (vector-ref bsm 0)))) (cond ((pair? first) bsm) ((vector? first) first) - (else false))))))) + (else #f))))))) ((and (pair? descriptor) (string? (car descriptor)) (exact-nonnegative-integer? (cdr descriptor))) @@ -411,8 +409,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (vector? bsm) (< (cdr descriptor) (vector-length bsm)) (vector-ref bsm (cdr descriptor))))) - (else - false))) + (else #f))) (define (read-bsm-file name) (let ((pathname @@ -446,9 +443,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let ((bifpath (merge-pathnames bifpath)) (bsmpath (and bsmpath (merge-pathnames bsmpath)))) (let ((bsm (split-inf-structure! binf bsmpath))) - (fasdump binf bifpath true) + (fasdump binf bifpath #t) (if bsmpath - (fasdump bsm bsmpath true))))) + (fasdump bsm bsmpath #t))))) (define (split-inf-structure! binf bsmpath) (let ((bsmname (and bsmpath (->namestring bsmpath)))) @@ -477,18 +474,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define-integrable window-size 4096) (define (uncompress-ports input-port output-port #!optional buffer-size) - (let ((buffer-size (if (default-object? buffer-size) - 4096 - buffer-size))) - (let ((read-substring (input-port/operation input-port 'READ-SUBSTRING))) - (if read-substring - (uncompress-kernel-by-blocks input-port output-port buffer-size - read-substring) - (let ((read-char - (or (input-port/operation/read-char input-port) - (error "Port doesn't support read-char" input-port)))) - (uncompress-kernel-by-chars input-port output-port buffer-size - read-char)))))) + (uncompress-kernel-by-blocks + input-port output-port + (if (default-object? buffer-size) 4096 buffer-size) + (input-port/operation input-port 'READ-SUBSTRING))) (define (uncompress-read-substring port buffer start end) (let loop ((i start)) @@ -510,6 +499,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;; . The EOF indicator returned by READ-CHAR must not be a character, which ;; implies that EOF-OBJECT? and CHAR? are disjoint. +#| (define (uncompress-kernel-by-chars input-port output-port buffer-size read-char) (let ((buffer (make-string buffer-size)) @@ -576,6 +566,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (vector-8b-ref buffer bp*)))) (vector-set! cp-table cp bp) (loop nbp ncp)))))))))) +|# ;; This version will uncompress any input that can be read in chunks by ;; applying parameter READ-SUBSTRING to INPUT-PORT and a substring @@ -675,7 +666,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (do ((bp bp (fix:+ bp 1)) (cp cp (cp:+ cp 1))) ((fix:= bp nbp)) (vector-set! cp-table cp bp)) - (parse-command nbp ncp nip ip-end buffer buffer-size))))))) + (parse-command nbp ncp nip ip-end buffer + buffer-size))))))) (define (copy-command byte) (let ((ip* (fix:+ ip 1))) @@ -708,8 +700,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (call-with-current-continuation (lambda (if-fail) (bind-condition-handler (list condition-type:fasload-band) - (lambda (condition) condition (if-fail false)) - (lambda () (fasload filename true)))))) + (lambda (condition) condition (if-fail #f)) + (lambda () (fasload filename #t)))))) (define (compressed-loader uncompressed-type) (lambda (compressed-file) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 25b596dde..4322192a6 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.310 1999/02/16 05:39:38 cph Exp $ +$Id: runtime.pkg,v 14.311 1999/02/16 18:48:29 cph Exp $ Copyright (c) 1988-1999 Massachusetts Institute of Technology @@ -1102,13 +1102,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. input-port/custom-operation input-port/operation input-port/operation-names - input-port/operation/char-ready? - input-port/operation/discard-char - input-port/operation/discard-chars - input-port/operation/peek-char - input-port/operation/read-char - input-port/operation/read-string - input-port/operation/read-substring input-port/state input-port? interaction-i/o-port @@ -1121,10 +1114,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. output-port/custom-operation output-port/operation output-port/operation-names - output-port/operation/discretionary-flush - output-port/operation/flush-output - output-port/operation/write-char - output-port/operation/write-substring output-port/state output-port? port/copy @@ -1161,6 +1150,19 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. with-notification-output-port with-output-to-port with-trace-output-port) + (export (runtime input-port) + input-port/operation/char-ready? + input-port/operation/discard-char + input-port/operation/discard-chars + input-port/operation/peek-char + input-port/operation/read-char + input-port/operation/read-string + input-port/operation/read-substring) + (export (runtime output-port) + output-port/operation/discretionary-flush + output-port/operation/flush-output + output-port/operation/write-char + output-port/operation/write-substring) (export (runtime rep) *current-input-port* *current-output-port* diff --git a/v8/src/runtime/infutl.scm b/v8/src/runtime/infutl.scm index 302eb3d59..6b387bf4d 100644 --- a/v8/src/runtime/infutl.scm +++ b/v8/src/runtime/infutl.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: infutl.scm,v 1.63 1999/01/02 06:11:34 cph Exp $ +$Id: infutl.scm,v 1.64 1999/02/16 18:48:47 cph Exp $ Copyright (c) 1988-1999 Massachusetts Institute of Technology @@ -53,7 +53,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define inf-load-types) (define bsm-load-types) - (define (compiled-module-eval module environment) (scode-eval (compiled-module/expression module) environment)) @@ -92,13 +91,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (if (vector? labels/desc) labels/desc (let ((labels - (read-labels (compiled-code-block/dbg-descriptor block)))) + (read-labels + (compiled-code-block/dbg-descriptor block)))) (and labels (begin (set-dbg-info/labels/desc! info labels) labels)))))))) - - + (define (discard-debugging-info!) (without-interrupts (lambda () @@ -161,7 +160,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (canonicalize-debug-info-pathname (dbg-locator/file locator)))) (find-alternate-file-type pathname load-types))) - (define (find-alternate-file-type base-pathname alist) (let loop ((left alist) (time 0) (file #f) (receiver (lambda (x t) t x))) (if (null? left) @@ -225,7 +223,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (lambda () (let ((expression (dbg-info/expression dbg-info))) (if (and expression - (= offset (dbg-expression/label-offset expression))) + (= offset + (dbg-expression/label-offset expression))) expression (find-procedure)))) (lambda () @@ -336,7 +335,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (and (not (null? x)) (equal? (car x) (car y)) (loop (cdr x) (cdr y))))))) - + (define (canonicalize-debug-info-filename filename) (->namestring (canonicalize-debug-info-pathname filename))) @@ -415,7 +414,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (and scode (lambda-body scode)))) entry))) - + ;;;; Splitting of info structures (define (inf->bif/bsm inffile) @@ -454,18 +453,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define-integrable window-size 4096) (define (uncompress-ports input-port output-port #!optional buffer-size) - (let ((buffer-size (if (default-object? buffer-size) - 4096 - buffer-size))) - (let ((read-substring (input-port/operation input-port 'READ-SUBSTRING))) - (if read-substring - (uncompress-kernel-by-blocks input-port output-port buffer-size - read-substring) - (let ((read-char - (or (input-port/operation/read-char input-port) - (error "Port doesn't support read-char" input-port)))) - (uncompress-kernel-by-chars input-port output-port buffer-size - read-char)))))) + (uncompress-kernel-by-blocks + input-port output-port + (if (default-object? buffer-size) 4096 buffer-size) + (input-port/operation input-port 'READ-SUBSTRING))) (define (uncompress-read-substring port buffer start end) (let loop ((i start)) @@ -488,6 +479,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;; . The EOF indicator returned by READ-CHAR must not be a character, which ;; implies that EOF-OBJECT? and CHAR? are disjoint. +#| (define (uncompress-kernel-by-chars input-port output-port buffer-size read-char) (let ((buffer (make-string buffer-size)) @@ -554,6 +546,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (vector-8b-ref buffer bp*)))) (vector-set! cp-table cp bp) (loop nbp ncp)))))))))) +|# ;; This version will uncompress any input that can be read in chunks by ;; applying parameter READ-SUBSTRING to INPUT-PORT and a substring @@ -653,7 +646,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (do ((bp bp (fix:+ bp 1)) (cp cp (cp:+ cp 1))) ((fix:= bp nbp)) (vector-set! cp-table cp bp)) - (parse-command nbp ncp nip ip-end buffer buffer-size))))))) + (parse-command nbp ncp nip ip-end buffer + buffer-size))))))) (define (copy-command byte) (let ((ip* (fix:+ ip 1))) @@ -813,7 +807,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (receiver temporary-file)) (lambda () (set-file-entry/last-use-time! entry (real-time-clock))))))) - + (define (delete-uncompressed-files!) (do ((entries (cdr uncompressed-files) (cdr entries))) ((null? entries) unspecific) diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 5a2d15f75..3601215b3 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: runtime.pkg,v 14.315 1999/02/16 05:39:45 cph Exp $ +$Id: runtime.pkg,v 14.316 1999/02/16 18:48:36 cph Exp $ Copyright (c) 1988-1999 Massachusetts Institute of Technology @@ -1106,13 +1106,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. input-port/custom-operation input-port/operation input-port/operation-names - input-port/operation/char-ready? - input-port/operation/discard-char - input-port/operation/discard-chars - input-port/operation/peek-char - input-port/operation/read-char - input-port/operation/read-string - input-port/operation/read-substring input-port/state input-port? interaction-i/o-port @@ -1125,10 +1118,6 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. output-port/custom-operation output-port/operation output-port/operation-names - output-port/operation/discretionary-flush - output-port/operation/flush-output - output-port/operation/write-char - output-port/operation/write-substring output-port/state output-port? port/copy @@ -1165,6 +1154,19 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. with-notification-output-port with-output-to-port with-trace-output-port) + (export (runtime input-port) + input-port/operation/char-ready? + input-port/operation/discard-char + input-port/operation/discard-chars + input-port/operation/peek-char + input-port/operation/read-char + input-port/operation/read-string + input-port/operation/read-substring) + (export (runtime output-port) + output-port/operation/discretionary-flush + output-port/operation/flush-output + output-port/operation/write-char + output-port/operation/write-substring) (export (runtime rep) *current-input-port* *current-output-port*