--- /dev/null
+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);
+}
+
+}
{
gc_root<object> fill(fill_,this);
gc_root<array> new_array(allot_array_internal<array>(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();
}
{
array *buckets = untag<array>(table);
cell bucket = array_nth(buckets,hashcode & (array_capacity(buckets) - 1));
- if(tagged<object>(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)
array *echelons = untag<array>(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);
return array_nth(hi_tag_methods,tag);
}
-cell factor_vm::lookup_hairy_method(cell obj, cell methods)
+cell factor_vm::lookup_method(cell obj, cell methods)
{
- cell method = array_nth(untag<array>(methods),TAG(obj));
- if(tagged<object>(method).type_p(WORD_TYPE))
- return method;
- else
+ cell tag = TAG(obj);
+ cell method = array_nth(untag<array>(methods),tag);
+
+ if(tag == TUPLE_TYPE)
{
- switch(TAG(obj))
- {
- case TUPLE_TYPE:
+ if(TAG(method) == ARRAY_TYPE)
return lookup_tuple_method(obj,method);
- break;
- case OBJECT_TYPE:
+ else
+ return method;
+ }
+ else if(tag == OBJECT_TYPE)
+ {
+ if(TAG(method) == ARRAY_TYPE)
return lookup_hi_tag_method(obj,method);
- break;
- default:
- critical_error("Bad methods array",methods);
- return 0;
- }
+ else
+ return method;
}
-}
-
-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);
else
- return array_nth(untag<array>(methods),TAG(obj));
+ return method;
}
void factor_vm::primitive_lookup_method()
* 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? */);
- }
-
- obj = data->tenured->allot(size);
+ object *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;
#include "code_heap.hpp"
#include "callbacks.hpp"
#include "vm.hpp"
+#include "allot.hpp"
#include "tagged.hpp"
#include "local_roots.hpp"
#include "collector.hpp"
drepl(tag<bignum>(result));
}
-cell factor_vm::unbox_array_size()
+cell factor_vm::unbox_array_size_slow()
{
- switch(tagged<object>(dpeek()).type())
+ if(tagged<object>(dpeek()).type() == BIGNUM_TYPE)
{
- case FIXNUM_TYPE:
- {
- fixnum n = untag_fixnum(dpeek());
- if(n >= 0 && n < (fixnum)array_size_max)
- {
- dpop();
- return n;
- }
- break;
- }
- case BIGNUM_TYPE:
+ bignum *zero = untag<bignum>(bignum_zero);
+ bignum *max = cell_to_bignum(array_size_max);
+ bignum *n = untag<bignum>(dpeek());
+ if(bignum_compare(n,zero) != bignum_comparison_less
+ && bignum_compare(n,max) == bignum_comparison_less)
{
- bignum * zero = untag<bignum>(bignum_zero);
- bignum * max = cell_to_bignum(array_size_max);
- bignum * n = untag<bignum>(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);
}
}
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);
return t.untagged();
}
+/* push a new tuple on the stack, filling its slots with f */
void factor_vm::primitive_tuple()
{
gc_root<tuple_layout> 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<tuple>(t));
}
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();
+
}
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();
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();
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);