\ 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
\ 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
\ 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
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
-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
{ "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 ) }
{ "(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 ) }
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 )
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
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());
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 */
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());
_(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) \
_(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) \
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);
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();