From: Chris Hanson Date: Wed, 15 Aug 2001 03:10:42 +0000 (+0000) Subject: Implement completely new format for compiled package descriptions. X-Git-Tag: 20090517-FFI~2601 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f02e79a0558cb4d998c1c4e2ab2274fba56337c1;p=mit-scheme.git Implement completely new format for compiled package descriptions. Old format was code to build the packages and load files into them. New format is a summary description of the packages, which is interpreted at run time to provide the same functionality. The purpose of this change is to support uninstallation and replacement of packages. The new compiled package descriptions are general enough for this purpose. --- diff --git a/v7/src/6001/6001.sf b/v7/src/6001/6001.sf index 2f567ea31..ba02c51a6 100644 --- a/v7/src/6001/6001.sf +++ b/v7/src/6001/6001.sf @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: 6001.sf,v 1.10 1999/01/02 06:06:43 cph Exp $ +$Id: 6001.sf,v 1.11 2001/08/15 03:08:50 cph Exp $ -Copyright (c) 1991-1999 Massachusetts Institute of Technology +Copyright (c) 1991-1999, 2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. |# (fluid-let ((sf/default-syntax-table syntax-table/system-internal)) @@ -29,12 +30,5 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (sf-conditionally "edextra") (sf-conditionally "floppy")) -;; Guarantee that the package modeller is loaded. -(if (not (name->package '(CROSS-REFERENCE))) - (with-working-directory-pathname "../cref" - (lambda () - (load "make")))) - -(cref/generate-constructors "6001") -(sf "6001.con") -(sf "6001.ldr") \ No newline at end of file +(load-option 'CREF) +(cref/generate-constructors "6001") \ No newline at end of file diff --git a/v7/src/compiler/machines/i386/compiler.sf b/v7/src/compiler/machines/i386/compiler.sf index b255b0971..0ec0cb9e5 100644 --- a/v7/src/compiler/machines/i386/compiler.sf +++ b/v7/src/compiler/machines/i386/compiler.sf @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: compiler.sf,v 1.10 2000/01/10 03:54:28 cph Exp $ +$Id: compiler.sf,v 1.11 2001/08/15 03:09:53 cph Exp $ -Copyright (c) 1992-2000 Massachusetts Institute of Technology +Copyright (c) 1992-2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. |# ;;;; Script to incrementally syntax the compiler @@ -27,13 +28,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (if (not (name->package '(COMPILER))) (begin ;; If there is no existing package constructor, generate one. - (if (not (file-exists? "compiler.bco")) - (begin - ((access cref/generate-trivial-constructor - (->environment '(CROSS-REFERENCE))) - "compiler") - (sf "compiler.con"))) - (load "compiler.bco"))) + (if (not (file-exists? "compiler.pkd")) + ((access cref/generate-trivial-constructor + (->environment '(CROSS-REFERENCE))) + "compiler")) + (construct-packages-from-file (fasload "compiler.pkd")))) ;; Guarantee that the necessary syntactic transforms and optimizers ;; are loaded. @@ -96,6 +95,4 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ((access syntax-files! (->environment '(COMPILER)))) ;; Rebuild the package constructors and cref. -(cref/generate-constructors "compiler") -(sf-conditionally "compiler.con") -(sf-conditionally "compiler.ldr") \ No newline at end of file +(cref/generate-constructors "compiler") \ No newline at end of file diff --git a/v7/src/cref/triv.con b/v7/src/cref/triv.con deleted file mode 100644 index 2bcc443cf..000000000 --- a/v7/src/cref/triv.con +++ /dev/null @@ -1,93 +0,0 @@ -#| -*-Scheme-*- - -$Id: triv.con,v 1.5 1999/01/02 06:11:34 cph Exp $ - -Copyright (c) 1989-1999 Massachusetts Institute of Technology - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or (at -your option) any later version. - -This program is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -|# - -;;;; "Trivial" constructor needed to bootstrap cref. - -(declare (usual-integrations)) - -(package/add-child! - (find-package '()) - 'cross-reference - (in-package (package/environment (find-package '())) - (let ((cref/generate-all) - (cref/generate-constructors) - (cref/generate-cref) - (cref/generate-cref-unusual) - (cref/generate-trivial-constructor)) - (the-environment)))) -(let ((source (package/environment (find-package '( cross-reference)))) - (destination (package/environment (find-package '())))) - (environment-link-name destination source 'cref/generate-all) - (environment-link-name destination source 'cref/generate-constructors) - (environment-link-name destination source 'cref/generate-cref) - (environment-link-name destination source 'cref/generate-cref-unusual) - (environment-link-name destination source 'cref/generate-trivial-constructor)) - -(package/add-child! - (find-package '(cross-reference)) - 'analyze-file - (in-package (package/environment (find-package '(cross-reference))) - (let ((analyze-file)) - (the-environment)))) -(let ((source (package/environment (find-package '(cross-reference analyze-file)))) - (destination (package/environment (find-package '(cross-reference))))) - (environment-link-name destination source 'analyze-file)) - -(package/add-child! - (find-package '(cross-reference)) - 'constructor - (in-package (package/environment (find-package '(cross-reference))) - (let ((construct-constructor) - (construct-loader)) - (the-environment)))) -(let ((source (package/environment (find-package '(cross-reference constructor)))) - (destination (package/environment (find-package '(cross-reference))))) - (environment-link-name destination source 'construct-constructor) - (environment-link-name destination source 'construct-loader)) - -(package/add-child! - (find-package '(cross-reference)) - 'formatter - (in-package (package/environment (find-package '(cross-reference))) - (let ((format-packages) - (format-packages-unusual)) - (the-environment)))) -(let ((source (package/environment (find-package '(cross-reference formatter)))) - (destination (package/environment (find-package '(cross-reference))))) - (environment-link-name destination source 'format-packages) - (environment-link-name destination source 'format-packages-unusual) - (environment-link-name source - (package/environment (find-package '(runtime scode))) - 'symbol-name)) - -(package/add-child! - (find-package '(cross-reference)) - 'reader - (in-package (package/environment (find-package '(cross-reference))) - (let ((read-file-analyses!) - (read-package-model) - (resolve-references!)) - (the-environment)))) -(let ((source (package/environment (find-package '(cross-reference reader)))) - (destination (package/environment (find-package '(cross-reference))))) - (environment-link-name destination source 'read-file-analyses!) - (environment-link-name destination source 'read-package-model) - (environment-link-name destination source 'resolve-references!)) \ No newline at end of file diff --git a/v7/src/cref/triv.ldr b/v7/src/cref/triv.ldr deleted file mode 100644 index b40955131..000000000 --- a/v7/src/cref/triv.ldr +++ /dev/null @@ -1,39 +0,0 @@ -#| -*-Scheme-*- - -$Id: triv.ldr,v 1.4 1999/01/02 06:11:34 cph Exp $ - -Copyright (c) 1989-1999 Massachusetts Institute of Technology - -This program is free software; you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation; either version 2 of the License, or (at -your option) any later version. - -This program is distributed in the hope that it will be useful, but -WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -General Public License for more details. - -You should have received a copy of the GNU General Public License -along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -|# - -;;;; "Trivial" loader needed to bootstrap cref. - -(declare (usual-integrations)) - -(lambda (load alist) - alist - (let ((env (package/environment (find-package '(cross-reference))))) - (load "mset" env) - (load "object" env) - (load "toplev" env)) - (load "anfile" - (package/environment (find-package '(cross-reference analyze-file)))) - (load "conpkg" - (package/environment (find-package '(cross-reference constructor)))) - (load "forpkg" - (package/environment (find-package '(cross-reference formatter)))) - (load "redpkg" - (package/environment (find-package '(cross-reference reader))))) \ No newline at end of file diff --git a/v7/src/edwin/edwin.sf b/v7/src/edwin/edwin.sf index 9b0766c0c..976f8aab2 100644 --- a/v7/src/edwin/edwin.sf +++ b/v7/src/edwin/edwin.sf @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: edwin.sf,v 1.24 2000/03/02 18:40:01 cph Exp $ +;;; $Id: edwin.sf,v 1.25 2001/08/15 03:07:50 cph Exp $ ;;; -;;; Copyright (c) 1991-2000 Massachusetts Institute of Technology +;;; Copyright (c) 1991-2001 Massachusetts Institute of Technology ;;; ;;; This program is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as @@ -16,7 +16,8 @@ ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software -;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;;; 02111-1307, USA. (load-option 'CREF) @@ -33,13 +34,13 @@ (if (not (name->package '(EDWIN))) (begin - (if (not (file-exists? (pathname-new-type package-name "bco"))) + (if (not (file-exists? (pathname-new-type package-name "pkd"))) (begin ((access cref/generate-trivial-constructor (->environment '(CROSS-REFERENCE))) - package-name) - (sf (pathname-new-type package-name "con")))) - (load (pathname-new-type package-name "bco")))) + package-name))) + (construct-packages-from-file + (fasload (pathname-new-type package-name "pkd"))))) (if (lexical-unreferenceable? (->environment '(EDWIN CLASS-CONSTRUCTOR)) 'CLASS-DESCRIPTORS) @@ -80,19 +81,7 @@ (load "decls") -(let ((generate - (in-package (->environment '(CROSS-REFERENCE)) - (generate/common - (lambda (pathname pmodel changes?) - (write-cref-unusual pathname pmodel changes?) - (write-globals pathname pmodel changes?) - (write-constructor pathname pmodel changes?)))))) - (generate package-name) - (sf-conditionally (pathname-new-type package-name "con")) - (if (and (file-exists? (pathname-new-type package-name "avd")) - (not (file-processed? package-name "avd" "bad"))) - (fasdump (read-file (pathname-new-type package-name "avd")) - (pathname-new-type package-name "bad")))) +(cref/generate-constructors package-name) (sf-conditionally "edwin.ldr") ) \ No newline at end of file diff --git a/v7/src/edwin/make.scm b/v7/src/edwin/make.scm index c5f83a723..1e7580b9f 100644 --- a/v7/src/edwin/make.scm +++ b/v7/src/edwin/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: make.scm,v 3.109 2001/07/21 05:49:59 cph Exp $ +$Id: make.scm,v 3.110 2001/08/15 03:07:53 cph Exp $ Copyright (c) 1989-2001 Massachusetts Institute of Technology @@ -32,18 +32,21 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (working-directory-pathname) (pathname-as-directory "edwin") (lambda () - (declare-shared-library "edwin" (lambda () true)) + (declare-shared-library "edwin" (lambda () #t)) (package/system-loader "edwin" - `((os-type . ,microcode-id/operating-system) - (make-constructor-name - . ,(lambda (pathname) - (pathname-new-name pathname - (case microcode-id/operating-system - ((DOS) "edwindos") - ((NT) "edwinw32") - ((OS/2) "edwinos2") - ((UNIX) "edwinunx") - (else "edwinunk")))))) + (let ((package-name + (case microcode-id/operating-system + ((DOS) "edwindos") + ((NT) "edwinw32") + ((OS/2) "edwinos2") + ((UNIX) "edwinunx") + (else "edwinunk")))) + `((os-type . ,microcode-id/operating-system) + (rewrite-package-file-name + . ,(lambda (pathname) + (pathname-new-name pathname package-name))) + (alternate-package-loader + . ,(load "edwin.bld" system-global-environment)))) 'QUERY))))) (add-identification! "Edwin" 3 110) \ No newline at end of file diff --git a/v7/src/imail/compile.scm b/v7/src/imail/compile.scm index 317fc13b2..47393588c 100644 --- a/v7/src/imail/compile.scm +++ b/v7/src/imail/compile.scm @@ -1,6 +1,6 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: compile.scm,v 1.11 2001/05/26 02:58:25 cph Exp $ +;;; $Id: compile.scm,v 1.12 2001/08/15 03:10:30 cph Exp $ ;;; ;;; Copyright (c) 2000-2001 Massachusetts Institute of Technology ;;; @@ -44,6 +44,4 @@ '("imail-browser" "imail-summary" "imail-top")) - (cref/generate-constructors "imail") - (sf "imail.con") - (sf "imail.ldr"))) \ No newline at end of file + (cref/generate-constructors "imail"))) \ No newline at end of file diff --git a/v7/src/rcs/compile.scm b/v7/src/rcs/compile.scm index 4b542045e..d92c0e5ef 100644 --- a/v7/src/rcs/compile.scm +++ b/v7/src/rcs/compile.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: compile.scm,v 1.2 2000/03/31 14:19:37 cph Exp $ +$Id: compile.scm,v 1.3 2001/08/15 03:10:15 cph Exp $ -Copyright (c) 2000 Massachusetts Institute of Technology +Copyright (c) 2000, 2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. |# (load-option 'CREF) @@ -26,6 +27,4 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (for-each (lambda (filename) (compile-file filename '() system-global-syntax-table)) '("object" "format" "nparse" "logmer")) - (cref/generate-constructors "rcs") - (sf "rcs.con") - (sf "rcs.ldr"))) \ No newline at end of file + (cref/generate-constructors "rcs"))) \ No newline at end of file diff --git a/v7/src/sf/sf.sf b/v7/src/sf/sf.sf index 8e5d8ebe8..f1916d863 100644 --- a/v7/src/sf/sf.sf +++ b/v7/src/sf/sf.sf @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: sf.sf,v 4.8 1999/01/02 06:19:10 cph Exp $ +$Id: sf.sf,v 4.9 2001/08/15 03:06:05 cph Exp $ -Copyright (c) 1988-1999 Massachusetts Institute of Technology +Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +USA. |# (fluid-let ((sf/default-syntax-table syntax-table/system-internal) @@ -40,6 +41,4 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (sf-directory ".")) (load-option 'CREF) -(cref/generate-constructors "sf") -(sf-conditionally "sf.con") -(sf-conditionally "sf.ldr") \ No newline at end of file +(cref/generate-constructors "sf") \ No newline at end of file diff --git a/v7/src/sos/compile.scm b/v7/src/sos/compile.scm index f629eeb0c..8289164ee 100644 --- a/v7/src/sos/compile.scm +++ b/v7/src/sos/compile.scm @@ -1,8 +1,8 @@ ;;; -*-Scheme-*- ;;; -;;; $Id: compile.scm,v 1.3 1999/01/02 06:19:10 cph Exp $ +;;; $Id: compile.scm,v 1.4 2001/08/15 03:10:42 cph Exp $ ;;; -;;; Copyright (c) 1995-1999 Massachusetts Institute of Technology +;;; Copyright (c) 1995-1999, 2001 Massachusetts Institute of Technology ;;; ;;; This program is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU General Public License as @@ -16,7 +16,8 @@ ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software -;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;;; 02111-1307, USA. (load-option 'CREF) @@ -28,6 +29,4 @@ (compile-file "method") (compile-file "printer") (compile-file "slot") - (cref/generate-constructors "sos") - (sf "sos.con") - (sf "sos.ldr"))) \ No newline at end of file + (cref/generate-constructors "sos"))) \ No newline at end of file