diff --git a/vm/allot.hpp b/vm/allot.hpp new file mode 100644 index 0000000000..9a00bafd38 --- /dev/null +++ b/vm/allot.hpp @@ -0,0 +1,29 @@ +namespace factor +{ + +/* + * It is up to the caller to fill in the object's fields in a meaningful + * fashion! + */ +inline object *factor_vm::allot_object(header header, cell size) +{ + /* If the object is smaller than the nursery, allocate it in the nursery, + after a GC if needed */ + if(nursery.size > size) + { + /* If there is insufficient room, collect the nursery */ + if(nursery.here + size > nursery.end) + primitive_minor_gc(); + + object *obj = nursery.allot(size); + + obj->h = header; + return obj; + } + /* If the object is bigger than the nursery, allocate it in + tenured space */ + else + return allot_large_object(header,size); +} + +} diff --git a/vm/arrays.cpp b/vm/arrays.cpp index 09c6998e69..1f60515bb8 100644 --- a/vm/arrays.cpp +++ b/vm/arrays.cpp @@ -8,17 +8,7 @@ array *factor_vm::allot_array(cell capacity, cell fill_) { gc_root fill(fill_,this); gc_root new_array(allot_array_internal(capacity),this); - - if(fill.value() == tag_fixnum(0)) - memset(new_array->data(),'\0',capacity * sizeof(cell)); - else - { - /* No need for write barrier here. Either the object is in - the nursery, or it was allocated directly in tenured space - and the write barrier is already hit for us in that case. */ - for(cell i = 0; i < capacity; i++) - new_array->data()[i] = fill.value(); - } + memset_cell(new_array->data(),fill.value(),capacity * sizeof(cell)); return new_array.untagged(); } diff --git a/vm/dispatch.cpp b/vm/dispatch.cpp index 0abde2e711..6bd9d6a13e 100755 --- a/vm/dispatch.cpp +++ b/vm/dispatch.cpp @@ -22,10 +22,10 @@ cell factor_vm::search_lookup_hash(cell table, cell klass, cell hashcode) { array *buckets = untag(table); cell bucket = array_nth(buckets,hashcode & (array_capacity(buckets) - 1)); - if(tagged(bucket).type_p(WORD_TYPE) || !to_boolean(bucket)) - return bucket; - else + if(TAG(bucket) == ARRAY_TYPE) return search_lookup_alist(bucket,klass); + else + return bucket; } cell factor_vm::nth_superclass(tuple_layout *layout, fixnum echelon) @@ -46,10 +46,8 @@ cell factor_vm::lookup_tuple_method(cell obj, cell methods) array *echelons = untag(methods); - fixnum echelon = untag_fixnum(layout->echelon); - fixnum max_echelon = array_capacity(echelons) - 1; - if(echelon > max_echelon) echelon = max_echelon; - + fixnum echelon = std::min(untag_fixnum(layout->echelon),(fixnum)array_capacity(echelons) - 1); + while(echelon >= 0) { cell echelon_methods = array_nth(echelons,echelon); @@ -82,35 +80,27 @@ cell factor_vm::lookup_hi_tag_method(cell obj, cell methods) return array_nth(hi_tag_methods,tag); } -cell factor_vm::lookup_hairy_method(cell obj, cell methods) -{ - cell method = array_nth(untag(methods),TAG(obj)); - if(tagged(method).type_p(WORD_TYPE)) - return method; - else - { - switch(TAG(obj)) - { - case TUPLE_TYPE: - return lookup_tuple_method(obj,method); - break; - case OBJECT_TYPE: - return lookup_hi_tag_method(obj,method); - break; - default: - critical_error("Bad methods array",methods); - return 0; - } - } -} - cell factor_vm::lookup_method(cell obj, cell methods) { cell tag = TAG(obj); - if(tag == TUPLE_TYPE || tag == OBJECT_TYPE) - return lookup_hairy_method(obj,methods); + cell method = array_nth(untag(methods),tag); + + if(tag == TUPLE_TYPE) + { + if(TAG(method) == ARRAY_TYPE) + return lookup_tuple_method(obj,method); + else + return method; + } + else if(tag == OBJECT_TYPE) + { + if(TAG(method) == ARRAY_TYPE) + return lookup_hi_tag_method(obj,method); + else + return method; + } else - return array_nth(untag(methods),TAG(obj)); + return method; } void factor_vm::primitive_lookup_method() diff --git a/vm/gc.cpp b/vm/gc.cpp index c8ba57b7f2..9e361a37e8 100755 --- a/vm/gc.cpp +++ b/vm/gc.cpp @@ -211,51 +211,29 @@ VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *pare * It is up to the caller to fill in the object's fields in a meaningful * fashion! */ -object *factor_vm::allot_object(header header, cell size) +object *factor_vm::allot_large_object(header header, cell size) { -#ifdef GC_DEBUG - if(!gc_off) + /* If tenured space does not have enough room, collect */ + if(data->tenured->here + size > data->tenured->end) primitive_full_gc(); -#endif - object *obj; - - /* If the object is smaller than the nursery, allocate it in the nursery, - after a GC if needed */ - if(nursery.size > size) + /* If it still won't fit, grow the heap */ + if(data->tenured->here + size > data->tenured->end) { - /* If there is insufficient room, collect the nursery */ - if(nursery.here + size > nursery.end) - primitive_minor_gc(); - - obj = nursery.allot(size); + gc(collect_growing_heap_op, + size, /* requested size */ + true, /* trace contexts? */ + false /* compact code heap? */); } - /* If the object is bigger than the nursery, allocate it in - tenured space */ - else - { - /* If tenured space does not have enough room, collect */ - if(data->tenured->here + size > data->tenured->end) - primitive_full_gc(); - /* If it still won't fit, grow the heap */ - if(data->tenured->here + size > data->tenured->end) - { - gc(collect_growing_heap_op, - size, /* requested size */ - true, /* trace contexts? */ - false /* compact code heap? */); - } + object *obj = data->tenured->allot(size); - obj = data->tenured->allot(size); - - /* Allows initialization code to store old->new pointers - without hitting the write barrier in the common case of - a nursery allocation */ - char *start = (char *)obj; - for(cell offset = 0; offset < size; offset += card_size) - write_barrier((cell *)(start + offset)); - } + /* Allows initialization code to store old->new pointers + without hitting the write barrier in the common case of + a nursery allocation */ + char *start = (char *)obj; + for(cell offset = 0; offset < size; offset += card_size) + write_barrier((cell *)(start + offset)); obj->h = header; return obj; diff --git a/vm/master.hpp b/vm/master.hpp index 847980fac6..7c841d94f6 100755 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -85,6 +85,7 @@ namespace factor #include "code_heap.hpp" #include "callbacks.hpp" #include "vm.hpp" +#include "allot.hpp" #include "tagged.hpp" #include "local_roots.hpp" #include "collector.hpp" diff --git a/vm/math.cpp b/vm/math.cpp index 169790d365..d5d4e89837 100755 --- a/vm/math.cpp +++ b/vm/math.cpp @@ -231,32 +231,18 @@ void factor_vm::primitive_byte_array_to_bignum() drepl(tag(result)); } -cell factor_vm::unbox_array_size() +cell factor_vm::unbox_array_size_slow() { - switch(tagged(dpeek()).type()) + if(tagged(dpeek()).type() == BIGNUM_TYPE) { - case FIXNUM_TYPE: + bignum *zero = untag(bignum_zero); + bignum *max = cell_to_bignum(array_size_max); + bignum *n = untag(dpeek()); + if(bignum_compare(n,zero) != bignum_comparison_less + && bignum_compare(n,max) == bignum_comparison_less) { - fixnum n = untag_fixnum(dpeek()); - if(n >= 0 && n < (fixnum)array_size_max) - { - dpop(); - return n; - } - break; - } - case BIGNUM_TYPE: - { - bignum * zero = untag(bignum_zero); - bignum * max = cell_to_bignum(array_size_max); - bignum * n = untag(dpeek()); - if(bignum_compare(n,zero) != bignum_comparison_less - && bignum_compare(n,max) == bignum_comparison_less) - { - dpop(); - return bignum_to_cell(n); - } - break; + dpop(); + return bignum_to_cell(n); } } diff --git a/vm/math.hpp b/vm/math.hpp index 1f7eda26fa..2fed585f98 100644 --- a/vm/math.hpp +++ b/vm/math.hpp @@ -58,7 +58,21 @@ inline double factor_vm::fixnum_to_float(cell tagged) return (double)untag_fixnum(tagged); } -// defined in assembler +inline cell factor_vm::unbox_array_size() +{ + cell obj = dpeek(); + if(TAG(obj) == FIXNUM_TYPE) + { + fixnum n = untag_fixnum(obj); + if(n >= 0 && n < (fixnum)array_size_max) + { + dpop(); + return n; + } + } + + return unbox_array_size_slow(); +} VM_C_API void box_float(float flo, factor_vm *vm); VM_C_API float to_float(cell value, factor_vm *vm); diff --git a/vm/tuples.cpp b/vm/tuples.cpp index 2d195ea13b..8a6e2d053b 100755 --- a/vm/tuples.cpp +++ b/vm/tuples.cpp @@ -12,14 +12,13 @@ tuple *factor_vm::allot_tuple(cell layout_) return t.untagged(); } +/* push a new tuple on the stack, filling its slots with f */ void factor_vm::primitive_tuple() { gc_root layout(dpop(),this); tuple *t = allot_tuple(layout.value()); - fixnum i; - for(i = tuple_size(layout.untagged()) - 1; i >= 0; i--) - t->data()[i] = false_object; - + cell size = (tuple_size(layout.untagged()) - 1) * sizeof(cell); + memset_cell(t->data(),false_object,size); dpush(tag(t)); } diff --git a/vm/utilities.hpp b/vm/utilities.hpp index f93fe13f78..3230e548a9 100755 --- a/vm/utilities.hpp +++ b/vm/utilities.hpp @@ -1,11 +1,37 @@ namespace factor { - vm_char *safe_strdup(const vm_char *str); - void print_string(const char *str); - void nl(); - void print_cell(cell x); - void print_cell_hex(cell x); - void print_cell_hex_pad(cell x); - void print_fixnum(fixnum x); - cell read_cell_hex(); + +inline static void memset_cell(void *dst, cell pattern, size_t size) +{ +#ifdef __APPLE__ + #ifdef FACTOR_64 + memset_pattern8(dst,&pattern,size); + #else + memset_pattern4(dst,&pattern,size); + #endif +#else + if(pattern == 0) + memset(dst,0,size); + else + { + cell *start = (cell *)dst; + cell *end = (cell *)((cell)dst + size); + while(start < end) + { + *start = fill; + start++; + } + } +#endif +} + +vm_char *safe_strdup(const vm_char *str); +void print_string(const char *str); +void nl(); +void print_cell(cell x); +void print_cell_hex(cell x); +void print_cell_hex_pad(cell x); +void print_fixnum(fixnum x); +cell read_cell_hex(); + } diff --git a/vm/vm.hpp b/vm/vm.hpp index 2c85b8ec49..e4a2ffc753 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -266,6 +266,7 @@ struct factor_vm void primitive_become(); void inline_gc(cell *gc_roots_base, cell gc_roots_size); object *allot_object(header header, cell size); + object *allot_large_object(header header, cell size); void add_gc_stats(generation_statistics *stats, growable_array *result); void primitive_clear_gc_stats(); @@ -409,7 +410,8 @@ struct factor_vm void primitive_bignum_log2(); unsigned int bignum_producer(unsigned int digit); void primitive_byte_array_to_bignum(); - cell unbox_array_size(); + inline cell unbox_array_size(); + cell unbox_array_size_slow(); void primitive_fixnum_to_float(); void primitive_bignum_to_float(); void primitive_str_to_float(); @@ -634,7 +636,6 @@ struct factor_vm cell nth_hashcode(tuple_layout *layout, fixnum echelon); cell lookup_tuple_method(cell obj, cell methods); cell lookup_hi_tag_method(cell obj, cell methods); - cell lookup_hairy_method(cell obj, cell methods); cell lookup_method(cell obj, cell methods); void primitive_lookup_method(); cell object_class(cell obj);