return array->data()[slot];
}
+inline void factor_vm::set_array_nth(array *array, cell slot, cell value)
+{
+#ifdef FACTOR_DEBUG
+ assert(slot < array_capacity(array));
+ assert(array->h.hi_tag() == ARRAY_TYPE);
+ check_tagged_pointer(value);
+#endif
+ array->data()[slot] = value;
+ write_barrier(array);
+}
+
+struct growable_array {
+ cell count;
+ gc_root<array> elements;
+
+ growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
+
+ void add(cell elt);
+ void trim();
+};
+
}
VM_C_API void box_boolean(bool value, factor_vm *vm);
VM_C_API bool to_boolean(cell value, factor_vm *vm);
+inline cell factor_vm::tag_boolean(cell untagged)
+{
+ return (untagged ? T : F);
+}
+
}
namespace factor
{
+struct growable_byte_array {
+ cell count;
+ gc_root<byte_array> elements;
+
+ growable_byte_array(factor_vm *myvm,cell capacity = 40) : count(0), elements(myvm->allot_byte_array(capacity),myvm) { }
+
+ void append_bytes(void *elts, cell len);
+ void append_byte_array(cell elts);
+
+ void trim();
+};
+
}
VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *vm);
+/* This is a little tricky. The iterator may allocate memory, so we
+keep the callstack in a GC root and use relative offsets */
+template<typename TYPE> void factor_vm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
+{
+ gc_root<callstack> stack(stack_,this);
+ fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
+
+ while(frame_offset >= 0)
+ {
+ stack_frame *frame = stack->frame_at(frame_offset);
+ frame_offset -= frame->size;
+ iterator(frame,this);
+ }
+}
+
+template<typename TYPE> void factor_vm::iterate_callstack(cell top, cell bottom, TYPE &iterator)
+{
+ stack_frame *frame = (stack_frame *)bottom - 1;
+
+ while((cell)frame >= top)
+ {
+ iterator(frame,this);
+ frame = frame_successor(frame);
+ }
+}
+
+/* Every object has a regular representation in the runtime, which makes GC
+much simpler. Every slot of the object until binary_payload_start is a pointer
+to some other object. */
+struct factor_vm;
+inline void factor_vm::do_slots(cell obj, void (* iter)(cell *,factor_vm*))
+{
+ cell scan = obj;
+ cell payload_start = binary_payload_start((object *)obj);
+ cell end = obj + payload_start;
+
+ scan += sizeof(cell);
+
+ while(scan < end)
+ {
+ iter((cell *)scan,this);
+ scan += sizeof(cell);
+ }
+}
+
}
namespace factor
{
+inline void factor_vm::check_code_pointer(cell ptr)
+{
+#ifdef FACTOR_DEBUG
+ assert(in_code_heap_p(ptr));
+#endif
+}
+
}
VM_PTR->inline_gc(gc_roots_base,gc_roots_size);
}
+inline object *factor_vm::allot_zone(zone *z, cell a)
+{
+ cell h = z->here;
+ z->here = h + align8(a);
+ object *obj = (object *)h;
+ allot_barrier(obj);
+ return obj;
+}
+
+/*
+ * 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)
+{
+#ifdef GC_DEBUG
+ if(!gc_off)
+ gc();
+#endif
+
+ object *obj;
+
+ if(nursery.size - allot_buffer_zone > size)
+ {
+ /* If there is insufficient room, collect the nursery */
+ if(nursery.here + allot_buffer_zone + size > nursery.end)
+ garbage_collection(data->nursery(),false,0);
+
+ cell h = nursery.here;
+ nursery.here = h + align8(size);
+ obj = (object *)h;
+ }
+ /* If the object is bigger than the nursery, allocate it in
+ tenured space */
+ else
+ {
+ zone *tenured = &data->generations[data->tenured()];
+
+ /* If tenured space does not have enough room, collect */
+ if(tenured->here + size > tenured->end)
+ {
+ gc();
+ tenured = &data->generations[data->tenured()];
+ }
+
+ /* If it still won't fit, grow the heap */
+ if(tenured->here + size > tenured->end)
+ {
+ garbage_collection(data->tenured(),true,size);
+ tenured = &data->generations[data->tenured()];
+ }
+
+ obj = allot_zone(tenured,size);
+
+ /* Allows initialization code to store old->new pointers
+ without hitting the write barrier in the common case of
+ a nursery allocation */
+ write_barrier(obj);
+ }
+
+ obj->h = header;
+ return obj;
+}
+
}
return array_size<T>(array_capacity(array));
}
+template <typename TYPE> TYPE *factor_vm::allot_array_internal(cell capacity)
+{
+ TYPE *array = allot<TYPE>(array_size<TYPE>(capacity));
+ array->capacity = tag_fixnum(capacity);
+ return array;
+}
+
+template <typename TYPE> bool factor_vm::reallot_array_in_place_p(TYPE *array, cell capacity)
+{
+ return in_zone(&nursery,array) && capacity <= array_capacity(array);
+}
+
+template <typename TYPE> TYPE *factor_vm::reallot_array(TYPE *array_, cell capacity)
+{
+ gc_root<TYPE> array(array_,this);
+
+ if(reallot_array_in_place_p(array.untagged(),capacity))
+ {
+ array->capacity = tag_fixnum(capacity);
+ return array.untagged();
+ }
+ else
+ {
+ cell to_copy = array_capacity(array.untagged());
+ if(capacity < to_copy)
+ to_copy = capacity;
+
+ TYPE *new_array = allot_array_internal<TYPE>(capacity);
+
+ memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size);
+ memset((char *)(new_array + 1) + to_copy * TYPE::element_size,
+ 0,(capacity - to_copy) * TYPE::element_size);
+
+ return new_array;
+ }
+}
+
}
+++ /dev/null
-namespace factor
-{
-
-// I've had to copy inline implementations here to make dependencies work. Am hoping to move this code back into include files
-// once the rest of the reentrant changes are done. -PD
-
-//data_gc.hpp
-inline bool factor_vm::collecting_accumulation_gen_p()
-{
- return ((data->have_aging_p()
- && collecting_gen == data->aging()
- && !collecting_aging_again)
- || collecting_gen == data->tenured());
-}
-
-inline object *factor_vm::allot_zone(zone *z, cell a)
-{
- cell h = z->here;
- z->here = h + align8(a);
- object *obj = (object *)h;
- allot_barrier(obj);
- return obj;
-}
-
-/*
- * 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)
-{
-#ifdef GC_DEBUG
- if(!gc_off)
- gc();
-#endif
-
- object *obj;
-
- if(nursery.size - allot_buffer_zone > size)
- {
- /* If there is insufficient room, collect the nursery */
- if(nursery.here + allot_buffer_zone + size > nursery.end)
- garbage_collection(data->nursery(),false,0);
-
- cell h = nursery.here;
- nursery.here = h + align8(size);
- obj = (object *)h;
- }
- /* If the object is bigger than the nursery, allocate it in
- tenured space */
- else
- {
- zone *tenured = &data->generations[data->tenured()];
-
- /* If tenured space does not have enough room, collect */
- if(tenured->here + size > tenured->end)
- {
- gc();
- tenured = &data->generations[data->tenured()];
- }
-
- /* If it still won't fit, grow the heap */
- if(tenured->here + size > tenured->end)
- {
- garbage_collection(data->tenured(),true,size);
- tenured = &data->generations[data->tenured()];
- }
-
- obj = allot_zone(tenured,size);
-
- /* Allows initialization code to store old->new pointers
- without hitting the write barrier in the common case of
- a nursery allocation */
- write_barrier(obj);
- }
-
- obj->h = header;
- return obj;
-}
-
-template<typename TYPE> TYPE *factor_vm::allot(cell size)
-{
- return (TYPE *)allot_object(header(TYPE::type_number),size);
-}
-
-inline void factor_vm::check_data_pointer(object *pointer)
-{
-#ifdef FACTOR_DEBUG
- if(!growing_data_heap)
- {
- assert((cell)pointer >= data->seg->start
- && (cell)pointer < data->seg->end);
- }
-#endif
-}
-
-inline void factor_vm::check_tagged_pointer(cell tagged)
-{
-#ifdef FACTOR_DEBUG
- if(!immediate_p(tagged))
- {
- object *obj = untag<object>(tagged);
- check_data_pointer(obj);
- obj->h.hi_tag();
- }
-#endif
-}
-
-//generic_arrays.hpp
-template <typename TYPE> TYPE *factor_vm::allot_array_internal(cell capacity)
-{
- TYPE *array = allot<TYPE>(array_size<TYPE>(capacity));
- array->capacity = tag_fixnum(capacity);
- return array;
-}
-
-template <typename TYPE> bool factor_vm::reallot_array_in_place_p(TYPE *array, cell capacity)
-{
- return in_zone(&nursery,array) && capacity <= array_capacity(array);
-}
-
-template <typename TYPE> TYPE *factor_vm::reallot_array(TYPE *array_, cell capacity)
-{
- gc_root<TYPE> array(array_,this);
-
- if(reallot_array_in_place_p(array.untagged(),capacity))
- {
- array->capacity = tag_fixnum(capacity);
- return array.untagged();
- }
- else
- {
- cell to_copy = array_capacity(array.untagged());
- if(capacity < to_copy)
- to_copy = capacity;
-
- TYPE *new_array = allot_array_internal<TYPE>(capacity);
-
- memcpy(new_array + 1,array.untagged() + 1,to_copy * TYPE::element_size);
- memset((char *)(new_array + 1) + to_copy * TYPE::element_size,
- 0,(capacity - to_copy) * TYPE::element_size);
-
- return new_array;
- }
-}
-
-//arrays.hpp
-inline void factor_vm::set_array_nth(array *array, cell slot, cell value)
-{
-#ifdef FACTOR_DEBUG
- assert(slot < array_capacity(array));
- assert(array->h.hi_tag() == ARRAY_TYPE);
- check_tagged_pointer(value);
-#endif
- array->data()[slot] = value;
- write_barrier(array);
-}
-
-struct growable_array {
- cell count;
- gc_root<array> elements;
-
- growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
-
- void add(cell elt);
- void trim();
-};
-
-//byte_arrays.hpp
-struct growable_byte_array {
- cell count;
- gc_root<byte_array> elements;
-
- growable_byte_array(factor_vm *myvm,cell capacity = 40) : count(0), elements(myvm->allot_byte_array(capacity),myvm) { }
-
- void append_bytes(void *elts, cell len);
- void append_byte_array(cell elts);
-
- void trim();
-};
-
-//math.hpp
-inline cell factor_vm::allot_integer(fixnum x)
-{
- if(x < fixnum_min || x > fixnum_max)
- return tag<bignum>(fixnum_to_bignum(x));
- else
- return tag_fixnum(x);
-}
-
-inline cell factor_vm::allot_cell(cell x)
-{
- if(x > (cell)fixnum_max)
- return tag<bignum>(cell_to_bignum(x));
- else
- return tag_fixnum(x);
-}
-
-inline cell factor_vm::allot_float(double n)
-{
- boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
- flo->n = n;
- return tag(flo);
-}
-
-inline bignum *factor_vm::float_to_bignum(cell tagged)
-{
- return double_to_bignum(untag_float(tagged));
-}
-
-inline double factor_vm::bignum_to_float(cell tagged)
-{
- return bignum_to_double(untag<bignum>(tagged));
-}
-
-inline double factor_vm::untag_float(cell tagged)
-{
- return untag<boxed_float>(tagged)->n;
-}
-
-inline double factor_vm::untag_float_check(cell tagged)
-{
- return untag_check<boxed_float>(tagged)->n;
-}
-
-inline fixnum factor_vm::float_to_fixnum(cell tagged)
-{
- return (fixnum)untag_float(tagged);
-}
-
-inline double factor_vm::fixnum_to_float(cell tagged)
-{
- return (double)untag_fixnum(tagged);
-}
-
-//callstack.hpp
-/* This is a little tricky. The iterator may allocate memory, so we
-keep the callstack in a GC root and use relative offsets */
-template<typename TYPE> void factor_vm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
-{
- gc_root<callstack> stack(stack_,this);
- fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
-
- while(frame_offset >= 0)
- {
- stack_frame *frame = stack->frame_at(frame_offset);
- frame_offset -= frame->size;
- iterator(frame,this);
- }
-}
-
-//booleans.hpp
-inline cell factor_vm::tag_boolean(cell untagged)
-{
- return (untagged ? T : F);
-}
-
-// callstack.hpp
-template<typename TYPE> void factor_vm::iterate_callstack(cell top, cell bottom, TYPE &iterator)
-{
- stack_frame *frame = (stack_frame *)bottom - 1;
-
- while((cell)frame >= top)
- {
- iterator(frame,this);
- frame = frame_successor(frame);
- }
-}
-
-// data_heap.hpp
-/* Every object has a regular representation in the runtime, which makes GC
-much simpler. Every slot of the object until binary_payload_start is a pointer
-to some other object. */
-struct factor_vm;
-inline void factor_vm::do_slots(cell obj, void (* iter)(cell *,factor_vm*))
-{
- cell scan = obj;
- cell payload_start = binary_payload_start((object *)obj);
- cell end = obj + payload_start;
-
- scan += sizeof(cell);
-
- while(scan < end)
- {
- iter((cell *)scan,this);
- scan += sizeof(cell);
- }
-}
-
-// code_heap.hpp
-
-inline void factor_vm::check_code_pointer(cell ptr)
-{
-#ifdef FACTOR_DEBUG
- assert(in_code_heap_p(ptr));
-#endif
-}
-
-}
namespace factor
{
-//local_roots.hpp
template <typename TYPE>
struct gc_root : public tagged<TYPE>
{
#include "data_heap.hpp"
#include "write_barrier.hpp"
#include "data_gc.hpp"
-#include "generic_arrays.hpp"
#include "debug.hpp"
-#include "arrays.hpp"
#include "strings.hpp"
-#include "booleans.hpp"
-#include "byte_arrays.hpp"
#include "tuples.hpp"
#include "words.hpp"
-#include "math.hpp"
#include "float_bits.hpp"
#include "io.hpp"
#include "heap.hpp"
-#include "code_heap.hpp"
#include "image.hpp"
-#include "callstack.hpp"
#include "alien.hpp"
#include "vm.hpp"
#include "tagged.hpp"
#include "local_roots.hpp"
-#include "inlineimpls.hpp"
+#include "callstack.hpp"
+#include "generic_arrays.hpp"
+#include "arrays.hpp"
+#include "math.hpp"
+#include "booleans.hpp"
+#include "code_heap.hpp"
+#include "byte_arrays.hpp"
#include "jit.hpp"
#include "quotations.hpp"
#include "dispatch.hpp"
static const fixnum fixnum_min = (-((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)));
static const fixnum array_size_max = ((cell)1 << (WORD_SIZE - TAG_BITS - 2));
-// defined in assembler
+inline cell factor_vm::allot_integer(fixnum x)
+{
+ if(x < fixnum_min || x > fixnum_max)
+ return tag<bignum>(fixnum_to_bignum(x));
+ else
+ return tag_fixnum(x);
+}
+inline cell factor_vm::allot_cell(cell x)
+{
+ if(x > (cell)fixnum_max)
+ return tag<bignum>(cell_to_bignum(x));
+ else
+ return tag_fixnum(x);
+}
+inline cell factor_vm::allot_float(double n)
+{
+ boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
+ flo->n = n;
+ return tag(flo);
+}
+inline bignum *factor_vm::float_to_bignum(cell tagged)
+{
+ return double_to_bignum(untag_float(tagged));
+}
+
+inline double factor_vm::bignum_to_float(cell tagged)
+{
+ return bignum_to_double(untag<bignum>(tagged));
+}
+inline double factor_vm::untag_float(cell tagged)
+{
+ return untag<boxed_float>(tagged)->n;
+}
+
+inline double factor_vm::untag_float_check(cell tagged)
+{
+ return untag_check<boxed_float>(tagged)->n;
+}
+
+inline fixnum factor_vm::float_to_fixnum(cell tagged)
+{
+ return (fixnum)untag_float(tagged);
+}
+
+inline double factor_vm::fixnum_to_float(cell tagged)
+{
+ return (double)untag_fixnum(tagged);
+}
+
+// defined in assembler
VM_C_API void box_float(float flo, factor_vm *vm);
VM_C_API float to_float(cell value, factor_vm *vm);
void bignum_destructive_add(bignum * bignum, bignum_digit_type n);
void bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor);
void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator,
- bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p);
+ bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p);
void bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q);
bignum_digit_type bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end,
- bignum_digit_type guess, bignum_digit_type * u_start);
+ bignum_digit_type guess, bignum_digit_type * u_start);
void bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator,
- bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
+ bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
void bignum_destructive_normalization(bignum * source, bignum * target, int shift_left);
void bignum_destructive_unnormalization(bignum * bignum, int shift_right);
bignum_digit_type bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
- bignum_digit_type v, bignum_digit_type * q) /* return value */;
+ bignum_digit_type v, bignum_digit_type * q) /* return value */;
bignum_digit_type bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
- bignum_digit_type guess, bignum_digit_type * u);
+ bignum_digit_type guess, bignum_digit_type * u);
void bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator,
- bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
+ bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
bignum_digit_type bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator);
bignum * bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p);
bignum *bignum_digit_to_bignum(bignum_digit_type digit, int negative_p);
template<typename T> void each_object(T &functor);
cell find_all_words();
cell object_size(cell tagged);
-
//write barrier
cell allot_markers_offset;
void clear_gc_stats();
void primitive_become();
void inline_gc(cell *gc_roots_base, cell gc_roots_size);
- inline bool collecting_accumulation_gen_p();
inline object *allot_zone(zone *z, cell a);
- inline object *allot_object(header header, cell size);
- template <typename TYPE> TYPE *allot(cell size);
- inline void check_data_pointer(object *pointer);
- inline void check_tagged_pointer(cell tagged);
+ object *allot_object(header header, cell size);
void primitive_clear_gc_stats();
+ template<typename TYPE> TYPE *allot(cell size)
+ {
+ return (TYPE *)allot_object(header(TYPE::type_number),size);
+ }
+
+ inline bool collecting_accumulation_gen_p()
+ {
+ return ((data->have_aging_p()
+ && collecting_gen == data->aging()
+ && !collecting_aging_again)
+ || collecting_gen == data->tenured());
+ }
+
+ inline void check_data_pointer(object *pointer)
+ {
+ #ifdef FACTOR_DEBUG
+ if(!growing_data_heap)
+ {
+ assert((cell)pointer >= data->seg->start
+ && (cell)pointer < data->seg->end);
+ }
+ #endif
+ }
+
+ inline void check_tagged_pointer(cell tagged)
+ {
+ #ifdef FACTOR_DEBUG
+ if(!immediate_p(tagged))
+ {
+ object *obj = untag<object>(tagged);
+ check_data_pointer(obj);
+ obj->h.hi_tag();
+ }
+ #endif
+ }
+
// local roots
/* If a runtime function needs to call another function which potentially
allocates memory, it must wrap any local variable references to Factor