From e3cfc66b335b2296888fb5566de41d6ae276d427 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 7 Jul 1988 16:13:39 +0000 Subject: [PATCH] Add option files and procedure `load-option' to load them. --- v7/src/runtime/make.scm | 5 +-- v7/src/runtime/option.scm | 63 ++++++++++++++++++++++++++++++++++++++ v7/src/runtime/runtime.pkg | 17 +++++++++- v7/src/runtime/version.scm | 4 +-- v8/src/runtime/make.scm | 5 +-- v8/src/runtime/runtime.pkg | 17 +++++++++- 6 files changed, 103 insertions(+), 8 deletions(-) create mode 100644 v7/src/runtime/option.scm diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm index 44e7f2f67..91783d9c2 100644 --- a/v7/src/runtime/make.scm +++ b/v7/src/runtime/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/make.scm,v 14.3 1988/06/16 06:32:27 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/make.scm,v 14.4 1988/07/07 16:13:22 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -291,7 +291,8 @@ MIT in each case. |# (string=? filename "gc"))) (eval (purify (fasload (map-filename filename))) environment))) `((SORT-TYPE . MERGE-SORT) - (OS-TYPE . ,(string->symbol (string-upcase os-name-string))))) + (OS-TYPE . ,(string->symbol (string-upcase os-name-string))) + (OPTIONS . NO-LOAD))) ;; Funny stuff is done. Rest of sequence is standardized. (package-initialization-sequence diff --git a/v7/src/runtime/option.scm b/v7/src/runtime/option.scm new file mode 100644 index 000000000..1587d2870 --- /dev/null +++ b/v7/src/runtime/option.scm @@ -0,0 +1,63 @@ +#| -*-Scheme-*- + +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/option.scm,v 14.1 1988/07/07 16:13:08 cph Exp $ + +Copyright (c) 1988 Massachusetts Institute of Technology + +This material was developed by the Scheme project at the Massachusetts +Institute of Technology, Department of Electrical Engineering and +Computer Science. Permission to copy this software, to redistribute +it, and to use it for any purpose is granted, subject to the following +restrictions and understandings. + +1. Any copy made of this software must include this copyright notice +in full. + +2. Users of this software agree to make their best efforts (a) to +return to the MIT Scheme project any improvements or extensions that +they make, so that these may be included in future releases; and (b) +to inform MIT of noteworthy uses of this software. + +3. All materials developed as a consequence of the use of this +software shall duly acknowledge such use, in accordance with the usual +standards of acknowledging credit in academic research. + +4. MIT has made no warrantee or representation that the operation of +this software will be error-free, and MIT is under no obligation to +provide any services, by way of maintenance, update, or otherwise. + +5. In conjunction with products arising from the use of this material, +there shall be no use of the name of the Massachusetts Institute of +Technology nor of any adaptation thereof in any advertising, +promotional, or sales literature without prior written consent from +MIT in each case. |# + +;;;; Option Loader +;;; package: (runtime option-loader) + +(declare (usual-integrations)) + +(define (load-option name) + (let ((entry (assq name options)) + (pathname + (merge-pathnames (make-pathname false false '("options") + false false false) + (pathname-directory-path + (string->pathname + ((ucode-primitive microcode-tables-filename))))))) (if (not entry) + (error "Unknown option name" name)) + (for-each + (lambda (descriptor) + (let ((environment + (package/environment (find-package (car descriptor))))) + (for-each (lambda (filename) + (load (merge-pathnames (string->pathname filename) + pathname) + environment)) + (cddr descriptor)) + (eval (cadr descriptor) environment))) + (cdr entry)) + name)) + +(define options + '((FORMAT ((RUNTIME FORMAT) (INITIALIZE-PACKAGE!) "format")))) \ No newline at end of file diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg index e07499e2e..2e90ab3b0 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.9 1988/06/30 22:22:42 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.10 1988/07/07 16:12:23 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -495,6 +495,15 @@ MIT in each case. |# open-output-file) (initialization (initialize-package!))) +(define-package (runtime format) + (file-case options + ((load) "format") + (else)) + (parent ()) + (export () + format) + (initialization (initialize-package!))) + (define-package (runtime garbage-collector) (files "gc") (parent ()) @@ -934,6 +943,12 @@ MIT in each case. |# (export () number->string) (initialization (initialize-package!))) +(define-package (runtime options) + (files "option") + (parent ()) + (export () + load-option)) + (define-package (runtime output-port) (files "output") (parent ()) diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm index 2f5f68755..04f7431e4 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.8 1988/06/30 22:23:49 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.9 1988/07/07 16:13:39 cph Exp $ Copyright (c) 1988 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 8)) + (add-identification! "Runtime" 14 9)) (define microcode-system) diff --git a/v8/src/runtime/make.scm b/v8/src/runtime/make.scm index e25fccb4b..33c5f6957 100644 --- a/v8/src/runtime/make.scm +++ b/v8/src/runtime/make.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/make.scm,v 14.3 1988/06/16 06:32:27 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/make.scm,v 14.4 1988/07/07 16:13:22 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -291,7 +291,8 @@ MIT in each case. |# (string=? filename "gc"))) (eval (purify (fasload (map-filename filename))) environment))) `((SORT-TYPE . MERGE-SORT) - (OS-TYPE . ,(string->symbol (string-upcase os-name-string))))) + (OS-TYPE . ,(string->symbol (string-upcase os-name-string))) + (OPTIONS . NO-LOAD))) ;; Funny stuff is done. Rest of sequence is standardized. (package-initialization-sequence diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg index 76247b086..b8db1af71 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.9 1988/06/30 22:22:42 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.10 1988/07/07 16:12:23 cph Exp $ Copyright (c) 1988 Massachusetts Institute of Technology @@ -495,6 +495,15 @@ MIT in each case. |# open-output-file) (initialization (initialize-package!))) +(define-package (runtime format) + (file-case options + ((load) "format") + (else)) + (parent ()) + (export () + format) + (initialization (initialize-package!))) + (define-package (runtime garbage-collector) (files "gc") (parent ()) @@ -934,6 +943,12 @@ MIT in each case. |# (export () number->string) (initialization (initialize-package!))) +(define-package (runtime options) + (files "option") + (parent ()) + (export () + load-option)) + (define-package (runtime output-port) (files "output") (parent ()) -- 2.25.1