diff --git a/basis/concurrency/mailboxes/mailboxes.factor b/basis/concurrency/mailboxes/mailboxes.factor index df73c36183..5bd8d8719b 100755 --- a/basis/concurrency/mailboxes/mailboxes.factor +++ b/basis/concurrency/mailboxes/mailboxes.factor @@ -84,7 +84,7 @@ C: linked-error TUPLE: linked-thread < thread supervisor ; M: linked-thread error-in-thread - [ ] [ supervisor>> ] bi mailbox-put ; + [ ] [ supervisor>> ] bi mailbox-put stop ; : ( 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 4b6c2d6c4f..f487c5e013 100644 --- 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 58cd3fbdd8..461e383f29 100644 --- 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 3044403614..27eb8cfaad 100644 --- 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 -- ) - > "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 index 0000000000..c5eb1b0f64 --- /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 f2cbb57276..2d04720433 100755 --- 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 expiry-check boa ] dip set-global ] diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor index 810f853ef2..8bcc7c754e 100644 --- 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 896a4b982d..ec8be7efa4 100644 --- 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