concurrency.mailboxes: linked-thread's error reporting should still work even when debugger.threads is not loaded. This addresses part of #95

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 ;

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
+USING: accessors debugger continuations threads io io.styles
-threads.private io io.styles prettyprint kernel make math.parser
+prettyprint kernel make math.parser namespaces ;
-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 -- ? )
+! ( error 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 ;
-
 [
-    dup call-thread-error-handler?
+    dup initial-thread get-global eq? [ die ] [
-    [ self error-in-thread stop ]
+        global [
-    [ [ die ] call( error thread -- * ) ] if
+            error-in-thread. nl
+            print-error nl
+            :c
+            flush
+        ] bind
+        stop
+    ] if
 ] thread-error-hook set-global

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

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 ( -- )

basis/tools/deploy/shaker/shaker.factor

@@ -393,10 +393,7 @@ IN: tools.deploy.shaker
         ] when
 
         strip-debugger? [
-            {
+            \ compiler.errors:compiler-errors ,
-                compiler.errors:compiler-errors
-                continuations:thread-error-hook
-            } %
         ] when
 
         "windows-messages" "windows.messages" lookup [ , ] when*

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

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 }
+}

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 ]

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." } ;

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? [
+    catchstack* [
-        thread-error-hook get-global
+        in-callback?
-        [ original-error get-global die ] or
+        [ callback-error-hook get-global call( error -- * ) ]
-        (( error -- * )) call-effect-unsafe
+        [ 63 special-object error-in-thread ]
-    ] when
+        if
-    c> continue-with ;
+    ] [ 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