Implement new mechanism to simplify initialization during cold load.

diff --git a/v7/src/runtime/boot.scm b/v7/src/runtime/boot.scm
index a179e206278fc16d92552a4d06094e0cffaaed66..d9b82d45648fb91177f35885d0f73d0912015625 100644 (file)
--- a/v7/src/runtime/boot.scm
+++ b/v7/src/runtime/boot.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: boot.scm,v 14.30 2008/02/10 06:14:03 cph Exp $
+$Id: boot.scm,v 14.31 2008/08/31 07:27:00 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -142,4 +142,27 @@ USA.
   (eq? object (default-object)))
 
 (define-integrable (default-object)
-  ((ucode-primitive object-set-type) (ucode-type constant) 7))
\ No newline at end of file
+  ((ucode-primitive object-set-type) (ucode-type constant) 7))
+
+(define (init-boot-inits!)
+  (set! boot-inits '())
+  unspecific)
+
+(define (add-boot-init! thunk)
+  (set! boot-inits (cons thunk boot-inits))
+  unspecific)
+
+(define (save-boot-inits! environment)
+  (let ((inits (reverse! boot-inits)))
+    (set! boot-inits)
+    ((ucode-primitive local-assignment) environment saved-boot-inits inits)))
+
+(define (run-boot-inits! environment)
+  (let ((inits
+        ((ucode-primitive lexical-reference) environment saved-boot-inits)))
+    ((ucode-primitive unbind-variable) environment saved-boot-inits)
+    (for-each (lambda (init) (init))
+             inits)))
+
+(define boot-inits)
+(define saved-boot-inits '|#[saved-boot-inits]|)
\ No newline at end of file

diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm
index 95f054d7a406a9feaad06c7a9653c652eddfbad9..6005b006eb804bd2b8a6870133ca9fda2521ef22 100644 (file)
--- a/v7/src/runtime/make.scm
+++ b/v7/src/runtime/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.117 2008/08/24 07:20:09 cph Exp $
+$Id: make.scm,v 14.118 2008/08/31 07:28:05 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -401,14 +401,19 @@ USA.
            (let loop ((files files))
              (and (pair? files)
                   (or (string=? (car (car files)) filename)
-                      (loop (cdr files))))))))
+                      (loop (cdr files)))))))
+        (boot-defs
+         (package/environment (name->package '(RUNTIME BOOT-DEFINITIONS)))))
      (lambda (filename environment)
        (if (not (or (string=? filename "make")
                    (string=? filename "packag")
                    (file-member? filename files1)
                    (file-member? filename files2)))
-          (eval (file->object filename #t #t)
-                environment))
+          (begin
+            ((access init-boot-inits! boot-defs))
+            (eval (file->object filename #t #t)
+                  environment)
+            ((access save-boot-inits! boot-defs) environment)))
        unspecific))))
 \f
 ;;; Funny stuff is done.  Rest of sequence is standardized.

diff --git a/v7/src/runtime/mit-syntax.scm b/v7/src/runtime/mit-syntax.scm
index 00a7f72b285f41dc369931c2ffff7a40c364edd2..9326ddc8b2bb618e477560869123f96d7fda1a84 100644 (file)
--- a/v7/src/runtime/mit-syntax.scm
+++ b/v7/src/runtime/mit-syntax.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: mit-syntax.scm,v 14.32 2008/01/30 20:02:32 cph Exp $
+$Id: mit-syntax.scm,v 14.33 2008/08/31 07:27:34 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -225,18 +225,26 @@ USA.
                             variable-binding-theory)))))
     (lambda (form rename compare)
       compare                          ;ignore
-      (cond ((syntax-match? '((IDENTIFIER . MIT-BVL) + FORM) (cdr form))
-            `(,(car form) ,(caadr form)
-                          (,(rename 'NAMED-LAMBDA) ,@(cdr form))))
-           ((syntax-match? '((DATUM . MIT-BVL) + FORM) (cdr form))
-            `(,(car form) ,(caadr form)
-                          (,(rename 'LAMBDA) ,(cdadr form) ,@(cddr form))))
-           ((syntax-match? '(IDENTIFIER) (cdr form))
-            `(,keyword ,(cadr form) ,(unassigned-expression)))
-           ((syntax-match? '(IDENTIFIER EXPRESSION) (cdr form))
-            `(,keyword ,(cadr form) ,(caddr form)))
-           (else
-            (ill-formed-syntax form))))))
+      (receive (name value) (parse-define-form form rename)
+       `(,keyword ,name ,value)))))
+
+(define (parse-define-form form rename)
+  (cond ((syntax-match? '((IDENTIFIER . MIT-BVL) + FORM) (cdr form))
+        (parse-define-form
+         `(,(car form) ,(caadr form)
+                       (,(rename 'NAMED-LAMBDA) ,@(cdr form)))
+         rename))
+       ((syntax-match? '((DATUM . MIT-BVL) + FORM) (cdr form))
+        (parse-define-form
+         `(,(car form) ,(caadr form)
+                       (,(rename 'LAMBDA) ,(cdadr form) ,@(cddr form)))
+         rename))
+       ((syntax-match? '(IDENTIFIER) (cdr form))
+        (values (cadr form) (unassigned-expression)))
+       ((syntax-match? '(IDENTIFIER EXPRESSION) (cdr form))
+        (values (cadr form) (caddr form)))
+       (else
+        (ill-formed-syntax form))))
 
 (define-classifier 'DEFINE-SYNTAX system-global-environment
   (lambda (form environment definition-environment history)

diff --git a/v7/src/runtime/sysmac.scm b/v7/src/runtime/sysmac.scm
index 0d825b1543ebac619bdb633c53cce6607dbda2cf..9e4baf073cc3a9734786844ef3174ce5039996fc 100644 (file)
--- a/v7/src/runtime/sysmac.scm
+++ b/v7/src/runtime/sysmac.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: sysmac.scm,v 14.19 2008/02/14 02:35:05 cph Exp $
+$Id: sysmac.scm,v 14.20 2008/08/31 07:27:37 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -94,4 +94,16 @@ USA.
                                             (IF (DEFAULT-OBJECT? CALLER)
                                                 #F
                                                 CALLER))))))
-        (ill-formed-syntax form)))))
\ No newline at end of file
+        (ill-formed-syntax form)))))
+
+(define-syntax define-deferred
+  (er-macro-transformer
+   (lambda (form rename compare)
+     compare
+      (receive (name value) (parse-define-form form rename)
+       `(,(rename 'BEGIN)
+         (,(rename 'DEFINE) ,name)
+         (,(rename 'ADD-BOOT-INIT!)
+          (,(rename 'LAMBDA) ()
+                             (,(rename 'SET!) ,name ,value)
+                             ,(rename 'UNSPECIFIC))))))))
\ No newline at end of file