Defer enabling runtime handling of errors until end of cold load.
authorChris Hanson <org/chris-hanson/cph>
Sun, 21 Jan 2018 09:28:41 +0000 (01:28 -0800)
committerChris Hanson <org/chris-hanson/cph>
Sun, 21 Jan 2018 09:28:41 +0000 (01:28 -0800)
Otherwise, once the error system is initialized, a subsequent cold-load error
causes an infinite loop.  At least this way there's some information about what
went wrong.

src/runtime/make.scm
src/runtime/uerror.scm

index 153c8f6a4cded76798019b86a022674588d34ac5..c40fa1eedc940e0ebe0a52084376c7a6714996da 100644 (file)
@@ -566,7 +566,9 @@ USA.
    (RUNTIME SAVE/RESTORE)
    (RUNTIME STRUCTURE-PARSER)
    (RUNTIME SWANK)
-   (RUNTIME STACK-SAMPLER)))
+   (RUNTIME STACK-SAMPLER)
+   ;; Last since it turns on runtime handling of microcode errors.
+   ((runtime microcode-errors) initialize-error-hooks!)))
 \f
 (let ((obj (file->object "site" #t #f)))
   (if obj
index adda0a717f0fe00ac53b52159d90e84db66d6ab3..554d23b19218472c096c9c2d0fb5fb7b2fbc8683 100644 (file)
@@ -85,6 +85,14 @@ USA.
                    (cons* continuation
                           'BOUND-RESTARTS
                           field-values))))))
+
+(define (initialize-error-hooks!)
+  (set-fixed-objects-item! 'system-error-vector error-handler-vector)
+  (set-fixed-objects-item! 'error-procedure
+                          (lambda (datum arguments environment)
+                            environment
+                            (apply error (cons* datum arguments))))
+  (set-fixed-objects-item! 'compiler-error-procedure error))
 \f
 ;;;; Restart Bindings
 
@@ -457,13 +465,6 @@ USA.
         default-error-handler)
      continuation
      argument)))
-
-(set-fixed-objects-item! 'system-error-vector error-handler-vector)
-(set-fixed-objects-item! 'error-procedure
-                        (lambda (datum arguments environment)
-                          environment
-                          (apply error (cons* datum arguments))))
-(set-fixed-objects-item! 'compiler-error-procedure error)
 \f
 ;;;; Variable Errors