continuations: keep original error when throwing wrapped errors as well, for easier...

diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor
index 98b6a472edc0e0ad49b44076e790379c67d11a7c..da4fbc444b8f0cad187d96b22d3de51a9a42f32c 100644 (file)
--- a/basis/bootstrap/stage2.factor
+++ b/basis/bootstrap/stage2.factor
@@ -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

diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor
index 196a12d0d2765fce3f71222683dd72a2bef0382c..896a4b982d3934ac5b0aab3f394fb2e79e03cade 100644 (file)
--- a/core/continuations/continuations.factor
+++ b/core/continuations/continuations.factor
@@ -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