From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 21 Jan 2018 09:28:41 +0000 (-0800)
Subject: Defer enabling runtime handling of errors until end of cold load.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~329
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ee1faf45e163932a5597cc082fac037426ff105f;p=mit-scheme.git

Defer enabling runtime handling of errors until end of cold load.

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.
---

diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index 153c8f6a4..c40fa1eed 100644
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -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!)))
 
 (let ((obj (file->object "site" #t #f)))
   (if obj
diff --git a/src/runtime/uerror.scm b/src/runtime/uerror.scm
index adda0a717..554d23b19 100644
--- a/src/runtime/uerror.scm
+++ b/src/runtime/uerror.scm
@@ -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))
 
 ;;;; 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)
 
 ;;;; Variable Errors