From ee1faf45e163932a5597cc082fac037426ff105f Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sun, 21 Jan 2018 01:28:41 -0800 Subject: [PATCH] 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. --- src/runtime/make.scm | 4 +++- src/runtime/uerror.scm | 15 ++++++++------- 2 files changed, 11 insertions(+), 8 deletions(-) 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 -- 2.25.1