kernel: fix stack effect declarations of call-clear and set-callstack, and add a...

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 72348ffa03fe66020e8bfc840c0de908b3a49979..4a4d178f9e6bb053ef4185e4134b6213853b06dc 100644 (file)
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -430,7 +430,7 @@ tuple
     { "callstack" "kernel" (( -- cs )) }
     { "set-datastack" "kernel" (( ds -- )) }
     { "set-retainstack" "kernel" (( rs -- )) }
-    { "set-callstack" "kernel" (( cs -- )) }
+    { "set-callstack" "kernel" (( cs -- * )) }
     { "(exit)" "system" (( n -- )) }
     { "data-room" "memory" (( -- data-room )) }
     { "code-room" "memory" (( -- code-room )) }
@@ -503,7 +503,7 @@ tuple
     { "innermost-frame-executing" "kernel.private" (( callstack -- obj )) }
     { "innermost-frame-scan" "kernel.private" (( callstack -- n )) }
     { "set-innermost-frame-quot" "kernel.private" (( n callstack -- )) }
-    { "call-clear" "kernel.private" (( quot -- )) }
+    { "call-clear" "kernel.private" (( quot -- * )) }
     { "resize-byte-array" "byte-arrays" (( n byte-array -- newbyte-array )) }
     { "dll-valid?" "alien.libraries" (( dll -- ? )) }
     { "unimplemented" "kernel.private" (( -- * )) }

diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index 0e8c3368ff55a34b047adcae73c3a150f9af1b3b..87cb1a4709421d91cf7375ec5e96f238898b1bec 100644 (file)
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -46,7 +46,7 @@ HELP: callstack ( -- cs )
 { $values { "cs" callstack } }
 { $description "Outputs a copy of the call stack contents, with the top of the stack at the end of the vector. The stack frame of the caller word is " { $emphasis "not" } " included." } ;
 
-HELP: set-callstack ( cs -- )
+HELP: set-callstack ( cs -- * )
 { $values { "cs" callstack } }
 { $description "Replaces the call stack contents. The end of the vector becomes the top of the stack. Control flow is transferred immediately to the new call stack." } ;
 
@@ -208,7 +208,7 @@ HELP: call
 
 { call POSTPONE: call( } related-words
 
-HELP: call-clear ( quot -- )
+HELP: call-clear ( quot -- * )
 { $values { "quot" callable } }
 { $description "Calls a quotation with an empty call stack. If the quotation returns, Factor will exit.." }
 { $notes "Used to implement " { $link "threads" } "." } ;

diff --git a/core/kernel/kernel-tests.factor b/core/kernel/kernel-tests.factor
index ded2ee970294496376f419b42a1963ab2c716426..bd21490542b6894c60bc93ccbbf5d794bf14d113 100644 (file)
--- a/core/kernel/kernel-tests.factor
+++ b/core/kernel/kernel-tests.factor
@@ -164,6 +164,11 @@ IN: kernel.tests
     last-frame
 ] unit-test
 
+: throw-frame-test ( c -- * ) [ gc gc continue ] call-clear ;
+: throw-frame-test' ( -- ) [ throw-frame-test ] callcc0 ;
+
+[ ] [ throw-frame-test' ] unit-test
+
 [ 10 2 3 4 5 ] [ 1 2 3 4 5 [ 10 * ] 4dip ] unit-test
 
 [ 3 -1 5/6 ] [ 1 2 3 4 5 6 [ + ] [ - ] [ / ] 2tri* ] unit-test