concurrency.mailboxes: linked-thread's error reporting should still work even when...

diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor
index df73c36183e7baf83e7ed10501fa34a111e4b2dc..5bd8d8719b351aef738e7c9bf69f3d20129a426a 100755 (executable)
--- a/basis/concurrency/mailboxes/mailboxes.factor
+++ b/basis/concurrency/mailboxes/mailboxes.factor
@@ -84,7 +84,7 @@ C: <linked-error> linked-error
 TUPLE: linked-thread < thread supervisor ;
 
 M: linked-thread error-in-thread
-    [ <linked-error> ] [ supervisor>> ] bi mailbox-put ;
+    [ <linked-error> ] [ supervisor>> ] bi mailbox-put stop ;
 
 : <linked-thread> ( quot name mailbox -- thread' )
     [ linked-thread new-thread ] dip >>supervisor ;

diff --git a/basis/debugger/threads/threads.factor b/basis/debugger/threads/threads.factor
index 4b6c2d6c4fad584565f8ed67a56a18282c0c77ef..f487c5e01300aada39590b2562ccc2b236208140 100644 (file)
--- a/basis/debugger/threads/threads.factor
+++ b/basis/debugger/threads/threads.factor
@@ -1,8 +1,7 @@
 ! Copyright (C) 2008, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien debugger continuations threads
-threads.private io io.styles prettyprint kernel make math.parser
-namespaces ;
+USING: accessors debugger continuations threads io io.styles
+prettyprint kernel make math.parser namespaces ;
 IN: debugger.threads
 
 : error-in-thread. ( thread -- )
@@ -13,21 +12,15 @@ IN: debugger.threads
         ", " % dup quot>> unparse-short % ")" %
     ] "" make swap write-object ":" print ;
 
-: call-thread-error-handler? ( thread -- ? )
-    initial-thread get-global eq?
-    in-callback?
-    or not ;
-
-M: thread error-in-thread ( error thread -- )
-    global [
-        error-in-thread. nl
-        print-error nl
-        :c
-        flush
-    ] bind ;
-
+! ( error thread -- )
 [
-    dup call-thread-error-handler?
-    [ self error-in-thread stop ]
-    [ [ die ] call( error thread -- * ) ] if
+    dup initial-thread get-global eq? [ die ] [
+        global [
+            error-in-thread. nl
+            print-error nl
+            :c
+            flush
+        ] bind
+        stop
+    ] if
 ] thread-error-hook set-global

diff --git a/basis/io/thread/thread.factor b/basis/io/thread/thread.factor
index 58cd3fbdd8e9e672f1227b444accdaae65168bf4..461e383f2945dc5ab9a2020d6c89db60de630394 100644 (file)
--- a/basis/io/thread/thread.factor
+++ b/basis/io/thread/thread.factor
@@ -1,6 +1,6 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: init io.backend kernel namespaces threads ;
+USING: continuations init io.backend kernel namespaces threads ;
 IN: io.thread
 
 ! The Cocoa and Gtk UI backend stops the I/O thread and takes
@@ -18,7 +18,7 @@ TUPLE: io-thread < thread ;
     "I/O wait"
     io-thread new-thread ;
 
-M: io-thread error-in-thread [ die ] call( error thread -- ) ;
+M: io-thread error-in-thread [ die ] call( error thread -- * ) ;
 
 : start-io-thread ( -- )
     t io-thread-running? set-global

diff --git a/basis/threads/threads.factor b/basis/threads/threads.factor
index 30444036146ead8c685bfe568be33933caf9afef..27eb8cfaad9b347f9b0760020be40e64564af555 100644 (file)
--- a/basis/threads/threads.factor
+++ b/basis/threads/threads.factor
@@ -233,8 +233,6 @@ M: real sleep
     '[ _ set-datastack @ ]
     "Thread" spawn drop ;
 
-GENERIC: error-in-thread ( error thread -- )
-
 <PRIVATE
 
 : init-thread-state ( -- )

diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor
index 89684cf273077ceb95ebe9560175551b7cf58655..2ca94389638cd4ba6e7bc0997605b8bf6d833499 100755 (executable)
--- a/basis/tools/deploy/shaker/shaker.factor
+++ b/basis/tools/deploy/shaker/shaker.factor
@@ -393,10 +393,7 @@ IN: tools.deploy.shaker
         ] when
 
         strip-debugger? [
-            {
-                compiler.errors:compiler-errors
-                continuations:thread-error-hook
-            } %
+            \ compiler.errors:compiler-errors ,
         ] when
 
         "windows-messages" "windows.messages" lookup [ , ] when*

diff --git a/basis/tools/deploy/test/22/22.factor b/basis/tools/deploy/test/22/22.factor
new file mode 100644 (file)
index 0000000..c3da9b6
--- /dev/null
+++ b/basis/tools/deploy/test/22/22.factor
@@ -0,0 +1,12 @@
+! Copyright (C) 2011 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors continuations concurrency.mailboxes
+concurrency.messaging kernel system threads ;
+IN: tools.deploy.test.22
+
+: linked-error-test ( -- )
+    [ "Linked" throw ] "Test" spawn-linked drop
+    [ receive drop 1 ] [ error>> "Linked" = 0 1 ? ] recover
+    exit ;
+
+MAIN: linked-error-test

diff --git a/basis/tools/deploy/test/22/deploy.factor b/basis/tools/deploy/test/22/deploy.factor
new file mode 100644 (file)
index 0000000..c5eb1b0
--- /dev/null
+++ b/basis/tools/deploy/test/22/deploy.factor
@@ -0,0 +1,16 @@
+USING: tools.deploy.config ;
+H{
+    { deploy-c-types? f }
+    { deploy-help? f }
+    { deploy-name "tools.deploy.test.22" }
+    { "stop-after-last-window?" t }
+    { deploy-unicode? f }
+    { deploy-console? t }
+    { deploy-io 2 }
+    { deploy-reflection 1 }
+    { deploy-ui? f }
+    { deploy-word-defs? f }
+    { deploy-threads? t }
+    { deploy-math? t }
+    { deploy-word-props? f }
+}

diff --git a/core/alien/alien.factor b/core/alien/alien.factor
index f2cbb572769d91092e098ac3c728cfd21ae168c6..2d04720433e7ce16cf3feb1b8c7a4f07612f7c58 100755 (executable)
--- a/core/alien/alien.factor
+++ b/core/alien/alien.factor
@@ -118,8 +118,6 @@ TUPLE: expiry-check object alien ;
 
 PRIVATE>
 
-: in-callback? ( -- ? ) 3 context-object ;
-
 : initialize-alien ( symbol quot -- )
     swap dup get-global dup recompute-value?
     [ drop [ call dup 31337 <alien> expiry-check boa ] dip set-global ]

diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor
index 810f853ef252ff4b86288a158ca46318932bf01b..8bcc7c754e639cd34f0b6f42d958cc1c35df3989 100644 (file)
--- a/core/continuations/continuations-docs.factor
+++ b/core/continuations/continuations-docs.factor
@@ -163,14 +163,6 @@ HELP: restarts
 { $var-description "Global variable holding the set of possible restarts for the most recently thrown error." }
 { $notes "Only updated by " { $link throw } ", not " { $link rethrow } "." } ;
 
-HELP: >c
-{ $values { "continuation" continuation } }
-{ $description "Pushes an exception handler continuation on the catch stack. The continuation must have been reified by " { $link callcc1 } "." } ;
-
-HELP: c>
-{ $values { "continuation" continuation } }
-{ $description "Pops an exception handler continuation from the catch stack." } ;
-
 HELP: throw
 { $values { "error" object } }
 { $description "Saves the current continuation in the " { $link error-continuation } " global variable and throws an error. Execution does not continue at the point after the " { $link throw } " call. Rather, the innermost catch block is invoked, and execution continues at that point." } ;

diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor
index 896a4b982d3934ac5b0aab3f394fb2e79e03cade..ec8be7efa42be0e2d203cfc9c659240736751d1d 100644 (file)
--- a/core/continuations/continuations.factor
+++ b/core/continuations/continuations.factor
@@ -1,4 +1,4 @@
-! Copyright (C) 2003, 2010 Slava Pestov.
+! Copyright (C) 2003, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays vectors kernel kernel.private sequences
 namespaces make math splitting sorting quotations assocs
@@ -23,13 +23,9 @@ SYMBOL: restarts
 : catchstack* ( -- catchstack )
     1 context-object { vector } declare ; inline
 
-: >c ( continuation -- ) catchstack* push ;
-
-: c> ( -- continuation ) catchstack* pop ;
-
 ! We have to defeat some optimizations to make continuations work
 : dummy-1 ( -- obj ) f ;
-: dummy-2 ( obj -- obj ) dup drop ;
+: dummy-2 ( obj -- obj ) ;
 
 : catchstack ( -- catchstack ) catchstack* clone ; inline
 
@@ -108,19 +104,38 @@ GENERIC: compute-restarts ( error -- seq )
 
 PRIVATE>
 
-SYMBOL: thread-error-hook
+GENERIC: error-in-thread ( error thread -- * )
+
+SYMBOL: thread-error-hook ! ( error thread -- )
+
+thread-error-hook [ [ die ] ] initialize
+
+M: object error-in-thread ( error thread -- )
+    thread-error-hook get-global call( error thread -- * ) ;
+
+: in-callback? ( -- ? ) 3 context-object ;
+
+SYMBOL: callback-error-hook ! ( error -- * )
+
+callback-error-hook [ [ die ] ] initialize
 
 : rethrow ( error -- * )
     dup save-error
-    catchstack* empty? [
-        thread-error-hook get-global
-        [ original-error get-global die ] or
-        (( error -- * )) call-effect-unsafe
-    ] when
-    c> continue-with ;
+    catchstack* [
+        in-callback?
+        [ callback-error-hook get-global call( error -- * ) ]
+        [ 63 special-object error-in-thread ]
+        if
+    ] [ pop continue-with ] if-empty ;
 
 : recover ( ..a try: ( ..a -- ..b ) recovery: ( ..a error -- ..b ) -- ..b )
-    [ [ swap >c call c> drop ] curry ] dip ifcc ; inline
+    [
+        [
+            [ catchstack* push ] dip
+            call
+            catchstack* pop*
+        ] curry
+    ] dip ifcc ; inline
 
 : ignore-errors ( quot -- )
     [ drop ] recover ; inline