VM: removing the get_datastack/retainstack/callstack primitives

they can all be implemented using the
datastack/retainstack/callstack-for primitives and the less primitives
the better!

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

@@ -346,7 +346,6 @@ M: object infer-call* \ call bad-macro-input ;
 \ bits>double { integer } { float } define-primitive \ bits>double make-foldable
 \ bits>float { integer } { float } define-primitive \ bits>float make-foldable
 \ both-fixnums? { object object } { object } define-primitive
-\ get-callstack { } { callstack } define-primitive \ get-callstack make-flushable
 \ callstack-bounds { } { alien alien } define-primitive \ callstack-bounds make-flushable
 \ callstack-for { c-ptr } { callstack } define-primitive \ callstack make-flushable
 \ callstack>array { callstack } { array } define-primitive \ callstack>array make-flushable
@@ -359,7 +358,6 @@ M: object infer-call* \ call bad-macro-input ;
 \ current-callback { } { fixnum } define-primitive \ current-callback make-flushable
 \ (callback-room) { } { byte-array } define-primitive \ (callback-room) make-flushable
 \ (data-room) { } { byte-array } define-primitive \ (data-room) make-flushable
-\ get-datastack { } { array } define-primitive \ get-datastack make-flushable
 \ datastack-for { c-ptr } { array } define-primitive \ datastack-for make-flushable
 \ die { } { } define-primitive
 \ disable-gc-events { } { object } define-primitive
@@ -438,7 +436,6 @@ M: object infer-call* \ call bad-macro-input ;
 \ resize-array { integer array } { array } define-primitive
 \ resize-byte-array { integer byte-array } { byte-array } define-primitive
 \ resize-string { integer string } { string } define-primitive
-\ get-retainstack { } { array } define-primitive \ get-retainstack make-flushable
 \ retainstack-for { c-ptr } { array } define-primitive \ retainstack-for make-flushable
 \ set-alien-cell { c-ptr c-ptr integer } { } define-primitive
 \ set-alien-double { float c-ptr integer } { } define-primitive

basis/threads/threads.factor

@@ -13,16 +13,11 @@ PRIMITIVE: (set-context-and-delete) ( obj context -- * )
 PRIMITIVE: (sleep) ( nanos -- )
 PRIMITIVE: (start-context) ( obj quot -- obj' )
 PRIMITIVE: (start-context-and-delete) ( obj quot -- * )
-PRIMITIVE: callstack-for ( context -- array )
+
 PRIMITIVE: context-object-for ( n context -- obj )
-PRIMITIVE: datastack-for ( context -- array )
-PRIMITIVE: retainstack-for ( context -- array )
 
 ! Wrap sub-primitives; we don't want them inlined into callers
 ! since their behavior depends on what frames are on the callstack
-: context ( -- context )
-    CONTEXT-OBJ-CONTEXT context-object ; inline
-
 : set-context ( obj context -- obj' )
     (set-context) ; inline
 

basis/vm/vm-tests.factor

@@ -1,4 +1,4 @@
-USING: accessors classes.struct kernel math math.order threads.private
+USING: accessors classes.struct kernel kernel.private math math.order
 tools.test ;
 QUALIFIED: vm
 IN: vm.tests

core/bootstrap/primitives.factor

@@ -451,11 +451,12 @@ tuple
     { "fwrite" "io.streams.c" "primitive_fwrite" ( data length alien -- ) }
     { "(clone)" "kernel" "primitive_clone" ( obj -- newobj ) }
     { "<wrapper>" "kernel" "primitive_wrapper" ( obj -- wrapper ) }
-    { "get-callstack" "kernel" "primitive_callstack" ( -- callstack ) }
+
     { "callstack>array" "kernel" "primitive_callstack_to_array" ( callstack -- array ) }
-    { "get-datastack" "kernel" "primitive_datastack" ( -- array ) }
     { "die" "kernel" "primitive_die" ( -- ) }
-    { "get-retainstack" "kernel" "primitive_retainstack" ( -- array ) }
+    { "callstack-for" "kernel.private" "primitive_callstack_for" ( context -- array ) }
+    { "datastack-for" "kernel.private" "primitive_datastack_for" ( context -- array ) }
+    { "retainstack-for" "kernel.private" "primitive_retainstack_for" ( context -- array ) }
     { "(identity-hashcode)" "kernel.private" "primitive_identity_hashcode" ( obj -- code ) }
     { "become" "kernel.private" "primitive_become" ( old new -- ) }
     { "callstack-bounds" "kernel.private" "primitive_callstack_bounds" ( -- start end ) }
@@ -542,10 +543,7 @@ tuple
     { "(exit)" "system" "primitive_exit" ( n -- * ) }
     { "nano-count" "system" "primitive_nano_count" ( -- ns ) }
     { "(sleep)" "threads.private" "primitive_sleep" ( nanos -- ) }
-    { "callstack-for" "threads.private" "primitive_callstack_for" ( context -- array ) }
     { "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 ) }
     { "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" ( -- stats ) }
     { "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" ( -- ) }
     { "word-code" "words" "primitive_word_code" ( word -- start end ) }

core/kernel/kernel.factor

@@ -28,9 +28,6 @@ PRIMITIVE: 4dup ( w x y z -- w x y z w x y z )
 PRIMITIVE: (clone) ( obj -- newobj )
 PRIMITIVE: eq? ( obj1 obj2 -- ? )
 PRIMITIVE: <wrapper> ( obj -- wrapper )
-PRIMITIVE: get-datastack ( -- array )
-PRIMITIVE: get-callstack ( -- callstack )
-PRIMITIVE: get-retainstack ( -- array )
 PRIMITIVE: die ( -- )
 PRIMITIVE: callstack>array ( callstack -- array )
 
@@ -453,4 +450,20 @@ CONSTANT: ERROR-FP-TRAP 18
 CONSTANT: ERROR-INTERRUPT 19
 CONSTANT: ERROR-CALLBACK-SPACE-OVERFLOW 20
 
+PRIMITIVE: callstack-for ( context -- array )
+PRIMITIVE: retainstack-for ( context -- array )
+PRIMITIVE: datastack-for ( context -- array )
+
+: context ( -- context )
+    CONTEXT-OBJ-CONTEXT context-object ; inline
+
 PRIVATE>
+
+: get-callstack ( -- callstack )
+    context callstack-for ; inline
+
+: get-datastack ( -- array )
+    context datastack-for ; inline
+
+: get-retainstack ( -- array )
+    context retainstack-for ; inline

vm/callstack.cpp

@@ -40,9 +40,6 @@ cell factor_vm::capture_callstack(context* ctx) {
   return tag<callstack>(stack);
 }
 
-/* Allocates memory (capture_callstack) */
-void factor_vm::primitive_callstack() { ctx->push(capture_callstack(ctx)); }
-
 /* Allocates memory (capture_callstack) */
 void factor_vm::primitive_callstack_for() {
   context* other_ctx = (context*)pinned_alien_offset(ctx->peek());

vm/contexts.cpp

@@ -227,13 +227,12 @@ cell factor_vm::datastack_to_array(context* ctx) {
                         ERROR_DATASTACK_UNDERFLOW);
 }
 
-/* Allocates memory */
-void factor_vm::primitive_datastack() { ctx->push(datastack_to_array(ctx)); }
-
 /* Allocates memory */
 void factor_vm::primitive_datastack_for() {
-  context* other_ctx = (context*)pinned_alien_offset(ctx->peek());
-  ctx->replace(datastack_to_array(other_ctx));
+  data_root<alien> alien_ctx(ctx->pop(), this);
+  context* other_ctx = (context*)pinned_alien_offset(alien_ctx.value());
+  cell array = datastack_to_array(other_ctx);
+  ctx->push(array);
 }
 
 /* Allocates memory */
@@ -243,11 +242,6 @@ cell factor_vm::retainstack_to_array(context* ctx) {
                         ERROR_RETAINSTACK_UNDERFLOW);
 }
 
-/* Allocates memory */
-void factor_vm::primitive_retainstack() {
-  ctx->push(retainstack_to_array(ctx));
-}
-
 /* Allocates memory */
 void factor_vm::primitive_retainstack_for() {
   context* other_ctx = (context*)pinned_alien_offset(ctx->peek());

vm/primitives.hpp

@@ -10,11 +10,11 @@ namespace factor {
       _(bignum_gcd) _(bignum_multiply) _(bignum_not) _(bignum_or)              \
       _(bignum_shift) _(bignum_subtract) _(bignum_to_fixnum)                   \
       _(bignum_to_fixnum_strict) _(bignum_xor) _(bits_double) _(bits_float)    \
-      _(byte_array) _(callback) _(callback_room) _(callstack)                  \
+      _(byte_array) _(callback) _(callback_room)                               \
       _(callstack_bounds) _(callstack_for) _(callstack_to_array)               \
       _(check_datastack) _(clear_samples) _(clone) _(code_blocks) _(code_room) \
       _(compact_gc) _(compute_identity_hashcode) _(context_object)             \
-      _(context_object_for) _(current_callback) _(data_room) _(datastack)      \
+      _(context_object_for) _(current_callback) _(data_room)                   \
       _(datastack_for) _(die) _(disable_gc_events) _(dispatch_stats)           \
       _(displaced_alien) _(dlclose) _(dll_validp) _(dlopen) _(dlsym)           \
       _(dlsym_raw) _(double_bits) _(enable_gc_events) _(existsp) _(exit)       \
@@ -29,7 +29,7 @@ namespace factor {
       _(jit_compile) _(load_locals) _(lookup_method) _(mega_cache_miss)        \
       _(minor_gc) _(modify_code_heap) _(nano_count) _(quotation_code)          \
       _(quotation_compiled_p) _(reset_dispatch_stats) _(resize_array)          \
-      _(resize_byte_array) _(resize_string) _(retainstack) _(retainstack_for)  \
+      _(resize_byte_array) _(resize_string) _(retainstack_for)                 \
       _(sampling_profiler) _(save_image) _(set_context_object)                 \
       _(set_datastack) _(set_innermost_stack_frame_quotation)                  \
       _(set_retainstack) _(set_slot) _(set_special_object)                     \

vm/vm.hpp

@@ -171,10 +171,8 @@ struct factor_vm {
   void primitive_set_context_object();
   cell stack_to_array(cell bottom, cell top, vm_error_type error);
   cell datastack_to_array(context* ctx);
-  void primitive_datastack();
   void primitive_datastack_for();
   cell retainstack_to_array(context* ctx);
-  void primitive_retainstack();
   void primitive_retainstack_for();
   cell array_to_stack(array* array, cell bottom);
   void set_datastack(context* ctx, array* array);
@@ -626,7 +624,6 @@ struct factor_vm {
   callstack* allot_callstack(cell size);
   cell second_from_top_stack_frame(context* ctx);
   cell capture_callstack(context* ctx);
-  void primitive_callstack();
   void primitive_callstack_for();
   void primitive_callstack_to_array();
   void primitive_innermost_stack_frame_executing();