Fix cold-load errors.

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index f2f773d339148442384c608d06cc6c6f0330ae45..310737daa2c11f99f88036ee74c2d03a16aea277 100644 (file)
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -174,7 +174,9 @@ USA.
           (and package
                (let ((env (package/environment package)))
                  (if (not procedure-name)
-                     (lambda () ((access run-boot-inits! boot-defs) env))
+                     (if (lexical-unreferenceable? env 'INITIALIZE-PACKAGE!)
+                         (lambda () ((access run-boot-inits! boot-defs) env))
+                         (lexical-reference env 'INITIALIZE-PACKAGE!))
                      (and (not (lexical-unreferenceable? env procedure-name))
                           (lexical-reference env procedure-name))))))
         => (lambda (procedure)
@@ -205,8 +207,12 @@ USA.
        (let ((spec (car specs)))
          (if (or (not (pair? spec))
                  (symbol? (car spec)))
-             (package-initialize spec 'INITIALIZE-PACKAGE! #f)
-             (package-initialize (car spec) (cadr spec) (caddr spec)))
+             (package-initialize spec #f #t)
+             (package-initialize (car spec)
+                                 (cadr spec)
+                                 (if (pair? (cddr spec))
+                                     (caddr spec)
+                                     #t)))
          (loop (cdr specs))))))
 
 (define (remember-to-purify purify? filename value)
@@ -375,21 +381,21 @@ USA.
           (eval (file->object (car (car files)) #t #t)
                 (package-reference (cdr (car files))))))))
   (load-files files1)
-  (package-initialize '(RUNTIME GC-DAEMONS) 'INITIALIZE-PACKAGE! #t)
-  (package-initialize '(RUNTIME GARBAGE-COLLECTOR) 'INITIALIZE-PACKAGE! #t)
-  (package-initialize '(RUNTIME RANDOM-NUMBER) 'INITIALIZE-PACKAGE! #t)
+  (package-initialize '(RUNTIME GC-DAEMONS) #f #t)
+  (package-initialize '(RUNTIME GARBAGE-COLLECTOR) #f #t)
+  (package-initialize '(RUNTIME RANDOM-NUMBER) #f #t)
   (package-initialize '(RUNTIME GENERIC-PROCEDURE) 'INITIALIZE-TAG-CONSTANTS!
                      #t)
-  (package-initialize '(RUNTIME POPULATION) 'INITIALIZE-PACKAGE! #t)
+  (package-initialize '(RUNTIME POPULATION) #f #t)
   (package-initialize '(RUNTIME RECORD) 'INITIALIZE-RECORD-TYPE-TYPE! #t)
   (load-files files2)
-  (package-initialize '(RUNTIME 1D-PROPERTY) 'INITIALIZE-PACKAGE! #t)
-  (package-initialize '(RUNTIME EVENT-DISTRIBUTOR) 'INITIALIZE-PACKAGE! #t)
-  (package-initialize '(RUNTIME GLOBAL-DATABASE) 'INITIALIZE-PACKAGE! #t)
+  (package-initialize '(RUNTIME 1D-PROPERTY) #f #t)
+  (package-initialize '(RUNTIME EVENT-DISTRIBUTOR) #f #t)
+  (package-initialize '(RUNTIME GLOBAL-DATABASE) #f #t)
   (package-initialize '(RUNTIME POPULATION) 'INITIALIZE-UNPARSER! #t)
   (package-initialize '(RUNTIME 1D-PROPERTY) 'INITIALIZE-UNPARSER! #t)
-  (package-initialize '(RUNTIME GC-FINALIZER) 'INITIALIZE-PACKAGE! #t)
-  (package-initialize '(RUNTIME STRING) 'INITIALIZE-PACKAGE! #t)
+  (package-initialize '(RUNTIME GC-FINALIZER) #f #t)
+  (package-initialize '(RUNTIME STRING) #f #t)
 
   (set! boot-defs
        (package/environment (name->package '(RUNTIME BOOT-DEFINITIONS))))
@@ -422,16 +428,16 @@ USA.
 (package-initialization-sequence
  '(
    ;; Microcode interface
-   ((RUNTIME MICROCODE-TABLES) READ-MICROCODE-TABLES! #t)
+   ((RUNTIME MICROCODE-TABLES) READ-MICROCODE-TABLES!)
    (RUNTIME STATE-SPACE)
    (RUNTIME APPLY)
    (RUNTIME HASH)                      ; First GC daemon!
    (RUNTIME PRIMITIVE-IO)
    (RUNTIME SYSTEM-CLOCK)
-   ((RUNTIME GC-FINALIZER) INITIALIZE-EVENTS! #t)
+   ((RUNTIME GC-FINALIZER) INITIALIZE-EVENTS!)
    ;; Basic data structures
    (RUNTIME NUMBER)
-   ((RUNTIME NUMBER) INITIALIZE-DRAGON4! #t)
+   ((RUNTIME NUMBER) INITIALIZE-DRAGON4!)
    (RUNTIME MISCELLANEOUS-GLOBAL)
    (RUNTIME CHARACTER)
    (RUNTIME CHARACTER-SET)
@@ -439,7 +445,7 @@ USA.
    (RUNTIME STREAM)
    (RUNTIME 2D-PROPERTY)
    (RUNTIME HASH-TABLE)
-   ((RUNTIME REGULAR-SEXPRESSION) #f #f)
+   (RUNTIME REGULAR-SEXPRESSION)
    ;; Microcode data structures
    (RUNTIME HISTORY)
    (RUNTIME LAMBDA-ABSTRACTION)
@@ -449,23 +455,24 @@ USA.
    (RUNTIME CONTINUATION-PARSER)
    (RUNTIME PROGRAM-COPIER)
    ;; Generic Procedures
-   ((RUNTIME GENERIC-PROCEDURE EQHT) INITIALIZE-ADDRESS-HASHING! #t)
-   ((RUNTIME GENERIC-PROCEDURE) INITIALIZE-GENERIC-PROCEDURES! #t)
-   ((RUNTIME GENERIC-PROCEDURE MULTIPLEXER) INITIALIZE-MULTIPLEXER! #t)
-   ((RUNTIME TAGGED-VECTOR) INITIALIZE-TAGGED-VECTOR! #t)
-   ((RUNTIME RECORD-SLOT-ACCESS) INITIALIZE-RECORD-SLOT-ACCESS! #t)
-   ((RUNTIME RECORD) INITIALIZE-RECORD-PROCEDURES! #t)
-   ((PACKAGE) FINALIZE-PACKAGE-RECORD-TYPE! #t)
-   ((RUNTIME RANDOM-NUMBER) FINALIZE-RANDOM-STATE-TYPE! #t)
+   ((RUNTIME GENERIC-PROCEDURE EQHT) INITIALIZE-ADDRESS-HASHING!)
+   ((RUNTIME GENERIC-PROCEDURE) INITIALIZE-GENERIC-PROCEDURES!)
+   ((RUNTIME GENERIC-PROCEDURE MULTIPLEXER) INITIALIZE-MULTIPLEXER!)
+   ((RUNTIME TAGGED-VECTOR) INITIALIZE-TAGGED-VECTOR!)
+   ((RUNTIME RECORD-SLOT-ACCESS) INITIALIZE-RECORD-SLOT-ACCESS!)
+   ((RUNTIME RECORD) INITIALIZE-RECORD-PROCEDURES!)
+   ((PACKAGE) FINALIZE-PACKAGE-RECORD-TYPE!)
+   ((RUNTIME RANDOM-NUMBER) FINALIZE-RANDOM-STATE-TYPE!)
    ;; Condition System
    (RUNTIME ERROR-HANDLER)
    (RUNTIME MICROCODE-ERRORS)
-   ((RUNTIME GENERIC-PROCEDURE) INITIALIZE-CONDITIONS! #t)
-   ((RUNTIME GENERIC-PROCEDURE MULTIPLEXER) INITIALIZE-CONDITIONS! #t)
-   ((RUNTIME RECORD-SLOT-ACCESS) INITIALIZE-CONDITIONS! #t)
-   ((RUNTIME STREAM) INITIALIZE-CONDITIONS! #t)
+   ((RUNTIME GENERIC-PROCEDURE) INITIALIZE-CONDITIONS!)
+   ((RUNTIME GENERIC-PROCEDURE MULTIPLEXER) INITIALIZE-CONDITIONS!)
+   ((RUNTIME RECORD-SLOT-ACCESS) INITIALIZE-CONDITIONS!)
+   ((RUNTIME STREAM) INITIALIZE-CONDITIONS!)
+   ((RUNTIME REGULAR-SEXPRESSION) INITIALIZE-CONDITIONS!)
    ;; System dependent stuff
-   ((RUNTIME OS-PRIMITIVES) INITIALIZE-SYSTEM-PRIMITIVES! #t)
+   ((RUNTIME OS-PRIMITIVES) INITIALIZE-SYSTEM-PRIMITIVES!)
    ;; Threads
    (RUNTIME THREAD)
    ;; I/O
@@ -489,7 +496,7 @@ USA.
    ;; Syntax
    (RUNTIME NUMBER-PARSER)
    (RUNTIME PARSER)
-   ((RUNTIME PATHNAME) INITIALIZE-PARSER-METHOD! #t)
+   ((RUNTIME PATHNAME) INITIALIZE-PARSER-METHOD!)
    (RUNTIME UNPARSER)
    (RUNTIME UNSYNTAXER)
    (RUNTIME PRETTY-PRINTER)
@@ -513,19 +520,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)
+   ((RUNTIME STARBASE-GRAPHICS) #f #f)
    (RUNTIME X-GRAPHICS)
-   (RUNTIME OS2-GRAPHICS)
+   ((RUNTIME OS2-GRAPHICS) #f #f)
    ;; Emacs -- last because it installs hooks everywhere which must be initted.
    (RUNTIME EMACS-INTERFACE)
    ;; More debugging
    ((RUNTIME CONTINUATION-PARSER) INITIALIZE-SPECIAL-FRAMES! #f)
    (RUNTIME URI)
    (RUNTIME RFC2822-HEADERS)
-   ((RUNTIME HTTP-SYNTAX) #f #f)
+   (RUNTIME HTTP-SYNTAX)
    (RUNTIME HTTP-CLIENT)
    (RUNTIME HTML-FORM-CODEC)
-   (RUNTIME WIN32-REGISTRY)))
+   ((RUNTIME WIN32-REGISTRY) #f #f)))
 \f
 (let ((obj (file->object "site" #t #f)))
   (if obj

diff --git a/src/runtime/regsexp.scm b/src/runtime/regsexp.scm
index ddac4b36e52dc23caf1e257eef1311fd5cb77a0e..7f0a3394d09592d2028103f000b1c38e56651db6 100644 (file)
--- a/src/runtime/regsexp.scm
+++ b/src/runtime/regsexp.scm
@@ -98,18 +98,21 @@ USA.
       (error "Ill-formed regsexp group key:" key))
   key)
 
-(define condition-type:compile-regsexp
-  (make-condition-type 'COMPILE-REGSEXP condition-type:error
-      '(PATTERN CAUSE)
-    (lambda (condition port)
-      (write (access-condition condition 'PATTERN) port)
-      (write-string ": " port)
-      (write-condition-report (access-condition condition 'CAUSE) port))))
-
-(define signal-compile-error
-  (condition-signaller condition-type:compile-regsexp
-                      '(PATTERN CAUSE)
-                      standard-error-handler))
+(define condition-type:compile-regsexp)
+(define signal-compile-error)
+(define (initialize-conditions!)
+  (set! condition-type:compile-regsexp
+       (make-condition-type 'COMPILE-REGSEXP condition-type:error
+           '(PATTERN CAUSE)
+         (lambda (condition port)
+           (write (access-condition condition 'PATTERN) port)
+           (write-string ": " port)
+           (write-condition-report (access-condition condition 'CAUSE) port))))
+  (set! signal-compile-error
+       (condition-signaller condition-type:compile-regsexp
+                            '(PATTERN CAUSE)
+                            standard-error-handler))
+  unspecific)
 \f
 ;;;; Compiler rules