continuations: keep original error when throwing wrapped errors as well, for easier debugging of bootstrap failures

db4
Slava Pestov 2010-04-30 05:33:34 -04:00
parent 33eb15bf44
commit e436ae7314
2 changed files with 10 additions and 5 deletions

View File

@ -51,9 +51,11 @@ SYMBOL: bootstrap-time
: save/restore-error ( quot -- )
error get-global
original-error get-global
error-continuation get-global
[ call ] 2dip
[ call ] 3dip
error-continuation set-global
original-error set-global
error set-global ; inline
@ -89,6 +91,7 @@ SYMBOL: bootstrap-time
run-bootstrap-init
f error set-global
f original-error set-global
f error-continuation set-global
nano-count swap - bootstrap-time set-global

View File

@ -12,6 +12,7 @@ IN: continuations
swap [ set-datastack ] dip
] (( stack quot -- new-stack )) call-effect-unsafe ;
SYMBOL: original-error
SYMBOL: error
SYMBOL: error-continuation
SYMBOL: error-thread
@ -102,8 +103,8 @@ GENERIC: compute-restarts ( error -- seq )
<PRIVATE
: save-error ( error -- )
dup error set-global
compute-restarts restarts set-global ;
[ error set-global ]
[ compute-restarts restarts set-global ] bi ;
PRIVATE>
@ -113,7 +114,8 @@ SYMBOL: thread-error-hook
dup save-error
catchstack* empty? [
thread-error-hook get-global
[ (( error -- * )) call-effect-unsafe ] [ die ] if*
[ original-error get-global die ] or
(( error -- * )) call-effect-unsafe
] when
c> continue-with ;
@ -176,7 +178,7 @@ M: condition compute-restarts
! 63 = self
63 special-object error-thread set-global
continuation error-continuation set-global
rethrow
[ original-error set-global ] [ rethrow ] bi
] 5 set-special-object
! VM adds this to kernel errors, so that user-space
! can identify them