threads: delete old contexts immediately instead of handing them off to a 'context recycler' thread

basis/cpu/x86/32/bootstrap.factor

@@ -72,6 +72,12 @@ IN: bootstrap.x86
     jit-restore-context
 ] jit-primitive jit-define
 
+: jit-jump-quot ( -- )
+    EAX quot-entry-point-offset [+] JMP ;
+
+: jit-call-quot ( -- )
+    EAX quot-entry-point-offset [+] CALL ;
+
 [
     jit-load-vm
     ESP [] vm-reg MOV
@@ -92,8 +98,7 @@ IN: bootstrap.x86
     ESP ctx-reg context-callstack-bottom-offset [+] MOV
     ESP 4 ADD
 
-    ! call the quotation
+    jit-call-quot
-    EAX quot-entry-point-offset [+] CALL
 
     jit-load-vm
     jit-save-context
@@ -109,8 +114,8 @@ IN: bootstrap.x86
     EAX ds-reg [] MOV
     ds-reg bootstrap-cell SUB
 ]
-[ EAX quot-entry-point-offset [+] CALL ]
+[ jit-call-quot ]
-[ EAX quot-entry-point-offset [+] JMP ]
+[ jit-jump-quot ]
 \ (call) define-combinator-primitive
 
 [
@@ -133,8 +138,7 @@ IN: bootstrap.x86
     jit-load-context
     jit-restore-context
 
-    ! Call quotation
+    jit-jump-quot
-    EAX quot-entry-point-offset [+] JMP
 ] \ unwind-native-frames define-sub-primitive
 
 [
@@ -175,8 +179,8 @@ IN: bootstrap.x86
     ! Call VM
     "lazy_jit_compile" jit-call
 ]
-[ EAX quot-entry-point-offset [+] CALL ]
+[ jit-call-quot ]
-[ EAX quot-entry-point-offset [+] JMP ]
+[ jit-jump-quot ]
 \ lazy-jit-compile define-combinator-primitive
 
 ! Inline cache miss entry points
@@ -247,8 +251,8 @@ IN: bootstrap.x86
     jit-conditional
 ] \ fixnum* define-sub-primitive
 
-! Threads
+! Contexts
-: jit-set-context ( reg -- )
+: jit-switch-context ( reg -- )
     ! Save ds, rs registers
     jit-load-vm
     jit-save-context
@@ -263,7 +267,26 @@ IN: bootstrap.x86
     ! Load new ds, rs registers
     jit-restore-context ;
 
-[
+: jit-set-context ( -- )
+    ! Load context and parameter from datastack
+    EAX ds-reg [] MOV
+    EAX EAX alien-offset [+] MOV
+    EBX ds-reg -4 [+] MOV
+    ds-reg 8 SUB
+
+    ! Make the new context active
+    EAX jit-switch-context
+
+    ! Twiddle stack for return
+    ESP 4 ADD
+
+    ! Store parameter to datastack
+    ds-reg 4 ADD
+    ds-reg [] EBX MOV ;
+
+[ jit-set-context ] \ (set-context) define-sub-primitive
+
+: jit-start-context ( -- )
     ! Create the new context in return-reg
     jit-load-vm
     ESP [] vm-reg MOV
@@ -274,7 +297,7 @@ IN: bootstrap.x86
     ds-reg 8 SUB
 
     ! Make the new context active
-    EAX jit-set-context
+    EAX jit-switch-context
 
     ! Push parameter
     EAX EBX -4 [+] MOV
@@ -283,26 +306,26 @@ IN: bootstrap.x86
 
     ! Jump to initial quotation
     EAX EBX [] MOV
-    EAX quot-entry-point-offset [+] JMP
+    jit-jump-quot ;
-] \ (start-context) define-sub-primitive
+
+[ jit-start-context ] \ (start-context) define-sub-primitive
+
+: jit-delete-current-context ( -- )
+    jit-load-vm
+    jit-load-context
+    ESP [] vm-reg MOV
+    ESP 4 [+] ctx-reg MOV
+    "delete_context" jit-call ;
 
 [
-    ! Load context and parameter from datastack
+    jit-delete-current-context
-    EAX ds-reg [] MOV
+    jit-set-context
-    EAX EAX alien-offset [+] MOV
+] \ (set-context-and-delete) define-sub-primitive
-    EBX ds-reg -4 [+] MOV
-    ds-reg 8 SUB
 
-    ! Make the new context active
+[
-    EAX jit-set-context
+    jit-delete-current-context
-
+    jit-start-context
-    ! Twiddle stack for return
+] \ (start-context-and-delete) define-sub-primitive
-    ESP 4 ADD
-
-    ! Store parameter to datastack
-    ds-reg 4 ADD
-    ds-reg [] EBX MOV
-] \ (set-context) define-sub-primitive
 
 << "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
 call

basis/cpu/x86/64/bootstrap.factor

@@ -70,6 +70,10 @@ IN: bootstrap.x86
     jit-restore-context
 ] jit-primitive jit-define
 
+: jit-jump-quot ( -- ) arg1 quot-entry-point-offset [+] JMP ;
+
+: jit-call-quot ( -- ) arg1 quot-entry-point-offset [+] CALL ;
+
 [
     nv-reg arg1 MOV
 
@@ -87,7 +91,7 @@ IN: bootstrap.x86
 
     ! call the quotation
     arg1 nv-reg MOV
-    arg1 quot-entry-point-offset [+] CALL
+    jit-call-quot
 
     jit-save-context
 
@@ -102,8 +106,8 @@ IN: bootstrap.x86
     arg1 ds-reg [] MOV
     ds-reg bootstrap-cell SUB
 ]
-[ arg1 quot-entry-point-offset [+] CALL ]
+[ jit-call-quot ]
-[ arg1 quot-entry-point-offset [+] JMP ]
+[ jit-jump-quot ]
 \ (call) define-combinator-primitive
 
 [
@@ -124,7 +128,7 @@ IN: bootstrap.x86
     jit-restore-context
 
     ! Call quotation
-    arg1 quot-entry-point-offset [+] JMP
+    jit-jump-quot
 ] \ unwind-native-frames define-sub-primitive
 
 [
@@ -157,9 +161,10 @@ IN: bootstrap.x86
     jit-save-context
     arg2 vm-reg MOV
     "lazy_jit_compile" jit-call
+    arg1 return-reg MOV
 ]
 [ return-reg quot-entry-point-offset [+] CALL ]
-[ return-reg quot-entry-point-offset [+] JMP ]
+[ jit-jump-quot ]
 \ lazy-jit-compile define-combinator-primitive
 
 ! Inline cache miss entry points
@@ -222,8 +227,8 @@ IN: bootstrap.x86
     jit-conditional
 ] \ fixnum* define-sub-primitive
 
-! Threads
+! Contexts
-: jit-set-context ( reg -- )
+: jit-switch-context ( reg -- )
     ! Save ds, rs registers
     jit-save-context
 
@@ -237,44 +242,59 @@ IN: bootstrap.x86
     ! Load new ds, rs registers
     jit-restore-context ;
 
-[
+: jit-pop-context-and-param ( -- )
+    arg1 ds-reg [] MOV
+    arg1 arg1 alien-offset [+] MOV
+    arg2 ds-reg -8 [+] MOV
+    ds-reg 16 SUB ;
+
+: jit-push-param ( -- )
+    ds-reg 8 ADD
+    ds-reg [] arg2 MOV ;
+
+: jit-set-context ( -- )
+    jit-pop-context-and-param
+    arg1 jit-switch-context
+    RSP 8 ADD
+    jit-push-param ;
+
+[ jit-set-context ] \ (set-context) define-sub-primitive
+
+: jit-pop-quot-and-param ( -- )
+    arg1 ds-reg [] MOV
+    arg2 ds-reg -8 [+] MOV
+    ds-reg 16 SUB ;
+
+: jit-start-context ( -- )
     ! Create the new context in return-reg
     arg1 vm-reg MOV
     "new_context" jit-call
 
-    ! Load quotation and parameter from datastack
+    jit-pop-quot-and-param
-    arg1 ds-reg [] MOV
-    arg2 ds-reg -8 [+] MOV
-    ds-reg 16 SUB
 
-    ! Make the new context active
+    return-reg jit-switch-context
-    return-reg jit-set-context
 
-    ! Push parameter
+    jit-push-param
-    ds-reg 8 ADD
-    ds-reg [] arg2 MOV
 
-    ! Jump to initial quotation
+    jit-jump-quot ;
-    arg1 quot-entry-point-offset [+] JMP
+
-] \ (start-context) define-sub-primitive
+[ jit-start-context ] \ (start-context) define-sub-primitive
+
+: jit-delete-current-context ( -- )
+    jit-load-context
+    arg1 vm-reg MOV
+    arg2 ctx-reg MOV
+    "delete_context" jit-call ;
 
 [
-    ! Load context and parameter from datastack
+    jit-delete-current-context
-    temp0 ds-reg [] MOV
+    jit-set-context
-    temp0 temp0 alien-offset [+] MOV
+] \ (set-context-and-delete) define-sub-primitive
-    temp1 ds-reg -8 [+] MOV
-    ds-reg 16 SUB
 
-    ! Make the new context active
+[
-    temp0 jit-set-context
+    jit-delete-current-context
-
+    jit-start-context
-    ! Twiddle stack for return
+] \ (start-context-and-delete) define-sub-primitive
-    RSP 8 ADD
-
-    ! Store parameter to datastack
-    ds-reg 8 ADD
-    ds-reg [] temp1 MOV
-] \ (set-context) define-sub-primitive
 
 << "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
 call

basis/stack-checker/backend/backend.factor

@@ -151,13 +151,6 @@ M: bad-call summary
 : required-stack-effect ( word -- effect )
     dup stack-effect [ ] [ missing-effect ] ?if ;
 
-: infer-word ( word -- )
-    {
-        { [ dup macro? ] [ do-not-compile ] }
-        { [ dup "no-compile" word-prop ] [ do-not-compile ] }
-        [ dup required-stack-effect apply-word/effect ]
-    } cond ;
-
 : with-infer ( quot -- effect visitor )
     [
         init-inference

basis/stack-checker/known-words/known-words.factor

@@ -14,7 +14,7 @@ compiler.units system.private combinators
 combinators.short-circuit locals locals.backend locals.types
 combinators.private stack-checker.values generic.single
 generic.single.private alien.libraries tools.dispatch.private
-tools.profiler.private
+tools.profiler.private macros
 stack-checker.alien
 stack-checker.state
 stack-checker.errors
@@ -27,11 +27,41 @@ stack-checker.recursive-state
 stack-checker.row-polymorphism ;
 IN: stack-checker.known-words
 
-: infer-primitive ( word -- )
+: infer-special ( word -- )
-    dup
+    [ current-word set ] [ "special" word-prop call( -- ) ] bi ;
-    [ "input-classes" word-prop ]
+
-    [ "default-output-classes" word-prop ] bi <effect>
+: infer-shuffle ( shuffle -- )
-    apply-word/effect ;
+    [ in>> length consume-d ] keep ! inputs shuffle
+    [ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
+    [ nip f f ] [ swap zip ] 2bi ! in-d out-d in-r out-r mapping
+    #shuffle, ;
+
+: infer-shuffle-word ( word -- )
+    "shuffle" word-prop infer-shuffle ;
+
+: infer-local-reader ( word -- )
+    (( -- value )) apply-word/effect ;
+
+: infer-local-writer ( word -- )
+    (( value -- )) apply-word/effect ;
+
+: infer-local-word ( word -- )
+    "local-word-def" word-prop infer-quot-here ;
+
+: non-inline-word ( word -- )
+    dup depends-on-effect
+    {
+        { [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
+        { [ dup "special" word-prop ] [ infer-special ] }
+        { [ dup "transform-quot" word-prop ] [ apply-transform ] }
+        { [ dup macro? ] [ apply-macro ] }
+        { [ dup local? ] [ infer-local-reader ] }
+        { [ dup local-reader? ] [ infer-local-reader ] }
+        { [ dup local-writer? ] [ infer-local-writer ] }
+        { [ dup local-word? ] [ infer-local-word ] }
+        { [ dup "no-compile" word-prop ] [ do-not-compile ] }
+        [ dup required-stack-effect apply-word/effect ]
+    } cond ;
 
 {
     { drop  (( x     --             )) }
@@ -51,15 +81,6 @@ IN: stack-checker.known-words
     { swap  (( x y   -- y x         )) }
 } [ "shuffle" set-word-prop ] assoc-each
 
-: infer-shuffle ( shuffle -- )
-    [ in>> length consume-d ] keep ! inputs shuffle
-    [ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
-    [ nip f f ] [ swap zip ] 2bi ! in-d out-d in-r out-r mapping
-    #shuffle, ;
-
-: infer-shuffle-word ( word -- )
-    "shuffle" word-prop infer-shuffle ;
-
 : check-declaration ( declaration -- declaration )
     dup { [ array? ] [ [ class? ] all? ] } 1&&
     [ bad-declaration-error ] unless ;
@@ -180,11 +201,6 @@ M: bad-executable summary
 
 \ call-effect-unsafe [ infer-call-effect-unsafe ] "special" set-word-prop
 
-: infer-exit ( -- )
-    \ exit (( n -- * )) apply-word/effect ;
-
-\ exit [ infer-exit ] "special" set-word-prop
-
 : infer-load-locals ( -- )
     pop-literal nip
     consume-d dup copy-values dup output-r
@@ -249,22 +265,10 @@ M: bad-executable summary
     c-to-factor
 } [ dup '[ _ do-not-compile ] "special" set-word-prop ] each
 
-: infer-special ( word -- )
-    [ current-word set ] [ "special" word-prop call( -- ) ] bi ;
-
-: infer-local-reader ( word -- )
-    (( -- value )) apply-word/effect ;
-
-: infer-local-writer ( word -- )
-    (( value -- )) apply-word/effect ;
-
-: infer-local-word ( word -- )
-    "local-word-def" word-prop infer-quot-here ;
-
 {
     declare call (call) dip 2dip 3dip curry compose
     execute (execute) call-effect-unsafe execute-effect-unsafe if
-    dispatch <tuple-boa> exit load-local load-locals get-local
+    dispatch <tuple-boa> load-local load-locals get-local
     drop-locals do-primitive alien-invoke alien-indirect
     alien-callback
 } [ t "no-compile" set-word-prop ] each
@@ -276,26 +280,10 @@ M: bad-executable summary
 ! More words not to compile
 \ clear t "no-compile" set-word-prop
 
-: non-inline-word ( word -- )
-    dup depends-on-effect
-    {
-        { [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
-        { [ dup "special" word-prop ] [ infer-special ] }
-        { [ dup "primitive" word-prop ] [ infer-primitive ] }
-        { [ dup "transform-quot" word-prop ] [ apply-transform ] }
-        { [ dup "macro" word-prop ] [ apply-macro ] }
-        { [ dup local? ] [ infer-local-reader ] }
-        { [ dup local-reader? ] [ infer-local-reader ] }
-        { [ dup local-writer? ] [ infer-local-writer ] }
-        { [ dup local-word? ] [ infer-local-word ] }
-        [ infer-word ]
-    } cond ;
-
 : define-primitive ( word inputs outputs -- )
-    [ 2drop t "primitive" set-word-prop ]
+    [ "input-classes" set-word-prop ]
-    [ drop "input-classes" set-word-prop ]
+    [ "default-output-classes" set-word-prop ]
-    [ nip "default-output-classes" set-word-prop ]
+    bi-curry* bi ;
-    3tri ;
 
 ! Stack effects for all primitives
 \ (byte-array) { integer } { byte-array } define-primitive \ (byte-array) make-flushable
@@ -311,8 +299,10 @@ M: bad-executable summary
 \ (save-image) { byte-array byte-array } { } define-primitive
 \ (save-image-and-exit) { byte-array byte-array } { } define-primitive
 \ (set-context) { object alien } { object } define-primitive
+\ (set-context-and-delete) { object alien } { } define-primitive
 \ (sleep) { integer } { } define-primitive
 \ (start-context) { object quotation } { object } define-primitive
+\ (start-context-and-delete) { object quotation } { } define-primitive
 \ (word) { object object object } { word } define-primitive \ (word) make-flushable
 \ <array> { integer object } { array } define-primitive \ <array> make-flushable
 \ <byte-array> { integer } { byte-array } define-primitive \ <byte-array> make-flushable
@@ -376,7 +366,6 @@ M: bad-executable summary
 \ data-room { } { byte-array } define-primitive \ data-room make-flushable
 \ datastack { } { array } define-primitive \ datastack make-flushable
 \ datastack-for { c-ptr } { array } define-primitive \ datastack-for make-flushable
-\ delete-context { c-ptr } { } define-primitive
 \ die { } { } define-primitive
 \ disable-gc-events { } { object } define-primitive
 \ dispatch-stats { } { byte-array } define-primitive

basis/threads/threads.factor

@@ -9,13 +9,21 @@ IN: threads
 
 <PRIVATE
 
-! (set-context) and (start-context) are sub-primitives, but
+! Wrap sub-primitives; we don't want them inlined into callers
-! we don't want them inlined into callers since their behavior
+! since their behavior depends on what frames are on the callstack
-! depends on what frames are on the callstack
+: set-context ( obj context -- obj' )
-: set-context ( obj context -- obj' ) (set-context) ;
+    (set-context) ;
 
-: start-context ( obj quot: ( obj -- * ) -- obj' ) (start-context) ;
+: start-context ( obj quot: ( obj -- * ) -- obj' )
+    (start-context) ;
 
+: set-context-and-delete ( obj context -- * )
+    (set-context-and-delete) ;
+
+: start-context-and-delete ( obj quot: ( obj -- * ) -- * )
+    (start-context-and-delete) ;
+
+! Context introspection
 : namestack-for ( context -- namestack )
     [ 0 ] dip context-object-for ;
 
@@ -159,60 +167,43 @@ DEFER: stop
     while
     drop ;
 
-: start ( namestack -- obj )
+CONSTANT: [start]
     [
         set-namestack
         init-catchstack
         self quot>> call
         stop
-    ] start-context ;
+    ]
 
-DEFER: next
+: no-runnable-threads ( -- ) die ;
-
-: no-runnable-threads ( -- obj )
-    ! We should never be in a state where the only threads
-    ! are sleeping; the I/O wait thread is always runnable.
-    ! However, if it dies, we handle this case
-    ! semi-gracefully.
-    !
-    ! And if sleep-time outputs f, there are no sleeping
-    ! threads either... so WTF.
-    sleep-time {
-        { [ dup not ] [ drop die ] }
-        { [ dup 0 = ] [ drop ] }
-        [ (sleep) ]
-    } cond next ;
 
 : (next) ( obj thread -- obj' )
-    f >>state
-    dup set-self
     dup runnable>>
-    [ context>> box> set-context ] [ t >>runnable drop start ] if ;
+    [ context>> box> set-context ]
+    [ t >>runnable drop [start] start-context ] if ;
 
-: next ( -- obj )
+: (stop) ( obj thread -- * )
+    dup runnable>>
+    [ context>> box> set-context-and-delete ]
+    [ t >>runnable drop [start] start-context-and-delete ] if ;
+
+: next ( -- obj thread )
     expire-sleep-loop
-    run-queue dup deque-empty?
+    run-queue pop-back
-    [ drop no-runnable-threads ]
+    dup array? [ first2 ] [ [ f ] dip ] if
-    [ pop-back dup array? [ first2 ] [ [ f ] dip ] if (next) ] if ;
+    f >>state
-
+    dup set-self ;
-: recycler-thread ( -- thread ) 68 special-object ;
-
-: recycler-queue ( -- vector ) 69 special-object ;
-
-: delete-context-later ( context -- )
-    recycler-queue push recycler-thread interrupt ;
 
 PRIVATE>
 
 : stop ( -- * )
     self [ exit-handler>> call( -- ) ] [ unregister-thread ] bi
-    context delete-context-later next
+    next (stop) ;
-    die 1 exit ;
 
 : suspend ( state -- obj )
     [ self ] dip >>state
     [ context ] dip context>> >box
-    next ;
+    next (next) ;
 
 : yield ( -- ) self resume f suspend drop ;
 
@@ -260,22 +251,9 @@ GENERIC: error-in-thread ( error thread -- )
     [ set-self ]
     tri ;
 
-! The recycler thread deletes contexts belonging to stopped
-! threads
-
-: recycler-loop ( -- )
-    recycler-queue [ [ delete-context ] each ] [ delete-all ] bi
-    f sleep-until
-    recycler-loop ;
-
-: init-recycler ( -- )
-    [ recycler-loop ] "Context recycler" spawn 68 set-special-object
-    V{ } clone 69 set-special-object ;
-
 : init-threads ( -- )
     init-thread-state
-    init-initial-thread
+    init-initial-thread ;
-    init-recycler ;
 
 PRIVATE>
 

basis/tools/deploy/shaker/shaker.factor

@@ -175,7 +175,6 @@ IN: tools.deploy.shaker
                 "predicate"
                 "predicate-definition"
                 "predicating"
-                "primitive"
                 "reader"
                 "reading"
                 "recursive"

core/bootstrap/primitives.factor

@@ -370,7 +370,9 @@ tuple
     { "fixnum>" "math.private" (( x y -- ? )) }
     { "fixnum>=" "math.private" (( x y -- ? )) }
     { "(set-context)" "threads.private" (( obj context -- obj' )) }
+    { "(set-context-and-delete)" "threads.private" (( obj context -- * )) }
     { "(start-context)" "threads.private" (( obj quot -- obj' )) }
+    { "(start-context-and-delete)" "threads.private" (( obj quot -- * )) }
 } [ first3 make-sub-primitive ] each
 
 ! Primitive words
@@ -531,7 +533,7 @@ tuple
     { "set-string-nth-fast" "strings.private" "primitive_set_string_nth_fast" (( ch n string -- )) }
     { "set-string-nth-slow" "strings.private" "primitive_set_string_nth_slow" (( ch n string -- )) }
     { "string-nth" "strings.private" "primitive_string_nth" (( n string -- ch )) }
-    { "(exit)" "system" "primitive_exit" (( n -- )) }
+    { "(exit)" "system" "primitive_exit" (( n -- * )) }
     { "nano-count" "system" "primitive_nano_count" (( -- ns )) }
     { "system-micros" "system" "primitive_system_micros" (( -- us )) }
     { "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) }
@@ -540,13 +542,12 @@ tuple
     { "context-object-for" "threads.private" "primitive_context_object_for" (( n context -- obj )) }
     { "datastack-for" "threads.private" "primitive_datastack_for" (( context -- array )) }
     { "retainstack-for" "threads.private" "primitive_retainstack_for" (( context -- array )) }
-    { "delete-context" "threads.private" "primitive_delete_context" (( context -- )) }
     { "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" (( -- stats )) }
     { "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" (( -- )) }
     { "profiling" "tools.profiler.private" "primitive_profiling" (( ? -- )) }
     { "optimized?" "words" "primitive_optimized_p" (( word -- ? )) }
     { "word-code" "words" "primitive_word_code" (( word -- start end )) }
-    { "(word)" "words.private" "primitive_word" (( name vocab -- word )) }
+    { "(word)" "words.private" "primitive_word" (( name vocab hashcode -- word )) }
 } [ first4 make-primitive ] each
 
 ! Bump build number

core/system/system.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2007, 2009 Slava Pestov.
+! Copyright (C) 2007, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private sequences math namespaces
 init splitting assocs system.private layouts words ;
@@ -57,4 +57,4 @@ PRIVATE>
 
 : embedded? ( -- ? ) 15 special-object ;
 
-: exit ( n -- ) do-shutdown-hooks (exit) ;
+: exit ( n -- * ) do-shutdown-hooks (exit) ;

vm/contexts.cpp

@@ -119,6 +119,11 @@ void factor_vm::delete_context(context *old_context)
 	active_contexts.erase(old_context);
 }
 
+VM_C_API void delete_context(factor_vm *parent, context *old_context)
+{
+	parent->delete_context(old_context);
+}
+
 void factor_vm::begin_callback()
 {
 	ctx->reset();
@@ -185,7 +190,10 @@ cell factor_vm::datastack_to_array(context *ctx)
 {
 	cell array = stack_to_array(ctx->datastack_seg->start,ctx->datastack);
 	if(array == false_object)
+	{
 		general_error(ERROR_DATASTACK_UNDERFLOW,false_object,false_object);
+		return false_object;
+	}
 	else
 		return array;
 }
@@ -293,10 +301,4 @@ void factor_vm::primitive_context()
 	ctx->push(allot_alien(ctx));
 }
 
-void factor_vm::primitive_delete_context()
-{
-	context *old_context = (context *)pinned_alien_offset(ctx->pop());
-	delete_context(old_context);
-}
-
 }

vm/contexts.hpp

@@ -70,6 +70,7 @@ struct context {
 };
 
 VM_C_API context *new_context(factor_vm *parent);
+VM_C_API void delete_context(factor_vm *parent, context *old_context);
 VM_C_API void begin_callback(factor_vm *parent);
 VM_C_API void end_callback(factor_vm *parent);
 

vm/objects.hpp

@@ -93,9 +93,6 @@ enum special_object {
 	OBJ_SLEEP_QUEUE = 66,
 
 	OBJ_VM_COMPILER = 67,     /* version string of the compiler we were built with */
-
-	OBJ_RECYCLE_THREAD = 68,
-	OBJ_RECYCLE_QUEUE = 69,
 };
 
 /* save-image-and-exit discards special objects that are filled in on startup

vm/primitives.hpp

@@ -50,7 +50,6 @@ namespace factor
 	_(data_room) \
 	_(datastack) \
 	_(datastack_for) \
-	_(delete_context) \
 	_(die) \
 	_(disable_gc_events) \
 	_(dispatch_stats) \

vm/vm.hpp

@@ -136,7 +136,6 @@ struct factor_vm
 	void primitive_check_datastack();
 	void primitive_load_locals();
 	void primitive_context();
-	void primitive_delete_context();
 
 	template<typename Iterator> void iterate_active_callstacks(Iterator &iter)
 	{