2005-01-29 14:18:28 -05:00
|
|
|
! Copyright (C) 2003, 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2005-09-22 21:01:55 -04:00
|
|
|
IN: errors
|
2005-11-12 00:37:24 -05:00
|
|
|
USING: kernel kernel-internals ;
|
2005-09-22 21:01:55 -04:00
|
|
|
|
2005-11-12 00:37:24 -05:00
|
|
|
: catchstack* ( -- cs ) 6 getenv ; inline
|
|
|
|
: catchstack ( -- cs ) catchstack* clone ; inline
|
|
|
|
: set-catchstack ( cs -- ) clone 6 setenv ; inline
|
2005-09-22 21:01:55 -04:00
|
|
|
|
2005-09-14 00:37:50 -04:00
|
|
|
IN: kernel
|
2005-09-22 21:01:55 -04:00
|
|
|
USING: namespaces sequences ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-12-13 17:33:58 -05:00
|
|
|
TUPLE: continuation data call name catch ;
|
2005-09-24 23:21:09 -04:00
|
|
|
|
2005-09-14 00:37:50 -04:00
|
|
|
: continuation ( -- interp )
|
|
|
|
#! The continuation is reified from after the *caller* of
|
2005-09-24 23:21:09 -04:00
|
|
|
#! this word returns. It must be declared inline for this
|
|
|
|
#! invariant to be preserved in compiled code too.
|
2005-12-13 17:33:58 -05:00
|
|
|
datastack callstack dup pop* dup pop*
|
2005-09-18 23:22:58 -04:00
|
|
|
namestack catchstack <continuation> ; inline
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-12-13 17:33:58 -05:00
|
|
|
: >continuation< ( continuation -- data call name catch )
|
2005-09-18 23:22:58 -04:00
|
|
|
[ continuation-data ] keep
|
|
|
|
[ continuation-call ] keep
|
|
|
|
[ continuation-name ] keep
|
|
|
|
continuation-catch ; inline
|
2005-06-15 23:27:28 -04:00
|
|
|
|
2005-09-22 21:01:55 -04:00
|
|
|
: ifcc ( terminator balance -- | quot: continuation -- )
|
2005-09-24 23:21:09 -04:00
|
|
|
#! Note that the branch at the end must not be optimized out
|
|
|
|
#! by the compiler.
|
2005-09-22 21:01:55 -04:00
|
|
|
[
|
2005-09-22 23:18:12 -04:00
|
|
|
continuation
|
2005-09-24 23:21:09 -04:00
|
|
|
dup continuation-data f over push f swap push dup
|
2005-09-24 15:21:17 -04:00
|
|
|
] call 2swap if ; inline
|
2005-09-22 21:01:55 -04:00
|
|
|
|
|
|
|
: callcc0 ( quot -- | quot: continuation -- )
|
|
|
|
#! Call a quotation with the current continuation, which may
|
2005-09-23 01:22:04 -04:00
|
|
|
#! be restored using continue.
|
2005-09-22 23:18:12 -04:00
|
|
|
[ drop ] ifcc ; inline
|
2005-09-22 21:01:55 -04:00
|
|
|
|
2005-09-14 00:37:50 -04:00
|
|
|
: continue ( continuation -- )
|
|
|
|
#! Restore a continuation.
|
2005-12-13 17:33:58 -05:00
|
|
|
>continuation<
|
|
|
|
set-catchstack set-namestack set-callstack set-datastack ;
|
|
|
|
inline
|
2005-09-14 00:37:50 -04:00
|
|
|
|
2005-09-23 01:22:04 -04:00
|
|
|
: (continue-with) 9 getenv ;
|
|
|
|
|
|
|
|
: callcc1 ( quot -- | quot: continuation -- )
|
|
|
|
#! Call a quotation with the current continuation, which may
|
|
|
|
#! be restored using continue-with.
|
|
|
|
[ drop (continue-with) ] ifcc ; inline
|
|
|
|
|
2005-09-14 00:37:50 -04:00
|
|
|
: continue-with ( object continuation -- object )
|
|
|
|
#! Restore a continuation, and place the object in the
|
|
|
|
#! restored data stack.
|
2005-09-22 21:01:55 -04:00
|
|
|
swap 9 setenv continue ; inline
|