diff --git a/README.txt b/README.txt index c0d56dfa09..addbe38f0d 100755 --- a/README.txt +++ b/README.txt @@ -20,7 +20,7 @@ implementation. It is not an introduction to the language itself. * Compiling the Factor VM -The Factor runtime is written in GNU C99, and is built with GNU make and +The Factor runtime is written in GNU C++, and is built with GNU make and gcc. Factor supports various platforms. For an up-to-date list, see @@ -138,7 +138,7 @@ usage documentation, enter the following in the UI listener: The Factor source tree is organized as follows: build-support/ - scripts used for compiling Factor - vm/ - sources for the Factor VM, written in C + vm/ - sources for the Factor VM, written in C++ core/ - Factor core library basis/ - Factor basis library, compiler, tools extra/ - more libraries and applications diff --git a/core/generic/standard/standard.factor b/core/generic/standard/standard.factor index 96c273e3f8..499adcc818 100644 --- a/core/generic/standard/standard.factor +++ b/core/generic/standard/standard.factor @@ -44,7 +44,7 @@ M: standard-combination inline-cache-quot ( word methods -- ) #! Direct calls to the generic word (not tail calls or indirect calls) #! will jump to the inline cache entry point instead of the megamorphic #! dispatch entry point. - combination get #>> [ f inline-cache-miss ] 3curry [ ] like ; + combination get #>> [ { } inline-cache-miss ] 3curry [ ] like ; : make-empty-cache ( -- array ) mega-cache-size get f ; diff --git a/vmpp/alien.cpp b/vmpp/alien.cpp index d55ea75b0d..f7c1d8919a 100755 --- a/vmpp/alien.cpp +++ b/vmpp/alien.cpp @@ -9,10 +9,10 @@ char *alien_offset(CELL object) switch(type_of(object)) { case BYTE_ARRAY_TYPE: - byte_array = untag_byte_array_fast(object); + byte_array = untagged(object); return (char *)(byte_array + 1); case ALIEN_TYPE: - alien = untag_alien_fast(object); + alien = untagged(object); if(alien->expired != F) general_error(ERROR_EXPIRED,object,F,NULL); return alien_offset(alien->alien) + alien->displacement; @@ -33,7 +33,7 @@ char *pinned_alien_offset(CELL object) switch(type_of(object)) { case ALIEN_TYPE: - alien = untag_alien_fast(object); + alien = untagged(object); if(alien->expired != F) general_error(ERROR_EXPIRED,object,F,NULL); return pinned_alien_offset(alien->alien) + alien->displacement; @@ -52,24 +52,24 @@ char *unbox_alien(void) } /* make an alien */ -CELL allot_alien(CELL delegate, CELL displacement) +CELL allot_alien(CELL delegate_, CELL displacement) { - REGISTER_ROOT(delegate); - F_ALIEN *alien = (F_ALIEN *)allot_object(ALIEN_TYPE,sizeof(F_ALIEN)); - UNREGISTER_ROOT(delegate); + gc_root delegate(delegate_); + gc_root alien(allot(sizeof(F_ALIEN))); - if(type_of(delegate) == ALIEN_TYPE) + if(delegate.isa(ALIEN_TYPE)) { - F_ALIEN *delegate_alien = untag_alien_fast(delegate); + tagged delegate_alien = delegate.as(); displacement += delegate_alien->displacement; alien->alien = delegate_alien->alien; } else - alien->alien = delegate; + alien->alien = delegate.value(); alien->displacement = displacement; alien->expired = F; - return tag_object(alien); + + return alien.value(); } /* make an alien and push */ @@ -183,35 +183,28 @@ void box_medium_struct(CELL x1, CELL x2, CELL x3, CELL x4, CELL size) /* open a native library and push a handle */ void primitive_dlopen(void) { - CELL path = tag_object(string_to_native_alien( - untag_string(dpop()))); - REGISTER_ROOT(path); - F_DLL *dll = (F_DLL *)allot_object(DLL_TYPE,sizeof(F_DLL)); - UNREGISTER_ROOT(path); - dll->path = path; - ffi_dlopen(dll); - dpush(tag_object(dll)); + gc_root path(tag_object(string_to_native_alien(untag_string(dpop())))); + gc_root dll(allot(sizeof(F_DLL))); + dll->path = path.value(); + ffi_dlopen(dll.untagged()); + dpush(dll.value()); } /* look up a symbol in a native library */ void primitive_dlsym(void) { - CELL dll = dpop(); - REGISTER_ROOT(dll); + gc_root dll(dpop()); F_SYMBOL *sym = unbox_symbol_string(); - UNREGISTER_ROOT(dll); - F_DLL *d; - - if(dll == F) + if(dll.value() == F) box_alien(ffi_dlsym(NULL,sym)); else { - d = untag_dll(dll); + tagged d = dll.as(); if(d->dll == NULL) dpush(F); else - box_alien(ffi_dlsym(d,sym)); + box_alien(ffi_dlsym(d.untagged(),sym)); } } @@ -227,8 +220,5 @@ void primitive_dll_validp(void) if(dll == F) dpush(T); else - { - F_DLL *d = untag_dll(dll); - dpush(d->dll == NULL ? F : T); - } + dpush(tagged(dll)->dll == NULL ? F : T); } diff --git a/vmpp/arrays.cpp b/vmpp/arrays.cpp index 3203da2c99..83953d20bc 100644 --- a/vmpp/arrays.cpp +++ b/vmpp/arrays.cpp @@ -1,13 +1,13 @@ #include "master.hpp" /* make a new array with an initial element */ -F_ARRAY *allot_array(CELL capacity, CELL fill) +F_ARRAY *allot_array(CELL capacity, CELL fill_) { - REGISTER_ROOT(fill); - F_ARRAY* array = allot_array_internal(capacity); - UNREGISTER_ROOT(fill); - if(fill == 0) - memset((void*)AREF(array,0),'\0',capacity * CELLS); + gc_root fill(fill_); + gc_root array(allot_array_internal(capacity)); + + if(fill.value() == tag_fixnum(0)) + memset((void*)AREF(array.untagged(),0),'\0',capacity * CELLS); else { /* No need for write barrier here. Either the object is in @@ -15,9 +15,9 @@ F_ARRAY *allot_array(CELL capacity, CELL fill) and the write barrier is already hit for us in that case. */ CELL i; for(i = 0; i < capacity; i++) - put(AREF(array,i),fill); + put(AREF(array.untagged(),i),fill.value()); } - return array; + return array.untagged(); } /* push a new array on the stack */ @@ -28,43 +28,36 @@ void primitive_array(void) dpush(tag_array(allot_array(size,initial))); } -CELL allot_array_1(CELL obj) +CELL allot_array_1(CELL obj_) { - REGISTER_ROOT(obj); - F_ARRAY *a = allot_array_internal(1); - UNREGISTER_ROOT(obj); - set_array_nth(a,0,obj); - return tag_array(a); + gc_root obj(obj_); + gc_root a(allot_array_internal(1)); + set_array_nth(a.untagged(),0,obj.value()); + return a.value(); } -CELL allot_array_2(CELL v1, CELL v2) +CELL allot_array_2(CELL v1_, CELL v2_) { - REGISTER_ROOT(v1); - REGISTER_ROOT(v2); - F_ARRAY *a = allot_array_internal(2); - UNREGISTER_ROOT(v2); - UNREGISTER_ROOT(v1); - set_array_nth(a,0,v1); - set_array_nth(a,1,v2); - return tag_array(a); + gc_root v1(v1_); + gc_root v2(v2_); + gc_root a(allot_array_internal(2)); + set_array_nth(a.untagged(),0,v1.value()); + set_array_nth(a.untagged(),1,v2.value()); + return a.value(); } -CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4) +CELL allot_array_4(CELL v1_, CELL v2_, CELL v3_, CELL v4_) { - REGISTER_ROOT(v1); - REGISTER_ROOT(v2); - REGISTER_ROOT(v3); - REGISTER_ROOT(v4); - F_ARRAY *a = allot_array_internal(4); - UNREGISTER_ROOT(v4); - UNREGISTER_ROOT(v3); - UNREGISTER_ROOT(v2); - UNREGISTER_ROOT(v1); - set_array_nth(a,0,v1); - set_array_nth(a,1,v2); - set_array_nth(a,2,v3); - set_array_nth(a,3,v4); - return tag_array(a); + gc_root v1(v1_); + gc_root v2(v2_); + gc_root v3(v3_); + gc_root v4(v4_); + gc_root a(allot_array_internal(4)); + set_array_nth(a.untagged(),0,v1.value()); + set_array_nth(a.untagged(),1,v2.value()); + set_array_nth(a.untagged(),2,v3.value()); + set_array_nth(a.untagged(),3,v4.value()); + return a.value(); } void primitive_resize_array(void) @@ -74,43 +67,16 @@ void primitive_resize_array(void) dpush(tag_array(reallot_array(array,capacity))); } -void growable_array_add(F_GROWABLE_ARRAY *array, CELL elt) +void growable_array::add(CELL elt_) { - F_ARRAY *underlying = untag_array_fast(array->array); - REGISTER_ROOT(elt); + gc_root elt(elt_); + if(count == array_capacity(array.untagged())) + array = reallot_array(array.untagged(),count * 2); - if(array->count == array_capacity(underlying)) - { - underlying = reallot_array(underlying,array->count * 2); - array->array = tag_array(underlying); - } - - UNREGISTER_ROOT(elt); - set_array_nth(underlying,array->count++,elt); + set_array_nth(array.untagged(),count++,elt.value()); } -void growable_array_append(F_GROWABLE_ARRAY *array, F_ARRAY *elts) +void growable_array::trim() { - REGISTER_UNTAGGED(elts); - - F_ARRAY *underlying = untag_array_fast(array->array); - - CELL elts_size = array_capacity(elts); - CELL new_size = array->count + elts_size; - - if(new_size >= array_capacity(underlying)) - { - underlying = reallot_array(underlying,new_size * 2); - array->array = tag_array(underlying); - } - - UNREGISTER_UNTAGGED(F_ARRAY,elts); - - write_barrier(array->array); - - memcpy((void *)AREF(underlying,array->count), - (void *)AREF(elts,0), - elts_size * CELLS); - - array->count += elts_size; + array = reallot_array(array.untagged(),count); } diff --git a/vmpp/arrays.hpp b/vmpp/arrays.hpp index 15caf3c56f..ad1112e81c 100644 --- a/vmpp/arrays.hpp +++ b/vmpp/arrays.hpp @@ -6,7 +6,6 @@ INLINE CELL tag_array(F_ARRAY *array) } F_ARRAY *allot_array(CELL capacity, CELL fill); -F_BYTE_ARRAY *allot_byte_array(CELL size); CELL allot_array_1(CELL obj); CELL allot_array_2(CELL v1, CELL v2); @@ -15,41 +14,12 @@ CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4); void primitive_array(void); void primitive_resize_array(void); -/* Macros to simulate a vector in C */ -struct F_GROWABLE_ARRAY { +struct growable_array { CELL count; - CELL array; + gc_root array; + + growable_array() : count(0), array(allot_array(2,F)) {} + + void add(CELL elt); + void trim(); }; - -/* Allocates memory */ -INLINE F_GROWABLE_ARRAY make_growable_array(void) -{ - F_GROWABLE_ARRAY result; - result.count = 0; - result.array = tag_array(allot_array(2,F)); - return result; -} - -#define GROWABLE_ARRAY(result) F_GROWABLE_ARRAY result##_g = make_growable_array(); \ - REGISTER_ROOT(result##_g.array) - -void growable_array_add(F_GROWABLE_ARRAY *result, CELL elt); - -#define GROWABLE_ARRAY_ADD(result,elt) \ - growable_array_add(&result##_g,elt) - -void growable_array_append(F_GROWABLE_ARRAY *result, F_ARRAY *elts); - -#define GROWABLE_ARRAY_APPEND(result,elts) \ - growable_array_append(&result##_g,elts) - -INLINE void growable_array_trim(F_GROWABLE_ARRAY *array) -{ - array->array = tag_array(reallot_array(untag_array_fast(array->array),array->count)); -} - -#define GROWABLE_ARRAY_TRIM(result) growable_array_trim(&result##_g) - -#define GROWABLE_ARRAY_DONE(result) \ - UNREGISTER_ROOT(result##_g.array); \ - CELL result = result##_g.array; diff --git a/vmpp/byte_arrays.cpp b/vmpp/byte_arrays.cpp index da44fc135b..389576e1ef 100644 --- a/vmpp/byte_arrays.cpp +++ b/vmpp/byte_arrays.cpp @@ -26,18 +26,34 @@ void primitive_resize_byte_array(void) dpush(tag_object(reallot_array(array,capacity))); } -void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *array, void *elts, CELL len) +void growable_byte_array::append_bytes(void *elts, CELL len) { - CELL new_size = array->count + len; - F_BYTE_ARRAY *underlying = untag_byte_array_fast(array->array); + CELL new_size = count + len; - if(new_size >= array_capacity(underlying)) - { - underlying = reallot_array(underlying,new_size * 2); - array->array = tag_object(underlying); - } + if(new_size >= array_capacity(array.untagged())) + array = reallot_array(array.untagged(),new_size * 2); - memcpy((void *)BREF(underlying,array->count),elts,len); + memcpy((void *)BREF(array.untagged(),count),elts,len); - array->count += len; + count += len; +} + +void growable_byte_array::append_byte_array(CELL byte_array_) +{ + gc_root byte_array(byte_array_); + + CELL len = array_capacity(byte_array.untagged()); + CELL new_size = count + len; + + if(new_size >= array_capacity(array.untagged())) + array = reallot_array(array.untagged(),new_size * 2); + + memcpy((void *)BREF(array.untagged(),count),byte_array.untagged() + 1,len); + + count += len; +} + +void growable_byte_array::trim() +{ + array = reallot_array(array.untagged(),count); } diff --git a/vmpp/byte_arrays.hpp b/vmpp/byte_arrays.hpp index fe0e5f7acd..6b89a16e48 100644 --- a/vmpp/byte_arrays.hpp +++ b/vmpp/byte_arrays.hpp @@ -7,22 +7,14 @@ void primitive_uninitialized_byte_array(void); void primitive_resize_byte_array(void); /* Macros to simulate a byte vector in C */ -struct F_GROWABLE_BYTE_ARRAY { +struct growable_byte_array { CELL count; - CELL array; + gc_root array; + + growable_byte_array() : count(0), array(allot_byte_array(2)) { } + + void append_bytes(void *elts, CELL len); + void append_byte_array(CELL elts); + + void trim(); }; - -INLINE F_GROWABLE_BYTE_ARRAY make_growable_byte_array(void) -{ - F_GROWABLE_BYTE_ARRAY result; - result.count = 0; - result.array = tag_object(allot_byte_array(2)); - return result; -} - -void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *result, void *elts, CELL len); - -INLINE void growable_byte_array_trim(F_GROWABLE_BYTE_ARRAY *byte_array) -{ - byte_array->array = tag_object(reallot_array(untag_byte_array_fast(byte_array->array),byte_array->count)); -} diff --git a/vmpp/callstack.cpp b/vmpp/callstack.cpp index 00f31b9b56..ff50186a7d 100755 --- a/vmpp/callstack.cpp +++ b/vmpp/callstack.cpp @@ -28,9 +28,7 @@ void iterate_callstack_object(F_CALLSTACK *stack, CALLSTACK_ITER iterator) F_CALLSTACK *allot_callstack(CELL size) { - F_CALLSTACK *callstack = (F_CALLSTACK *)allot_object( - CALLSTACK_TYPE, - callstack_size(size)); + F_CALLSTACK *callstack = allot(callstack_size(size)); callstack->length = tag_fixnum(size); return callstack; } @@ -158,17 +156,15 @@ void stack_frame_to_array(F_STACK_FRAME *frame) void primitive_callstack_to_array(void) { - F_CALLSTACK *stack = untag_callstack(dpop()); + gc_root callstack(dpop()); frame_count = 0; - iterate_callstack_object(stack,count_stack_frame); + iterate_callstack_object(callstack.untagged(),count_stack_frame); - REGISTER_UNTAGGED(stack); array = allot_array_internal(frame_count); - UNREGISTER_UNTAGGED(F_CALLSTACK,stack); frame_index = 0; - iterate_callstack_object(stack,stack_frame_to_array); + iterate_callstack_object(callstack.untagged(),stack_frame_to_array); dpush(tag_array(array)); } @@ -208,18 +204,12 @@ void primitive_innermost_stack_frame_scan(void) void primitive_set_innermost_stack_frame_quot(void) { - F_CALLSTACK *callstack = untag_callstack(dpop()); - F_QUOTATION *quot = untag_quotation(dpop()); + gc_root callstack(dpop()); + gc_root quot(dpop()); - REGISTER_UNTAGGED(callstack); - REGISTER_UNTAGGED(quot); + jit_compile(quot.value(),true); - jit_compile(tag_quotation(quot),true); - - UNREGISTER_UNTAGGED(F_QUOTATION,quot); - UNREGISTER_UNTAGGED(F_CALLSTACK,callstack); - - F_STACK_FRAME *inner = innermost_stack_frame(callstack); + F_STACK_FRAME *inner = innermost_stack_frame(callstack.untagged()); type_check(QUOTATION_TYPE,frame_executing(inner)); CELL offset = (char *)FRAME_RETURN_ADDRESS(inner) - (char *)inner->xt; diff --git a/vmpp/code_block.cpp b/vmpp/code_block.cpp index 7ef365f66b..4e42a2be84 100644 --- a/vmpp/code_block.cpp +++ b/vmpp/code_block.cpp @@ -454,47 +454,37 @@ F_CODE_BLOCK *allot_code_block(CELL size) /* Might GC */ F_CODE_BLOCK *add_code_block( CELL type, - F_BYTE_ARRAY *code, - F_ARRAY *labels, - CELL relocation, - CELL literals) + CELL code_, + CELL labels_, + CELL relocation_, + CELL literals_) { -#ifdef FACTOR_DEBUG - type_check(ARRAY_TYPE,literals); - type_check(BYTE_ARRAY_TYPE,relocation); - assert(untag_header(code->header) == BYTE_ARRAY_TYPE); -#endif - - CELL code_length = align8(array_capacity(code)); - - REGISTER_ROOT(literals); - REGISTER_ROOT(relocation); - REGISTER_UNTAGGED(code); - REGISTER_UNTAGGED(labels); + gc_root code(code_); + gc_root labels(labels_); + gc_root relocation(relocation_); + gc_root literals(literals_); + CELL code_length = align8(array_capacity(code.untagged())); F_CODE_BLOCK *compiled = allot_code_block(code_length); - UNREGISTER_UNTAGGED(F_ARRAY,labels); - UNREGISTER_UNTAGGED(F_BYTE_ARRAY,code); - UNREGISTER_ROOT(relocation); - UNREGISTER_ROOT(literals); - - /* slight space optimization */ - if(type_of(literals) == ARRAY_TYPE && array_capacity(untag_array_fast(literals)) == 0) - literals = F; - /* compiled header */ compiled->block.type = type; compiled->block.last_scan = NURSERY; compiled->block.needs_fixup = true; - compiled->literals = literals; - compiled->relocation = relocation; + compiled->relocation = relocation.value(); + + /* slight space optimization */ + if(literals.type() == ARRAY_TYPE && array_capacity(literals.untagged()) == 0) + compiled->literals = F; + else + compiled->literals = literals.value(); /* code */ - memcpy(compiled + 1,code + 1,code_length); + memcpy(compiled + 1,code.untagged() + 1,code_length); /* fixup labels */ - if(labels) fixup_labels(labels,compiled); + if(labels.value() != F) + fixup_labels(labels.as().untagged(),compiled); /* next time we do a minor GC, we have to scan the code heap for literals */ diff --git a/vmpp/code_block.hpp b/vmpp/code_block.hpp index a8350ad5cb..1115b9b891 100644 --- a/vmpp/code_block.hpp +++ b/vmpp/code_block.hpp @@ -84,9 +84,4 @@ INLINE bool stack_traces_p(void) return userenv[STACK_TRACES_ENV] != F; } -F_CODE_BLOCK *add_code_block( - CELL type, - F_BYTE_ARRAY *code, - F_ARRAY *labels, - CELL relocation, - CELL literals); +F_CODE_BLOCK *add_code_block(CELL type, CELL code, CELL labels, CELL relocation, CELL literals); diff --git a/vmpp/code_heap.cpp b/vmpp/code_heap.cpp index 1545dbeaf6..c1b6cdbc3e 100755 --- a/vmpp/code_heap.cpp +++ b/vmpp/code_heap.cpp @@ -15,15 +15,14 @@ bool in_code_heap_p(CELL ptr) } /* Compile a word definition with the non-optimizing compiler. Allocates memory */ -void jit_compile_word(F_WORD *word, CELL def, bool relocate) +void jit_compile_word(CELL word_, CELL def_, bool relocate) { - REGISTER_ROOT(def); - REGISTER_UNTAGGED(word); - jit_compile(def,relocate); - UNREGISTER_UNTAGGED(F_WORD,word); - UNREGISTER_ROOT(def); + gc_root word(word_); + gc_root def(def_); - word->code = untag_quotation(def)->code; + jit_compile(def.value(),relocate); + + word->code = def->code; if(word->direct_entry_def != F) jit_compile(word->direct_entry_def,relocate); @@ -58,40 +57,32 @@ void update_code_heap_words(void) void primitive_modify_code_heap(void) { - F_ARRAY *alist = untag_array(dpop()); + gc_root alist(dpop()); + + CELL count = array_capacity(alist.untagged()); - CELL count = untag_fixnum_fast(alist->capacity); if(count == 0) return; CELL i; for(i = 0; i < count; i++) { - F_ARRAY *pair = untag_array(array_nth(alist,i)); + gc_root pair(array_nth(alist.untagged(),i)); - F_WORD *word = untag_word(array_nth(pair,0)); + gc_root word(array_nth(pair.untagged(),0)); + gc_root data(array_nth(pair.untagged(),1)); - CELL data = array_nth(pair,1); - - if(type_of(data) == QUOTATION_TYPE) + switch(data.type()) { - REGISTER_UNTAGGED(alist); - REGISTER_UNTAGGED(word); - jit_compile_word(word,data,false); - UNREGISTER_UNTAGGED(F_WORD,word); - UNREGISTER_UNTAGGED(F_ARRAY,alist); - } - else if(type_of(data) == ARRAY_TYPE) - { - F_ARRAY *compiled_code = untag_array(data); - - CELL literals = array_nth(compiled_code,0); - CELL relocation = array_nth(compiled_code,1); - F_ARRAY *labels = untag_array(array_nth(compiled_code,2)); - F_BYTE_ARRAY *code = untag_byte_array(array_nth(compiled_code,3)); - - REGISTER_UNTAGGED(alist); - REGISTER_UNTAGGED(word); + case QUOTATION_TYPE: + jit_compile_word(word.value(),data.value(),false); + break; + case ARRAY_TYPE: + F_ARRAY *compiled_data = data.as().untagged(); + CELL literals = array_nth(compiled_data,0); + CELL relocation = array_nth(compiled_data,1); + CELL labels = array_nth(compiled_data,2); + CELL code = array_nth(compiled_data,3); F_CODE_BLOCK *compiled = add_code_block( WORD_TYPE, @@ -100,17 +91,14 @@ void primitive_modify_code_heap(void) relocation, literals); - UNREGISTER_UNTAGGED(F_WORD,word); - UNREGISTER_UNTAGGED(F_ARRAY,alist); - word->code = compiled; + break; + default: + critical_error("Expected a quotation or an array",data.value()); + break; } - else - critical_error("Expected a quotation or an array",data); - REGISTER_UNTAGGED(alist); - update_word_xt(word); - UNREGISTER_UNTAGGED(F_ARRAY,alist); + update_word_xt(word.value()); } update_code_heap_words(); @@ -184,10 +172,7 @@ void fixup_object_xts(void) while((obj = next_object()) != F) { if(type_of(obj) == WORD_TYPE) - { - F_WORD *word = untag_word_fast(obj); - update_word_xt(word); - } + update_word_xt(obj); else if(type_of(obj) == QUOTATION_TYPE) { F_QUOTATION *quot = untag_quotation_fast(obj); diff --git a/vmpp/code_heap.hpp b/vmpp/code_heap.hpp index e312d0ccd4..42571825be 100755 --- a/vmpp/code_heap.hpp +++ b/vmpp/code_heap.hpp @@ -5,7 +5,7 @@ void init_code_heap(CELL size); bool in_code_heap_p(CELL ptr); -void jit_compile_word(F_WORD *word, CELL def, bool relocate); +void jit_compile_word(CELL word, CELL def, bool relocate); typedef void (*CODE_HEAP_ITERATOR)(F_CODE_BLOCK *compiled); diff --git a/vmpp/data_gc.cpp b/vmpp/data_gc.cpp index 07242d4d56..634d44ab2c 100755 --- a/vmpp/data_gc.cpp +++ b/vmpp/data_gc.cpp @@ -179,7 +179,7 @@ void copy_registered_locals(void) } /* Copy roots over at the start of GC, namely various constants, stacks, -the user environment and extra roots registered with REGISTER_ROOT */ +the user environment and extra roots registered by local_roots.hpp */ void copy_roots(void) { copy_handle(&T); @@ -595,7 +595,7 @@ void primitive_gc(void) void primitive_gc_stats(void) { - GROWABLE_ARRAY(stats); + growable_array stats; CELL i; u64 total_gc_time = 0; @@ -603,25 +603,24 @@ void primitive_gc_stats(void) for(i = 0; i < MAX_GEN_COUNT; i++) { F_GC_STATS *s = &gc_stats[i]; - GROWABLE_ARRAY_ADD(stats,allot_cell(s->collections)); - GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->gc_time))); - GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->max_gc_time))); - GROWABLE_ARRAY_ADD(stats,allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections)); - GROWABLE_ARRAY_ADD(stats,allot_cell(s->object_count)); - GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->bytes_copied))); + stats.add(allot_cell(s->collections)); + stats.add(tag_bignum(long_long_to_bignum(s->gc_time))); + stats.add(tag_bignum(long_long_to_bignum(s->max_gc_time))); + stats.add(allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections)); + stats.add(allot_cell(s->object_count)); + stats.add(tag_bignum(long_long_to_bignum(s->bytes_copied))); total_gc_time += s->gc_time; } - GROWABLE_ARRAY_ADD(stats,tag_bignum(ulong_long_to_bignum(total_gc_time))); - GROWABLE_ARRAY_ADD(stats,tag_bignum(ulong_long_to_bignum(cards_scanned))); - GROWABLE_ARRAY_ADD(stats,tag_bignum(ulong_long_to_bignum(decks_scanned))); - GROWABLE_ARRAY_ADD(stats,tag_bignum(ulong_long_to_bignum(card_scan_time))); - GROWABLE_ARRAY_ADD(stats,allot_cell(code_heap_scans)); + stats.add(tag_bignum(ulong_long_to_bignum(total_gc_time))); + stats.add(tag_bignum(ulong_long_to_bignum(cards_scanned))); + stats.add(tag_bignum(ulong_long_to_bignum(decks_scanned))); + stats.add(tag_bignum(ulong_long_to_bignum(card_scan_time))); + stats.add(allot_cell(code_heap_scans)); - GROWABLE_ARRAY_TRIM(stats); - GROWABLE_ARRAY_DONE(stats); - dpush(stats); + stats.trim(); + dpush(stats.array.value()); } void clear_gc_stats(void) diff --git a/vmpp/data_gc.hpp b/vmpp/data_gc.hpp index 2978b20cf6..9dc3a77071 100755 --- a/vmpp/data_gc.hpp +++ b/vmpp/data_gc.hpp @@ -46,24 +46,24 @@ registers) does not run out of memory */ * It is up to the caller to fill in the object's fields in a meaningful * fashion! */ -INLINE void *allot_object(CELL type, CELL a) +INLINE void *allot_object(CELL header, CELL size) { #ifdef GC_DEBUG if(!gc_off) gc(); #endif - CELL *object; + F_OBJECT *object; - if(nursery.size - ALLOT_BUFFER_ZONE > a) + if(nursery.size - ALLOT_BUFFER_ZONE > size) { /* If there is insufficient room, collect the nursery */ - if(nursery.here + ALLOT_BUFFER_ZONE + a > nursery.end) + if(nursery.here + ALLOT_BUFFER_ZONE + size > nursery.end) garbage_collection(NURSERY,false,0); CELL h = nursery.here; - nursery.here = h + align8(a); - object = (CELL*)h; + nursery.here = h + align8(size); + object = (F_OBJECT *)h; } /* If the object is bigger than the nursery, allocate it in tenured space */ @@ -72,20 +72,20 @@ INLINE void *allot_object(CELL type, CELL a) F_ZONE *tenured = &data_heap->generations[TENURED]; /* If tenured space does not have enough room, collect */ - if(tenured->here + a > tenured->end) + if(tenured->here + size > tenured->end) { gc(); tenured = &data_heap->generations[TENURED]; } /* If it still won't fit, grow the heap */ - if(tenured->here + a > tenured->end) + if(tenured->here + size > tenured->end) { - garbage_collection(TENURED,true,a); + garbage_collection(TENURED,true,size); tenured = &data_heap->generations[TENURED]; } - object = (CELL *)allot_zone(tenured,a); + object = (F_OBJECT *)allot_zone(tenured,size); /* We have to do this */ allot_barrier((CELL)object); @@ -96,10 +96,15 @@ INLINE void *allot_object(CELL type, CELL a) write_barrier((CELL)object); } - *object = tag_header(type); + object->header = header; return object; } +template T *allot(CELL size) +{ + return (T *)allot_object(tag_header(T::type_number),size); +} + void copy_reachable_objects(CELL scan, CELL *end); void primitive_gc(void); diff --git a/vmpp/data_heap.cpp b/vmpp/data_heap.cpp index c02c1c2a2f..a3ba93ee58 100644 --- a/vmpp/data_heap.cpp +++ b/vmpp/data_heap.cpp @@ -301,19 +301,18 @@ void primitive_data_room(void) dpush(tag_fixnum((data_heap->cards_end - data_heap->cards) >> 10)); dpush(tag_fixnum((data_heap->decks_end - data_heap->decks) >> 10)); - GROWABLE_ARRAY(a); + growable_array a; CELL gen; for(gen = 0; gen < data_heap->gen_count; gen++) { F_ZONE *z = (gen == NURSERY ? &nursery : &data_heap->generations[gen]); - GROWABLE_ARRAY_ADD(a,tag_fixnum((z->end - z->here) >> 10)); - GROWABLE_ARRAY_ADD(a,tag_fixnum((z->size) >> 10)); + a.add(tag_fixnum((z->end - z->here) >> 10)); + a.add(tag_fixnum((z->size) >> 10)); } - GROWABLE_ARRAY_TRIM(a); - GROWABLE_ARRAY_DONE(a); - dpush(a); + a.trim(); + dpush(a.array.value()); } /* A heap walk allows useful things to be done, like finding all @@ -364,7 +363,7 @@ void primitive_end_scan(void) CELL find_all_words(void) { - GROWABLE_ARRAY(words); + growable_array words; begin_scan(); @@ -372,14 +371,12 @@ CELL find_all_words(void) while((obj = next_object()) != F) { if(type_of(obj) == WORD_TYPE) - GROWABLE_ARRAY_ADD(words,obj); + words.add(obj); } /* End heap scan */ gc_off = false; - GROWABLE_ARRAY_TRIM(words); - GROWABLE_ARRAY_DONE(words); - - return words; + words.trim(); + return words.array.value(); } diff --git a/vmpp/data_heap.hpp b/vmpp/data_heap.hpp index 4753db6d61..3b4231d98f 100644 --- a/vmpp/data_heap.hpp +++ b/vmpp/data_heap.hpp @@ -2,16 +2,16 @@ extern bool secure_gc; /* generational copying GC divides memory into zones */ -typedef struct { +struct F_ZONE { /* allocation pointer is 'here'; its offset is hardcoded in the - compiler backends*/ + compiler backends */ CELL start; CELL here; CELL size; CELL end; -} F_ZONE; +}; -typedef struct { +struct F_DATA_HEAP { F_SEGMENT *segment; CELL young_size; @@ -31,7 +31,7 @@ typedef struct { CELL *decks; CELL *decks_end; -} F_DATA_HEAP; +}; extern F_DATA_HEAP *data_heap; diff --git a/vmpp/dispatch.cpp b/vmpp/dispatch.cpp index a759894b22..fc76d8b34e 100644 --- a/vmpp/dispatch.cpp +++ b/vmpp/dispatch.cpp @@ -167,39 +167,35 @@ void primitive_reset_dispatch_stats(void) void primitive_dispatch_stats(void) { - GROWABLE_ARRAY(stats); - GROWABLE_ARRAY_ADD(stats,allot_cell(megamorphic_cache_hits)); - GROWABLE_ARRAY_ADD(stats,allot_cell(megamorphic_cache_misses)); - GROWABLE_ARRAY_TRIM(stats); - GROWABLE_ARRAY_DONE(stats); - dpush(stats); + growable_array stats; + stats.add(allot_cell(megamorphic_cache_hits)); + stats.add(allot_cell(megamorphic_cache_misses)); + stats.trim(); + dpush(stats.array.value()); } -void jit_emit_class_lookup(F_JIT *jit, F_FIXNUM index, CELL type) +void quotation_jit::emit_mega_cache_lookup(CELL methods_, F_FIXNUM index, CELL cache_) { - jit_emit_with(jit,userenv[PIC_LOAD],tag_fixnum(-index * CELLS)); - jit_emit(jit,userenv[type]); -} + gc_root methods(methods_); + gc_root cache(cache_); -void jit_emit_mega_cache_lookup(F_JIT *jit, CELL methods, F_FIXNUM index, CELL cache) -{ /* Generate machine code to determine the object's class. */ - jit_emit_class_lookup(jit,index,PIC_HI_TAG_TUPLE); + emit_class_lookup(index,PIC_HI_TAG_TUPLE); /* Do a cache lookup. */ - jit_emit_with(jit,userenv[MEGA_LOOKUP],cache); + emit_with(userenv[MEGA_LOOKUP],cache.value()); /* If we end up here, the cache missed. */ - jit_emit(jit,userenv[JIT_PROLOG]); + emit(userenv[JIT_PROLOG]); /* Push index, method table and cache on the stack. */ - jit_push(jit,methods); - jit_push(jit,tag_fixnum(index)); - jit_push(jit,cache); - jit_word_call(jit,userenv[MEGA_MISS_WORD]); + push(methods.value()); + push(tag_fixnum(index)); + push(cache.value()); + word_call(userenv[MEGA_MISS_WORD]); /* Now the new method has been stored into the cache, and its on the stack. */ - jit_emit(jit,userenv[JIT_EPILOG]); - jit_emit(jit,userenv[JIT_EXECUTE_JUMP]); + emit(userenv[JIT_EPILOG]); + emit(userenv[JIT_EXECUTE_JUMP]); } diff --git a/vmpp/dispatch.hpp b/vmpp/dispatch.hpp index 10c9c6b320..be1359fc15 100644 --- a/vmpp/dispatch.hpp +++ b/vmpp/dispatch.hpp @@ -8,6 +8,6 @@ void primitive_mega_cache_miss(void); void primitive_reset_dispatch_stats(void); void primitive_dispatch_stats(void); -void jit_emit_class_lookup(F_JIT *jit, F_FIXNUM index, CELL type); +void jit_emit_class_lookup(jit *jit, F_FIXNUM index, CELL type); -void jit_emit_mega_cache_lookup(F_JIT *jit, CELL methods, F_FIXNUM index, CELL cache); +void jit_emit_mega_cache_lookup(jit *jit, CELL methods, F_FIXNUM index, CELL cache); diff --git a/vmpp/factor.cpp b/vmpp/factor.cpp index 2321a7cc1f..147dff913b 100755 --- a/vmpp/factor.cpp +++ b/vmpp/factor.cpp @@ -152,18 +152,14 @@ void init_factor(F_PARAMETERS *p) /* May allocate memory */ void pass_args_to_factor(int argc, F_CHAR **argv) { - F_ARRAY *args = allot_array(argc,F); + growable_array args; int i; for(i = 1; i < argc; i++) - { - REGISTER_UNTAGGED(args); - CELL arg = tag_object(from_native_string(argv[i])); - UNREGISTER_UNTAGGED(F_ARRAY,args); - set_array_nth(args,i,arg); - } + args.add(tag_object(from_native_string(argv[i]))); - userenv[ARGS_ENV] = tag_array(args); + args.trim(); + userenv[ARGS_ENV] = args.array.value(); } void start_factor(F_PARAMETERS *p) diff --git a/vmpp/generic_arrays.hpp b/vmpp/generic_arrays.hpp index 1c505acea1..ac5a353d83 100644 --- a/vmpp/generic_arrays.hpp +++ b/vmpp/generic_arrays.hpp @@ -41,7 +41,7 @@ template CELL array_size(T *array) template T *allot_array_internal(CELL capacity) { - T *array = (T *)allot_object(T::type_number,array_size(capacity)); + T *array = allot(array_size(capacity)); array->capacity = tag_fixnum(capacity); return array; } @@ -51,29 +51,24 @@ template bool reallot_array_in_place_p(T *array, CELL capacity) return in_zone(&nursery,(CELL)array) && capacity <= array_capacity(array); } -template T *reallot_array(T *array, CELL capacity) +template T *reallot_array(T *array_, CELL capacity) { -#ifdef FACTOR_DEBUG - CELL header = untag_header(array->header); - assert(header == T::type_number); -#endif + gc_root array(array_); - if(reallot_array_in_place_p(array,capacity)) + if(reallot_array_in_place_p(array.untagged(),capacity)) { array->capacity = tag_fixnum(capacity); - return array; + return array.untagged(); } else { - CELL to_copy = array_capacity(array); + CELL to_copy = array_capacity(array.untagged()); if(capacity < to_copy) to_copy = capacity; - REGISTER_UNTAGGED(array); T *new_array = allot_array_internal(capacity); - UNREGISTER_UNTAGGED(T,array); - memcpy(new_array + 1,array + 1,to_copy * T::element_size); + memcpy(new_array + 1,array.untagged() + 1,to_copy * T::element_size); memset((char *)(new_array + 1) + to_copy * T::element_size, 0,(capacity - to_copy) * T::element_size); diff --git a/vmpp/inline_cache.cpp b/vmpp/inline_cache.cpp index d1835231ad..cfdae972b0 100644 --- a/vmpp/inline_cache.cpp +++ b/vmpp/inline_cache.cpp @@ -33,16 +33,14 @@ void deallocate_inline_cache(CELL return_address) /* Figure out what kind of type check the PIC needs based on the methods it contains */ -static CELL determine_inline_cache_type(CELL cache_entries) +static CELL determine_inline_cache_type(F_ARRAY *cache_entries) { - F_ARRAY *array = untag_array_fast(cache_entries); - - bool seen_hi_tag = false, seen_tuple = false; + bool seen_hi_tag = false, seen_tuple = false; CELL i; - for(i = 0; i < array_capacity(array); i += 2) + for(i = 0; i < array_capacity(cache_entries); i += 2) { - CELL klass = array_nth(array,i); + CELL klass = array_nth(cache_entries,i); F_FIXNUM type; /* Is it a tuple layout? */ @@ -76,7 +74,16 @@ static void update_pic_count(CELL type) pic_counts[type - PIC_TAG]++; } -static void jit_emit_check(F_JIT *jit, CELL klass) +struct inline_cache_jit : public jit { + F_FIXNUM index; + + inline_cache_jit(CELL generic_word_) : jit(PIC_TYPE,generic_word_) {}; + + void emit_check(CELL klass); + void compile_inline_cache(F_FIXNUM index, CELL generic_word_, CELL methods_, CELL cache_entries_); +}; + +void inline_cache_jit::emit_check(CELL klass) { CELL code_template; if(TAG(klass) == FIXNUM_TYPE && untag_fixnum_fast(klass) < HEADER_TYPE) @@ -84,43 +91,34 @@ static void jit_emit_check(F_JIT *jit, CELL klass) else code_template = userenv[PIC_CHECK]; - jit_emit_with(jit,code_template,klass); + emit_with(code_template,klass); } /* index: 0 = top of stack, 1 = item underneath, etc cache_entries: array of class/method pairs */ -static F_CODE_BLOCK *compile_inline_cache(F_FIXNUM index, CELL generic_word, CELL methods, CELL cache_entries) +void inline_cache_jit::compile_inline_cache(F_FIXNUM index, CELL generic_word_, CELL methods_, CELL cache_entries_) { -#ifdef FACTOR_DEBUG - type_check(WORD_TYPE,generic_word); - type_check(ARRAY_TYPE,cache_entries); -#endif - - REGISTER_ROOT(generic_word); - REGISTER_ROOT(methods); - REGISTER_ROOT(cache_entries); - - CELL inline_cache_type = determine_inline_cache_type(cache_entries); + gc_root generic_word(generic_word_); + gc_root methods(methods_); + gc_root cache_entries(cache_entries_); + CELL inline_cache_type = determine_inline_cache_type(cache_entries.untagged()); update_pic_count(inline_cache_type); - F_JIT jit; - jit_init(&jit,PIC_TYPE,generic_word); - /* Generate machine code to determine the object's class. */ - jit_emit_class_lookup(&jit,index,inline_cache_type); + emit_class_lookup(index,inline_cache_type); /* Generate machine code to check, in turn, if the class is one of the cached entries. */ CELL i; - for(i = 0; i < array_capacity(untag_array_fast(cache_entries)); i += 2) + for(i = 0; i < array_capacity(cache_entries.untagged()); i += 2) { /* Class equal? */ - CELL klass = array_nth(untag_array_fast(cache_entries),i); - jit_emit_check(&jit,klass); + CELL klass = array_nth(cache_entries.untagged(),i); + emit_check(klass); /* Yes? Jump to method */ - CELL method = array_nth(untag_array_fast(cache_entries),i + 1); - jit_emit_with(&jit,userenv[PIC_HIT],method); + CELL method = array_nth(cache_entries.untagged(),i + 1); + emit_with(userenv[PIC_HIT],method); } /* Generate machine code to handle a cache miss, which ultimately results in @@ -128,21 +126,26 @@ static F_CODE_BLOCK *compile_inline_cache(F_FIXNUM index, CELL generic_word, CEL The inline-cache-miss primitive call receives enough information to reconstruct the PIC. */ - jit_push(&jit,generic_word); - jit_push(&jit,methods); - jit_push(&jit,tag_fixnum(index)); - jit_push(&jit,cache_entries); - jit_word_jump(&jit,userenv[PIC_MISS_WORD]); + push(generic_word.value()); + push(methods.value()); + push(tag_fixnum(index)); + push(cache_entries.value()); + word_jump(userenv[PIC_MISS_WORD]); +} - F_CODE_BLOCK *code = jit_make_code_block(&jit); +static F_CODE_BLOCK *compile_inline_cache(F_FIXNUM index, + CELL generic_word_, + CELL methods_, + CELL cache_entries_) +{ + gc_root generic_word(generic_word_); + gc_root methods(methods_); + gc_root cache_entries(cache_entries_); + + inline_cache_jit jit(generic_word.value()); + jit.compile_inline_cache(index,generic_word.value(),methods.value(),cache_entries.value()); + F_CODE_BLOCK *code = jit.code_block(); relocate_code_block(code); - - jit_dispose(&jit); - - UNREGISTER_ROOT(cache_entries); - UNREGISTER_ROOT(methods); - UNREGISTER_ROOT(generic_word); - return code; } @@ -154,23 +157,21 @@ static XT megamorphic_call_stub(CELL generic_word) static CELL inline_cache_size(CELL cache_entries) { - return (cache_entries == F ? 0 : array_capacity(untag_array(cache_entries)) / 2); + return array_capacity(untag_array(cache_entries)) / 2; } /* Allocates memory */ -static CELL add_inline_cache_entry(CELL cache_entries, CELL klass, CELL method) +static CELL add_inline_cache_entry(CELL cache_entries_, CELL klass_, CELL method_) { - if(cache_entries == F) - return allot_array_2(klass,method); - else - { - F_ARRAY *cache_entries_array = untag_array_fast(cache_entries); - CELL pic_size = array_capacity(cache_entries_array); - cache_entries_array = reallot_array(cache_entries_array,pic_size + 2); - set_array_nth(cache_entries_array,pic_size,klass); - set_array_nth(cache_entries_array,pic_size + 1,method); - return tag_array(cache_entries_array); - } + gc_root cache_entries(cache_entries_); + gc_root klass(klass_); + gc_root method(method_); + + CELL pic_size = array_capacity(cache_entries.untagged()); + gc_root new_cache_entries(reallot_array(cache_entries.untagged(),pic_size + 2)); + set_array_nth(new_cache_entries.untagged(),pic_size,klass.value()); + set_array_nth(new_cache_entries.untagged(),pic_size + 1,method.value()); + return new_cache_entries.value(); } static void update_pic_transitions(CELL pic_size) @@ -194,35 +195,33 @@ XT inline_cache_miss(CELL return_address) instead of leaving dead PICs around until the next GC. */ deallocate_inline_cache(return_address); - CELL cache_entries = dpop(); + gc_root cache_entries(dpop()); F_FIXNUM index = untag_fixnum_fast(dpop()); - CELL methods = dpop(); - CELL generic_word = dpop(); - CELL object = get(ds - index * CELLS); + gc_root methods(dpop()); + gc_root generic_word(dpop()); + gc_root object(get(ds - index * CELLS)); XT xt; - CELL pic_size = inline_cache_size(cache_entries); + CELL pic_size = inline_cache_size(cache_entries.value()); update_pic_transitions(pic_size); if(pic_size >= max_pic_size) - xt = megamorphic_call_stub(generic_word); + xt = megamorphic_call_stub(generic_word.value()); else { - REGISTER_ROOT(generic_word); - REGISTER_ROOT(cache_entries); - REGISTER_ROOT(methods); + CELL klass = object_class(object.value()); + CELL method = lookup_method(object.value(),methods.value()); - CELL klass = object_class(object); - CELL method = lookup_method(object,methods); - - cache_entries = add_inline_cache_entry(cache_entries,klass,method); - xt = compile_inline_cache(index,generic_word,methods,cache_entries) + 1; - - UNREGISTER_ROOT(methods); - UNREGISTER_ROOT(cache_entries); - UNREGISTER_ROOT(generic_word); + gc_root new_cache_entries(add_inline_cache_entry( + cache_entries.value(), + klass, + method)); + xt = compile_inline_cache(index, + generic_word.value(), + methods.value(), + new_cache_entries.value()) + 1; } /* Install the new stub. */ @@ -244,14 +243,13 @@ void primitive_reset_inline_cache_stats(void) void primitive_inline_cache_stats(void) { - GROWABLE_ARRAY(stats); - GROWABLE_ARRAY_ADD(stats,allot_cell(cold_call_to_ic_transitions)); - GROWABLE_ARRAY_ADD(stats,allot_cell(ic_to_pic_transitions)); - GROWABLE_ARRAY_ADD(stats,allot_cell(pic_to_mega_transitions)); + growable_array stats; + stats.add(allot_cell(cold_call_to_ic_transitions)); + stats.add(allot_cell(ic_to_pic_transitions)); + stats.add(allot_cell(pic_to_mega_transitions)); CELL i; for(i = 0; i < 4; i++) - GROWABLE_ARRAY_ADD(stats,allot_cell(pic_counts[i])); - GROWABLE_ARRAY_TRIM(stats); - GROWABLE_ARRAY_DONE(stats); - dpush(stats); + stats.add(allot_cell(pic_counts[i])); + stats.trim(); + dpush(stats.array.value()); } diff --git a/vmpp/io.cpp b/vmpp/io.cpp index a48b252e2a..4a61a317c2 100755 --- a/vmpp/io.cpp +++ b/vmpp/io.cpp @@ -85,11 +85,11 @@ void primitive_fread(void) return; } - F_BYTE_ARRAY *buf = allot_byte_array(size); + gc_root buf(allot_array_internal(size)); for(;;) { - int c = fread(buf + 1,1,size,file); + int c = fread(buf.untagged() + 1,1,size,file); if(c <= 0) { if(feof(file)) @@ -104,13 +104,11 @@ void primitive_fread(void) { if(c != size) { - REGISTER_UNTAGGED(buf); F_BYTE_ARRAY *new_buf = allot_byte_array(c); - UNREGISTER_UNTAGGED(F_BYTE_ARRAY,buf); - memcpy(new_buf + 1, buf + 1,c); + memcpy(new_buf + 1, buf.untagged() + 1,c); buf = new_buf; } - dpush(tag_object(buf)); + dpush(buf.value()); break; } } diff --git a/vmpp/jit.cpp b/vmpp/jit.cpp index d5196ed663..e9018af682 100644 --- a/vmpp/jit.cpp +++ b/vmpp/jit.cpp @@ -1,68 +1,26 @@ #include "master.hpp" /* Simple code generator used by: -- profiler (profiler.c), -- quotation compiler (quotations.c), -- megamorphic caches (dispatch.c), -- polymorphic inline caches (inline_cache.c) */ +- profiler (profiler.cpp), +- quotation compiler (quotations.cpp), +- megamorphic caches (dispatch.cpp), +- polymorphic inline caches (inline_cache.cpp) */ /* Allocates memory */ -void jit_init(F_JIT *jit, CELL jit_type, CELL owner) +jit::jit(CELL type_, CELL owner_) + : type(type_), + owner(owner_), + code(), + relocation(), + literals(), + computing_offset_p(false), + position(0), + offset(0) { - jit->owner = owner; - REGISTER_ROOT(jit->owner); - - jit->type = jit_type; - - jit->code = make_growable_byte_array(); - REGISTER_ROOT(jit->code.array); - jit->relocation = make_growable_byte_array(); - REGISTER_ROOT(jit->relocation.array); - jit->literals = make_growable_array(); - REGISTER_ROOT(jit->literals.array); - - if(stack_traces_p()) - growable_array_add(&jit->literals,jit->owner); - - jit->computing_offset_p = false; + if(stack_traces_p()) literal(owner.value()); } -/* Facility to convert compiled code offsets to quotation offsets. -Call jit_compute_offset() with the compiled code offset, then emit -code, and at the end jit->position is the quotation position. */ -void jit_compute_position(F_JIT *jit, CELL offset) -{ - jit->computing_offset_p = true; - jit->position = 0; - jit->offset = offset; -} - -/* Allocates memory */ -F_CODE_BLOCK *jit_make_code_block(F_JIT *jit) -{ - growable_byte_array_trim(&jit->code); - growable_byte_array_trim(&jit->relocation); - growable_array_trim(&jit->literals); - - F_CODE_BLOCK *code = add_code_block( - jit->type, - untag_byte_array_fast(jit->code.array), - NULL, /* no labels */ - jit->relocation.array, - jit->literals.array); - - return code; -} - -void jit_dispose(F_JIT *jit) -{ - UNREGISTER_ROOT(jit->literals.array); - UNREGISTER_ROOT(jit->relocation.array); - UNREGISTER_ROOT(jit->code.array); - UNREGISTER_ROOT(jit->owner); -} - -static F_REL rel_to_emit(F_JIT *jit, CELL code_template, bool *rel_p) +F_REL jit::rel_to_emit(CELL code_template, bool *rel_p) { F_ARRAY *quadruple = untag_array_fast(code_template); CELL rel_class = array_nth(quadruple,1); @@ -79,45 +37,78 @@ static F_REL rel_to_emit(F_JIT *jit, CELL code_template, bool *rel_p) *rel_p = true; return (untag_fixnum_fast(rel_type) << 28) | (untag_fixnum_fast(rel_class) << 24) - | ((jit->code.count + untag_fixnum_fast(offset))); + | ((code.count + untag_fixnum_fast(offset))); } } /* Allocates memory */ -void jit_emit(F_JIT *jit, CELL code_template) +void jit::emit(CELL code_template_) { -#ifdef FACTOR_DEBUG - type_check(ARRAY_TYPE,code_template); -#endif - - REGISTER_ROOT(code_template); + gc_root code_template(code_template_); bool rel_p; - F_REL rel = rel_to_emit(jit,code_template,&rel_p); - if(rel_p) growable_byte_array_append(&jit->relocation,&rel,sizeof(F_REL)); + F_REL rel = rel_to_emit(code_template.value(),&rel_p); + if(rel_p) relocation.append_bytes(&rel,sizeof(F_REL)); - F_BYTE_ARRAY *code = code_to_emit(code_template); + gc_root insns(array_nth(code_template.untagged(),0)); - if(jit->computing_offset_p) + if(computing_offset_p) { - CELL size = array_capacity(code); + CELL size = array_capacity(insns.untagged()); - if(jit->offset == 0) + if(offset == 0) { - jit->position--; - jit->computing_offset_p = false; + position--; + computing_offset_p = false; } - else if(jit->offset < size) + else if(offset < size) { - jit->position++; - jit->computing_offset_p = false; + position++; + computing_offset_p = false; } else - jit->offset -= size; + offset -= size; } - growable_byte_array_append(&jit->code,code + 1,array_capacity(code)); - - UNREGISTER_ROOT(code_template); + code.append_byte_array(insns.value()); } +void jit::emit_with(CELL code_template_, CELL argument_) { + gc_root code_template(code_template_); + gc_root argument(argument_); + literal(argument.value()); + emit(code_template.value()); +} + +void jit::emit_class_lookup(F_FIXNUM index, CELL type) +{ + emit_with(userenv[PIC_LOAD],tag_fixnum(-index * CELLS)); + emit(userenv[type]); +} + +/* Facility to convert compiled code offsets to quotation offsets. +Call jit_compute_offset() with the compiled code offset, then emit +code, and at the end jit->position is the quotation position. */ +void jit::compute_position(CELL offset_) +{ + computing_offset_p = true; + position = 0; + offset = offset_; +} + +/* Allocates memory */ +F_CODE_BLOCK *jit::code_block() +{ + code.trim(); + relocation.trim(); + literals.trim(); + + return add_code_block( + type, + code.array.value(), + F, /* no labels */ + relocation.array.value(), + literals.array.value()); +} + + diff --git a/vmpp/jit.hpp b/vmpp/jit.hpp index e6219ed8c7..a2233aa4fb 100644 --- a/vmpp/jit.hpp +++ b/vmpp/jit.hpp @@ -1,92 +1,58 @@ -typedef struct { +struct jit { CELL type; - CELL owner; - F_GROWABLE_BYTE_ARRAY code; - F_GROWABLE_BYTE_ARRAY relocation; - F_GROWABLE_ARRAY literals; + gc_root owner; + growable_byte_array code; + growable_byte_array relocation; + growable_array literals; bool computing_offset_p; F_FIXNUM position; CELL offset; -} F_JIT; -void jit_init(F_JIT *jit, CELL jit_type, CELL owner); + jit(CELL jit_type, CELL owner); + void compute_position(CELL offset); -void jit_compute_position(F_JIT *jit, CELL offset); + F_REL rel_to_emit(CELL code_template, bool *rel_p); + void emit(CELL code_template); -F_CODE_BLOCK *jit_make_code_block(F_JIT *jit); + void literal(CELL literal) { literals.add(literal); } + void emit_with(CELL code_template_, CELL literal_); -void jit_dispose(F_JIT *jit); - -INLINE F_BYTE_ARRAY *code_to_emit(CELL code_template) -{ - return untag_byte_array_fast(array_nth(untag_array_fast(code_template),0)); -} - -void jit_emit(F_JIT *jit, CELL code_template); - -/* Allocates memory */ -INLINE void jit_add_literal(F_JIT *jit, CELL literal) -{ -#ifdef FACTOR_DEBUG - type_of(literal); -#endif - growable_array_add(&jit->literals,literal); -} - -/* Allocates memory */ -INLINE void jit_emit_with(F_JIT *jit, CELL code_template, CELL argument) -{ - REGISTER_ROOT(code_template); - jit_add_literal(jit,argument); - UNREGISTER_ROOT(code_template); - jit_emit(jit,code_template); -} - -/* Allocates memory */ -INLINE void jit_push(F_JIT *jit, CELL literal) -{ - jit_emit_with(jit,userenv[JIT_PUSH_IMMEDIATE],literal); -} - -/* Allocates memory */ -INLINE void jit_word_jump(F_JIT *jit, CELL word) -{ - jit_emit_with(jit,userenv[JIT_WORD_JUMP],word); -} - -/* Allocates memory */ -INLINE void jit_word_call(F_JIT *jit, CELL word) -{ - jit_emit_with(jit,userenv[JIT_WORD_CALL],word); -} - -/* Allocates memory */ -INLINE void jit_emit_subprimitive(F_JIT *jit, CELL word) -{ - CELL code_template = untag_word_fast(word)->subprimitive; - REGISTER_ROOT(code_template); - - if(array_nth(untag_array_fast(code_template),1) != F) - jit_add_literal(jit,T); - - jit_emit(jit,code_template); - UNREGISTER_ROOT(code_template); -} - -INLINE F_FIXNUM jit_get_position(F_JIT *jit) -{ - if(jit->computing_offset_p) - { - /* If this is still on, jit_emit() didn't clear it, - so the offset was out of bounds */ - return -1; + void push(CELL literal) { + emit_with(userenv[JIT_PUSH_IMMEDIATE],literal); } - else - return jit->position; -} -INLINE void jit_set_position(F_JIT *jit, F_FIXNUM position) -{ - if(jit->computing_offset_p) - jit->position = position; -} + void word_jump(CELL word) { + emit_with(userenv[JIT_WORD_JUMP],word); + } + + void word_call(CELL word) { + emit_with(userenv[JIT_WORD_CALL],word); + } + + void emit_subprimitive(CELL word) { + gc_root code_template(untagged(word)->subprimitive); + if(array_nth(code_template.untagged(),1) != F) literal(T); + emit(code_template.value()); + } + + void emit_class_lookup(F_FIXNUM index, CELL type); + + F_FIXNUM get_position() { + if(computing_offset_p) + { + /* If this is still on, emit() didn't clear it, + so the offset was out of bounds */ + return -1; + } + else + return position; + } + + void set_position(F_FIXNUM position_) { + if(computing_offset_p) + position = position_; + } + + + F_CODE_BLOCK *code_block(); +}; diff --git a/vmpp/layouts.hpp b/vmpp/layouts.hpp index 75f91c41e5..340d9d3f77 100755 --- a/vmpp/layouts.hpp +++ b/vmpp/layouts.hpp @@ -81,6 +81,7 @@ INLINE CELL tag_fixnum(F_FIXNUM untagged) typedef void *XT; struct F_OBJECT { + static const CELL type_number = TYPE_COUNT; CELL header; }; diff --git a/vmpp/local_roots.hpp b/vmpp/local_roots.hpp index 2a5d3559e5..6dee443f78 100644 --- a/vmpp/local_roots.hpp +++ b/vmpp/local_roots.hpp @@ -7,28 +7,19 @@ extern CELL gc_locals; DEFPUSHPOP(gc_local_,gc_locals) template -class gc_root : public tagged +struct gc_root : public tagged { void push() { gc_local_push((CELL)this); } -public: + explicit gc_root(CELL value_) : tagged(value_) { push(); } explicit gc_root(T *value_) : tagged(value_) { push(); } - gc_root(const gc_root& copy) : tagged(copy.untag()) {} + + const gc_root& operator=(const T *x) { tagged::operator=(x); return *this; } + const gc_root& operator=(const CELL &x) { tagged::operator=(x); return *this; } + ~gc_root() { CELL old = gc_local_pop(); assert(old == (CELL)this); } }; -#define REGISTER_ROOT(obj) \ - { \ - if(!immediate_p(obj)) \ - check_data_pointer(obj); \ - gc_local_push((CELL)&(obj)); \ - } -#define UNREGISTER_ROOT(obj) \ - { \ - if(gc_local_pop() != (CELL)&(obj)) \ - critical_error("Mismatched REGISTER_ROOT/UNREGISTER_ROOT",0); \ - } - /* Extra roots: stores pointers to objects in the heap. Requires extra work (you have to unregister before accessing the object) but more flexible. */ extern F_SEGMENT *extra_roots_region; @@ -36,9 +27,6 @@ extern CELL extra_roots; DEFPUSHPOP(root_,extra_roots) -#define REGISTER_UNTAGGED(obj) root_push(obj ? RETAG(obj,OBJECT_TYPE) : 0) -#define UNREGISTER_UNTAGGED(type,obj) obj = (type *)UNTAG(root_pop()) - /* We ignore strings which point outside the data heap, but we might be given a char* which points inside the data heap, in which case it is a root, for example if we call unbox_char_string() the result is placed in a byte array */ diff --git a/vmpp/master.hpp b/vmpp/master.hpp index 3ba7b70813..172886c946 100644 --- a/vmpp/master.hpp +++ b/vmpp/master.hpp @@ -21,10 +21,10 @@ #include #include "layouts.hpp" -#include "tagged.hpp" #include "platform.hpp" #include "primitives.hpp" #include "run.hpp" +#include "tagged.hpp" #include "profiler.hpp" #include "errors.hpp" #include "bignumint.hpp" @@ -50,8 +50,8 @@ #include "image.hpp" #include "callstack.hpp" #include "alien.hpp" -#include "quotations.hpp" #include "jit.hpp" +#include "quotations.hpp" #include "dispatch.hpp" #include "inline_cache.hpp" #include "factor.hpp" diff --git a/vmpp/math.hpp b/vmpp/math.hpp index 2f80cc7732..20c762d485 100644 --- a/vmpp/math.hpp +++ b/vmpp/math.hpp @@ -96,7 +96,7 @@ INLINE double untag_float(CELL tagged) INLINE CELL allot_float(double n) { - F_FLOAT* flo = (F_FLOAT *)allot_object(FLOAT_TYPE,sizeof(F_FLOAT)); + F_FLOAT *flo = allot(sizeof(F_FLOAT)); flo->n = n; return RETAG(flo,FLOAT_TYPE); } diff --git a/vmpp/profiler.cpp b/vmpp/profiler.cpp index 9a78ae57e7..0dea08254b 100755 --- a/vmpp/profiler.cpp +++ b/vmpp/profiler.cpp @@ -8,16 +8,14 @@ void init_profiler(void) } /* Allocates memory */ -F_CODE_BLOCK *compile_profiling_stub(CELL word) +F_CODE_BLOCK *compile_profiling_stub(CELL word_) { - REGISTER_ROOT(word); - F_JIT jit; - jit_init(&jit,WORD_TYPE,word); - jit_emit_with(&jit,userenv[JIT_PROFILING],word); - F_CODE_BLOCK *block = jit_make_code_block(&jit); - jit_dispose(&jit); - UNREGISTER_ROOT(word); - return block; + gc_root word(word_); + + jit jit(WORD_TYPE,word.value()); + jit.emit_with(userenv[JIT_PROFILING],word.value()); + + return jit.code_block(); } /* Allocates memory */ @@ -32,22 +30,18 @@ static void set_profiling(bool profiling) and allocate profiling blocks if necessary */ gc(); - CELL words = find_all_words(); - - REGISTER_ROOT(words); + gc_root words(find_all_words()); CELL i; - CELL length = array_capacity(untag_array_fast(words)); + CELL length = array_capacity(words.untagged()); for(i = 0; i < length; i++) { - F_WORD *word = untag_word(array_nth(untag_array(words),i)); + tagged word(array_nth(words.untagged(),i)); if(profiling) word->counter = tag_fixnum(0); - update_word_xt(word); + update_word_xt(word.value()); } - UNREGISTER_ROOT(words); - /* Update XTs in code heap */ iterate_code_heap(relocate_code_block); } diff --git a/vmpp/quotations.cpp b/vmpp/quotations.cpp index 8747e4ea3f..e61f8b36ed 100755 --- a/vmpp/quotations.cpp +++ b/vmpp/quotations.cpp @@ -33,70 +33,67 @@ includes stack shufflers, some fixnum arithmetic words, and words such as tag, slot and eq?. A primitive call is relatively expensive (two subroutine calls) so this results in a big speedup for relatively little effort. */ -static bool jit_primitive_call_p(F_ARRAY *array, CELL i) +bool quotation_jit::primitive_call_p(CELL i) { - return (i + 2) == array_capacity(array) - && type_of(array_nth(array,i)) == FIXNUM_TYPE - && array_nth(array,i + 1) == userenv[JIT_PRIMITIVE_WORD]; + return (i + 2) == array_capacity(array.untagged()) + && type_of(array_nth(array.untagged(),i)) == FIXNUM_TYPE + && array_nth(array.untagged(),i + 1) == userenv[JIT_PRIMITIVE_WORD]; } -static bool jit_fast_if_p(F_ARRAY *array, CELL i) +bool quotation_jit::fast_if_p(CELL i) { - return (i + 3) == array_capacity(array) - && type_of(array_nth(array,i)) == QUOTATION_TYPE - && type_of(array_nth(array,i + 1)) == QUOTATION_TYPE - && array_nth(array,i + 2) == userenv[JIT_IF_WORD]; + return (i + 3) == array_capacity(array.untagged()) + && type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE + && type_of(array_nth(array.untagged(),i + 1)) == QUOTATION_TYPE + && array_nth(array.untagged(),i + 2) == userenv[JIT_IF_WORD]; } -static bool jit_fast_dip_p(F_ARRAY *array, CELL i) +bool quotation_jit::fast_dip_p(CELL i) { - return (i + 2) <= array_capacity(array) - && type_of(array_nth(array,i)) == QUOTATION_TYPE - && array_nth(array,i + 1) == userenv[JIT_DIP_WORD]; + return (i + 2) <= array_capacity(array.untagged()) + && type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE + && array_nth(array.untagged(),i + 1) == userenv[JIT_DIP_WORD]; } -static bool jit_fast_2dip_p(F_ARRAY *array, CELL i) +bool quotation_jit::fast_2dip_p(CELL i) { - return (i + 2) <= array_capacity(array) - && type_of(array_nth(array,i)) == QUOTATION_TYPE - && array_nth(array,i + 1) == userenv[JIT_2DIP_WORD]; + return (i + 2) <= array_capacity(array.untagged()) + && type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE + && array_nth(array.untagged(),i + 1) == userenv[JIT_2DIP_WORD]; } -static bool jit_fast_3dip_p(F_ARRAY *array, CELL i) +bool quotation_jit::fast_3dip_p(CELL i) { - return (i + 2) <= array_capacity(array) - && type_of(array_nth(array,i)) == QUOTATION_TYPE - && array_nth(array,i + 1) == userenv[JIT_3DIP_WORD]; + return (i + 2) <= array_capacity(array.untagged()) + && type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE + && array_nth(array.untagged(),i + 1) == userenv[JIT_3DIP_WORD]; } -static bool jit_mega_lookup_p(F_ARRAY *array, CELL i) +bool quotation_jit::mega_lookup_p(CELL i) { - return (i + 3) < array_capacity(array) - && type_of(array_nth(array,i)) == ARRAY_TYPE - && type_of(array_nth(array,i + 1)) == FIXNUM_TYPE - && type_of(array_nth(array,i + 2)) == ARRAY_TYPE - && array_nth(array,i + 3) == userenv[MEGA_LOOKUP_WORD]; + return (i + 3) < array_capacity(array.untagged()) + && type_of(array_nth(array.untagged(),i)) == ARRAY_TYPE + && type_of(array_nth(array.untagged(),i + 1)) == FIXNUM_TYPE + && type_of(array_nth(array.untagged(),i + 2)) == ARRAY_TYPE + && array_nth(array.untagged(),i + 3) == userenv[MEGA_LOOKUP_WORD]; } -static bool jit_stack_frame_p(F_ARRAY *array) +bool quotation_jit::stack_frame_p() { - F_FIXNUM length = array_capacity(array); + F_FIXNUM length = array_capacity(array.untagged()); F_FIXNUM i; for(i = 0; i < length - 1; i++) { - CELL obj = array_nth(array,i); + CELL obj = array_nth(array.untagged(),i); if(type_of(obj) == WORD_TYPE) { - F_WORD *word = untag_word_fast(obj); - if(word->subprimitive == F) + if(untagged(obj)->subprimitive == F) return true; } else if(type_of(obj) == QUOTATION_TYPE) { - if(jit_fast_dip_p(array,i) - || jit_fast_2dip_p(array,i) - || jit_fast_3dip_p(array,i)) + if(fast_dip_p(i) || fast_2dip_p(i) || fast_3dip_p(i)) return true; } } @@ -104,78 +101,66 @@ static bool jit_stack_frame_p(F_ARRAY *array) return false; } -#define TAIL_CALL { \ - if(stack_frame) jit_emit(jit,userenv[JIT_EPILOG]); \ - tail_call = true; \ - } - /* Allocates memory */ -static void jit_iterate_quotation(F_JIT *jit, CELL array, CELL compiling, CELL relocate) +void quotation_jit::iterate_quotation() { - REGISTER_ROOT(array); + bool stack_frame = stack_frame_p(); - bool stack_frame = jit_stack_frame_p(untag_array_fast(array)); - - jit_set_position(jit,0); + set_position(0); if(stack_frame) - jit_emit(jit,userenv[JIT_PROLOG]); + emit(userenv[JIT_PROLOG]); CELL i; - CELL length = array_capacity(untag_array_fast(array)); + CELL length = array_capacity(array.untagged()); bool tail_call = false; for(i = 0; i < length; i++) { - jit_set_position(jit,i); + set_position(i); - CELL obj = array_nth(untag_array_fast(array),i); - REGISTER_ROOT(obj); + gc_root obj(array_nth(array.untagged(),i)); - F_WORD *word; - F_WRAPPER *wrapper; - - switch(type_of(obj)) + switch(obj.type()) { case WORD_TYPE: - word = untag_word_fast(obj); - /* Intrinsics */ - if(word->subprimitive != F) - jit_emit_subprimitive(jit,obj); + if(obj.as()->subprimitive != F) + emit_subprimitive(obj.value()); /* The (execute) primitive is special-cased */ - else if(obj == userenv[JIT_EXECUTE_WORD]) + else if(obj.value() == userenv[JIT_EXECUTE_WORD]) { if(i == length - 1) { - TAIL_CALL; - jit_emit(jit,userenv[JIT_EXECUTE_JUMP]); + if(stack_frame) emit(userenv[JIT_EPILOG]); + tail_call = true; + emit(userenv[JIT_EXECUTE_JUMP]); } else - jit_emit(jit,userenv[JIT_EXECUTE_CALL]); + emit(userenv[JIT_EXECUTE_CALL]); } /* Everything else */ else { if(i == length - 1) { - TAIL_CALL; - jit_word_jump(jit,obj); + if(stack_frame) emit(userenv[JIT_EPILOG]); + tail_call = true; + word_jump(obj.value()); } else - jit_word_call(jit,obj); + word_call(obj.value()); } break; case WRAPPER_TYPE: - wrapper = untag_wrapper_fast(obj); - jit_push(jit,wrapper->object); + push(obj.as()->object); break; case FIXNUM_TYPE: /* Primitive calls */ - if(jit_primitive_call_p(untag_array_fast(array),i)) + if(primitive_call_p(i)) { - jit_emit(jit,userenv[JIT_SAVE_STACK]); - jit_emit_with(jit,userenv[JIT_PRIMITIVE],obj); + emit(userenv[JIT_SAVE_STACK]); + emit_with(userenv[JIT_PRIMITIVE],obj.value()); i++; @@ -185,80 +170,77 @@ static void jit_iterate_quotation(F_JIT *jit, CELL array, CELL compiling, CELL r case QUOTATION_TYPE: /* 'if' preceeded by two literal quotations (this is why if and ? are mutually recursive in the library, but both still work) */ - if(jit_fast_if_p(untag_array_fast(array),i)) + if(fast_if_p(i)) { - TAIL_CALL; + if(stack_frame) emit(userenv[JIT_EPILOG]); + tail_call = true; if(compiling) { - jit_compile(array_nth(untag_array_fast(array),i),relocate); - jit_compile(array_nth(untag_array_fast(array),i + 1),relocate); + jit_compile(array_nth(array.untagged(),i),relocate); + jit_compile(array_nth(array.untagged(),i + 1),relocate); } - jit_emit_with(jit,userenv[JIT_IF_1],array_nth(untag_array_fast(array),i)); - jit_emit_with(jit,userenv[JIT_IF_2],array_nth(untag_array_fast(array),i + 1)); + emit_with(userenv[JIT_IF_1],array_nth(array.untagged(),i)); + emit_with(userenv[JIT_IF_2],array_nth(array.untagged(),i + 1)); i += 2; break; } /* dip */ - else if(jit_fast_dip_p(untag_array_fast(array),i)) + else if(fast_dip_p(i)) { if(compiling) - jit_compile(obj,relocate); - jit_emit_with(jit,userenv[JIT_DIP],obj); + jit_compile(obj.value(),relocate); + emit_with(userenv[JIT_DIP],obj.value()); i++; break; } /* 2dip */ - else if(jit_fast_2dip_p(untag_array_fast(array),i)) + else if(fast_2dip_p(i)) { if(compiling) - jit_compile(obj,relocate); - jit_emit_with(jit,userenv[JIT_2DIP],obj); + jit_compile(obj.value(),relocate); + emit_with(userenv[JIT_2DIP],obj.value()); i++; break; } /* 3dip */ - else if(jit_fast_3dip_p(untag_array_fast(array),i)) + else if(fast_3dip_p(i)) { if(compiling) - jit_compile(obj,relocate); - jit_emit_with(jit,userenv[JIT_3DIP],obj); + jit_compile(obj.value(),relocate); + emit_with(userenv[JIT_3DIP],obj.value()); i++; break; } case ARRAY_TYPE: /* Method dispatch */ - if(jit_mega_lookup_p(untag_array_fast(array),i)) + if(mega_lookup_p(i)) { - jit_emit_mega_cache_lookup(jit, - array_nth(untag_array_fast(array),i), - untag_fixnum_fast(array_nth(untag_array_fast(array),i + 1)), - array_nth(untag_array_fast(array),i + 2)); + emit_mega_cache_lookup( + array_nth(array.untagged(),i), + untag_fixnum_fast(array_nth(array.untagged(),i + 1)), + array_nth(array.untagged(),i + 2)); i += 3; tail_call = true; break; } default: - jit_push(jit,obj); + push(obj.value()); break; } - - UNREGISTER_ROOT(obj); } if(!tail_call) { - jit_set_position(jit,length); + set_position(length); if(stack_frame) - jit_emit(jit,userenv[JIT_EPILOG]); - jit_emit(jit,userenv[JIT_RETURN]); + emit(userenv[JIT_EPILOG]); + emit(userenv[JIT_RETURN]); } - - UNREGISTER_ROOT(array); } void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code) @@ -272,56 +254,26 @@ void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code) } /* Allocates memory */ -void jit_compile(CELL quot, bool relocate) +void jit_compile(CELL quot_, bool relocating) { - if(untag_quotation(quot)->compiledp != F) - return; + gc_root quot(quot_); + if(quot->compiledp != F) return; - CELL array = untag_quotation(quot)->array; + quotation_jit jit(quot.value(),true,relocating); + jit.iterate_quotation(); - REGISTER_ROOT(quot); - REGISTER_ROOT(array); + F_CODE_BLOCK *compiled = jit.code_block(); + set_quot_xt(quot.untagged(),compiled); - F_JIT jit; - jit_init(&jit,QUOTATION_TYPE,quot); - - jit_iterate_quotation(&jit,array,true,relocate); - - F_CODE_BLOCK *compiled = jit_make_code_block(&jit); - - set_quot_xt(untag_quotation_fast(quot),compiled); - - if(relocate) relocate_code_block(compiled); - - jit_dispose(&jit); - - UNREGISTER_ROOT(array); - UNREGISTER_ROOT(quot); + if(relocating) relocate_code_block(compiled); } -F_FIXNUM quot_code_offset_to_scan(CELL quot, CELL offset) -{ - CELL array = untag_quotation(quot)->array; - REGISTER_ROOT(array); - - F_JIT jit; - jit_init(&jit,QUOTATION_TYPE,quot); - jit_compute_position(&jit,offset); - jit_iterate_quotation(&jit,array,false,false); - jit_dispose(&jit); - - UNREGISTER_ROOT(array); - - return jit_get_position(&jit); -} - -F_FASTCALL CELL lazy_jit_compile_impl(CELL quot, F_STACK_FRAME *stack) +F_FASTCALL CELL lazy_jit_compile_impl(CELL quot_, F_STACK_FRAME *stack) { + gc_root quot(quot_); stack_chain->callstack_top = stack; - REGISTER_ROOT(quot); - jit_compile(quot,true); - UNREGISTER_ROOT(quot); - return quot; + jit_compile(quot.value(),true); + return quot.value(); } void primitive_jit_compile(void) @@ -332,7 +284,7 @@ void primitive_jit_compile(void) /* push a new quotation on the stack */ void primitive_array_to_quotation(void) { - F_QUOTATION *quot = (F_QUOTATION *)allot_object(QUOTATION_TYPE,sizeof(F_QUOTATION)); + F_QUOTATION *quot = allot(sizeof(F_QUOTATION)); quot->array = dpeek(); quot->xt = (void *)lazy_jit_compile; quot->compiledp = F; @@ -349,26 +301,33 @@ void primitive_quotation_xt(void) void compile_all_words(void) { - CELL words = find_all_words(); - - REGISTER_ROOT(words); + gc_root words(find_all_words()); CELL i; - CELL length = array_capacity(untag_array(words)); + CELL length = array_capacity(words.untagged()); for(i = 0; i < length; i++) { - F_WORD *word = untag_word(array_nth(untag_array(words),i)); - REGISTER_UNTAGGED(word); + gc_root word(array_nth(words.untagged(),i)); - if(!word->code || !word_optimized_p(word)) - jit_compile_word(word,word->def,false); + if(!word->code || !word_optimized_p(word.untagged())) + jit_compile_word(word.value(),word->def,false); - UNREGISTER_UNTAGGED(F_WORD,word); - update_word_xt(word); + update_word_xt(word.value()); } - UNREGISTER_ROOT(words); - iterate_code_heap(relocate_code_block); } + +/* Allocates memory */ +F_FIXNUM quot_code_offset_to_scan(CELL quot_, CELL offset) +{ + gc_root quot(quot_); + gc_root array(quot->array); + + quotation_jit jit(quot.value(),false,false); + jit.compute_position(offset); + jit.iterate_quotation(); + + return jit.get_position(); +} diff --git a/vmpp/quotations.hpp b/vmpp/quotations.hpp index f3dc9920de..f802f46b64 100755 --- a/vmpp/quotations.hpp +++ b/vmpp/quotations.hpp @@ -5,12 +5,37 @@ INLINE CELL tag_quotation(F_QUOTATION *quotation) return RETAG(quotation,QUOTATION_TYPE); } +struct quotation_jit : public jit { + gc_root array; + bool compiling, relocate; + + quotation_jit(CELL quot, bool compiling_, bool relocate_) + : jit(QUOTATION_TYPE,quot), + array(owner.as().untagged()->array), + compiling(compiling_), + relocate(relocate_) {}; + + void emit_mega_cache_lookup(CELL methods, F_FIXNUM index, CELL cache); + bool primitive_call_p(CELL i); + bool fast_if_p(CELL i); + bool fast_dip_p(CELL i); + bool fast_2dip_p(CELL i); + bool fast_3dip_p(CELL i); + bool mega_lookup_p(CELL i); + bool stack_frame_p(); + void iterate_quotation(); +}; + void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code); void jit_compile(CELL quot, bool relocate); F_FIXNUM quot_code_offset_to_scan(CELL quot, CELL offset); -void primitive_array_to_quotation(void); -void primitive_quotation_xt(void); + void primitive_jit_compile(void); -void compile_all_words(void); F_FASTCALL CELL lazy_jit_compile_impl(CELL quot, F_STACK_FRAME *stack); + +void compile_all_words(void); + +void primitive_array_to_quotation(void); +void primitive_quotation_xt(void); + diff --git a/vmpp/run.cpp b/vmpp/run.cpp index 588caacc74..9b46e85f7d 100755 --- a/vmpp/run.cpp +++ b/vmpp/run.cpp @@ -231,19 +231,19 @@ void primitive_load_locals(void) rs += CELLS * count; } -static CELL clone_object(CELL object) +static CELL clone_object(CELL object_) { - CELL size = object_size(object); + gc_root object(object_); + + CELL size = object_size(object.value()); if(size == 0) - return object; + return object.value(); else { - REGISTER_ROOT(object); - void *new_obj = allot_object(type_of(object),size); - UNREGISTER_ROOT(object); + void *new_obj = allot_object(object.type(),size); - CELL tag = TAG(object); - memcpy(new_obj,(void*)UNTAG(object),size); + CELL tag = TAG(object.value()); + memcpy(new_obj,object.untagged(),size); return RETAG(new_obj,tag); } } diff --git a/vmpp/strings.cpp b/vmpp/strings.cpp index fcb7dbcf97..a69e7dd3c7 100644 --- a/vmpp/strings.cpp +++ b/vmpp/strings.cpp @@ -17,20 +17,21 @@ CELL string_nth(F_STRING* string, CELL index) } } -void set_string_nth_fast(F_STRING* string, CELL index, CELL ch) +void set_string_nth_fast(F_STRING *string, CELL index, CELL ch) { bput(SREF(string,index),ch); } -void set_string_nth_slow(F_STRING* string, CELL index, CELL ch) +void set_string_nth_slow(F_STRING *string_, CELL index, CELL ch) { + gc_root string(string_); + F_BYTE_ARRAY *aux; - bput(SREF(string,index),(ch & 0x7f) | 0x80); + bput(SREF(string.untagged(),index),(ch & 0x7f) | 0x80); if(string->aux == F) { - REGISTER_UNTAGGED(string); /* We don't need to pre-initialize the byte array with any data, since we only ever read from the aux vector @@ -40,9 +41,8 @@ void set_string_nth_slow(F_STRING* string, CELL index, CELL ch) aux = allot_array_internal( untag_fixnum_fast(string->length) * sizeof(u16)); - UNREGISTER_UNTAGGED(F_STRING,string); - write_barrier((CELL)string); + write_barrier(string.value()); string->aux = tag_object(aux); } else @@ -60,10 +60,10 @@ void set_string_nth(F_STRING* string, CELL index, CELL ch) set_string_nth_slow(string,index,ch); } -/* untagged */ -F_STRING* allot_string_internal(CELL capacity) +/* Allocates memory */ +F_STRING *allot_string_internal(CELL capacity) { - F_STRING *string = (F_STRING *)allot_object(STRING_TYPE,string_size(capacity)); + F_STRING *string = allot(string_size(capacity)); string->length = tag_fixnum(capacity); string->hashcode = F; @@ -72,32 +72,28 @@ F_STRING* allot_string_internal(CELL capacity) return string; } -/* allocates memory */ -void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill) +/* Allocates memory */ +void fill_string(F_STRING *string_, CELL start, CELL capacity, CELL fill) { + gc_root string(string_); + if(fill <= 0x7f) - memset((void *)SREF(string,start),fill,capacity - start); + memset((void *)SREF(string.untagged(),start),fill,capacity - start); else { CELL i; for(i = start; i < capacity; i++) - { - REGISTER_UNTAGGED(string); - set_string_nth(string,i,fill); - UNREGISTER_UNTAGGED(F_STRING,string); - } + set_string_nth(string.untagged(),i,fill); } } -/* untagged */ +/* Allocates memory */ F_STRING *allot_string(CELL capacity, CELL fill) { - F_STRING* string = allot_string_internal(capacity); - REGISTER_UNTAGGED(string); - fill_string(string,0,capacity,fill); - UNREGISTER_UNTAGGED(F_STRING,string); - return string; + gc_root string(allot_string_internal(capacity)); + fill_string(string.untagged(),0,capacity,fill); + return string.untagged(); } void primitive_string(void) @@ -112,9 +108,11 @@ static bool reallot_string_in_place_p(F_STRING *string, CELL capacity) return in_zone(&nursery,(CELL)string) && capacity <= string_capacity(string); } -F_STRING* reallot_string(F_STRING* string, CELL capacity) +F_STRING* reallot_string(F_STRING *string_, CELL capacity) { - if(reallot_string_in_place_p(string,capacity)) + gc_root string(string_); + + if(reallot_string_in_place_p(string.untagged(),capacity)) { string->length = tag_fixnum(capacity); @@ -124,42 +122,31 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity) aux->capacity = tag_fixnum(capacity * 2); } - return string; + return string.untagged(); } else { - CELL to_copy = string_capacity(string); + CELL to_copy = string_capacity(string.untagged()); if(capacity < to_copy) to_copy = capacity; - REGISTER_UNTAGGED(string); - F_STRING *new_string = allot_string_internal(capacity); - UNREGISTER_UNTAGGED(F_STRING,string); + gc_root new_string(allot_string_internal(capacity)); - memcpy(new_string + 1,string + 1,to_copy); + memcpy(new_string.untagged() + 1,string.untagged() + 1,to_copy); if(string->aux != F) { - REGISTER_UNTAGGED(string); - REGISTER_UNTAGGED(new_string); F_BYTE_ARRAY *new_aux = allot_byte_array(capacity * sizeof(u16)); - UNREGISTER_UNTAGGED(F_STRING,new_string); - UNREGISTER_UNTAGGED(F_STRING,string); - write_barrier((CELL)new_string); + write_barrier(new_string.value()); new_string->aux = tag_object(new_aux); F_BYTE_ARRAY *aux = untag_byte_array_fast(string->aux); memcpy(new_aux + 1,aux + 1,to_copy * sizeof(u16)); } - REGISTER_UNTAGGED(string); - REGISTER_UNTAGGED(new_string); - fill_string(new_string,to_copy,capacity,'\0'); - UNREGISTER_UNTAGGED(F_STRING,new_string); - UNREGISTER_UNTAGGED(F_STRING,string); - - return new_string; + fill_string(new_string.untagged(),to_copy,capacity,'\0'); + return new_string.untagged(); } } @@ -175,18 +162,16 @@ void primitive_resize_string(void) #define MEMORY_TO_STRING(type,utype) \ F_STRING *memory_to_##type##_string(const type *string, CELL length) \ { \ - REGISTER_C_STRING(string); \ - F_STRING *s = allot_string_internal(length); \ - UNREGISTER_C_STRING(type,string); \ + REGISTER_C_STRING(string); \ + gc_root s(allot_string_internal(length)); \ + UNREGISTER_C_STRING(type,string); \ CELL i; \ for(i = 0; i < length; i++) \ { \ - REGISTER_UNTAGGED(s); \ - set_string_nth(s,i,(utype)*string); \ - UNREGISTER_UNTAGGED(F_STRING,s); \ + set_string_nth(s.untagged(),i,(utype)*string); \ string++; \ } \ - return s; \ + return s.untagged(); \ } \ F_STRING *from_##type##_string(const type *str) \ { \ @@ -236,17 +221,16 @@ F_BYTE_ARRAY *allot_c_string(CELL capacity, CELL size) F_STRING *str = untag_string(dpop()); \ type##_string_to_memory(str,address); \ } \ - F_BYTE_ARRAY *string_to_##type##_alien(F_STRING *s, bool check) \ + F_BYTE_ARRAY *string_to_##type##_alien(F_STRING *s_, bool check) \ { \ - CELL capacity = string_capacity(s); \ + gc_root s(s_); \ + CELL capacity = string_capacity(s.untagged()); \ F_BYTE_ARRAY *_c_str; \ - if(check && !check_string(s,sizeof(type))) \ - general_error(ERROR_C_STRING,tag_object(s),F,NULL); \ - REGISTER_UNTAGGED(s); \ + if(check && !check_string(s.untagged(),sizeof(type))) \ + general_error(ERROR_C_STRING,s.value(),F,NULL); \ _c_str = allot_c_string(capacity,sizeof(type)); \ - UNREGISTER_UNTAGGED(F_STRING,s); \ type *c_str = (type*)(_c_str + 1); \ - type##_string_to_memory(s,c_str); \ + type##_string_to_memory(s.untagged(),c_str); \ c_str[capacity] = 0; \ return _c_str; \ } \ diff --git a/vmpp/tagged.hpp b/vmpp/tagged.hpp index c6ccc66cd9..86f31f8281 100644 --- a/vmpp/tagged.hpp +++ b/vmpp/tagged.hpp @@ -7,26 +7,49 @@ template CELL tag(T *value) } template -class tagged +struct tagged { - CELL value; -public: - explicit tagged(CELL tagged) : value(tagged) {} - explicit tagged(T *untagged) : value(::tag(untagged)) {} + CELL value_; - CELL tag() const { return value; } - T *untag() const { type_check(T::type_number,value); } - T *untag_fast() const { return (T *)(UNTAG(value)); } - T *operator->() const { return untag_fast(); } - CELL *operator&() const { return &value; } + T *untag_check() const { + if(T::type_number != TYPE_COUNT) + type_check(T::type_number,value_); + return untagged(); + } + + explicit tagged(CELL tagged) : value_(tagged) { +#ifdef FACTOR_DEBUG + untag_check(); +#endif + } + + explicit tagged(T *untagged) : value_(::tag(untagged)) { +#ifdef FACTOR_DEBUG + untag_check(); +#endif + } + + CELL value() const { return value_; } + T *untagged() const { return (T *)(UNTAG(value_)); } + + T *operator->() const { return untagged(); } + CELL *operator&() const { return &value_; } + + const tagged& operator=(const T *x) { value_ = tag(x); return *this; } + const tagged& operator=(const CELL &x) { value_ = x; return *this; } + + CELL type() const { return type_of(value_); } + bool isa(CELL type_) const { return type() == type_; } + + template tagged as() { return tagged(value_); } }; -template T *untag(CELL value) +template T *untag_check(CELL value) { - return tagged(value).untag(); + return tagged(value).untag_check(); } -template T *untag_fast(CELL value) +template T *untagged(CELL value) { - return tagged(value).untag_fast(); + return tagged(value).untagged(); } diff --git a/vmpp/tuples.cpp b/vmpp/tuples.cpp index 27a8cf21d9..63ea924559 100644 --- a/vmpp/tuples.cpp +++ b/vmpp/tuples.cpp @@ -1,23 +1,20 @@ #include "master.hpp" /* push a new tuple on the stack */ -F_TUPLE *allot_tuple(F_TUPLE_LAYOUT *layout) +F_TUPLE *allot_tuple(CELL layout_) { - REGISTER_UNTAGGED(layout); - F_TUPLE *tuple = (F_TUPLE *)allot_object(TUPLE_TYPE,tuple_size(layout)); - UNREGISTER_UNTAGGED(F_TUPLE_LAYOUT,layout); - tuple->layout = tag_array((F_ARRAY *)layout); - return tuple; + gc_root layout(layout_); + gc_root tuple(allot(tuple_size(layout.untagged()))); + tuple->layout = layout.value(); + return tuple.untagged(); } void primitive_tuple(void) { - F_TUPLE_LAYOUT *layout = untag_tuple_layout(dpop()); - F_FIXNUM size = untag_fixnum_fast(layout->size); - - F_TUPLE *tuple = allot_tuple(layout); + gc_root layout(dpop()); + F_TUPLE *tuple = allot_tuple(layout.value()); F_FIXNUM i; - for(i = size - 1; i >= 0; i--) + for(i = tuple_size(layout.untagged()) - 1; i >= 0; i--) put(AREF(tuple,i),F); dpush(tag_tuple(tuple)); @@ -26,10 +23,10 @@ void primitive_tuple(void) /* push a new tuple on the stack, filling its slots from the stack */ void primitive_tuple_boa(void) { - F_TUPLE_LAYOUT *layout = untag_tuple_layout(dpop()); - F_FIXNUM size = untag_fixnum_fast(layout->size); - F_TUPLE *tuple = allot_tuple(layout); - memcpy(tuple + 1,(CELL *)(ds - CELLS * (size - 1)),CELLS * size); - ds -= CELLS * size; - dpush(tag_tuple(tuple)); + gc_root layout(dpop()); + gc_root tuple(allot_tuple(layout.value())); + CELL size = untag_fixnum_fast(layout.untagged()->size) * CELLS; + memcpy(tuple.untagged() + 1,(CELL *)(ds - (size - CELLS)),size); + ds -= size; + dpush(tuple.value()); } diff --git a/vmpp/words.cpp b/vmpp/words.cpp index ed13671bab..53d6e4d795 100644 --- a/vmpp/words.cpp +++ b/vmpp/words.cpp @@ -1,16 +1,15 @@ #include "master.hpp" -F_WORD *allot_word(CELL vocab, CELL name) +F_WORD *allot_word(CELL vocab_, CELL name_) { - REGISTER_ROOT(vocab); - REGISTER_ROOT(name); - F_WORD *word = (F_WORD *)allot_object(WORD_TYPE,sizeof(F_WORD)); - UNREGISTER_ROOT(name); - UNREGISTER_ROOT(vocab); + gc_root vocab(vocab_); + gc_root name(name_); + + gc_root word(allot(sizeof(F_WORD))); word->hashcode = tag_fixnum((rand() << 16) ^ rand()); - word->vocabulary = vocab; - word->name = name; + word->vocabulary = vocab.value(); + word->name = name.value(); word->def = userenv[UNDEFINED_ENV]; word->props = F; word->counter = tag_fixnum(0); @@ -19,18 +18,13 @@ F_WORD *allot_word(CELL vocab, CELL name) word->profiling = NULL; word->code = NULL; - REGISTER_UNTAGGED(word); - jit_compile_word(word,word->def,true); - UNREGISTER_UNTAGGED(F_WORD,word); - - REGISTER_UNTAGGED(word); - update_word_xt(word); - UNREGISTER_UNTAGGED(F_WORD,word); + jit_compile_word(word.value(),word->def,true); + update_word_xt(word.value()); if(profiling_p) relocate_code_block(word->profiling); - return word; + return word.untagged(); } /* ( name vocabulary -- word ) */ @@ -51,15 +45,15 @@ void primitive_word_xt(void) } /* Allocates memory */ -void update_word_xt(F_WORD *word) +void update_word_xt(CELL word_) { + gc_root word(word_); + if(profiling_p) { if(!word->profiling) { - REGISTER_UNTAGGED(word); - F_CODE_BLOCK *profiling = compile_profiling_stub(tag_object(word)); - UNREGISTER_UNTAGGED(F_WORD,word); + F_CODE_BLOCK *profiling = compile_profiling_stub(word.value()); word->profiling = profiling; } @@ -76,7 +70,7 @@ void primitive_optimized_p(void) void primitive_wrapper(void) { - F_WRAPPER *wrapper = (F_WRAPPER *)allot_object(WRAPPER_TYPE,sizeof(F_WRAPPER)); + F_WRAPPER *wrapper = allot(sizeof(F_WRAPPER)); wrapper->object = dpeek(); drepl(tag_object(wrapper)); } diff --git a/vmpp/words.hpp b/vmpp/words.hpp index cbc0d3c0d0..94912adc97 100644 --- a/vmpp/words.hpp +++ b/vmpp/words.hpp @@ -4,7 +4,7 @@ F_WORD *allot_word(CELL vocab, CELL name); void primitive_word(void); void primitive_word_xt(void); -void update_word_xt(F_WORD *word); +void update_word_xt(CELL word); INLINE bool word_optimized_p(F_WORD *word) {