From: Chris Hanson Date: Wed, 6 Jun 2007 20:03:25 +0000 (+0000) Subject: Use WITH-LOADER-BASE-URI in all the subsystem loaders. X-Git-Tag: 20090517-FFI~546 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8ebc1512bde0a2bc697a80613d0da8bf954b99ef;p=mit-scheme.git Use WITH-LOADER-BASE-URI in all the subsystem loaders. --- diff --git a/v7/src/6001/make.scm b/v7/src/6001/make.scm index ee9892965..78624f45d 100644 --- a/v7/src/6001/make.scm +++ b/v7/src/6001/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: make.scm,v 15.40 2007/01/05 21:19:20 cph Exp $ +$Id: make.scm,v 15.41 2007/06/06 20:03:24 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -29,17 +29,12 @@ USA. (declare (usual-integrations)) -(with-working-directory-pathname (directory-pathname (current-load-pathname)) +(with-loader-base-uri (system-library-uri "6001/") (lambda () - ((access with-directory-rewriting-rule - (->environment '(RUNTIME COMPILER-INFO))) - (working-directory-pathname) - (pathname-as-directory "6001") - (lambda () - (load-package-set "6001") - (if (and (eq? 'UNIX microcode-id/operating-system) - (string-ci=? "HP-UX" microcode-id/operating-system-variant)) - (load "floppy" (->environment '(EDWIN)))))))) + (load-package-set "6001") + (if (and (eq? 'UNIX microcode-id/operating-system) + (string-ci=? "HP-UX" microcode-id/operating-system-variant)) + (load "floppy" (->environment '(EDWIN)))))) (add-subsystem-identification! "6.001" '(15 31)) ;;; Customize the runtime system: diff --git a/v7/src/compiler/base/make.scm b/v7/src/compiler/base/make.scm index d89aaa8d7..8669e03cc 100644 --- a/v7/src/compiler/base/make.scm +++ b/v7/src/compiler/base/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: make.scm,v 4.127 2007/01/05 21:19:20 cph Exp $ +$Id: make.scm,v 4.128 2007/06/06 20:03:24 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -33,10 +33,7 @@ USA. architecture-name (load-option 'COMPRESS) (load-option 'RB-TREE) - ((access with-directory-rewriting-rule - (->environment '(RUNTIME COMPILER-INFO))) - (working-directory-pathname) - (pathname-as-directory "compiler") + (with-loader-base-uri (system-library-uri "compiler/") (lambda () (load-package-set "compiler"))) - (add-subsystem-identification! "LIAR" '(4 118))) + (add-subsystem-identification! "LIAR" '(4 118))) \ No newline at end of file diff --git a/v7/src/cref/make.scm b/v7/src/cref/make.scm index ac81d669e..3c1092b2b 100644 --- a/v7/src/cref/make.scm +++ b/v7/src/cref/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: make.scm,v 1.32 2007/06/06 19:42:38 cph Exp $ +$Id: make.scm,v 1.33 2007/06/06 20:03:24 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -30,12 +30,7 @@ USA. (declare (usual-integrations)) (load-option 'RB-TREE) -(with-working-directory-pathname (directory-pathname (current-load-pathname)) +(with-loader-base-uri (system-library-uri "cref/") (lambda () - ((access with-directory-rewriting-rule - (->environment '(RUNTIME COMPILER-INFO))) - (working-directory-pathname) - (pathname-as-directory "cref") - (lambda () - (load-package-set "cref"))))) + (load-package-set "cref"))) (add-subsystem-identification! "CREF" '(2 3)) \ No newline at end of file diff --git a/v7/src/imail/load.scm b/v7/src/imail/load.scm index f0c9d9a5d..98edaaf11 100644 --- a/v7/src/imail/load.scm +++ b/v7/src/imail/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: load.scm,v 1.49 2007/06/06 19:42:40 cph Exp $ +$Id: load.scm,v 1.50 2007/06/06 20:03:25 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -30,7 +30,7 @@ USA. (load-option 'REGULAR-EXPRESSION) (load-option 'SOS) (load-option 'WT-TREE) -(with-working-directory-pathname (directory-pathname (current-load-pathname)) +(with-loader-base-uri (system-library-uri "imail/") (lambda () (fluid-let ((*allow-package-redefinition?* #t)) (load-package-set "imail")))) diff --git a/v7/src/rcs/load.scm b/v7/src/rcs/load.scm index 8914fb92c..5afd32e70 100644 --- a/v7/src/rcs/load.scm +++ b/v7/src/rcs/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: load.scm,v 1.8 2007/01/05 21:19:27 cph Exp $ +$Id: load.scm,v 1.9 2007/06/06 20:03:25 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -26,7 +26,7 @@ USA. |# (load-option 'REGULAR-EXPRESSION) -(with-working-directory-pathname (directory-pathname (current-load-pathname)) +(with-loader-base-uri (system-library-uri "rcs/") (lambda () (load-package-set "rcs"))) (add-subsystem-identification! "RCS" '(2 2)) \ No newline at end of file diff --git a/v7/src/sf/make.scm b/v7/src/sf/make.scm index 32e2c0def..314d6d37a 100644 --- a/v7/src/sf/make.scm +++ b/v7/src/sf/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: make.scm,v 4.48 2007/06/06 19:42:43 cph Exp $ +$Id: make.scm,v 4.49 2007/06/06 20:03:25 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -29,15 +29,9 @@ USA. (declare (usual-integrations)) -(with-working-directory-pathname - (directory-pathname (current-load-pathname)) +(with-loader-base-uri (system-library-uri "sf/") (lambda () - ((access with-directory-rewriting-rule - (->environment '(RUNTIME COMPILER-INFO))) - (working-directory-pathname) - (pathname-as-directory "sf") - (lambda () - (load-package-set "sf"))) + (load-package-set "sf") ((package/reference (find-package '(SCODE-OPTIMIZER)) 'USUAL-INTEGRATIONS/CACHE!)))) (add-subsystem-identification! "SF" '(4 41)) \ No newline at end of file diff --git a/v7/src/sos/load.scm b/v7/src/sos/load.scm index 84d7cc532..b0885c7c6 100644 --- a/v7/src/sos/load.scm +++ b/v7/src/sos/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: load.scm,v 1.20 2007/06/06 19:42:43 cph Exp $ +$Id: load.scm,v 1.21 2007/06/06 20:03:25 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -25,7 +25,7 @@ USA. |# -(with-working-directory-pathname (directory-pathname (current-load-pathname)) +(with-loader-base-uri (system-library-uri "sos/") (lambda () (load-package-set "sos"))) (add-subsystem-identification! "SOS" '(1 8)) \ No newline at end of file diff --git a/v7/src/ssp/load.scm b/v7/src/ssp/load.scm index b1a03bb5c..dda022738 100644 --- a/v7/src/ssp/load.scm +++ b/v7/src/ssp/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: load.scm,v 1.10 2007/06/06 19:42:43 cph Exp $ +$Id: load.scm,v 1.11 2007/06/06 20:03:25 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -30,7 +30,7 @@ USA. (load-option 'xml) (load-option 'postgresql) (load-option 'mime-codec) -(with-working-directory-pathname (directory-pathname (current-load-pathname)) +(with-loader-base-uri (system-library-uri "ssp/") (lambda () (load-package-set "ssp"))) (add-subsystem-identification! "SSP" '(0 4)) \ No newline at end of file diff --git a/v7/src/star-parser/load.scm b/v7/src/star-parser/load.scm index cb117d27b..234d0494a 100644 --- a/v7/src/star-parser/load.scm +++ b/v7/src/star-parser/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: load.scm,v 1.22 2007/06/06 19:42:43 cph Exp $ +$Id: load.scm,v 1.23 2007/06/06 20:03:25 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -25,12 +25,7 @@ USA. |# -(with-working-directory-pathname (directory-pathname (current-load-pathname)) +(with-loader-base-uri (system-library-uri "star-parser/") (lambda () - ((access with-directory-rewriting-rule - (->environment '(RUNTIME COMPILER-INFO))) - (working-directory-pathname) - (pathname-as-directory "star-parser") - (lambda () - (load-package-set "parser"))))) + (load-package-set "parser"))) (add-subsystem-identification! "*Parser" '(0 13)) \ No newline at end of file diff --git a/v7/src/win32/make.scm b/v7/src/win32/make.scm index 942632b14..4de117789 100644 --- a/v7/src/win32/make.scm +++ b/v7/src/win32/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: make.scm,v 1.18 2007/01/05 21:19:29 cph Exp $ +$Id: make.scm,v 1.19 2007/06/06 20:03:25 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -29,12 +29,7 @@ USA. (declare (usual-integrations)) -(with-working-directory-pathname (directory-pathname (current-load-pathname)) +(with-loader-base-uri (system-library-uri "win32/") (lambda () - ((access with-directory-rewriting-rule - (->environment '(RUNTIME COMPILER-INFO))) - (working-directory-pathname) - (pathname-as-directory "win32") - (lambda () - (load-package-set "win32"))))) + (load-package-set "win32"))) (add-subsystem-identification! "Win32" '(1 8)) \ No newline at end of file diff --git a/v7/src/xdoc/load.scm b/v7/src/xdoc/load.scm index 6c97d2d9c..285d97823 100644 --- a/v7/src/xdoc/load.scm +++ b/v7/src/xdoc/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: load.scm,v 1.7 2007/06/06 19:42:43 cph Exp $ +$Id: load.scm,v 1.8 2007/06/06 20:03:25 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -45,7 +45,7 @@ USA. (export 'html:style-attr 'style) (export 'xml-attrs 'attributes) (export 'xml-comment 'comment))) -(with-working-directory-pathname (directory-pathname (current-load-pathname)) +(with-loader-base-uri (system-library-uri "xdoc/") (lambda () (load-package-set "xdoc"))) (add-subsystem-identification! "XDOC" '(0 3)) \ No newline at end of file diff --git a/v7/src/xml/load.scm b/v7/src/xml/load.scm index 7e984ddcd..fd8a55f48 100644 --- a/v7/src/xml/load.scm +++ b/v7/src/xml/load.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: load.scm,v 1.21 2007/06/06 19:42:43 cph Exp $ +$Id: load.scm,v 1.22 2007/06/06 20:03:25 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -27,7 +27,7 @@ USA. (load-option 'REGULAR-EXPRESSION) (load-option 'SOS) -(with-working-directory-pathname (directory-pathname (current-load-pathname)) +(with-loader-base-uri (system-library-uri "xml/") (lambda () (load-package-set "xml"))) (add-subsystem-identification! "XML" '(1 0)) \ No newline at end of file