2006-05-02 06:05:58 -04:00
|
|
|
! Copyright (C) 2003, 2006 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
IN: kernel-internals
|
|
|
|
USING: vectors ;
|
|
|
|
|
2006-08-15 21:23:05 -04:00
|
|
|
: catchstack* ( -- catchstack )
|
|
|
|
6 getenv { vector } declare ; inline
|
2006-05-02 06:05:58 -04:00
|
|
|
|
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
|
|
|
|
2006-08-15 21:23:05 -04:00
|
|
|
: catchstack ( -- catchstack ) catchstack* clone ; inline
|
|
|
|
: set-catchstack ( catchstack -- ) >vector 6 setenv ; inline
|
2005-09-22 21:01:55 -04:00
|
|
|
|
2005-09-14 00:37:50 -04:00
|
|
|
IN: kernel
|
2006-09-07 17:58:27 -04:00
|
|
|
USING: arrays namespaces sequences ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2006-05-14 23:09:47 -04:00
|
|
|
TUPLE: continuation data retain call name catch ;
|
2005-09-24 23:21:09 -04:00
|
|
|
|
2006-08-15 21:23:05 -04:00
|
|
|
: continuation ( -- continuation )
|
2006-07-24 00:41:27 -04:00
|
|
|
datastack retainstack callstack namestack catchstack
|
|
|
|
<continuation> ; inline
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2006-05-14 23:09:47 -04:00
|
|
|
: >continuation< ( continuation -- data retain call name catch )
|
2005-09-18 23:22:58 -04:00
|
|
|
[ continuation-data ] keep
|
2006-05-14 23:09:47 -04:00
|
|
|
[ continuation-retain ] keep
|
2005-09-18 23:22:58 -04:00
|
|
|
[ continuation-call ] keep
|
|
|
|
[ continuation-name ] keep
|
|
|
|
continuation-catch ; inline
|
2005-06-15 23:27:28 -04:00
|
|
|
|
2006-08-15 16:29:35 -04:00
|
|
|
: ifcc ( terminator balance -- )
|
2006-09-08 02:32:14 -04:00
|
|
|
>r >r f [ continuation nip t ] call r> r> if ; inline
|
|
|
|
|
|
|
|
: callcc0 ( quot -- ) [ ] ifcc ; inline
|
2005-09-22 21:01:55 -04:00
|
|
|
|
2006-09-08 21:12:18 -04:00
|
|
|
: callcc1 ( quot -- obj ) callcc0 ; inline
|
2005-09-22 21:01:55 -04:00
|
|
|
|
2006-09-07 17:14:35 -04:00
|
|
|
DEFER: continue-with
|
|
|
|
|
|
|
|
: set-walker-hook 2 setenv ; inline
|
|
|
|
|
|
|
|
: get-walker-hook 2 getenv f set-walker-hook ; inline
|
|
|
|
|
2006-09-07 17:58:27 -04:00
|
|
|
: (continue) ( continuation -- )
|
|
|
|
>continuation<
|
|
|
|
set-catchstack
|
|
|
|
set-namestack
|
|
|
|
set-callstack
|
|
|
|
set-retainstack
|
|
|
|
set-datastack ; inline
|
|
|
|
|
|
|
|
: (continue-with) ( obj continuation -- )
|
2006-09-08 02:32:14 -04:00
|
|
|
#! There's no good way to avoid this code duplication!
|
|
|
|
swap 9 setenv
|
|
|
|
>continuation<
|
|
|
|
set-catchstack
|
|
|
|
set-namestack
|
|
|
|
set-callstack
|
|
|
|
set-retainstack
|
|
|
|
set-datastack
|
|
|
|
9 getenv swap ; inline
|
2006-09-07 17:58:27 -04:00
|
|
|
|
2005-09-14 00:37:50 -04:00
|
|
|
: continue ( continuation -- )
|
2006-09-08 21:12:18 -04:00
|
|
|
get-walker-hook [ (continue-with) ] [ (continue) ] if* ;
|
2006-09-07 17:58:27 -04:00
|
|
|
inline
|
|
|
|
|
2006-08-15 21:23:05 -04:00
|
|
|
: continue-with ( obj continuation -- )
|
2006-09-07 17:58:27 -04:00
|
|
|
get-walker-hook [ >r 2array r> ] when* (continue-with) ;
|
|
|
|
inline
|
2006-08-24 02:40:03 -04:00
|
|
|
|
|
|
|
M: continuation clone
|
|
|
|
[ continuation-data clone ] keep
|
|
|
|
[ continuation-retain clone ] keep
|
|
|
|
[ continuation-call clone ] keep
|
|
|
|
[ continuation-name clone ] keep
|
|
|
|
continuation-catch clone <continuation> ;
|