From: Chris Hanson Date: Tue, 29 Oct 1991 14:32:22 +0000 (+0000) Subject: Introduce new condition type FILE-OPERATION-ERROR to handle errors X-Git-Tag: 20090517-FFI~10105 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c941635b2e594a46f5d50113fd9580d2d2fa3990;p=mit-scheme.git Introduce new condition type FILE-OPERATION-ERROR to handle errors generated by all file and directory primitives. Consequently eliminate FILE-TOUCH-ERROR and OPEN-FILE-ERROR. --- diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm index 73aedf795..caac1d995 100644 --- a/v7/src/runtime/error.scm +++ b/v7/src/runtime/error.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.26 1991/10/26 16:20:41 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/error.scm,v 14.27 1991/10/29 14:31:40 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -214,16 +214,16 @@ MIT in each case. |# (define (condition-accessor type field-name) (guarantee-condition-type type 'CONDITION-ACCESSOR) (guarantee-symbol field-name 'CONDITION-ACCESSOR) - (let ((type-description - (string-append "condition of type " (write-to-string type))) - (index + (let ((index (%condition-type/field-index type field-name 'CONDITION-ACCESSOR))) (lambda (condition) (if (not (and (condition? condition) (eq? type (%condition/type condition)))) - (error:wrong-type-argument condition type-description + (error:wrong-type-argument condition + (string-append "condition of type " + (write-to-string type)) 'CONDITION-ACCESSOR)) (vector-ref (%condition/field-values condition) index)))) @@ -565,31 +565,36 @@ MIT in each case. |# (error:wrong-number-of-arguments constructor arity field-values)) - (let ((field-value (list-ref field-values index))) - (call-with-current-continuation - (lambda (continuation) - (bind-restart 'USE-VALUE use-value-message + (call-with-current-continuation + (lambda (continuation) + (let ((condition + (apply make-condition + continuation + 'BOUND-RESTARTS + field-values))) + (bind-restart 'USE-VALUE + (if (string? use-value-message) + use-value-message + (use-value-message condition)) continuation (lambda (restart) (restart/put! restart 'INTERACTIVE (let ((prompt - (if (procedure? use-value-prompt) - (use-value-prompt field-value) - use-value-prompt))) + (if (string? use-value-prompt) + use-value-prompt + (use-value-prompt condition)))) (lambda () (values (prompt-for-evaluated-expression prompt))))) - (bind-restart 'RETRY retry-message + (bind-restart 'RETRY + (if (string? retry-message) + retry-message + (retry-message condition)) (lambda () - (continuation field-value)) + (continuation (list-ref field-values index))) (lambda (restart) (restart/put! restart 'INTERACTIVE values) - (let ((condition - (apply make-condition - continuation - 'BOUND-RESTARTS - field-values))) - (signal-condition condition) - (default-handler condition)))))))))))) + (signal-condition condition) + (default-handler condition))))))))))) constructor))) ;;;; Basic Condition Types @@ -604,12 +609,11 @@ MIT in each case. |# (define condition-type:divide-by-zero) (define condition-type:error) (define condition-type:file-error) -(define condition-type:file-touch-error) +(define condition-type:file-operation-error) (define condition-type:floating-point-overflow) (define condition-type:floating-point-underflow) (define condition-type:illegal-datum) (define condition-type:no-such-restart) -(define condition-type:open-file-error) (define condition-type:port-error) (define condition-type:serious-condition) (define condition-type:simple-condition) @@ -629,9 +633,8 @@ MIT in each case. |# (define error:bad-range-argument) (define error:datum-out-of-range) (define error:divide-by-zero) -(define error:file-touch) +(define error:file-operation) (define error:no-such-restart) -(define error:open-file) (define error:derived-file) (define error:derived-port) (define error:wrong-number-of-arguments) @@ -869,13 +872,14 @@ MIT in each case. |# filename condition))))) - (set! condition-type:open-file-error - (make-condition-type 'OPEN-FILE-ERROR condition-type:file-error - '(NOUN EXPLANATION) + (set! condition-type:file-operation-error + (make-condition-type 'FILE-OPERATION-ERROR condition-type:file-error + '(VERB NOUN REASON OPERATOR OPERANDS) (lambda (condition port) - (let ((noun (access-condition condition 'NOUN)) - (explanation (access-condition condition 'EXPLANATION))) - (write-string "Unable to open " port) + (let ((noun (access-condition condition 'NOUN))) + (write-string "Unable to " port) + (write-string (access-condition condition 'VERB) port) + (write-string " " port) (write-string noun port) (write-string " " port) (write (let ((filename (access-condition condition 'FILENAME))) @@ -883,48 +887,41 @@ MIT in each case. |# (pathname->string filename) filename)) port) - (cond ((string? explanation) - (write-string " because: " port) - (write-string (string-capitalize explanation) port) - (write-string "." port)) - ((condition? explanation) - (write-string " because: " port) - (write-condition-report explanation port)) - (else - (write-string " because: No such " port) - (write-string noun port) - (write-string "." port))))))) - - (set! error:open-file - (let ((signaller - (substitutable-value-condition-signaller - condition-type:open-file-error - '(FILENAME EXPLANATION NOUN) - standard-error-handler - 0 - "New file name (an expression to be evaluated)" - "Try opening a different file." - "Try opening the same file again."))) - (lambda (filename #!optional explanation noun) - (signaller filename - (and (not (default-object? explanation)) explanation) - (if (or (default-object? noun) - (not noun)) - "file" - noun))))) - - (set! condition-type:file-touch-error - (make-condition-type 'FILE-TOUCH-ERROR condition-type:file-error - '(MESSAGE) - (lambda (condition port) - (write-string "The primitive file-touch signalled an error: " port) - (write (access-condition condition 'MESSAGE) port) - (write-string "." port)))) - - (set! error:file-touch - (condition-signaller condition-type:file-touch-error - '(FILENAME MESSAGE) - standard-error-handler)) + (write-string " because: " port) + (let ((reason (access-condition condition 'REASON))) + (if reason + (write-string (string-capitalize reason) port) + (begin + (write-string "No such " port) + (write-string noun port)))) + (write-string "." port))))) + + (set! error:file-operation + (let ((get-verb + (condition-accessor condition-type:file-operation-error 'VERB)) + (get-noun + (condition-accessor condition-type:file-operation-error 'NOUN))) + (substitutable-value-condition-signaller + condition-type:file-operation-error + '(FILENAME VERB NOUN REASON OPERATOR OPERANDS) + standard-error-handler + 0 + (lambda (condition) + (string-append "New " + (get-noun condition) + " name (an expression to be evaluated)")) + (lambda (condition) + (string-append "Try to " + (get-verb condition) + " a different " + (get-noun condition) + ".")) + (lambda (condition) + (string-append "Try to " + (get-verb condition) + " the same " + (get-noun condition) + " again."))))) (set! condition-type:variable-error (make-condition-type 'VARIABLE-ERROR condition-type:cell-error diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm index 561e33337..038c360f6 100644 --- a/v7/src/runtime/load.scm +++ b/v7/src/runtime/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.28 1991/10/26 16:20:56 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.29 1991/10/29 14:31:49 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -183,8 +183,15 @@ MIT in each case. |# (if (pathname-type pathname) (pathname->input-truename pathname) (load/default-find-pathname-with-type pathname default-types))) - (find-true-pathname (->pathname (error:open-file pathname)) - default-types))) + (find-true-pathname + (->pathname + (error:file-operation pathname + "find" + "file" + "file does not exist" + find-true-pathname + (list pathname default-types))) + default-types))) (define (search-types-in-order pathname default-types) (let loop ((types default-types)) diff --git a/v7/src/runtime/pathnm.scm b/v7/src/runtime/pathnm.scm index 065549ec6..4288c59af 100644 --- a/v7/src/runtime/pathnm.scm +++ b/v7/src/runtime/pathnm.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/pathnm.scm,v 14.14 1991/10/26 16:21:00 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/pathnm.scm,v 14.15 1991/10/29 14:31:56 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -340,13 +340,19 @@ See the files unkpth.scm, vmspth.scm, or unxpth.scm for examples.|# (define (canonicalize-input-pathname filename) (let ((pathname (->pathname filename))) (or (pathname->input-truename pathname) - (canonicalize-input-pathname (error:open-file pathname))))) + (canonicalize-input-pathname + (error:file-operation pathname + "find" + "file" + "file does not exist" + canonicalize-input-pathname + (list filename)))))) (define (pathname->input-truename pathname) (let ((pathname (pathname->absolute-pathname pathname)) (truename-exists? (lambda (pathname) - (and ((ucode-primitive file-exists?) (pathname->string pathname)) + (and ((ucode-primitive file-exists? 1) (pathname->string pathname)) pathname)))) (cond ((not (eq? 'NEWEST (pathname-version pathname))) (truename-exists? pathname)) @@ -392,7 +398,16 @@ See the files unkpth.scm, vmspth.scm, or unxpth.scm for examples.|# (pathname-new-version pathname 1))))) (define (file-exists? filename) - (pathname->input-truename (->pathname filename))) + (let ((pathname (pathname->absolute-pathname (->pathname filename))) + (pathname-exists? + (lambda (pathname) + ((ucode-primitive file-exists? 1) (pathname->string pathname))))) + (cond ((not (eq? 'NEWEST (pathname-version pathname))) + (pathname-exists? pathname)) + ((not pathname-newest) + (pathname-exists? (pathname-new-version pathname false))) + (else + (pathname-newest pathname))))) (define (init-file-truename) (let ((pathname (init-file-pathname))) @@ -431,8 +446,12 @@ See the files unkpth.scm, vmspth.scm, or unxpth.scm for examples.|# (if (null? directories) (system-library-pathname (->pathname - (error:open-file pathname - "no such file in system library path"))) + (error:file-operation pathname + "find" + "file" + "no such file in system library path" + system-library-pathname + (list pathname)))) (or (pathname->input-truename (merge-pathnames pathname (car directories))) (loop (cdr directories))))))) diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index 30232cf19..3dc78978b 100644 --- a/v7/src/runtime/runtime.pkg +++ b/v7/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.123 1991/09/18 20:01:00 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.124 1991/10/29 14:32:03 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -558,12 +558,11 @@ MIT in each case. |# condition-type:divide-by-zero condition-type:error condition-type:file-error - condition-type:file-touch-error + condition-type:file-operation-error condition-type:floating-point-overflow condition-type:floating-point-underflow condition-type:illegal-datum condition-type:no-such-restart - condition-type:open-file-error condition-type:port-error condition-type:serious-condition condition-type:simple-condition @@ -595,9 +594,8 @@ MIT in each case. |# error:derived-file error:derived-port error:divide-by-zero - error:file-touch + error:file-operation error:no-such-restart - error:open-file error:wrong-number-of-arguments error:wrong-type-argument error:wrong-type-datum diff --git a/v7/src/runtime/sfile.scm b/v7/src/runtime/sfile.scm index 82a4a492b..3fad13bf2 100644 --- a/v7/src/runtime/sfile.scm +++ b/v7/src/runtime/sfile.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/sfile.scm,v 14.6 1991/10/26 16:21:04 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/sfile.scm,v 14.7 1991/10/29 14:32:11 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -37,36 +37,12 @@ MIT in each case. |# (declare (usual-integrations)) -(define (canonicalize-existing-filename filename) - (pathname->string (canonicalize-existing-pathname filename))) - -(define (canonicalize-existing-pathname filename) - (let ((pathname (->pathname filename))) - (or (pathname->existing-truename pathname) - (canonicalize-existing-pathname (error:open-file pathname))))) - -(define (pathname->existing-truename pathname) - (let ((pathname (pathname->absolute-pathname pathname)) - (truename-exists? - (lambda (pathname) - ;; This primitive, a unix-specific one, is used, because it - ;; is the simplest way to do an lstat on the file. The - ;; usual primitive, FILE-EXISTS?, does a stat. - (and ((ucode-primitive file-mod-time 1) (pathname->string pathname)) - pathname)))) - (cond ((not (eq? 'NEWEST (pathname-version pathname))) - (truename-exists? pathname)) - ((not pathname-newest) - (truename-exists? (pathname-new-version pathname false))) - (else - (pathname-newest pathname))))) - (define (rename-file from to) - ((ucode-primitive file-rename) (canonicalize-existing-filename from) + ((ucode-primitive file-rename) (canonicalize-input-filename from) (canonicalize-output-filename to))) (define (delete-file filename) - (let ((truename (pathname->existing-truename (->pathname filename)))) + (let ((truename (pathname->input-truename (->pathname filename)))) (and truename (begin ((ucode-primitive file-remove) (pathname->string truename)) diff --git a/v7/src/runtime/uerror.scm b/v7/src/runtime/uerror.scm index e7c424033..3946c1376 100644 --- a/v7/src/runtime/uerror.scm +++ b/v7/src/runtime/uerror.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uerror.scm,v 14.28 1991/10/26 16:21:08 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uerror.scm,v 14.29 1991/10/29 14:32:14 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -182,25 +182,24 @@ MIT in each case. |# (thunk))) (thunk)))) -(define (open-file-signaller) +(define (file-operation-signaller) (let ((signal - (condition-signaller condition-type:open-file-error - '(FILENAME NOUN EXPLANATION)))) - (lambda (continuation operator operands index noun explanation) - (open-file/use-value continuation operator operands index noun + (condition-signaller condition-type:file-operation-error + '(FILENAME VERB NOUN REASON OPERATOR OPERANDS)))) + (lambda (continuation operator operands index verb noun reason) + (file-operation/use-value continuation operator operands index verb noun (lambda () - (open-file/retry continuation operator operands noun + (file-operation/retry continuation operator operands verb noun (lambda () - (signal continuation - (list-ref operands index) - noun - explanation)))))))) + (signal continuation (list-ref operands index) + verb noun reason operator operands)))))))) -(define (open-file/use-value continuation operator operands index noun thunk) +(define (file-operation/use-value continuation operator operands index + verb noun thunk) (let ((continuation (continuation/next-continuation continuation))) (if continuation (bind-restart 'USE-VALUE - (string-append "Try opening a different " noun ".") + (string-append "Try to " verb " a different " noun ".") (lambda (operand) (within-continuation continuation (lambda () @@ -217,11 +216,11 @@ MIT in each case. |# (thunk)))) (thunk)))) -(define (open-file/retry continuation operator operands noun thunk) +(define (file-operation/retry continuation operator operands verb noun thunk) (let ((continuation (continuation/next-continuation continuation))) (if continuation (bind-restart 'RETRY - (string-append "Try opening the same " noun " again.") + (string-append "Try to " verb " the same " noun " again.") (lambda () (within-continuation continuation (lambda () @@ -328,35 +327,48 @@ MIT in each case. |# 'DIVIDE-BY-ZERO) (else false))) -(define file-open-primitives - (list (ucode-primitive file-open-append-channel 1) - (ucode-primitive file-open-input-channel 1) - (ucode-primitive file-open-io-channel 1) - (ucode-primitive file-open-output-channel 1))) - -(define directory-open-primitives - (list (ucode-primitive directory-open 1) - (ucode-primitive directory-open-noread 1))) - -(define file-primitives - (list (ucode-primitive directory-make 1) - (ucode-primitive file-access 2) - (ucode-primitive file-attributes 1) - (ucode-primitive file-attributes-indirect 1) - (ucode-primitive file-copy 2) - (ucode-primitive file-directory? 1) - (ucode-primitive file-exists? 1) - (ucode-primitive file-link-hard 2) - (ucode-primitive file-link-soft 2) - (ucode-primitive file-mod-time-indirect 1) - (ucode-primitive file-modes 1) - (ucode-primitive file-remove 1) - (ucode-primitive file-remove-link 1) - (ucode-primitive file-rename 2) - (ucode-primitive file-soft-link? 1) - (ucode-primitive file-touch 1) - (ucode-primitive link-file 3) - (ucode-primitive set-file-modes! 2))) +(define (file-primitive-description primitive) + (cond ((eq? primitive (ucode-primitive file-exists? 1)) + (values "determine existence of" "file")) + ((or (eq? primitive (ucode-primitive file-directory? 1)) + (eq? primitive (ucode-primitive file-soft-link? 1))) + (values "determine type of of" "file")) + ((or (eq? primitive (ucode-primitive file-open-append-channel 1)) + (eq? primitive (ucode-primitive file-open-input-channel 1)) + (eq? primitive (ucode-primitive file-open-io-channel 1)) + (eq? primitive (ucode-primitive file-open-output-channel 1))) + (values "open" "file")) + ((or (eq? primitive (ucode-primitive directory-open 1)) + (eq? primitive (ucode-primitive directory-open-noread 1))) + (values "open" "directory")) + ((or (eq? primitive (ucode-primitive file-modes 1)) + (eq? primitive (ucode-primitive file-access 2))) + (values "read permissions of" "file")) + ((eq? primitive (ucode-primitive set-file-modes! 2)) + (values "set permissions of" "file")) + ((or (eq? primitive (ucode-primitive file-mod-time 1)) + (eq? primitive (ucode-primitive file-mod-time-indirect 1))) + (values "read modification time of" "file")) + ((or (eq? primitive (ucode-primitive file-attributes 1)) + (eq? primitive (ucode-primitive file-attributes-indirect 1))) + (values "read attributes of" "file")) + ((eq? primitive (ucode-primitive directory-make 1)) + (values "create" "directory")) + ((eq? primitive (ucode-primitive file-copy 2)) + (values "copy" "file")) + ((or (eq? primitive (ucode-primitive file-link-hard 2)) + (eq? primitive (ucode-primitive file-link-soft 2)) + (eq? primitive (ucode-primitive link-file 3))) + (values "link" "file")) + ((or (eq? primitive (ucode-primitive file-remove 1)) + (eq? primitive (ucode-primitive file-remove-link 1))) + (values "delete" "file")) + ((eq? primitive (ucode-primitive file-rename 2)) + (values "rename" "file")) + ((eq? primitive (ucode-primitive file-touch 1)) + (values "touch" "file")) + (else + (values false false)))) (define (initialize-package!) @@ -674,7 +686,7 @@ MIT in each case. |# (let ((signal (condition-signaller condition-type:out-of-file-handles '(OPERATOR OPERANDS))) - (signal-open-file (open-file-signaller))) + (signal-file-operation (file-operation-signaller))) (lambda (continuation) (let ((frame (continuation/first-subproblem continuation))) (if (apply-frame? frame) @@ -685,8 +697,8 @@ MIT in each case. |# (eq? (ucode-primitive file-open-io-channel) operator) (eq? (ucode-primitive file-open-append-channel) operator)) - (signal-open-file continuation operator operands 0 "file" - "Channel table full.") + (signal-file-operation continuation operator operands 0 + "open" "file" "channel table full") (signal continuation operator operands)))))))) (set! condition-type:system-call-error @@ -717,7 +729,7 @@ MIT in each case. |# (let ((make-condition (condition-constructor condition-type:system-call-error '(OPERATOR OPERANDS SYSTEM-CALL ERROR-TYPE))) - (signal-open-file (open-file-signaller))) + (signal-file-operation (file-operation-signaller))) (lambda (continuation error-code) (let ((frame (continuation/first-subproblem continuation))) (if (and (apply-frame? frame) @@ -742,22 +754,18 @@ MIT in each case. |# (cond ((port-error-test operator operands) => (lambda (port) (error:derived-port port (make-condition)))) - ((and (not (null? operands)) + ((and (primitive-procedure? operator) + (not (null? operands)) (string? (car operands))) - (let ((signal-open-file - (lambda (noun) - (signal-open-file - continuation operator operands 0 noun - (error-type->string error-type))))) - (cond ((memq operator file-open-primitives) - (signal-open-file "file")) - ((memq operator directory-open-primitives) - (signal-open-file "directory")) - ((memq operator file-primitives) - (error:derived-file (car operands) - (make-condition))) - (else - (error (make-condition)))))) + (with-values + (lambda () + (file-primitive-description operator)) + (lambda (verb noun) + (if verb + (signal-file-operation + continuation operator operands 0 verb noun + (error-type->string error-type)) + (error (make-condition)))))) (else (error (make-condition))))))))))) diff --git a/v7/src/runtime/unxprm.scm b/v7/src/runtime/unxprm.scm index 5ec7b831a..0948b3a4b 100644 --- a/v7/src/runtime/unxprm.scm +++ b/v7/src/runtime/unxprm.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxprm.scm,v 1.14 1991/05/09 17:25:05 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/unxprm.scm,v 1.15 1991/10/29 14:32:22 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -145,7 +145,12 @@ MIT in each case. |# (pathname-new-version pathname false))))))) (let ((result ((ucode-primitive file-touch) filename))) (if (string? result) - (error:file-touch filename result)) + (error:file-operation filename + "touch" + "file" + result + (ucode-primitive file-touch) + (list filename))) result))) (define (make-directory name) diff --git a/v8/src/runtime/load.scm b/v8/src/runtime/load.scm index 1f679c267..91b6fc8e1 100644 --- a/v8/src/runtime/load.scm +++ b/v8/src/runtime/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.28 1991/10/26 16:20:56 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.29 1991/10/29 14:31:49 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -183,8 +183,15 @@ MIT in each case. |# (if (pathname-type pathname) (pathname->input-truename pathname) (load/default-find-pathname-with-type pathname default-types))) - (find-true-pathname (->pathname (error:open-file pathname)) - default-types))) + (find-true-pathname + (->pathname + (error:file-operation pathname + "find" + "file" + "file does not exist" + find-true-pathname + (list pathname default-types))) + default-types))) (define (search-types-in-order pathname default-types) (let loop ((types default-types)) diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 355091b65..ee44a28a5 100644 --- a/v8/src/runtime/runtime.pkg +++ b/v8/src/runtime/runtime.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.123 1991/09/18 20:01:00 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.124 1991/10/29 14:32:03 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -558,12 +558,11 @@ MIT in each case. |# condition-type:divide-by-zero condition-type:error condition-type:file-error - condition-type:file-touch-error + condition-type:file-operation-error condition-type:floating-point-overflow condition-type:floating-point-underflow condition-type:illegal-datum condition-type:no-such-restart - condition-type:open-file-error condition-type:port-error condition-type:serious-condition condition-type:simple-condition @@ -595,9 +594,8 @@ MIT in each case. |# error:derived-file error:derived-port error:divide-by-zero - error:file-touch + error:file-operation error:no-such-restart - error:open-file error:wrong-number-of-arguments error:wrong-type-argument error:wrong-type-datum