diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 8b0051148f..c0fafdc0f5 100644 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -134,6 +134,7 @@ SYMBOL: jit-epilog SYMBOL: jit-return SYMBOL: jit-profiling SYMBOL: jit-declare-word +SYMBOL: jit-save-stack ! Default definition for undefined words SYMBOL: undefined-quot @@ -158,6 +159,7 @@ SYMBOL: undefined-quot { jit-profiling 35 } { jit-push-immediate 36 } { jit-declare-word 42 } + { jit-save-stack 43 } { undefined-quot 60 } } at header-size + ; @@ -459,6 +461,7 @@ M: quotation ' jit-return jit-profiling jit-declare-word + jit-save-stack undefined-quot } [ emit-userenv ] each ; diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index 9bf88185c5..8809311f21 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -57,7 +57,12 @@ big-endian on [ 0 6 LOAD32 - 4 1 MR + 7 6 0 LWZ + 1 7 0 STW +] rc-absolute-ppc-2/2 rt-primitive 1 jit-save-stack jit-define + +[ + 0 6 LOAD32 6 MTCTR BCTR ] rc-absolute-ppc-2/2 rt-primitive 1 jit-primitive jit-define diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor index 44f840e66a..ba963ab477 100644 --- a/basis/cpu/x86/32/bootstrap.factor +++ b/basis/cpu/x86/32/bootstrap.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system -cpu.x86.assembler layouts vocabs parser ; +cpu.x86.assembler layouts vocabs parser compiler.constants ; IN: bootstrap.x86 4 \ cell set @@ -19,5 +19,14 @@ IN: bootstrap.x86 : fixnum>slot@ ( -- ) arg0 1 SAR ; : rex-length ( -- n ) 0 ; +[ + arg0 0 [] MOV ! load stack_chain + arg0 [] stack-reg MOV ! save stack pointer +] rc-absolute-cell rt-stack-chain 2 jit-save-stack jit-define + +[ + (JMP) drop +] rc-relative rt-primitive 1 jit-primitive jit-define + << "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >> call diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor index acac8b55bc..83a72d6dd3 100644 --- a/basis/cpu/x86/64/bootstrap.factor +++ b/basis/cpu/x86/64/bootstrap.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system -cpu.x86.assembler layouts vocabs parser ; +cpu.x86.assembler layouts vocabs parser compiler.constants math ; IN: bootstrap.x86 8 \ cell set @@ -16,5 +16,16 @@ IN: bootstrap.x86 : fixnum>slot@ ( -- ) ; : rex-length ( -- n ) 1 ; +[ + arg0 0 MOV ! load stack_chain + arg0 arg0 [] MOV + arg0 [] stack-reg MOV ! save stack pointer +] rc-absolute-cell rt-stack-chain 1 rex-length + jit-save-stack jit-define + +[ + arg1 0 MOV ! load XT + arg1 JMP ! go +] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define + << "resource:basis/cpu/x86/bootstrap.factor" parse-file parsed >> call diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index 6dadbc096c..1ee74a434b 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -44,12 +44,6 @@ big-endian off ds-reg [] arg0 MOV ! store literal on datastack ] rc-absolute-cell rt-immediate 1 rex-length + jit-push-immediate jit-define -[ - arg0 0 MOV ! load XT - arg1 stack-reg MOV ! pass callstack pointer as arg 2 - arg0 JMP ! go -] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define - [ (JMP) drop ] rc-relative rt-xt 1 jit-word-jump jit-define diff --git a/vm/alien.c b/vm/alien.c index 5b4ff3b832..8b7df45e9a 100755 --- a/vm/alien.c +++ b/vm/alien.c @@ -82,7 +82,7 @@ void box_alien(void *ptr) } /* make an alien pointing at an offset of another alien */ -DEFINE_PRIMITIVE(displaced_alien) +void primitive_displaced_alien(void) { CELL alien = dpop(); CELL displacement = to_cell(dpop()); @@ -107,7 +107,7 @@ DEFINE_PRIMITIVE(displaced_alien) /* address of an object representing a C pointer. Explicitly throw an error if the object is a byte array, as a sanity check. */ -DEFINE_PRIMITIVE(alien_address) +void primitive_alien_address(void) { box_unsigned_cell((CELL)pinned_alien_offset(dpop())); } @@ -121,11 +121,11 @@ INLINE void *alien_pointer(void) /* define words to read/write values at an alien address */ #define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \ - DEFINE_PRIMITIVE(alien_##name) \ + void primitive_alien_##name(void) \ { \ boxer(*(type*)alien_pointer()); \ } \ - DEFINE_PRIMITIVE(set_alien_##name) \ + void primitive_set_alien_##name(void) \ { \ type* ptr = alien_pointer(); \ type value = to(dpop()); \ @@ -170,7 +170,7 @@ void box_small_struct(CELL x, CELL y, CELL size) } /* open a native library and push a handle */ -DEFINE_PRIMITIVE(dlopen) +void primitive_dlopen(void) { CELL path = tag_object(string_to_native_alien( untag_string(dpop()))); @@ -183,7 +183,7 @@ DEFINE_PRIMITIVE(dlopen) } /* look up a symbol in a native library */ -DEFINE_PRIMITIVE(dlsym) +void primitive_dlsym(void) { CELL dll = dpop(); REGISTER_ROOT(dll); @@ -205,12 +205,12 @@ DEFINE_PRIMITIVE(dlsym) } /* close a native library handle */ -DEFINE_PRIMITIVE(dlclose) +void primitive_dlclose(void) { ffi_dlclose(untag_dll(dpop())); } -DEFINE_PRIMITIVE(dll_validp) +void primitive_dll_validp(void) { CELL dll = dpop(); if(dll == F) diff --git a/vm/alien.h b/vm/alien.h index babfbc358d..ec1eb08acf 100755 --- a/vm/alien.h +++ b/vm/alien.h @@ -1,7 +1,7 @@ CELL allot_alien(CELL delegate, CELL displacement); -DECLARE_PRIMITIVE(displaced_alien); -DECLARE_PRIMITIVE(alien_address); +void primitive_displaced_alien(void); +void primitive_alien_address(void); DLLEXPORT void *alien_offset(CELL object); @@ -10,32 +10,32 @@ void fixup_alien(F_ALIEN* d); DLLEXPORT void *unbox_alien(void); DLLEXPORT void box_alien(void *ptr); -DECLARE_PRIMITIVE(alien_signed_cell); -DECLARE_PRIMITIVE(set_alien_signed_cell); -DECLARE_PRIMITIVE(alien_unsigned_cell); -DECLARE_PRIMITIVE(set_alien_unsigned_cell); -DECLARE_PRIMITIVE(alien_signed_8); -DECLARE_PRIMITIVE(set_alien_signed_8); -DECLARE_PRIMITIVE(alien_unsigned_8); -DECLARE_PRIMITIVE(set_alien_unsigned_8); -DECLARE_PRIMITIVE(alien_signed_4); -DECLARE_PRIMITIVE(set_alien_signed_4); -DECLARE_PRIMITIVE(alien_unsigned_4); -DECLARE_PRIMITIVE(set_alien_unsigned_4); -DECLARE_PRIMITIVE(alien_signed_2); -DECLARE_PRIMITIVE(set_alien_signed_2); -DECLARE_PRIMITIVE(alien_unsigned_2); -DECLARE_PRIMITIVE(set_alien_unsigned_2); -DECLARE_PRIMITIVE(alien_signed_1); -DECLARE_PRIMITIVE(set_alien_signed_1); -DECLARE_PRIMITIVE(alien_unsigned_1); -DECLARE_PRIMITIVE(set_alien_unsigned_1); -DECLARE_PRIMITIVE(alien_float); -DECLARE_PRIMITIVE(set_alien_float); -DECLARE_PRIMITIVE(alien_double); -DECLARE_PRIMITIVE(set_alien_double); -DECLARE_PRIMITIVE(alien_cell); -DECLARE_PRIMITIVE(set_alien_cell); +void primitive_alien_signed_cell(void); +void primitive_set_alien_signed_cell(void); +void primitive_alien_unsigned_cell(void); +void primitive_set_alien_unsigned_cell(void); +void primitive_alien_signed_8(void); +void primitive_set_alien_signed_8(void); +void primitive_alien_unsigned_8(void); +void primitive_set_alien_unsigned_8(void); +void primitive_alien_signed_4(void); +void primitive_set_alien_signed_4(void); +void primitive_alien_unsigned_4(void); +void primitive_set_alien_unsigned_4(void); +void primitive_alien_signed_2(void); +void primitive_set_alien_signed_2(void); +void primitive_alien_unsigned_2(void); +void primitive_set_alien_unsigned_2(void); +void primitive_alien_signed_1(void); +void primitive_set_alien_signed_1(void); +void primitive_alien_unsigned_1(void); +void primitive_set_alien_unsigned_1(void); +void primitive_alien_float(void); +void primitive_set_alien_float(void); +void primitive_alien_double(void); +void primitive_set_alien_double(void); +void primitive_alien_cell(void); +void primitive_set_alien_cell(void); DLLEXPORT void to_value_struct(CELL src, void *dest, CELL size); DLLEXPORT void box_value_struct(void *src, CELL size); @@ -43,7 +43,7 @@ DLLEXPORT void box_small_struct(CELL x, CELL y, CELL size); DEFINE_UNTAG(F_DLL,DLL_TYPE,dll) -DECLARE_PRIMITIVE(dlopen); -DECLARE_PRIMITIVE(dlsym); -DECLARE_PRIMITIVE(dlclose); -DECLARE_PRIMITIVE(dll_validp); +void primitive_dlopen(void); +void primitive_dlsym(void); +void primitive_dlclose(void); +void primitive_dll_validp(void); diff --git a/vm/callstack.c b/vm/callstack.c index b7e99b418c..dfa7dd5f4a 100755 --- a/vm/callstack.c +++ b/vm/callstack.c @@ -6,11 +6,6 @@ F_FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom) stack_chain->callstack_bottom = callstack_bottom; } -F_FASTCALL __attribute__((noinline)) void save_callstack_top(F_STACK_FRAME *callstack_top) -{ - stack_chain->callstack_top = callstack_top; -} - void iterate_callstack(CELL top, CELL bottom, CALLSTACK_ITER iterator) { F_STACK_FRAME *frame = (F_STACK_FRAME *)bottom - 1; @@ -68,7 +63,7 @@ F_STACK_FRAME *capture_start(void) return frame + 1; } -DEFINE_PRIMITIVE(callstack) +void primitive_callstack(void) { F_STACK_FRAME *top = capture_start(); F_STACK_FRAME *bottom = stack_chain->callstack_bottom; @@ -82,7 +77,7 @@ DEFINE_PRIMITIVE(callstack) dpush(tag_object(callstack)); } -DEFINE_PRIMITIVE(set_callstack) +void primitive_set_callstack(void) { F_CALLSTACK *stack = untag_callstack(dpop()); @@ -158,7 +153,7 @@ void stack_frame_to_array(F_STACK_FRAME *frame) set_array_nth(array,frame_index++,frame_scan(frame)); } -DEFINE_PRIMITIVE(callstack_to_array) +void primitive_callstack_to_array(void) { F_CALLSTACK *stack = untag_callstack(dpop()); @@ -190,7 +185,7 @@ F_STACK_FRAME *innermost_stack_frame(F_CALLSTACK *callstack) /* Some primitives implementing a limited form of callstack mutation. Used by the single stepper. */ -DEFINE_PRIMITIVE(innermost_stack_frame_quot) +void primitive_innermost_stack_frame_quot(void) { F_STACK_FRAME *inner = innermost_stack_frame( untag_callstack(dpop())); @@ -199,7 +194,7 @@ DEFINE_PRIMITIVE(innermost_stack_frame_quot) dpush(frame_executing(inner)); } -DEFINE_PRIMITIVE(innermost_stack_frame_scan) +void primitive_innermost_stack_frame_scan(void) { F_STACK_FRAME *inner = innermost_stack_frame( untag_callstack(dpop())); @@ -208,7 +203,7 @@ DEFINE_PRIMITIVE(innermost_stack_frame_scan) dpush(frame_scan(inner)); } -DEFINE_PRIMITIVE(set_innermost_stack_frame_quot) +void primitive_set_innermost_stack_frame_quot(void) { F_CALLSTACK *callstack = untag_callstack(dpop()); F_QUOTATION *quot = untag_quotation(dpop()); diff --git a/vm/callstack.h b/vm/callstack.h index 6c38cd0117..da0748b071 100755 --- a/vm/callstack.h +++ b/vm/callstack.h @@ -1,5 +1,4 @@ F_FASTCALL void save_callstack_bottom(F_STACK_FRAME *callstack_bottom); -F_FASTCALL __attribute__((noinline)) void save_callstack_top(F_STACK_FRAME *callstack_top); #define FIRST_STACK_FRAME(stack) (F_STACK_FRAME *)((stack) + 1) @@ -14,11 +13,11 @@ CELL frame_executing(F_STACK_FRAME *frame); CELL frame_scan(F_STACK_FRAME *frame); CELL frame_type(F_STACK_FRAME *frame); -DECLARE_PRIMITIVE(callstack); -DECLARE_PRIMITIVE(set_datastack); -DECLARE_PRIMITIVE(set_retainstack); -DECLARE_PRIMITIVE(set_callstack); -DECLARE_PRIMITIVE(callstack_to_array); -DECLARE_PRIMITIVE(innermost_stack_frame_quot); -DECLARE_PRIMITIVE(innermost_stack_frame_scan); -DECLARE_PRIMITIVE(set_innermost_stack_frame_quot); +void primitive_callstack(void); +void primitive_set_datastack(void); +void primitive_set_retainstack(void); +void primitive_set_callstack(void); +void primitive_callstack_to_array(void); +void primitive_innermost_stack_frame_quot(void); +void primitive_innermost_stack_frame_scan(void); +void primitive_set_innermost_stack_frame_quot(void); diff --git a/vm/code_gc.c b/vm/code_gc.c index 03661999c5..bd6384408b 100755 --- a/vm/code_gc.c +++ b/vm/code_gc.c @@ -295,7 +295,7 @@ void recursive_mark(F_BLOCK *block) } /* Push the free space and total size of the code heap */ -DEFINE_PRIMITIVE(code_room) +void primitive_code_room(void) { CELL used, total_free, max_free; heap_usage(&code_heap,&used,&total_free,&max_free); diff --git a/vm/code_gc.h b/vm/code_gc.h index f93cba9c7a..72ad8d451c 100644 --- a/vm/code_gc.h +++ b/vm/code_gc.h @@ -82,4 +82,4 @@ void recursive_mark(F_BLOCK *block); void dump_heap(F_HEAP *heap); void compact_code_heap(void); -DECLARE_PRIMITIVE(code_room); +void primitive_code_room(void); diff --git a/vm/code_heap.c b/vm/code_heap.c index 1435caa9d2..2268df27e3 100755 --- a/vm/code_heap.c +++ b/vm/code_heap.c @@ -68,9 +68,11 @@ INLINE CELL compute_code_rel(F_REL *rel, case RT_XT: return (CELL)untag_word(get(CREF(literals_start,REL_ARGUMENT(rel))))->xt; case RT_HERE: - return rel->offset + code_start; + return rel->offset + code_start + (short)REL_ARGUMENT(rel); case RT_LABEL: return code_start + REL_ARGUMENT(rel); + case RT_STACK_CHAIN: + return (CELL)&stack_chain; default: critical_error("Bad rel type",rel->type); return -1; /* Can't happen */ @@ -322,7 +324,7 @@ void default_word_code(F_WORD *word, bool relocate) word->compiledp = F; } -DEFINE_PRIMITIVE(modify_code_heap) +void primitive_modify_code_heap(void) { bool rescan_code_heap = to_boolean(dpop()); F_ARRAY *alist = untag_array(dpop()); diff --git a/vm/code_heap.h b/vm/code_heap.h index c3b476c4b5..7b1545ddf5 100755 --- a/vm/code_heap.h +++ b/vm/code_heap.h @@ -13,8 +13,10 @@ typedef enum { RT_HERE, /* a local label */ RT_LABEL, - /* immeditae literal */ - RT_IMMEDIATE + /* immediate literal */ + RT_IMMEDIATE, + /* address of stack_chain var */ + RT_STACK_CHAIN } F_RELTYPE; typedef enum { @@ -71,4 +73,4 @@ F_COMPILED *add_compiled_block( CELL compiled_code_format(void); bool stack_traces_p(void); -DECLARE_PRIMITIVE(modify_code_heap); +void primitive_modify_code_heap(void); diff --git a/vm/data_gc.c b/vm/data_gc.c index 5342ff04d9..cf1632811c 100755 --- a/vm/data_gc.c +++ b/vm/data_gc.c @@ -250,13 +250,13 @@ CELL unaligned_object_size(CELL pointer) } } -DEFINE_PRIMITIVE(size) +void primitive_size(void) { box_unsigned_cell(object_size(dpop())); } /* Push memory usage statistics in data heap */ -DEFINE_PRIMITIVE(data_room) +void primitive_data_room(void) { F_ARRAY *a = allot_array(ARRAY_TYPE,data_heap->gen_count * 2,F); int gen; @@ -281,7 +281,7 @@ void begin_scan(void) gc_off = true; } -DEFINE_PRIMITIVE(begin_scan) +void primitive_begin_scan(void) { gc(); begin_scan(); @@ -306,13 +306,13 @@ CELL next_object(void) } /* Push object at heap scan cursor and advance; pushes f when done */ -DEFINE_PRIMITIVE(next_object) +void primitive_next_object(void) { dpush(next_object()); } /* Re-enables GC */ -DEFINE_PRIMITIVE(end_scan) +void primitive_end_scan(void) { gc_off = false; } @@ -911,12 +911,12 @@ void minor_gc(void) garbage_collection(NURSERY,false,0); } -DEFINE_PRIMITIVE(gc) +void primitive_gc(void) { gc(); } -DEFINE_PRIMITIVE(gc_stats) +void primitive_gc_stats(void) { GROWABLE_ARRAY(stats); @@ -945,12 +945,12 @@ DEFINE_PRIMITIVE(gc_stats) dpush(stats); } -DEFINE_PRIMITIVE(gc_reset) +void primitive_gc_reset(void) { gc_reset(); } -DEFINE_PRIMITIVE(become) +void primitive_become(void) { F_ARRAY *new_objects = untag_array(dpop()); F_ARRAY *old_objects = untag_array(dpop()); diff --git a/vm/data_gc.h b/vm/data_gc.h index 3c21695c2c..0d63cc6bfe 100755 --- a/vm/data_gc.h +++ b/vm/data_gc.h @@ -13,11 +13,11 @@ CELL binary_payload_start(CELL pointer); void begin_scan(void); CELL next_object(void); -DECLARE_PRIMITIVE(data_room); -DECLARE_PRIMITIVE(size); -DECLARE_PRIMITIVE(begin_scan); -DECLARE_PRIMITIVE(next_object); -DECLARE_PRIMITIVE(end_scan); +void primitive_data_room(void); +void primitive_size(void); +void primitive_begin_scan(void); +void primitive_next_object(void); +void primitive_end_scan(void); void gc(void); DLLEXPORT void minor_gc(void); @@ -388,9 +388,9 @@ INLINE void* allot_object(CELL type, CELL a) CELL collect_next(CELL scan); -DECLARE_PRIMITIVE(gc); -DECLARE_PRIMITIVE(gc_stats); -DECLARE_PRIMITIVE(gc_reset); -DECLARE_PRIMITIVE(become); +void primitive_gc(void); +void primitive_gc_stats(void); +void primitive_gc_reset(void); +void primitive_become(void); CELL find_all_words(void); diff --git a/vm/debug.c b/vm/debug.c index 2550931c72..41205d4aff 100755 --- a/vm/debug.c +++ b/vm/debug.c @@ -474,7 +474,7 @@ void factorbug(void) } } -DEFINE_PRIMITIVE(die) +void primitive_die(void) { fprintf(stderr,"The die word was called by the library. Unless you called it yourself,\n"); fprintf(stderr,"you have triggered a bug in Factor. Please report.\n"); diff --git a/vm/debug.h b/vm/debug.h index 547fdba436..594d8ec919 100755 --- a/vm/debug.h +++ b/vm/debug.h @@ -6,4 +6,4 @@ void dump_zone(F_ZONE *z); bool fep_disabled; -DECLARE_PRIMITIVE(die); +void primitive_die(void); diff --git a/vm/errors.c b/vm/errors.c index 36072920fe..fe6e79be6d 100755 --- a/vm/errors.c +++ b/vm/errors.c @@ -142,19 +142,19 @@ void misc_signal_handler_impl(void) signal_error(signal_number,signal_callstack_top); } -DEFINE_PRIMITIVE(throw) +void primitive_throw(void) { dpop(); throw_impl(dpop(),stack_chain->callstack_top); } -DEFINE_PRIMITIVE(call_clear) +void primitive_call_clear(void) { throw_impl(dpop(),stack_chain->callstack_bottom); } /* For testing purposes */ -DEFINE_PRIMITIVE(unimplemented) +void primitive_unimplemented(void) { not_implemented_error(); } diff --git a/vm/errors.h b/vm/errors.h index 22cd6533c3..c7f8bc8712 100755 --- a/vm/errors.h +++ b/vm/errors.h @@ -22,7 +22,7 @@ typedef enum void out_of_memory(void); void fatal_error(char* msg, CELL tagged); void critical_error(char* msg, CELL tagged); -DECLARE_PRIMITIVE(die); +void primitive_die(void); void throw_error(CELL error, F_STACK_FRAME *native_stack); void general_error(F_ERRORTYPE error, CELL arg1, CELL arg2, F_STACK_FRAME *native_stack); @@ -32,8 +32,8 @@ void signal_error(int signal, F_STACK_FRAME *native_stack); void type_error(CELL type, CELL tagged); void not_implemented_error(void); -DECLARE_PRIMITIVE(throw); -DECLARE_PRIMITIVE(call_clear); +void primitive_throw(void); +void primitive_call_clear(void); INLINE void type_check(CELL type, CELL tagged) { @@ -57,4 +57,4 @@ void memory_signal_handler_impl(void); void divide_by_zero_signal_handler_impl(void); void misc_signal_handler_impl(void); -DECLARE_PRIMITIVE(unimplemented); +void primitive_unimplemented(void); diff --git a/vm/image.c b/vm/image.c index 62f9e1c906..289c1e94c8 100755 --- a/vm/image.c +++ b/vm/image.c @@ -161,7 +161,7 @@ bool save_image(const F_CHAR *filename) return true; } -DEFINE_PRIMITIVE(save_image) +void primitive_save_image(void) { /* do a full GC to push everything into tenured space */ gc(); @@ -184,7 +184,7 @@ void strip_compiled_quotations(void) gc_off = false; } -DEFINE_PRIMITIVE(save_image_and_exit) +void primitive_save_image_and_exit(void) { /* We unbox this before doing anything else. This is the only point where we might throw an error, so we have to throw an error here since diff --git a/vm/image.h b/vm/image.h index 9e582fc6c6..6e1b03af0d 100755 --- a/vm/image.h +++ b/vm/image.h @@ -40,8 +40,8 @@ void load_image(F_PARAMETERS *p); void init_objects(F_HEADER *h); bool save_image(const F_CHAR *file); -DECLARE_PRIMITIVE(save_image); -DECLARE_PRIMITIVE(save_image_and_exit); +void primitive_save_image(void); +void primitive_save_image_and_exit(void); /* relocation base of currently loaded image's data heap */ CELL data_relocation_base; diff --git a/vm/io.c b/vm/io.c index bc561f5e5b..bad4854775 100755 --- a/vm/io.c +++ b/vm/io.c @@ -29,7 +29,7 @@ void io_error(void) general_error(ERROR_IO,error,F,NULL); } -DEFINE_PRIMITIVE(fopen) +void primitive_fopen(void) { char *mode = unbox_char_string(); REGISTER_C_STRING(mode); @@ -49,7 +49,7 @@ DEFINE_PRIMITIVE(fopen) } } -DEFINE_PRIMITIVE(fgetc) +void primitive_fgetc(void) { FILE* file = unbox_alien(); @@ -74,7 +74,7 @@ DEFINE_PRIMITIVE(fgetc) } } -DEFINE_PRIMITIVE(fread) +void primitive_fread(void) { FILE* file = unbox_alien(); CELL size = unbox_array_size(); @@ -116,7 +116,7 @@ DEFINE_PRIMITIVE(fread) } } -DEFINE_PRIMITIVE(fputc) +void primitive_fputc(void) { FILE *file = unbox_alien(); F_FIXNUM ch = to_fixnum(dpop()); @@ -134,7 +134,7 @@ DEFINE_PRIMITIVE(fputc) } } -DEFINE_PRIMITIVE(fwrite) +void primitive_fwrite(void) { FILE *file = unbox_alien(); F_BYTE_ARRAY *text = untag_byte_array(dpop()); @@ -163,7 +163,7 @@ DEFINE_PRIMITIVE(fwrite) } } -DEFINE_PRIMITIVE(fflush) +void primitive_fflush(void) { FILE *file = unbox_alien(); for(;;) @@ -175,7 +175,7 @@ DEFINE_PRIMITIVE(fflush) } } -DEFINE_PRIMITIVE(fclose) +void primitive_fclose(void) { FILE *file = unbox_alien(); for(;;) diff --git a/vm/io.h b/vm/io.h index f4af9b8bec..08c9dd7807 100755 --- a/vm/io.h +++ b/vm/io.h @@ -3,15 +3,15 @@ void io_error(void); int err_no(void); void clear_err_no(void); -DECLARE_PRIMITIVE(fopen); -DECLARE_PRIMITIVE(fgetc); -DECLARE_PRIMITIVE(fread); -DECLARE_PRIMITIVE(fputc); -DECLARE_PRIMITIVE(fwrite); -DECLARE_PRIMITIVE(fflush); -DECLARE_PRIMITIVE(fclose); +void primitive_fopen(void); +void primitive_fgetc(void); +void primitive_fread(void); +void primitive_fputc(void); +void primitive_fwrite(void); +void primitive_fflush(void); +void primitive_fclose(void); /* Platform specific primitives */ -DECLARE_PRIMITIVE(open_file); -DECLARE_PRIMITIVE(existsp); -DECLARE_PRIMITIVE(read_dir); +void primitive_open_file(void); +void primitive_existsp(void); +void primitive_read_dir(void); diff --git a/vm/math.c b/vm/math.c index 7d3b64ed39..388a472f2e 100644 --- a/vm/math.c +++ b/vm/math.c @@ -21,12 +21,12 @@ CELL to_cell(CELL tagged) return (CELL)to_fixnum(tagged); } -DEFINE_PRIMITIVE(bignum_to_fixnum) +void primitive_bignum_to_fixnum(void) { drepl(tag_fixnum(bignum_to_fixnum(untag_object(dpeek())))); } -DEFINE_PRIMITIVE(float_to_fixnum) +void primitive_float_to_fixnum(void) { drepl(tag_fixnum(float_to_fixnum(dpeek()))); } @@ -35,13 +35,13 @@ DEFINE_PRIMITIVE(float_to_fixnum) F_FIXNUM y = untag_fixnum_fast(dpop()); \ F_FIXNUM x = untag_fixnum_fast(dpop()); -DEFINE_PRIMITIVE(fixnum_add) +void primitive_fixnum_add(void) { POP_FIXNUMS(x,y) box_signed_cell(x + y); } -DEFINE_PRIMITIVE(fixnum_subtract) +void primitive_fixnum_subtract(void) { POP_FIXNUMS(x,y) box_signed_cell(x - y); @@ -49,7 +49,7 @@ DEFINE_PRIMITIVE(fixnum_subtract) /* Multiply two integers, and trap overflow. Thanks to David Blaikie (The_Vulture from freenode #java) for the hint. */ -DEFINE_PRIMITIVE(fixnum_multiply) +void primitive_fixnum_multiply(void) { POP_FIXNUMS(x,y) @@ -72,13 +72,13 @@ DEFINE_PRIMITIVE(fixnum_multiply) } } -DEFINE_PRIMITIVE(fixnum_divint) +void primitive_fixnum_divint(void) { POP_FIXNUMS(x,y) box_signed_cell(x / y); } -DEFINE_PRIMITIVE(fixnum_divmod) +void primitive_fixnum_divmod(void) { POP_FIXNUMS(x,y) box_signed_cell(x / y); @@ -90,7 +90,7 @@ DEFINE_PRIMITIVE(fixnum_divmod) * If we're shifting right by n bits, we won't overflow as long as none of the * high WORD_SIZE-TAG_BITS-n bits are set. */ -DEFINE_PRIMITIVE(fixnum_shift) +void primitive_fixnum_shift(void) { POP_FIXNUMS(x,y) @@ -122,12 +122,12 @@ DEFINE_PRIMITIVE(fixnum_shift) } /* Bignums */ -DEFINE_PRIMITIVE(fixnum_to_bignum) +void primitive_fixnum_to_bignum(void) { drepl(tag_bignum(fixnum_to_bignum(untag_fixnum_fast(dpeek())))); } -DEFINE_PRIMITIVE(float_to_bignum) +void primitive_float_to_bignum(void) { drepl(tag_bignum(float_to_bignum(dpeek()))); } @@ -136,37 +136,37 @@ DEFINE_PRIMITIVE(float_to_bignum) F_ARRAY *y = untag_object(dpop()); \ F_ARRAY *x = untag_object(dpop()); -DEFINE_PRIMITIVE(bignum_eq) +void primitive_bignum_eq(void) { POP_BIGNUMS(x,y); box_boolean(bignum_equal_p(x,y)); } -DEFINE_PRIMITIVE(bignum_add) +void primitive_bignum_add(void) { POP_BIGNUMS(x,y); dpush(tag_bignum(bignum_add(x,y))); } -DEFINE_PRIMITIVE(bignum_subtract) +void primitive_bignum_subtract(void) { POP_BIGNUMS(x,y); dpush(tag_bignum(bignum_subtract(x,y))); } -DEFINE_PRIMITIVE(bignum_multiply) +void primitive_bignum_multiply(void) { POP_BIGNUMS(x,y); dpush(tag_bignum(bignum_multiply(x,y))); } -DEFINE_PRIMITIVE(bignum_divint) +void primitive_bignum_divint(void) { POP_BIGNUMS(x,y); dpush(tag_bignum(bignum_quotient(x,y))); } -DEFINE_PRIMITIVE(bignum_divmod) +void primitive_bignum_divmod(void) { F_ARRAY *q, *r; POP_BIGNUMS(x,y); @@ -175,74 +175,74 @@ DEFINE_PRIMITIVE(bignum_divmod) dpush(tag_bignum(r)); } -DEFINE_PRIMITIVE(bignum_mod) +void primitive_bignum_mod(void) { POP_BIGNUMS(x,y); dpush(tag_bignum(bignum_remainder(x,y))); } -DEFINE_PRIMITIVE(bignum_and) +void primitive_bignum_and(void) { POP_BIGNUMS(x,y); dpush(tag_bignum(bignum_bitwise_and(x,y))); } -DEFINE_PRIMITIVE(bignum_or) +void primitive_bignum_or(void) { POP_BIGNUMS(x,y); dpush(tag_bignum(bignum_bitwise_ior(x,y))); } -DEFINE_PRIMITIVE(bignum_xor) +void primitive_bignum_xor(void) { POP_BIGNUMS(x,y); dpush(tag_bignum(bignum_bitwise_xor(x,y))); } -DEFINE_PRIMITIVE(bignum_shift) +void primitive_bignum_shift(void) { F_FIXNUM y = to_fixnum(dpop()); F_ARRAY* x = untag_object(dpop()); dpush(tag_bignum(bignum_arithmetic_shift(x,y))); } -DEFINE_PRIMITIVE(bignum_less) +void primitive_bignum_less(void) { POP_BIGNUMS(x,y); box_boolean(bignum_compare(x,y) == bignum_comparison_less); } -DEFINE_PRIMITIVE(bignum_lesseq) +void primitive_bignum_lesseq(void) { POP_BIGNUMS(x,y); box_boolean(bignum_compare(x,y) != bignum_comparison_greater); } -DEFINE_PRIMITIVE(bignum_greater) +void primitive_bignum_greater(void) { POP_BIGNUMS(x,y); box_boolean(bignum_compare(x,y) == bignum_comparison_greater); } -DEFINE_PRIMITIVE(bignum_greatereq) +void primitive_bignum_greatereq(void) { POP_BIGNUMS(x,y); box_boolean(bignum_compare(x,y) != bignum_comparison_less); } -DEFINE_PRIMITIVE(bignum_not) +void primitive_bignum_not(void) { drepl(tag_bignum(bignum_bitwise_not(untag_object(dpeek())))); } -DEFINE_PRIMITIVE(bignum_bitp) +void primitive_bignum_bitp(void) { F_FIXNUM bit = to_fixnum(dpop()); F_ARRAY *x = untag_object(dpop()); box_boolean(bignum_logbitp(bit,x)); } -DEFINE_PRIMITIVE(bignum_log2) +void primitive_bignum_log2(void) { drepl(tag_bignum(bignum_integer_length(untag_object(dpeek())))); } @@ -253,7 +253,7 @@ unsigned int bignum_producer(unsigned int digit) return *(ptr + digit); } -DEFINE_PRIMITIVE(byte_array_to_bignum) +void primitive_byte_array_to_bignum(void) { type_check(BYTE_ARRAY_TYPE,dpeek()); CELL n_digits = array_capacity(untag_object(dpeek())); @@ -383,7 +383,7 @@ CELL unbox_array_size(void) /* Does not reduce to lowest terms, so should only be used by math library implementation, to avoid breaking invariants. */ -DEFINE_PRIMITIVE(from_fraction) +void primitive_from_fraction(void) { F_RATIO* ratio = allot_object(RATIO_TYPE,sizeof(F_RATIO)); ratio->denominator = dpop(); @@ -392,17 +392,17 @@ DEFINE_PRIMITIVE(from_fraction) } /* Floats */ -DEFINE_PRIMITIVE(fixnum_to_float) +void primitive_fixnum_to_float(void) { drepl(allot_float(fixnum_to_float(dpeek()))); } -DEFINE_PRIMITIVE(bignum_to_float) +void primitive_bignum_to_float(void) { drepl(allot_float(bignum_to_float(dpeek()))); } -DEFINE_PRIMITIVE(str_to_float) +void primitive_str_to_float(void) { char *c_str, *end; double f; @@ -418,7 +418,7 @@ DEFINE_PRIMITIVE(str_to_float) drepl(allot_float(f)); } -DEFINE_PRIMITIVE(float_to_str) +void primitive_float_to_str(void) { char tmp[33]; snprintf(tmp,32,"%.16g",untag_float(dpop())); @@ -430,82 +430,82 @@ DEFINE_PRIMITIVE(float_to_str) double y = untag_float_fast(dpop()); \ double x = untag_float_fast(dpop()); -DEFINE_PRIMITIVE(float_eq) +void primitive_float_eq(void) { POP_FLOATS(x,y); box_boolean(x == y); } -DEFINE_PRIMITIVE(float_add) +void primitive_float_add(void) { POP_FLOATS(x,y); box_double(x + y); } -DEFINE_PRIMITIVE(float_subtract) +void primitive_float_subtract(void) { POP_FLOATS(x,y); box_double(x - y); } -DEFINE_PRIMITIVE(float_multiply) +void primitive_float_multiply(void) { POP_FLOATS(x,y); box_double(x * y); } -DEFINE_PRIMITIVE(float_divfloat) +void primitive_float_divfloat(void) { POP_FLOATS(x,y); box_double(x / y); } -DEFINE_PRIMITIVE(float_mod) +void primitive_float_mod(void) { POP_FLOATS(x,y); box_double(fmod(x,y)); } -DEFINE_PRIMITIVE(float_less) +void primitive_float_less(void) { POP_FLOATS(x,y); box_boolean(x < y); } -DEFINE_PRIMITIVE(float_lesseq) +void primitive_float_lesseq(void) { POP_FLOATS(x,y); box_boolean(x <= y); } -DEFINE_PRIMITIVE(float_greater) +void primitive_float_greater(void) { POP_FLOATS(x,y); box_boolean(x > y); } -DEFINE_PRIMITIVE(float_greatereq) +void primitive_float_greatereq(void) { POP_FLOATS(x,y); box_boolean(x >= y); } -DEFINE_PRIMITIVE(float_bits) +void primitive_float_bits(void) { box_unsigned_4(float_bits(untag_float(dpop()))); } -DEFINE_PRIMITIVE(bits_float) +void primitive_bits_float(void) { box_float(bits_float(to_cell(dpop()))); } -DEFINE_PRIMITIVE(double_bits) +void primitive_double_bits(void) { box_unsigned_8(double_bits(untag_float(dpop()))); } -DEFINE_PRIMITIVE(bits_double) +void primitive_bits_double(void) { box_double(bits_double(to_unsigned_8(dpop()))); } @@ -532,7 +532,7 @@ void box_double(double flo) /* Complex numbers */ -DEFINE_PRIMITIVE(from_rect) +void primitive_from_rect(void) { F_COMPLEX* complex = allot_object(COMPLEX_TYPE,sizeof(F_COMPLEX)); complex->imaginary = dpop(); diff --git a/vm/math.h b/vm/math.h index 07d7fa9199..4fa3c8d35f 100644 --- a/vm/math.h +++ b/vm/math.h @@ -6,15 +6,15 @@ DLLEXPORT F_FIXNUM to_fixnum(CELL tagged); DLLEXPORT CELL to_cell(CELL tagged); -DECLARE_PRIMITIVE(bignum_to_fixnum); -DECLARE_PRIMITIVE(float_to_fixnum); +void primitive_bignum_to_fixnum(void); +void primitive_float_to_fixnum(void); -DECLARE_PRIMITIVE(fixnum_add); -DECLARE_PRIMITIVE(fixnum_subtract); -DECLARE_PRIMITIVE(fixnum_multiply); -DECLARE_PRIMITIVE(fixnum_divint); -DECLARE_PRIMITIVE(fixnum_divmod); -DECLARE_PRIMITIVE(fixnum_shift); +void primitive_fixnum_add(void); +void primitive_fixnum_subtract(void); +void primitive_fixnum_multiply(void); +void primitive_fixnum_divint(void); +void primitive_fixnum_divmod(void); +void primitive_fixnum_shift(void); CELL bignum_zero; CELL bignum_pos_one; @@ -25,27 +25,27 @@ INLINE CELL tag_bignum(F_ARRAY* bignum) return RETAG(bignum,BIGNUM_TYPE); } -DECLARE_PRIMITIVE(fixnum_to_bignum); -DECLARE_PRIMITIVE(float_to_bignum); -DECLARE_PRIMITIVE(bignum_eq); -DECLARE_PRIMITIVE(bignum_add); -DECLARE_PRIMITIVE(bignum_subtract); -DECLARE_PRIMITIVE(bignum_multiply); -DECLARE_PRIMITIVE(bignum_divint); -DECLARE_PRIMITIVE(bignum_divmod); -DECLARE_PRIMITIVE(bignum_mod); -DECLARE_PRIMITIVE(bignum_and); -DECLARE_PRIMITIVE(bignum_or); -DECLARE_PRIMITIVE(bignum_xor); -DECLARE_PRIMITIVE(bignum_shift); -DECLARE_PRIMITIVE(bignum_less); -DECLARE_PRIMITIVE(bignum_lesseq); -DECLARE_PRIMITIVE(bignum_greater); -DECLARE_PRIMITIVE(bignum_greatereq); -DECLARE_PRIMITIVE(bignum_not); -DECLARE_PRIMITIVE(bignum_bitp); -DECLARE_PRIMITIVE(bignum_log2); -DECLARE_PRIMITIVE(byte_array_to_bignum); +void primitive_fixnum_to_bignum(void); +void primitive_float_to_bignum(void); +void primitive_bignum_eq(void); +void primitive_bignum_add(void); +void primitive_bignum_subtract(void); +void primitive_bignum_multiply(void); +void primitive_bignum_divint(void); +void primitive_bignum_divmod(void); +void primitive_bignum_mod(void); +void primitive_bignum_and(void); +void primitive_bignum_or(void); +void primitive_bignum_xor(void); +void primitive_bignum_shift(void); +void primitive_bignum_less(void); +void primitive_bignum_lesseq(void); +void primitive_bignum_greater(void); +void primitive_bignum_greatereq(void); +void primitive_bignum_not(void); +void primitive_bignum_bitp(void); +void primitive_bignum_log2(void); +void primitive_byte_array_to_bignum(void); INLINE CELL allot_integer(F_FIXNUM x) { @@ -80,7 +80,7 @@ DLLEXPORT u64 to_unsigned_8(CELL obj); CELL unbox_array_size(void); -DECLARE_PRIMITIVE(from_fraction); +void primitive_from_fraction(void); INLINE double untag_float_fast(CELL tagged) { @@ -125,26 +125,26 @@ DLLEXPORT float to_float(CELL value); DLLEXPORT void box_double(double flo); DLLEXPORT double to_double(CELL value); -DECLARE_PRIMITIVE(fixnum_to_float); -DECLARE_PRIMITIVE(bignum_to_float); -DECLARE_PRIMITIVE(str_to_float); -DECLARE_PRIMITIVE(float_to_str); -DECLARE_PRIMITIVE(float_to_bits); +void primitive_fixnum_to_float(void); +void primitive_bignum_to_float(void); +void primitive_str_to_float(void); +void primitive_float_to_str(void); +void primitive_float_to_bits(void); -DECLARE_PRIMITIVE(float_eq); -DECLARE_PRIMITIVE(float_add); -DECLARE_PRIMITIVE(float_subtract); -DECLARE_PRIMITIVE(float_multiply); -DECLARE_PRIMITIVE(float_divfloat); -DECLARE_PRIMITIVE(float_mod); -DECLARE_PRIMITIVE(float_less); -DECLARE_PRIMITIVE(float_lesseq); -DECLARE_PRIMITIVE(float_greater); -DECLARE_PRIMITIVE(float_greatereq); +void primitive_float_eq(void); +void primitive_float_add(void); +void primitive_float_subtract(void); +void primitive_float_multiply(void); +void primitive_float_divfloat(void); +void primitive_float_mod(void); +void primitive_float_less(void); +void primitive_float_lesseq(void); +void primitive_float_greater(void); +void primitive_float_greatereq(void); -DECLARE_PRIMITIVE(float_bits); -DECLARE_PRIMITIVE(bits_float); -DECLARE_PRIMITIVE(double_bits); -DECLARE_PRIMITIVE(bits_double); +void primitive_float_bits(void); +void primitive_bits_float(void); +void primitive_double_bits(void); +void primitive_bits_double(void); -DECLARE_PRIMITIVE(from_rect); +void primitive_from_rect(void); diff --git a/vm/os-unix.c b/vm/os-unix.c index 4ca62e6623..c11962f6e1 100755 --- a/vm/os-unix.c +++ b/vm/os-unix.c @@ -55,7 +55,7 @@ void ffi_dlclose(F_DLL *dll) dll->dll = NULL; } -DEFINE_PRIMITIVE(existsp) +void primitive_existsp(void) { struct stat sb; box_boolean(stat(unbox_char_string(),&sb) >= 0); diff --git a/vm/os-windows-ce.c b/vm/os-windows-ce.c index 9b73692aa0..02b51b82ed 100755 --- a/vm/os-windows-ce.c +++ b/vm/os-windows-ce.c @@ -27,7 +27,7 @@ char *getenv(char *name) return 0; /* unreachable */ } -DEFINE_PRIMITIVE(os_envs) +void primitive_os_envs(void) { not_implemented_error(); } diff --git a/vm/os-windows.c b/vm/os-windows.c index c19aa5c4b5..fc289c288e 100755 --- a/vm/os-windows.c +++ b/vm/os-windows.c @@ -87,7 +87,7 @@ const F_CHAR *vm_executable_path(void) return safe_strdup(full_path); } -DEFINE_PRIMITIVE(existsp) +void primitive_existsp(void) { BY_HANDLE_FILE_INFORMATION bhfi; diff --git a/vm/primitives.h b/vm/primitives.h index 811b473acd..30e0a4af96 100644 --- a/vm/primitives.h +++ b/vm/primitives.h @@ -1,42 +1 @@ extern void *primitives[]; - -/* Primitives are called with two parameters, the word itself and the current -callstack pointer. The DEFINE_PRIMITIVE() macro takes care of boilerplate to -save the current callstack pointer so that GC and other facilities can proceed -to inspect Factor stack frames below the primitive's C stack frame. - -Usage: - -DEFINE_PRIMITIVE(name) -{ - ... CODE ... -} - -Becomes - -F_FASTCALL void primitive_name(CELL word, F_STACK_FRAME *callstack_top) -{ - save_callstack_top(callstack_top); - ... CODE ... -} - -On x86, F_FASTCALL expands into a GCC declaration which forces the two -parameters to be passed in registers. This simplifies the quotation compiler -and support code in cpu-x86.S. - -We do the assignment of stack_chain->callstack_top in a ``noinline'' function -to inhibit assignment re-ordering. */ -#define DEFINE_PRIMITIVE(name) \ - INLINE void primitive_##name##_impl(void); \ - \ - F_FASTCALL void primitive_##name(CELL word, F_STACK_FRAME *callstack_top) \ - { \ - save_callstack_top(callstack_top); \ - primitive_##name##_impl(); \ - } \ - \ - INLINE void primitive_##name##_impl(void) \ - -/* Prototype for header files */ -#define DECLARE_PRIMITIVE(name) \ - F_FASTCALL void primitive_##name(CELL word, F_STACK_FRAME *callstack_top) diff --git a/vm/profiler.c b/vm/profiler.c index 250e5a996a..e3db67964f 100755 --- a/vm/profiler.c +++ b/vm/profiler.c @@ -79,7 +79,7 @@ void set_profiling(bool profiling) iterate_code_heap(relocate_code_block); } -DEFINE_PRIMITIVE(profiling) +void primitive_profiling(void) { set_profiling(to_boolean(dpop())); } diff --git a/vm/profiler.h b/vm/profiler.h index d14ceb283b..26a3a78d4b 100755 --- a/vm/profiler.h +++ b/vm/profiler.h @@ -1,4 +1,4 @@ bool profiling_p; -DECLARE_PRIMITIVE(profiling); +void primitive_profiling(void); F_COMPILED *compile_profiling_stub(F_WORD *word); void update_word_xt(F_WORD *word); diff --git a/vm/quotations.c b/vm/quotations.c index b75d3f79e0..bf917aeec0 100755 --- a/vm/quotations.c +++ b/vm/quotations.c @@ -209,6 +209,7 @@ void jit_compile(CELL quot, bool relocate) case FIXNUM_TYPE: if(jit_primitive_call_p(untag_object(array),i)) { + EMIT(userenv[JIT_SAVE_STACK],0); EMIT(userenv[JIT_PRIMITIVE],to_fixnum(obj)); i++; @@ -344,6 +345,7 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset) case FIXNUM_TYPE: if(jit_primitive_call_p(untag_object(array),i)) { + COUNT(userenv[JIT_SAVE_STACK],i); COUNT(userenv[JIT_PRIMITIVE],i); i++; @@ -412,7 +414,7 @@ F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack) } /* push a new quotation on the stack */ -DEFINE_PRIMITIVE(array_to_quotation) +void primitive_array_to_quotation(void) { F_QUOTATION *quot = allot_object(QUOTATION_TYPE,sizeof(F_QUOTATION)); quot->array = dpeek(); @@ -421,7 +423,7 @@ DEFINE_PRIMITIVE(array_to_quotation) drepl(tag_object(quot)); } -DEFINE_PRIMITIVE(quotation_xt) +void primitive_quotation_xt(void) { F_QUOTATION *quot = untag_quotation(dpeek()); drepl(allot_cell((CELL)quot->xt)); diff --git a/vm/quotations.h b/vm/quotations.h index 0845957c0b..45bf78d14f 100755 --- a/vm/quotations.h +++ b/vm/quotations.h @@ -2,5 +2,5 @@ void set_quot_xt(F_QUOTATION *quot, F_COMPILED *code); void jit_compile(CELL quot, bool relocate); F_FASTCALL CELL primitive_jit_compile(CELL quot, F_STACK_FRAME *stack); F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset); -DECLARE_PRIMITIVE(array_to_quotation); -DECLARE_PRIMITIVE(quotation_xt); +void primitive_array_to_quotation(void); +void primitive_quotation_xt(void); diff --git a/vm/run.c b/vm/run.c index c4a3e115c1..c7d93d29c8 100755 --- a/vm/run.c +++ b/vm/run.c @@ -105,13 +105,13 @@ bool stack_to_array(CELL bottom, CELL top) } } -DEFINE_PRIMITIVE(datastack) +void primitive_datastack(void) { if(!stack_to_array(ds_bot,ds)) general_error(ERROR_DS_UNDERFLOW,F,F,NULL); } -DEFINE_PRIMITIVE(retainstack) +void primitive_retainstack(void) { if(!stack_to_array(rs_bot,rs)) general_error(ERROR_RS_UNDERFLOW,F,F,NULL); @@ -125,45 +125,45 @@ CELL array_to_stack(F_ARRAY *array, CELL bottom) return bottom + depth - CELLS; } -DEFINE_PRIMITIVE(set_datastack) +void primitive_set_datastack(void) { ds = array_to_stack(untag_array(dpop()),ds_bot); } -DEFINE_PRIMITIVE(set_retainstack) +void primitive_set_retainstack(void) { rs = array_to_stack(untag_array(dpop()),rs_bot); } -DEFINE_PRIMITIVE(getenv) +void primitive_getenv(void) { F_FIXNUM e = untag_fixnum_fast(dpeek()); drepl(userenv[e]); } -DEFINE_PRIMITIVE(setenv) +void primitive_setenv(void) { F_FIXNUM e = untag_fixnum_fast(dpop()); CELL value = dpop(); userenv[e] = value; } -DEFINE_PRIMITIVE(exit) +void primitive_exit(void) { exit(to_fixnum(dpop())); } -DEFINE_PRIMITIVE(millis) +void primitive_millis(void) { box_unsigned_8(current_millis()); } -DEFINE_PRIMITIVE(sleep) +void primitive_sleep(void) { sleep_millis(to_cell(dpop())); } -DEFINE_PRIMITIVE(set_slot) +void primitive_set_slot(void) { F_FIXNUM slot = untag_fixnum_fast(dpop()); CELL obj = dpop(); diff --git a/vm/run.h b/vm/run.h index 96e606e38c..2dbbcc8c06 100755 --- a/vm/run.h +++ b/vm/run.h @@ -48,8 +48,8 @@ typedef enum { JIT_RETURN, JIT_PROFILING, JIT_PUSH_IMMEDIATE, - JIT_DECLARE_WORD = 42, + JIT_SAVE_STACK, STACK_TRACES_ENV = 59, @@ -226,18 +226,18 @@ DLLEXPORT void nest_stacks(void); DLLEXPORT void unnest_stacks(void); void init_stacks(CELL ds_size, CELL rs_size); -DECLARE_PRIMITIVE(datastack); -DECLARE_PRIMITIVE(retainstack); -DECLARE_PRIMITIVE(getenv); -DECLARE_PRIMITIVE(setenv); -DECLARE_PRIMITIVE(exit); -DECLARE_PRIMITIVE(os_env); -DECLARE_PRIMITIVE(os_envs); -DECLARE_PRIMITIVE(set_os_env); -DECLARE_PRIMITIVE(unset_os_env); -DECLARE_PRIMITIVE(set_os_envs); -DECLARE_PRIMITIVE(millis); -DECLARE_PRIMITIVE(sleep); -DECLARE_PRIMITIVE(set_slot); +void primitive_datastack(void); +void primitive_retainstack(void); +void primitive_getenv(void); +void primitive_setenv(void); +void primitive_exit(void); +void primitive_os_env(void); +void primitive_os_envs(void); +void primitive_set_os_env(void); +void primitive_unset_os_env(void); +void primitive_set_os_envs(void); +void primitive_millis(void); +void primitive_sleep(void); +void primitive_set_slot(void); bool stage2; diff --git a/vm/types.c b/vm/types.c index 38fe3460e7..f1588465a4 100755 --- a/vm/types.c +++ b/vm/types.c @@ -29,7 +29,7 @@ CELL clone_object(CELL object) } } -DEFINE_PRIMITIVE(clone) +void primitive_clone(void) { drepl(clone_object(dpeek())); } @@ -68,7 +68,7 @@ F_WORD *allot_word(CELL vocab, CELL name) } /* ( name vocabulary -- word ) */ -DEFINE_PRIMITIVE(word) +void primitive_word(void) { CELL vocab = dpop(); CELL name = dpop(); @@ -76,7 +76,7 @@ DEFINE_PRIMITIVE(word) } /* word-xt ( word -- start end ) */ -DEFINE_PRIMITIVE(word_xt) +void primitive_word_xt(void) { F_WORD *word = untag_word(dpop()); F_COMPILED *code = (profiling_p ? word->profiling : word->code); @@ -84,7 +84,7 @@ DEFINE_PRIMITIVE(word_xt) dpush(allot_cell((CELL)code + sizeof(F_COMPILED) + code->code_length)); } -DEFINE_PRIMITIVE(wrapper) +void primitive_wrapper(void) { F_WRAPPER *wrapper = allot_object(WRAPPER_TYPE,sizeof(F_WRAPPER)); wrapper->object = dpeek(); @@ -123,7 +123,7 @@ F_ARRAY *allot_array(CELL type, CELL capacity, CELL fill) } /* push a new array on the stack */ -DEFINE_PRIMITIVE(array) +void primitive_array(void) { CELL initial = dpop(); CELL size = unbox_array_size(); @@ -194,7 +194,7 @@ F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill) return new_array; } -DEFINE_PRIMITIVE(resize_array) +void primitive_resize_array(void) { F_ARRAY* array = untag_array(dpop()); CELL capacity = unbox_array_size(); @@ -259,7 +259,7 @@ F_BYTE_ARRAY *allot_byte_array(CELL size) } /* push a new byte array on the stack */ -DEFINE_PRIMITIVE(byte_array) +void primitive_byte_array(void) { CELL size = unbox_array_size(); dpush(tag_object(allot_byte_array(size))); @@ -280,7 +280,7 @@ F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity) return new_array; } -DEFINE_PRIMITIVE(resize_byte_array) +void primitive_resize_byte_array(void) { F_BYTE_ARRAY* array = untag_byte_array(dpop()); CELL capacity = unbox_array_size(); @@ -313,7 +313,7 @@ F_TUPLE *allot_tuple(F_TUPLE_LAYOUT *layout) return tuple; } -DEFINE_PRIMITIVE(tuple) +void primitive_tuple(void) { F_TUPLE_LAYOUT *layout = untag_object(dpop()); F_FIXNUM size = untag_fixnum_fast(layout->size); @@ -327,7 +327,7 @@ DEFINE_PRIMITIVE(tuple) } /* push a new tuple on the stack, filling its slots from the stack */ -DEFINE_PRIMITIVE(tuple_boa) +void primitive_tuple_boa(void) { F_TUPLE_LAYOUT *layout = untag_object(dpop()); F_FIXNUM size = untag_fixnum_fast(layout->size); @@ -434,7 +434,7 @@ F_STRING *allot_string(CELL capacity, CELL fill) return string; } -DEFINE_PRIMITIVE(string) +void primitive_string(void) { CELL initial = to_cell(dpop()); CELL length = unbox_array_size(); @@ -477,7 +477,7 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill) return new_string; } -DEFINE_PRIMITIVE(resize_string) +void primitive_resize_string(void) { F_STRING* string = untag_string(dpop()); CELL capacity = unbox_array_size(); @@ -544,7 +544,7 @@ F_BYTE_ARRAY *allot_c_string(CELL capacity, CELL size) for(i = 0; i < capacity; i++) \ string[i] = string_nth(s,i); \ } \ - DEFINE_PRIMITIVE(type##_string_to_memory) \ + void primitive_##type##_string_to_memory(void) \ { \ type *address = unbox_alien(); \ F_STRING *str = untag_string(dpop()); \ @@ -576,14 +576,14 @@ F_BYTE_ARRAY *allot_c_string(CELL capacity, CELL size) STRING_TO_MEMORY(char); STRING_TO_MEMORY(u16); -DEFINE_PRIMITIVE(string_nth) +void primitive_string_nth(void) { F_STRING *string = untag_object(dpop()); CELL index = untag_fixnum_fast(dpop()); dpush(tag_fixnum(string_nth(string,index))); } -DEFINE_PRIMITIVE(set_string_nth) +void primitive_set_string_nth(void) { F_STRING *string = untag_object(dpop()); CELL index = untag_fixnum_fast(dpop()); diff --git a/vm/types.h b/vm/types.h index 6efae35f5e..ebbb8a2642 100755 --- a/vm/types.h +++ b/vm/types.h @@ -112,23 +112,23 @@ CELL allot_array_1(CELL obj); CELL allot_array_2(CELL v1, CELL v2); CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4); -DECLARE_PRIMITIVE(array); -DECLARE_PRIMITIVE(tuple); -DECLARE_PRIMITIVE(tuple_boa); -DECLARE_PRIMITIVE(tuple_layout); -DECLARE_PRIMITIVE(byte_array); -DECLARE_PRIMITIVE(clone); +void primitive_array(void); +void primitive_tuple(void); +void primitive_tuple_boa(void); +void primitive_tuple_layout(void); +void primitive_byte_array(void); +void primitive_clone(void); F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity, CELL fill); F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity); -DECLARE_PRIMITIVE(resize_array); -DECLARE_PRIMITIVE(resize_byte_array); +void primitive_resize_array(void); +void primitive_resize_byte_array(void); F_STRING* allot_string_internal(CELL capacity); F_STRING* allot_string(CELL capacity, CELL fill); -DECLARE_PRIMITIVE(string); +void primitive_string(void); F_STRING *reallot_string(F_STRING *string, CELL capacity, CELL fill); -DECLARE_PRIMITIVE(resize_string); +void primitive_resize_string(void); F_STRING *memory_to_char_string(const char *string, CELL length); F_STRING *from_char_string(const char *c_string); @@ -152,14 +152,14 @@ DLLEXPORT u16 *unbox_u16_string(void); CELL string_nth(F_STRING* string, CELL index); void set_string_nth(F_STRING* string, CELL index, CELL value); -DECLARE_PRIMITIVE(string_nth); -DECLARE_PRIMITIVE(set_string_nth); +void primitive_string_nth(void); +void primitive_set_string_nth(void); F_WORD *allot_word(CELL vocab, CELL name); -DECLARE_PRIMITIVE(word); -DECLARE_PRIMITIVE(word_xt); +void primitive_word(void); +void primitive_word_xt(void); -DECLARE_PRIMITIVE(wrapper); +void primitive_wrapper(void); /* Macros to simulate a vector in C */ #define GROWABLE_ARRAY(result) \