split the moved inline stuff into separate header file
Phil Dawes
parent
e4f92cdbf2
commit
e08a6e21cb
|
|
@ -0,0 +1,616 @@
|
||||||
|
namespace factor
|
||||||
|
{
|
||||||
|
|
||||||
|
// I've had to copy inline implementations here to make dependencies work. Hopefully this can be better factored
|
||||||
|
// once the rest of the reentrant changes are done. -PD
|
||||||
|
|
||||||
|
//tagged.hpp
|
||||||
|
|
||||||
|
template <typename TYPE>
|
||||||
|
struct tagged
|
||||||
|
{
|
||||||
|
cell value_;
|
||||||
|
|
||||||
|
cell value() const { return value_; }
|
||||||
|
TYPE *untagged() const { return (TYPE *)(UNTAG(value_)); }
|
||||||
|
|
||||||
|
cell type() const {
|
||||||
|
cell tag = TAG(value_);
|
||||||
|
if(tag == OBJECT_TYPE)
|
||||||
|
return untagged()->h.hi_tag();
|
||||||
|
else
|
||||||
|
return tag;
|
||||||
|
}
|
||||||
|
|
||||||
|
bool type_p(cell type_) const { return type() == type_; }
|
||||||
|
|
||||||
|
TYPE *untag_check() const {
|
||||||
|
if(TYPE::type_number != TYPE_COUNT && !type_p(TYPE::type_number))
|
||||||
|
type_error(TYPE::type_number,value_);
|
||||||
|
return untagged();
|
||||||
|
}
|
||||||
|
|
||||||
|
explicit tagged(cell tagged) : value_(tagged) {
|
||||||
|
#ifdef FACTOR_DEBUG
|
||||||
|
untag_check();
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) {
|
||||||
|
#ifdef FACTOR_DEBUG
|
||||||
|
untag_check();
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
|
TYPE *operator->() const { return untagged(); }
|
||||||
|
cell *operator&() const { return &value_; }
|
||||||
|
|
||||||
|
const tagged<TYPE>& operator=(const TYPE *x) { value_ = tag(x); return *this; }
|
||||||
|
const tagged<TYPE>& operator=(const cell &x) { value_ = x; return *this; }
|
||||||
|
|
||||||
|
bool operator==(const tagged<TYPE> &x) { return value_ == x.value_; }
|
||||||
|
bool operator!=(const tagged<TYPE> &x) { return value_ != x.value_; }
|
||||||
|
|
||||||
|
template<typename X> tagged<X> as() { return tagged<X>(value_); }
|
||||||
|
};
|
||||||
|
|
||||||
|
template <typename TYPE> TYPE *factorvm::untag_check(cell value)
|
||||||
|
{
|
||||||
|
return tagged<TYPE>(value).untag_check();
|
||||||
|
}
|
||||||
|
|
||||||
|
template <typename TYPE> TYPE *untag_check(cell value)
|
||||||
|
{
|
||||||
|
return vm->untag_check<TYPE>(value);
|
||||||
|
}
|
||||||
|
|
||||||
|
template <typename TYPE> TYPE *factorvm::untag(cell value)
|
||||||
|
{
|
||||||
|
return tagged<TYPE>(value).untagged();
|
||||||
|
}
|
||||||
|
|
||||||
|
template <typename TYPE> TYPE *untag(cell value)
|
||||||
|
{
|
||||||
|
return vm->untag<TYPE>(value);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
// write_barrier.hpp
|
||||||
|
|
||||||
|
inline card *factorvm::addr_to_card(cell a)
|
||||||
|
{
|
||||||
|
return (card*)(((cell)(a) >> card_bits) + cards_offset);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline card *addr_to_card(cell a)
|
||||||
|
{
|
||||||
|
return vm->addr_to_card(a);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell factorvm::card_to_addr(card *c)
|
||||||
|
{
|
||||||
|
return ((cell)c - cards_offset) << card_bits;
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell card_to_addr(card *c)
|
||||||
|
{
|
||||||
|
return vm->card_to_addr(c);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell factorvm::card_offset(card *c)
|
||||||
|
{
|
||||||
|
return *(c - (cell)data->cards + (cell)data->allot_markers);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell card_offset(card *c)
|
||||||
|
{
|
||||||
|
return vm->card_offset(c);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline card_deck *factorvm::addr_to_deck(cell a)
|
||||||
|
{
|
||||||
|
return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline card_deck *addr_to_deck(cell a)
|
||||||
|
{
|
||||||
|
return vm->addr_to_deck(a);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell factorvm::deck_to_addr(card_deck *c)
|
||||||
|
{
|
||||||
|
return ((cell)c - decks_offset) << deck_bits;
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell deck_to_addr(card_deck *c)
|
||||||
|
{
|
||||||
|
return vm->deck_to_addr(c);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline card *factorvm::deck_to_card(card_deck *d)
|
||||||
|
{
|
||||||
|
return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline card *deck_to_card(card_deck *d)
|
||||||
|
{
|
||||||
|
return vm->deck_to_card(d);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline card *factorvm::addr_to_allot_marker(object *a)
|
||||||
|
{
|
||||||
|
return (card *)(((cell)a >> card_bits) + allot_markers_offset);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline card *addr_to_allot_marker(object *a)
|
||||||
|
{
|
||||||
|
return vm->addr_to_allot_marker(a);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* the write barrier must be called any time we are potentially storing a
|
||||||
|
pointer from an older generation to a younger one */
|
||||||
|
inline void factorvm::write_barrier(object *obj)
|
||||||
|
{
|
||||||
|
*addr_to_card((cell)obj) = card_mark_mask;
|
||||||
|
*addr_to_deck((cell)obj) = card_mark_mask;
|
||||||
|
}
|
||||||
|
|
||||||
|
inline void write_barrier(object *obj)
|
||||||
|
{
|
||||||
|
return vm->write_barrier(obj);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* we need to remember the first object allocated in the card */
|
||||||
|
inline void factorvm::allot_barrier(object *address)
|
||||||
|
{
|
||||||
|
card *ptr = addr_to_allot_marker(address);
|
||||||
|
if(*ptr == invalid_allot_marker)
|
||||||
|
*ptr = ((cell)address & addr_card_mask);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline void allot_barrier(object *address)
|
||||||
|
{
|
||||||
|
return vm->allot_barrier(address);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
//data_gc.hpp
|
||||||
|
inline bool factorvm::collecting_accumulation_gen_p()
|
||||||
|
{
|
||||||
|
return ((data->have_aging_p()
|
||||||
|
&& collecting_gen == data->aging()
|
||||||
|
&& !collecting_aging_again)
|
||||||
|
|| collecting_gen == data->tenured());
|
||||||
|
}
|
||||||
|
|
||||||
|
inline bool collecting_accumulation_gen_p()
|
||||||
|
{
|
||||||
|
return vm->collecting_accumulation_gen_p();
|
||||||
|
}
|
||||||
|
|
||||||
|
inline object *factorvm::allot_zone(zone *z, cell a)
|
||||||
|
{
|
||||||
|
cell h = z->here;
|
||||||
|
z->here = h + align8(a);
|
||||||
|
object *obj = (object *)h;
|
||||||
|
allot_barrier(obj);
|
||||||
|
return obj;
|
||||||
|
}
|
||||||
|
|
||||||
|
inline object *allot_zone(zone *z, cell a)
|
||||||
|
{
|
||||||
|
return vm->allot_zone(z,a);
|
||||||
|
}
|
||||||
|
|
||||||
|
/*
|
||||||
|
* It is up to the caller to fill in the object's fields in a meaningful
|
||||||
|
* fashion!
|
||||||
|
*/
|
||||||
|
inline object *factorvm::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;
|
||||||
|
}
|
||||||
|
|
||||||
|
inline object *allot_object(header header, cell size)
|
||||||
|
{
|
||||||
|
return vm->allot_object(header,size);
|
||||||
|
}
|
||||||
|
|
||||||
|
template<typename TYPE> TYPE *factorvm::allot(cell size)
|
||||||
|
{
|
||||||
|
return (TYPE *)allot_object(header(TYPE::type_number),size);
|
||||||
|
}
|
||||||
|
|
||||||
|
template<typename TYPE> TYPE *allot(cell size)
|
||||||
|
{
|
||||||
|
return vm->allot<TYPE>(size);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline void factorvm::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_data_pointer(object *pointer)
|
||||||
|
{
|
||||||
|
return vm->check_data_pointer(pointer);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline void factorvm::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
|
||||||
|
}
|
||||||
|
|
||||||
|
inline void check_tagged_pointer(cell tagged)
|
||||||
|
{
|
||||||
|
return vm->check_tagged_pointer(tagged);
|
||||||
|
}
|
||||||
|
|
||||||
|
//local_roots.hpp
|
||||||
|
template <typename TYPE>
|
||||||
|
struct gc_root : public tagged<TYPE>
|
||||||
|
{
|
||||||
|
factorvm *myvm;
|
||||||
|
|
||||||
|
void push() { check_tagged_pointer(tagged<TYPE>::value()); myvm->gc_locals.push_back((cell)this); }
|
||||||
|
|
||||||
|
//explicit gc_root(cell value_, factorvm *vm) : myvm(vm),tagged<TYPE>(value_) { push(); }
|
||||||
|
explicit gc_root(cell value_,factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
|
||||||
|
explicit gc_root(TYPE *value_, factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
|
||||||
|
|
||||||
|
const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; }
|
||||||
|
const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; }
|
||||||
|
|
||||||
|
~gc_root() {
|
||||||
|
#ifdef FACTOR_DEBUG
|
||||||
|
assert(myvm->gc_locals.back() == (cell)this);
|
||||||
|
#endif
|
||||||
|
myvm->gc_locals.pop_back();
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
/* A similar hack for the bignum implementation */
|
||||||
|
struct gc_bignum
|
||||||
|
{
|
||||||
|
bignum **addr;
|
||||||
|
factorvm *myvm;
|
||||||
|
gc_bignum(bignum **addr_, factorvm *vm) : addr(addr_), myvm(vm) {
|
||||||
|
if(*addr_)
|
||||||
|
check_data_pointer(*addr_);
|
||||||
|
myvm->gc_bignums.push_back((cell)addr);
|
||||||
|
}
|
||||||
|
|
||||||
|
~gc_bignum() {
|
||||||
|
#ifdef FACTOR_DEBUG
|
||||||
|
assert(myvm->gc_bignums.back() == (cell)addr);
|
||||||
|
#endif
|
||||||
|
myvm->gc_bignums.pop_back();
|
||||||
|
}
|
||||||
|
};
|
||||||
|
|
||||||
|
#define GC_BIGNUM(x,vm) gc_bignum x##__gc_root(&x,vm)
|
||||||
|
|
||||||
|
//generic_arrays.hpp
|
||||||
|
template <typename TYPE> TYPE *factorvm::allot_array_internal(cell capacity)
|
||||||
|
{
|
||||||
|
TYPE *array = allot<TYPE>(array_size<TYPE>(capacity));
|
||||||
|
array->capacity = tag_fixnum(capacity);
|
||||||
|
return array;
|
||||||
|
}
|
||||||
|
|
||||||
|
template <typename TYPE> TYPE *allot_array_internal(cell capacity)
|
||||||
|
{
|
||||||
|
return vm->allot_array_internal<TYPE>(capacity);
|
||||||
|
}
|
||||||
|
|
||||||
|
template <typename TYPE> bool factorvm::reallot_array_in_place_p(TYPE *array, cell capacity)
|
||||||
|
{
|
||||||
|
return in_zone(&nursery,array) && capacity <= array_capacity(array);
|
||||||
|
}
|
||||||
|
|
||||||
|
template <typename TYPE> bool reallot_array_in_place_p(TYPE *array, cell capacity)
|
||||||
|
{
|
||||||
|
return vm->reallot_array_in_place_p<TYPE>(array,capacity);
|
||||||
|
}
|
||||||
|
|
||||||
|
template <typename TYPE> TYPE *factorvm::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 factorvm::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);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline void set_array_nth(array *array, cell slot, cell value)
|
||||||
|
{
|
||||||
|
return vm->set_array_nth(array,slot,value);
|
||||||
|
}
|
||||||
|
|
||||||
|
struct growable_array {
|
||||||
|
cell count;
|
||||||
|
gc_root<array> elements;
|
||||||
|
|
||||||
|
growable_array(factorvm *myvm, cell capacity = 10) : count(0), elements(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(factorvm *vm,cell capacity = 40) : count(0), elements(allot_byte_array(capacity),vm) { }
|
||||||
|
|
||||||
|
void append_bytes(void *elts, cell len);
|
||||||
|
void append_byte_array(cell elts);
|
||||||
|
|
||||||
|
void trim();
|
||||||
|
};
|
||||||
|
|
||||||
|
//math.hpp
|
||||||
|
inline cell factorvm::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 allot_integer(fixnum x)
|
||||||
|
{
|
||||||
|
return vm->allot_integer(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell factorvm::allot_cell(cell x)
|
||||||
|
{
|
||||||
|
if(x > (cell)fixnum_max)
|
||||||
|
return tag<bignum>(cell_to_bignum(x));
|
||||||
|
else
|
||||||
|
return tag_fixnum(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell allot_cell(cell x)
|
||||||
|
{
|
||||||
|
return vm->allot_cell(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell factorvm::allot_float(double n)
|
||||||
|
{
|
||||||
|
boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
|
||||||
|
flo->n = n;
|
||||||
|
return tag(flo);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell allot_float(double n)
|
||||||
|
{
|
||||||
|
return vm->allot_float(n);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline bignum *factorvm::float_to_bignum(cell tagged)
|
||||||
|
{
|
||||||
|
return double_to_bignum(untag_float(tagged));
|
||||||
|
}
|
||||||
|
|
||||||
|
inline bignum *float_to_bignum(cell tagged)
|
||||||
|
{
|
||||||
|
return vm->float_to_bignum(tagged);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline double factorvm::bignum_to_float(cell tagged)
|
||||||
|
{
|
||||||
|
return bignum_to_double(untag<bignum>(tagged));
|
||||||
|
}
|
||||||
|
|
||||||
|
inline double bignum_to_float(cell tagged)
|
||||||
|
{
|
||||||
|
return vm->bignum_to_float(tagged);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline double factorvm::untag_float(cell tagged)
|
||||||
|
{
|
||||||
|
return untag<boxed_float>(tagged)->n;
|
||||||
|
}
|
||||||
|
|
||||||
|
inline double untag_float(cell tagged)
|
||||||
|
{
|
||||||
|
return vm->untag_float(tagged);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline double factorvm::untag_float_check(cell tagged)
|
||||||
|
{
|
||||||
|
return untag_check<boxed_float>(tagged)->n;
|
||||||
|
}
|
||||||
|
|
||||||
|
inline double untag_float_check(cell tagged)
|
||||||
|
{
|
||||||
|
return vm->untag_float_check(tagged);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline fixnum factorvm::float_to_fixnum(cell tagged)
|
||||||
|
{
|
||||||
|
return (fixnum)untag_float(tagged);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline static fixnum float_to_fixnum(cell tagged)
|
||||||
|
{
|
||||||
|
return vm->float_to_fixnum(tagged);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline double factorvm::fixnum_to_float(cell tagged)
|
||||||
|
{
|
||||||
|
return (double)untag_fixnum(tagged);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline double fixnum_to_float(cell tagged)
|
||||||
|
{
|
||||||
|
return vm->fixnum_to_float(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 factorvm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
|
||||||
|
{
|
||||||
|
gc_root<callstack> stack(stack_,vm);
|
||||||
|
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 iterate_callstack_object(callstack *stack_, TYPE &iterator)
|
||||||
|
{
|
||||||
|
return vm->iterate_callstack_object(stack_,iterator);
|
||||||
|
}
|
||||||
|
|
||||||
|
//booleans.hpp
|
||||||
|
inline cell factorvm::tag_boolean(cell untagged)
|
||||||
|
{
|
||||||
|
return (untagged ? T : F);
|
||||||
|
}
|
||||||
|
|
||||||
|
inline cell tag_boolean(cell untagged)
|
||||||
|
{
|
||||||
|
return vm->tag_boolean(untagged);
|
||||||
|
}
|
||||||
|
|
||||||
|
// callstack.hpp
|
||||||
|
template<typename TYPE> void factorvm::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);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
template<typename TYPE> void iterate_callstack(cell top, cell bottom, TYPE &iterator)
|
||||||
|
{
|
||||||
|
return vm->iterate_callstack(top,bottom,iterator);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
// 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 factorvm;
|
||||||
|
inline void factorvm::do_slots(cell obj, void (* iter)(cell *,factorvm*))
|
||||||
|
{
|
||||||
|
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);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
inline void do_slots(cell obj, void (* iter)(cell *,factorvm*))
|
||||||
|
{
|
||||||
|
return vm->do_slots(obj,iter);
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
||||||
|
|
@ -68,6 +68,7 @@
|
||||||
#include "callstack.hpp"
|
#include "callstack.hpp"
|
||||||
#include "alien.hpp"
|
#include "alien.hpp"
|
||||||
#include "vm.hpp"
|
#include "vm.hpp"
|
||||||
|
#include "inlineimpls.hpp"
|
||||||
#include "jit.hpp"
|
#include "jit.hpp"
|
||||||
#include "quotations.hpp"
|
#include "quotations.hpp"
|
||||||
#include "dispatch.hpp"
|
#include "dispatch.hpp"
|
||||||
|
|
|
||||||
610
vm/vm.hpp
610
vm/vm.hpp
|
|
@ -644,614 +644,4 @@ struct factorvm {
|
||||||
|
|
||||||
extern factorvm *vm;
|
extern factorvm *vm;
|
||||||
|
|
||||||
//tagged.hpp
|
|
||||||
|
|
||||||
template <typename TYPE>
|
|
||||||
struct tagged
|
|
||||||
{
|
|
||||||
cell value_;
|
|
||||||
|
|
||||||
cell value() const { return value_; }
|
|
||||||
TYPE *untagged() const { return (TYPE *)(UNTAG(value_)); }
|
|
||||||
|
|
||||||
cell type() const {
|
|
||||||
cell tag = TAG(value_);
|
|
||||||
if(tag == OBJECT_TYPE)
|
|
||||||
return untagged()->h.hi_tag();
|
|
||||||
else
|
|
||||||
return tag;
|
|
||||||
}
|
|
||||||
|
|
||||||
bool type_p(cell type_) const { return type() == type_; }
|
|
||||||
|
|
||||||
TYPE *untag_check() const {
|
|
||||||
if(TYPE::type_number != TYPE_COUNT && !type_p(TYPE::type_number))
|
|
||||||
type_error(TYPE::type_number,value_);
|
|
||||||
return untagged();
|
|
||||||
}
|
|
||||||
|
|
||||||
explicit tagged(cell tagged) : value_(tagged) {
|
|
||||||
#ifdef FACTOR_DEBUG
|
|
||||||
untag_check();
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
||||||
explicit tagged(TYPE *untagged) : value_(factor::tag(untagged)) {
|
|
||||||
#ifdef FACTOR_DEBUG
|
|
||||||
untag_check();
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
||||||
TYPE *operator->() const { return untagged(); }
|
|
||||||
cell *operator&() const { return &value_; }
|
|
||||||
|
|
||||||
const tagged<TYPE>& operator=(const TYPE *x) { value_ = tag(x); return *this; }
|
|
||||||
const tagged<TYPE>& operator=(const cell &x) { value_ = x; return *this; }
|
|
||||||
|
|
||||||
bool operator==(const tagged<TYPE> &x) { return value_ == x.value_; }
|
|
||||||
bool operator!=(const tagged<TYPE> &x) { return value_ != x.value_; }
|
|
||||||
|
|
||||||
template<typename X> tagged<X> as() { return tagged<X>(value_); }
|
|
||||||
};
|
|
||||||
|
|
||||||
template <typename TYPE> TYPE *factorvm::untag_check(cell value)
|
|
||||||
{
|
|
||||||
return tagged<TYPE>(value).untag_check();
|
|
||||||
}
|
|
||||||
|
|
||||||
template <typename TYPE> TYPE *untag_check(cell value)
|
|
||||||
{
|
|
||||||
return vm->untag_check<TYPE>(value);
|
|
||||||
}
|
|
||||||
|
|
||||||
template <typename TYPE> TYPE *factorvm::untag(cell value)
|
|
||||||
{
|
|
||||||
return tagged<TYPE>(value).untagged();
|
|
||||||
}
|
|
||||||
|
|
||||||
template <typename TYPE> TYPE *untag(cell value)
|
|
||||||
{
|
|
||||||
return vm->untag<TYPE>(value);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
// write_barrier.hpp
|
|
||||||
|
|
||||||
inline card *factorvm::addr_to_card(cell a)
|
|
||||||
{
|
|
||||||
return (card*)(((cell)(a) >> card_bits) + cards_offset);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline card *addr_to_card(cell a)
|
|
||||||
{
|
|
||||||
return vm->addr_to_card(a);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell factorvm::card_to_addr(card *c)
|
|
||||||
{
|
|
||||||
return ((cell)c - cards_offset) << card_bits;
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell card_to_addr(card *c)
|
|
||||||
{
|
|
||||||
return vm->card_to_addr(c);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell factorvm::card_offset(card *c)
|
|
||||||
{
|
|
||||||
return *(c - (cell)data->cards + (cell)data->allot_markers);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell card_offset(card *c)
|
|
||||||
{
|
|
||||||
return vm->card_offset(c);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline card_deck *factorvm::addr_to_deck(cell a)
|
|
||||||
{
|
|
||||||
return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline card_deck *addr_to_deck(cell a)
|
|
||||||
{
|
|
||||||
return vm->addr_to_deck(a);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell factorvm::deck_to_addr(card_deck *c)
|
|
||||||
{
|
|
||||||
return ((cell)c - decks_offset) << deck_bits;
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell deck_to_addr(card_deck *c)
|
|
||||||
{
|
|
||||||
return vm->deck_to_addr(c);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline card *factorvm::deck_to_card(card_deck *d)
|
|
||||||
{
|
|
||||||
return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline card *deck_to_card(card_deck *d)
|
|
||||||
{
|
|
||||||
return vm->deck_to_card(d);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline card *factorvm::addr_to_allot_marker(object *a)
|
|
||||||
{
|
|
||||||
return (card *)(((cell)a >> card_bits) + allot_markers_offset);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline card *addr_to_allot_marker(object *a)
|
|
||||||
{
|
|
||||||
return vm->addr_to_allot_marker(a);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* the write barrier must be called any time we are potentially storing a
|
|
||||||
pointer from an older generation to a younger one */
|
|
||||||
inline void factorvm::write_barrier(object *obj)
|
|
||||||
{
|
|
||||||
*addr_to_card((cell)obj) = card_mark_mask;
|
|
||||||
*addr_to_deck((cell)obj) = card_mark_mask;
|
|
||||||
}
|
|
||||||
|
|
||||||
inline void write_barrier(object *obj)
|
|
||||||
{
|
|
||||||
return vm->write_barrier(obj);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* we need to remember the first object allocated in the card */
|
|
||||||
inline void factorvm::allot_barrier(object *address)
|
|
||||||
{
|
|
||||||
card *ptr = addr_to_allot_marker(address);
|
|
||||||
if(*ptr == invalid_allot_marker)
|
|
||||||
*ptr = ((cell)address & addr_card_mask);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline void allot_barrier(object *address)
|
|
||||||
{
|
|
||||||
return vm->allot_barrier(address);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
//data_gc.hpp
|
|
||||||
inline bool factorvm::collecting_accumulation_gen_p()
|
|
||||||
{
|
|
||||||
return ((data->have_aging_p()
|
|
||||||
&& collecting_gen == data->aging()
|
|
||||||
&& !collecting_aging_again)
|
|
||||||
|| collecting_gen == data->tenured());
|
|
||||||
}
|
|
||||||
|
|
||||||
inline bool collecting_accumulation_gen_p()
|
|
||||||
{
|
|
||||||
return vm->collecting_accumulation_gen_p();
|
|
||||||
}
|
|
||||||
|
|
||||||
inline object *factorvm::allot_zone(zone *z, cell a)
|
|
||||||
{
|
|
||||||
cell h = z->here;
|
|
||||||
z->here = h + align8(a);
|
|
||||||
object *obj = (object *)h;
|
|
||||||
allot_barrier(obj);
|
|
||||||
return obj;
|
|
||||||
}
|
|
||||||
|
|
||||||
inline object *allot_zone(zone *z, cell a)
|
|
||||||
{
|
|
||||||
return vm->allot_zone(z,a);
|
|
||||||
}
|
|
||||||
|
|
||||||
/*
|
|
||||||
* It is up to the caller to fill in the object's fields in a meaningful
|
|
||||||
* fashion!
|
|
||||||
*/
|
|
||||||
inline object *factorvm::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;
|
|
||||||
}
|
|
||||||
|
|
||||||
inline object *allot_object(header header, cell size)
|
|
||||||
{
|
|
||||||
return vm->allot_object(header,size);
|
|
||||||
}
|
|
||||||
|
|
||||||
template<typename TYPE> TYPE *factorvm::allot(cell size)
|
|
||||||
{
|
|
||||||
return (TYPE *)allot_object(header(TYPE::type_number),size);
|
|
||||||
}
|
|
||||||
|
|
||||||
template<typename TYPE> TYPE *allot(cell size)
|
|
||||||
{
|
|
||||||
return vm->allot<TYPE>(size);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline void factorvm::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_data_pointer(object *pointer)
|
|
||||||
{
|
|
||||||
return vm->check_data_pointer(pointer);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline void factorvm::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
|
|
||||||
}
|
|
||||||
|
|
||||||
inline void check_tagged_pointer(cell tagged)
|
|
||||||
{
|
|
||||||
return vm->check_tagged_pointer(tagged);
|
|
||||||
}
|
|
||||||
|
|
||||||
//local_roots.hpp
|
|
||||||
template <typename TYPE>
|
|
||||||
struct gc_root : public tagged<TYPE>
|
|
||||||
{
|
|
||||||
factorvm *myvm;
|
|
||||||
|
|
||||||
void push() { check_tagged_pointer(tagged<TYPE>::value()); myvm->gc_locals.push_back((cell)this); }
|
|
||||||
|
|
||||||
//explicit gc_root(cell value_, factorvm *vm) : myvm(vm),tagged<TYPE>(value_) { push(); }
|
|
||||||
explicit gc_root(cell value_,factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
|
|
||||||
explicit gc_root(TYPE *value_, factorvm *vm) : tagged<TYPE>(value_),myvm(vm) { push(); }
|
|
||||||
|
|
||||||
const gc_root<TYPE>& operator=(const TYPE *x) { tagged<TYPE>::operator=(x); return *this; }
|
|
||||||
const gc_root<TYPE>& operator=(const cell &x) { tagged<TYPE>::operator=(x); return *this; }
|
|
||||||
|
|
||||||
~gc_root() {
|
|
||||||
#ifdef FACTOR_DEBUG
|
|
||||||
assert(myvm->gc_locals.back() == (cell)this);
|
|
||||||
#endif
|
|
||||||
myvm->gc_locals.pop_back();
|
|
||||||
}
|
|
||||||
};
|
|
||||||
|
|
||||||
/* A similar hack for the bignum implementation */
|
|
||||||
struct gc_bignum
|
|
||||||
{
|
|
||||||
bignum **addr;
|
|
||||||
factorvm *myvm;
|
|
||||||
gc_bignum(bignum **addr_, factorvm *vm) : addr(addr_), myvm(vm) {
|
|
||||||
if(*addr_)
|
|
||||||
check_data_pointer(*addr_);
|
|
||||||
myvm->gc_bignums.push_back((cell)addr);
|
|
||||||
}
|
|
||||||
|
|
||||||
~gc_bignum() {
|
|
||||||
#ifdef FACTOR_DEBUG
|
|
||||||
assert(myvm->gc_bignums.back() == (cell)addr);
|
|
||||||
#endif
|
|
||||||
myvm->gc_bignums.pop_back();
|
|
||||||
}
|
|
||||||
};
|
|
||||||
|
|
||||||
#define GC_BIGNUM(x,vm) gc_bignum x##__gc_root(&x,vm)
|
|
||||||
|
|
||||||
//generic_arrays.hpp
|
|
||||||
template <typename TYPE> TYPE *factorvm::allot_array_internal(cell capacity)
|
|
||||||
{
|
|
||||||
TYPE *array = allot<TYPE>(array_size<TYPE>(capacity));
|
|
||||||
array->capacity = tag_fixnum(capacity);
|
|
||||||
return array;
|
|
||||||
}
|
|
||||||
|
|
||||||
template <typename TYPE> TYPE *allot_array_internal(cell capacity)
|
|
||||||
{
|
|
||||||
return vm->allot_array_internal<TYPE>(capacity);
|
|
||||||
}
|
|
||||||
|
|
||||||
template <typename TYPE> bool factorvm::reallot_array_in_place_p(TYPE *array, cell capacity)
|
|
||||||
{
|
|
||||||
return in_zone(&nursery,array) && capacity <= array_capacity(array);
|
|
||||||
}
|
|
||||||
|
|
||||||
template <typename TYPE> bool reallot_array_in_place_p(TYPE *array, cell capacity)
|
|
||||||
{
|
|
||||||
return vm->reallot_array_in_place_p<TYPE>(array,capacity);
|
|
||||||
}
|
|
||||||
|
|
||||||
template <typename TYPE> TYPE *factorvm::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 factorvm::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);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline void set_array_nth(array *array, cell slot, cell value)
|
|
||||||
{
|
|
||||||
return vm->set_array_nth(array,slot,value);
|
|
||||||
}
|
|
||||||
|
|
||||||
struct growable_array {
|
|
||||||
cell count;
|
|
||||||
gc_root<array> elements;
|
|
||||||
|
|
||||||
growable_array(factorvm *myvm, cell capacity = 10) : count(0), elements(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(factorvm *vm,cell capacity = 40) : count(0), elements(allot_byte_array(capacity),vm) { }
|
|
||||||
|
|
||||||
void append_bytes(void *elts, cell len);
|
|
||||||
void append_byte_array(cell elts);
|
|
||||||
|
|
||||||
void trim();
|
|
||||||
};
|
|
||||||
|
|
||||||
//math.hpp
|
|
||||||
inline cell factorvm::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 allot_integer(fixnum x)
|
|
||||||
{
|
|
||||||
return vm->allot_integer(x);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell factorvm::allot_cell(cell x)
|
|
||||||
{
|
|
||||||
if(x > (cell)fixnum_max)
|
|
||||||
return tag<bignum>(cell_to_bignum(x));
|
|
||||||
else
|
|
||||||
return tag_fixnum(x);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell allot_cell(cell x)
|
|
||||||
{
|
|
||||||
return vm->allot_cell(x);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell factorvm::allot_float(double n)
|
|
||||||
{
|
|
||||||
boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
|
|
||||||
flo->n = n;
|
|
||||||
return tag(flo);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell allot_float(double n)
|
|
||||||
{
|
|
||||||
return vm->allot_float(n);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline bignum *factorvm::float_to_bignum(cell tagged)
|
|
||||||
{
|
|
||||||
return double_to_bignum(untag_float(tagged));
|
|
||||||
}
|
|
||||||
|
|
||||||
inline bignum *float_to_bignum(cell tagged)
|
|
||||||
{
|
|
||||||
return vm->float_to_bignum(tagged);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline double factorvm::bignum_to_float(cell tagged)
|
|
||||||
{
|
|
||||||
return bignum_to_double(untag<bignum>(tagged));
|
|
||||||
}
|
|
||||||
|
|
||||||
inline double bignum_to_float(cell tagged)
|
|
||||||
{
|
|
||||||
return vm->bignum_to_float(tagged);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline double factorvm::untag_float(cell tagged)
|
|
||||||
{
|
|
||||||
return untag<boxed_float>(tagged)->n;
|
|
||||||
}
|
|
||||||
|
|
||||||
inline double untag_float(cell tagged)
|
|
||||||
{
|
|
||||||
return vm->untag_float(tagged);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline double factorvm::untag_float_check(cell tagged)
|
|
||||||
{
|
|
||||||
return untag_check<boxed_float>(tagged)->n;
|
|
||||||
}
|
|
||||||
|
|
||||||
inline double untag_float_check(cell tagged)
|
|
||||||
{
|
|
||||||
return vm->untag_float_check(tagged);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline fixnum factorvm::float_to_fixnum(cell tagged)
|
|
||||||
{
|
|
||||||
return (fixnum)untag_float(tagged);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline static fixnum float_to_fixnum(cell tagged)
|
|
||||||
{
|
|
||||||
return vm->float_to_fixnum(tagged);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline double factorvm::fixnum_to_float(cell tagged)
|
|
||||||
{
|
|
||||||
return (double)untag_fixnum(tagged);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline double fixnum_to_float(cell tagged)
|
|
||||||
{
|
|
||||||
return vm->fixnum_to_float(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 factorvm::iterate_callstack_object(callstack *stack_, TYPE &iterator)
|
|
||||||
{
|
|
||||||
gc_root<callstack> stack(stack_,vm);
|
|
||||||
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 iterate_callstack_object(callstack *stack_, TYPE &iterator)
|
|
||||||
{
|
|
||||||
return vm->iterate_callstack_object(stack_,iterator);
|
|
||||||
}
|
|
||||||
|
|
||||||
//booleans.hpp
|
|
||||||
inline cell factorvm::tag_boolean(cell untagged)
|
|
||||||
{
|
|
||||||
return (untagged ? T : F);
|
|
||||||
}
|
|
||||||
|
|
||||||
inline cell tag_boolean(cell untagged)
|
|
||||||
{
|
|
||||||
return vm->tag_boolean(untagged);
|
|
||||||
}
|
|
||||||
|
|
||||||
// callstack.hpp
|
|
||||||
template<typename TYPE> void factorvm::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);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
template<typename TYPE> void iterate_callstack(cell top, cell bottom, TYPE &iterator)
|
|
||||||
{
|
|
||||||
return vm->iterate_callstack(top,bottom,iterator);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
// 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 factorvm;
|
|
||||||
inline void factorvm::do_slots(cell obj, void (* iter)(cell *,factorvm*))
|
|
||||||
{
|
|
||||||
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);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
inline void do_slots(cell obj, void (* iter)(cell *,factorvm*))
|
|
||||||
{
|
|
||||||
return vm->do_slots(obj,iter);
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue