From e35fc4e3646d83907f4311f634ba624d1a1bdae6 Mon Sep 17 00:00:00 2001 From: Arthur Gleckler Date: Thu, 22 Aug 1991 15:19:05 +0000 Subject: [PATCH] (Arthur and Jinx:) Add special restarts for open-file errors. --- v7/src/runtime/load.scm | 8 ++++---- v7/src/runtime/pathnm.scm | 20 ++++++++++++-------- v7/src/runtime/version.scm | 4 ++-- v8/src/runtime/load.scm | 8 ++++---- 4 files changed, 22 insertions(+), 18 deletions(-) diff --git a/v7/src/runtime/load.scm b/v7/src/runtime/load.scm index ff23db389..45053cd64 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.23 1991/08/20 22:01:33 arthur Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/load.scm,v 14.24 1991/08/22 15:18:02 arthur Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -189,9 +189,9 @@ MIT in each case. |# (pathname->input-truename pathname) (load/default-find-pathname-with-type pathname default-types))))) - (if (not truename) - (error:open-file pathname)) - truename))) + (or truename + (find-true-pathname (->pathname (error:open-file pathname)) + 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 2e03e1f30..c7a6f4daa 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.11 1991/02/15 18:06:34 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/pathnm.scm,v 14.12 1991/08/22 15:17:51 arthur Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -340,8 +340,8 @@ See the files unkpth.scm, vmspth.scm, or unxpth.scm for examples.|# (define (canonicalize-input-pathname filename) (let ((pathname (->pathname filename))) (let ((truename (pathname->input-truename pathname))) - (if (not truename) (error:open-file pathname)) - truename))) + (or truename + (canonicalize-input-pathname (error:open-file pathname)))))) (define (pathname->input-truename pathname) (let ((pathname (pathname->absolute-pathname pathname)) @@ -425,11 +425,15 @@ See the files unkpth.scm, vmspth.scm, or unxpth.scm for examples.|# (define library-directory-path) (define (system-library-pathname pathname) - (let loop ((directories library-directory-path)) - (if (null? directories) - (error:open-file pathname)) - (or (pathname->input-truename (merge-pathnames pathname (car directories))) - (loop (cdr directories))))) + (if (and (pathname-absolute? pathname) + (pathname->input-truename pathname)) + pathname + (let loop ((directories library-directory-path)) + (if (null? directories) + (system-library-pathname (->pathname (error:open-file pathname))) + (or (pathname->input-truename + (merge-pathnames pathname (car directories))) + (loop (cdr directories))))))) (define (system-library-directory-pathname pathname) (if (not pathname) diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm index 68abe0f47..f7bf87aae 100644 --- a/v7/src/runtime/version.scm +++ b/v7/src/runtime/version.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.133 1991/08/16 15:42:30 jinx Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.134 1991/08/22 15:19:05 arthur Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -45,7 +45,7 @@ MIT in each case. |# '())) (add-system! microcode-system) (add-event-receiver! event:after-restore snarf-microcode-version!) - (add-identification! "Runtime" 14 133)) + (add-identification! "Runtime" 14 134)) (define microcode-system) diff --git a/v8/src/runtime/load.scm b/v8/src/runtime/load.scm index 059050707..c87100dce 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.23 1991/08/20 22:01:33 arthur Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/load.scm,v 14.24 1991/08/22 15:18:02 arthur Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -189,9 +189,9 @@ MIT in each case. |# (pathname->input-truename pathname) (load/default-find-pathname-with-type pathname default-types))))) - (if (not truename) - (error:open-file pathname)) - truename))) + (or truename + (find-true-pathname (->pathname (error:open-file pathname)) + default-types))))) (define (search-types-in-order pathname default-types) (let loop ((types default-types)) -- 2.25.1