From e436ae7314faf47170ceeda855c816b5ae796526 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Fri, 30 Apr 2010 05:33:34 -0400
Subject: [PATCH] continuations: keep original error when throwing wrapped
 errors as well, for easier debugging of bootstrap failures

---
 basis/bootstrap/stage2.factor           |  5 ++++-
 core/continuations/continuations.factor | 10 ++++++----
 2 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor
index 98b6a472ed..da4fbc444b 100644
--- 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 196a12d0d2..896a4b982d 100644
--- 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
-- 
2.34.1