Implement start-context and set-context primitives

diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor
index c7457d27322ecfda839a72fcca6a239a341be42b..6fab8769d533c7b61f8002f8dcbfe2cdfe8ada62 100644 (file)
--- a/basis/cpu/x86/32/bootstrap.factor
+++ b/basis/cpu/x86/32/bootstrap.factor
@@ -3,7 +3,7 @@
 USING: bootstrap.image.private kernel kernel.private namespaces
 system cpu.x86.assembler cpu.x86.assembler.operands layouts
 vocabs parser compiler.constants sequences math math.private
-generic.single.private ;
+generic.single.private threads.private ;
 IN: bootstrap.x86
 
 4 \ cell set
@@ -21,7 +21,7 @@ IN: bootstrap.x86
 : vm-reg ( -- reg ) ECX ;
 : ctx-reg ( -- reg ) EBP ;
 : nv-regs ( -- seq ) { ESI EDI EBX } ;
-: nv-reg ( -- reg ) nv-regs first ;
+: nv-reg ( -- reg ) EBX ;
 : ds-reg ( -- reg ) ESI ;
 : rs-reg ( -- reg ) EDI ;
 : fixnum>slot@ ( -- ) temp0 2 SAR ;
@@ -52,6 +52,7 @@ IN: bootstrap.x86
     ctx-reg vm-reg vm-context-offset [+] MOV ;
 
 : jit-save-context ( -- )
+    jit-load-context
     EDX ESP -4 [+] LEA
     ctx-reg context-callstack-top-offset [+] EDX MOV
     ctx-reg context-datastack-offset [+] ds-reg MOV
@@ -63,7 +64,6 @@ IN: bootstrap.x86
 
 [
     jit-load-vm
-    jit-load-context
     jit-save-context
     ! call the primitive
     ESP [] vm-reg MOV
@@ -96,7 +96,6 @@ IN: bootstrap.x86
     EAX quot-entry-point-offset [+] CALL
 
     jit-load-vm
-    jit-load-context
     jit-save-context
 
     ! load C callstack pointer
@@ -167,7 +166,6 @@ IN: bootstrap.x86
 
 [
     jit-load-vm
-    jit-load-context
     jit-save-context
 
     ! Store arguments
@@ -189,7 +187,6 @@ IN: bootstrap.x86
 ! frame, and the stack. The frame setup takes this into account.
 : jit-inline-cache-miss ( -- )
     jit-load-vm
-    jit-load-context
     jit-save-context
     ESP 4 [+] vm-reg MOV
     ESP [] EBX MOV
@@ -210,7 +207,6 @@ IN: bootstrap.x86
 : jit-overflow ( insn func -- )
     ds-reg 4 SUB
     jit-load-vm
-    jit-load-context
     jit-save-context
     EAX ds-reg [] MOV
     EDX ds-reg 4 [+] MOV
@@ -233,7 +229,6 @@ IN: bootstrap.x86
 [
     ds-reg 4 SUB
     jit-load-vm
-    jit-load-context
     jit-save-context
     EBX ds-reg [] MOV
     EAX EBX MOV
@@ -252,5 +247,58 @@ IN: bootstrap.x86
     jit-conditional
 ] \ fixnum* define-sub-primitive
 
+! Threads
+: jit-set-context ( reg -- )
+    ! Save ds, rs registers
+    jit-load-vm
+    jit-save-context
+
+    ! Make the new context the current one
+    ctx-reg swap MOV
+    vm-reg vm-context-offset [+] ctx-reg MOV
+
+    ! Load new stack pointer
+    ESP ctx-reg context-callstack-top-offset [+] MOV
+
+    ! Load new ds, rs registers
+    jit-restore-context ;
+
+[
+    ! Create the new context in return-reg
+    jit-load-vm
+    ESP [] vm-reg MOV
+    "new_context" jit-call
+
+    ! Save pointer to quotation and parameter, pop them off the
+    ! datastack
+    EBX ds-reg MOV
+    ds-reg 8 SUB
+
+    ! Make the new context the active context
+    EAX jit-set-context
+
+    ! Push parameter
+    EAX EBX -4 [+] MOV
+    ds-reg 4 ADD
+    ds-reg [] EAX MOV
+
+    ! Jump to initial quotation
+    EAX EBX [] MOV
+    EAX quot-entry-point-offset [+] JMP
+] \ (start-context) define-sub-primitive
+
+[
+    ! Load context from datastack
+    EAX ds-reg [] MOV
+    EAX EAX alien-offset [+] MOV
+    ds-reg 4 SUB
+
+    ! Make it the active context
+    EAX jit-set-context
+
+    ! Twiddle stack for return
+    ESP 4 ADD
+] \ (set-context) define-sub-primitive
+
 << "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
 call

diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor
index 2da9f7564e075803c47b96ce86b02aeec21eee6c..e8fa026a4985f104d1695c3b039fb966be07c231 100644 (file)
--- a/basis/cpu/x86/64/bootstrap.factor
+++ b/basis/cpu/x86/64/bootstrap.factor
@@ -3,7 +3,7 @@
 USING: bootstrap.image.private kernel kernel.private namespaces
 system layouts vocabs parser compiler.constants math
 math.private cpu.x86.assembler cpu.x86.assembler.operands
-sequences generic.single.private ;
+sequences generic.single.private threads.private ;
 IN: bootstrap.x86
 
 8 \ cell set
@@ -16,7 +16,7 @@ IN: bootstrap.x86
 : temp2 ( -- reg ) RDX ;
 : temp3 ( -- reg ) RBX ;
 : return-reg ( -- reg ) RAX ;
-: nv-reg ( -- reg ) nv-regs first ;
+: nv-reg ( -- reg ) RBX ;
 : stack-reg ( -- reg ) RSP ;
 : frame-reg ( -- reg ) RBP ;
 : ctx-reg ( -- reg ) R12 ;
@@ -51,8 +51,8 @@ IN: bootstrap.x86
 
 : jit-save-context ( -- )
     jit-load-context
-    RAX RSP -8 [+] LEA
-    ctx-reg context-callstack-top-offset [+] RAX MOV
+    R11 RSP -8 [+] LEA
+    ctx-reg context-callstack-top-offset [+] R11 MOV
     ctx-reg context-datastack-offset [+] ds-reg MOV
     ctx-reg context-retainstack-offset [+] rs-reg MOV ;
 
@@ -222,5 +222,57 @@ IN: bootstrap.x86
     jit-conditional
 ] \ fixnum* define-sub-primitive
 
+! Threads
+: jit-set-context ( reg -- )
+    ! Save ds, rs registers
+    jit-save-context
+
+    ! Make the new context the current one
+    ctx-reg swap MOV
+    vm-reg vm-context-offset [+] ctx-reg MOV
+
+    ! Load new stack pointer
+    RSP ctx-reg context-callstack-top-offset [+] MOV
+
+    ! Load new ds, rs registers
+    jit-restore-context ;
+
+[
+    ! Create the new context in return-reg
+    arg1 vm-reg MOV
+    "new_context" jit-call
+
+    ! Load quotation from datastack
+    arg1 ds-reg [] MOV
+
+    ! Load parameter from datastack
+    arg2 ds-reg -8 [+] MOV
+
+    ds-reg 16 SUB
+
+    ! Make the new context the active context
+    return-reg jit-set-context
+
+    ! Push parameter
+    ds-reg 8 ADD
+    ds-reg [] arg2 MOV
+
+    ! Jump to initial quotation
+    arg1 quot-entry-point-offset [+] JMP
+] \ (start-context) define-sub-primitive
+
+[
+    ! Load context from datastack
+    temp0 ds-reg [] MOV
+    temp0 temp0 alien-offset [+] MOV
+    ds-reg 8 SUB
+
+    ! Make it the active context
+    temp0 jit-set-context
+
+    ! Twiddle stack for return
+    RSP 8 ADD
+] \ (set-context) define-sub-primitive
+
 << "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
 call

diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor
index 1c4a6b779643f902d41f9fd3b124ca63008315b1..d75d80faf2e3cf7dbd03252ea5d76941d4ec83d9 100644 (file)
--- a/basis/cpu/x86/bootstrap.factor
+++ b/basis/cpu/x86/bootstrap.factor
@@ -42,7 +42,8 @@ big-endian off
     nv-reg 0 MOV rc-absolute-cell rt-entry-point jit-rel
     nv-reg CALL
 
-    ! Load VM into vm-reg
+    ! Load VM into vm-reg; only needed on x86-32, but doesn't
+    ! hurt on x86-64
     vm-reg 0 MOV rc-absolute-cell rt-vm jit-rel
 
     ! Load C callstack pointer

diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 289afcf28cd42077b4c6267d8630e6dabf4696d3..656c159a9b6be8eb0355baf3b89606a8bf747b94 100644 (file)
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@@ -513,7 +513,9 @@ M: bad-executable summary
 
 \ delete-context { c-ptr } { } define-primitive
 
-\ start-context { quotation } { } define-primitive
+\ (start-context) { object quotation } { } define-primitive
+
+\ (set-context) { alien } { } define-primitive
 
 \ special-object { fixnum } { object } define-primitive
 \ special-object make-flushable

diff --git a/basis/threads/threads.factor b/basis/threads/threads.factor
index 952652d801dbeeb036e200ef1337694732eb4165..9282dda46f66a0bb437f75c3475c168d9a515b64 100644 (file)
--- a/basis/threads/threads.factor
+++ b/basis/threads/threads.factor
@@ -7,6 +7,16 @@ dlists assocs system combinators combinators.private init boxes
 accessors math.order deques strings quotations fry ;
 IN: threads
 
+<PRIVATE
+
+! (set-context) and (start-context) are sub-primitives, but
+! we don't want them inlined into callers since their behavior
+! depends on what frames are on the callstack
+: start-context ( obj quot: ( obj -- * ) -- ) (start-context) ;
+: set-context ( context -- ) (set-context) ;
+
+PRIVATE>
+
 SYMBOL: initial-thread
 
 TUPLE: thread

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index 9bf7be31a2cb504178a31a46e1729cef456a3de7..9971c00e1dc63b0580205b48a27569514336c8d6 100644 (file)
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -369,6 +369,8 @@ tuple
     { "fixnum<=" "math.private" (( x y -- z )) }
     { "fixnum>" "math.private" (( x y -- ? )) }
     { "fixnum>=" "math.private" (( x y -- ? )) }
+    { "(set-context)" "threads.private" (( context -- )) }
+    { "(start-context)" "threads.private" (( obj quot -- )) }
 } [ first3 make-sub-primitive ] each
 
 ! Primitive words
@@ -534,9 +536,8 @@ tuple
     { "nano-count" "system" "primitive_nano_count" (( -- ns )) }
     { "system-micros" "system" "primitive_system_micros" (( -- us )) }
     { "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) }
-    { "current-context" "threads.private" "primitive_current_context" (( -- c-ptr )) }
+    { "context" "threads.private" "primitive_context" (( -- c-ptr )) }
     { "delete-context" "threads.private" "primitive_delete_context" (( c-ptr -- )) }
-    { "start-context" "threads.private" "primitive_start_context" (( quot -- )) }
     { "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" (( ? -- )) }

diff --git a/vm/contexts.cpp b/vm/contexts.cpp
index b5ca348d146beca2a9d4dbf13535a772fe09a16d..f21d9c948dd5c8a9cf8606827994dd1e1bad4f04 100644 (file)
--- a/vm/contexts.cpp
+++ b/vm/contexts.cpp
@@ -97,6 +97,11 @@ context *factor_vm::new_context()
        return new_context;
 }
 
+context *new_context(factor_vm *parent)
+{
+       return parent->new_context();
+}
+
 void factor_vm::delete_context(context *old_context)
 {
        unused_contexts.push_back(old_context);
@@ -225,18 +230,11 @@ void factor_vm::primitive_load_locals()
        ctx->retainstack += sizeof(cell) * count;
 }
 
-void factor_vm::primitive_current_context()
+void factor_vm::primitive_context()
 {
        ctx->push(allot_alien(ctx));
 }
 
-void factor_vm::primitive_start_context()
-{
-       cell quot = ctx->pop();
-       ctx = new_context();
-       unwind_native_frames(quot,ctx->callstack_bottom);
-}
-
 void factor_vm::primitive_delete_context()
 {
        context *old_context = (context *)pinned_alien_offset(ctx->pop());

diff --git a/vm/contexts.hpp b/vm/contexts.hpp
index e746e53ffa15e0f4a0a81ce1ebc6aad33a3333ff..3adabd9e5d3b34a9b90a3b6890b11eb000b13d3d 100644 (file)
--- a/vm/contexts.hpp
+++ b/vm/contexts.hpp
@@ -79,7 +79,8 @@ struct context {
        }
 };
 
-VM_C_API void begin_callback(factor_vm *vm);
-VM_C_API void end_callback(factor_vm *vm);
+VM_C_API context *new_context(factor_vm *parent);
+VM_C_API void begin_callback(factor_vm *parent);
+VM_C_API void end_callback(factor_vm *parent);
 
 }

diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index cbbadd2596c3b5b6d824d5e9f4560168d77f697d..4d72cf1abbdf7b3060cd82f3c6935d0354a08420 100644 (file)
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -43,9 +43,9 @@ namespace factor
        _(code_room) \
        _(compact_gc) \
        _(compute_identity_hashcode) \
+       _(context) \
        _(context_object) \
        _(current_callback) \
-       _(current_context) \
        _(data_room) \
        _(datastack) \
        _(delete_context) \
@@ -122,7 +122,6 @@ namespace factor
        _(size) \
        _(sleep) \
        _(special_object) \
-       _(start_context) \
        _(string) \
        _(string_nth) \
        _(strip_stack_traces) \

diff --git a/vm/vm.hpp b/vm/vm.hpp
index f2f2d9a769857393a0f08569ccf0c8ebd23bafdb..defe4f24eb96d31378d71e6c64529e30bc529d54 100755 (executable)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -125,8 +125,7 @@ struct factor_vm
        void primitive_set_retainstack();
        void primitive_check_datastack();
        void primitive_load_locals();
-       void primitive_current_context();
-       void primitive_start_context();
+       void primitive_context();
        void primitive_delete_context();
 
        template<typename Iterator> void iterate_active_callstacks(Iterator &iter)