continuations: keep original error when throwing wrapped errors as well, for easier debugging of bootstrap failures
parent
33eb15bf44
commit
e436ae7314
|
@ -51,9 +51,11 @@ SYMBOL: bootstrap-time
|
||||||
|
|
||||||
: save/restore-error ( quot -- )
|
: save/restore-error ( quot -- )
|
||||||
error get-global
|
error get-global
|
||||||
|
original-error get-global
|
||||||
error-continuation get-global
|
error-continuation get-global
|
||||||
[ call ] 2dip
|
[ call ] 3dip
|
||||||
error-continuation set-global
|
error-continuation set-global
|
||||||
|
original-error set-global
|
||||||
error set-global ; inline
|
error set-global ; inline
|
||||||
|
|
||||||
|
|
||||||
|
@ -89,6 +91,7 @@ SYMBOL: bootstrap-time
|
||||||
run-bootstrap-init
|
run-bootstrap-init
|
||||||
|
|
||||||
f error set-global
|
f error set-global
|
||||||
|
f original-error set-global
|
||||||
f error-continuation set-global
|
f error-continuation set-global
|
||||||
|
|
||||||
nano-count swap - bootstrap-time set-global
|
nano-count swap - bootstrap-time set-global
|
||||||
|
|
|
@ -12,6 +12,7 @@ IN: continuations
|
||||||
swap [ set-datastack ] dip
|
swap [ set-datastack ] dip
|
||||||
] (( stack quot -- new-stack )) call-effect-unsafe ;
|
] (( stack quot -- new-stack )) call-effect-unsafe ;
|
||||||
|
|
||||||
|
SYMBOL: original-error
|
||||||
SYMBOL: error
|
SYMBOL: error
|
||||||
SYMBOL: error-continuation
|
SYMBOL: error-continuation
|
||||||
SYMBOL: error-thread
|
SYMBOL: error-thread
|
||||||
|
@ -102,8 +103,8 @@ GENERIC: compute-restarts ( error -- seq )
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: save-error ( error -- )
|
: save-error ( error -- )
|
||||||
dup error set-global
|
[ error set-global ]
|
||||||
compute-restarts restarts set-global ;
|
[ compute-restarts restarts set-global ] bi ;
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
@ -113,7 +114,8 @@ SYMBOL: thread-error-hook
|
||||||
dup save-error
|
dup save-error
|
||||||
catchstack* empty? [
|
catchstack* empty? [
|
||||||
thread-error-hook get-global
|
thread-error-hook get-global
|
||||||
[ (( error -- * )) call-effect-unsafe ] [ die ] if*
|
[ original-error get-global die ] or
|
||||||
|
(( error -- * )) call-effect-unsafe
|
||||||
] when
|
] when
|
||||||
c> continue-with ;
|
c> continue-with ;
|
||||||
|
|
||||||
|
@ -176,7 +178,7 @@ M: condition compute-restarts
|
||||||
! 63 = self
|
! 63 = self
|
||||||
63 special-object error-thread set-global
|
63 special-object error-thread set-global
|
||||||
continuation error-continuation set-global
|
continuation error-continuation set-global
|
||||||
rethrow
|
[ original-error set-global ] [ rethrow ] bi
|
||||||
] 5 set-special-object
|
] 5 set-special-object
|
||||||
! VM adds this to kernel errors, so that user-space
|
! VM adds this to kernel errors, so that user-space
|
||||||
! can identify them
|
! can identify them
|
||||||
|
|
Loading…
Reference in New Issue