Fix bug in cold-load sequence.

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index 310737daa2c11f99f88036ee74c2d03a16aea277..87299030d56eda2fbcf6b8062e0fa5e77062ee93 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -202,18 +202,21 @@ USA.
   (package/environment (find-package name)))
 
 (define (package-initialization-sequence specs)
-  (let loop ((specs specs))
-    (if (pair? specs)
-       (let ((spec (car specs)))
-         (if (or (not (pair? spec))
-                 (symbol? (car spec)))
-             (package-initialize spec #f #t)
-             (package-initialize (car spec)
-                                 (cadr spec)
-                                 (if (pair? (cddr spec))
-                                     (caddr spec)
-                                     #t)))
-         (loop (cdr specs))))))
+  (do ((specs specs (cdr specs)))
+      ((not (pair? specs)) unspecific)
+    (let ((spec (car specs)))
+      (cond ((eq? (car spec) 'OPTIONAL)
+            (package-initialize (cadr spec)
+                                (and (pair? (cddr spec))
+                                     (caddr spec))
+                                #f))
+           ((pair? (car spec))
+            (package-initialize (car spec)
+                                (and (pair? (cdr spec))
+                                     (cadr spec))
+                                #t))
+           (else
+            (package-initialize spec #f #t))))))
 
 (define (remember-to-purify purify? filename value)
   (if purify?
@@ -492,7 +495,7 @@ USA.
    (RUNTIME WORKING-DIRECTORY)
    (RUNTIME LOAD)
    (RUNTIME SIMPLE-FILE-OPS)
-   ((RUNTIME OS-PRIMITIVES) INITIALIZE-MIME-TYPES! #f)
+   (OPTIONAL (RUNTIME OS-PRIMITIVES) INITIALIZE-MIME-TYPES!)
    ;; Syntax
    (RUNTIME NUMBER-PARSER)
    (RUNTIME PARSER)
@@ -520,19 +523,19 @@ USA.
    ;; Graphics.  The last type initialized is the default for
    ;; MAKE-GRAPHICS-DEVICE, only the types that are valid for the
    ;; operating system are actually loaded and initialized.
-   ((RUNTIME STARBASE-GRAPHICS) #f #f)
-   (RUNTIME X-GRAPHICS)
-   ((RUNTIME OS2-GRAPHICS) #f #f)
+   (OPTIONAL (RUNTIME STARBASE-GRAPHICS))
+   (OPTIONAL (RUNTIME X-GRAPHICS))
+   (OPTIONAL (RUNTIME OS2-GRAPHICS))
    ;; Emacs -- last because it installs hooks everywhere which must be initted.
    (RUNTIME EMACS-INTERFACE)
    ;; More debugging
-   ((RUNTIME CONTINUATION-PARSER) INITIALIZE-SPECIAL-FRAMES! #f)
+   (OPTIONAL (RUNTIME CONTINUATION-PARSER) INITIALIZE-SPECIAL-FRAMES!)
    (RUNTIME URI)
    (RUNTIME RFC2822-HEADERS)
    (RUNTIME HTTP-SYNTAX)
    (RUNTIME HTTP-CLIENT)
    (RUNTIME HTML-FORM-CODEC)
-   ((RUNTIME WIN32-REGISTRY) #f #f)))
+   (OPTIONAL (RUNTIME WIN32-REGISTRY))))
 \f
 (let ((obj (file->object "site" #t #f)))
   (if obj

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 1aa268e31f33344256c48039591eb9f66eafea0d..046cb36e86218c311badef0beae7903e46893a1b 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -60,8 +60,7 @@ USA.
   (parent ())
   (export ()
          write-mit-scheme-copyright
-         write-mit-scheme-license)
-  (initialization (initialize-package!)))
+         write-mit-scheme-license))
 
 (define-package (runtime bit-string)
   (files "bitstr")

diff --git a/src/runtime/version.scm b/src/runtime/version.scm
index 309218e1c4b2f63ea690a23dc2d1cb8c6702911d..d32e95962cf2891969aec4fd51fe4e071ae1c384 100644 (file)
--- a/src/runtime/version.scm
+++ b/src/runtime/version.scm
@@ -30,15 +30,16 @@ USA.
 
 (define copyright-years)
 
-(define (initialize-package!)
-  (set! copyright-years
-       (let ((now 2009)
-             (then 1986))
-         (iota (+ (- now then) 1) then)))
-  (add-subsystem-identification! "Release" '(7 7 90 "+"))
-  (snarf-microcode-version!)
-  (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-subsystem-identification! "Runtime" '(15 7)))
+(add-boot-init!
+ (lambda ()
+   (set! copyright-years
+        (let ((now 2009)
+              (then 1986))
+          (iota (+ (- now then) 1) then)))
+   (add-subsystem-identification! "Release" '(7 7 90 "+"))
+   (snarf-microcode-version!)
+   (add-event-receiver! event:after-restore snarf-microcode-version!)
+   (add-subsystem-identification! "Runtime" '(15 7))))
 
 (define (snarf-microcode-version!)
   (add-subsystem-identification! "Microcode"