steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://factorcode.org/git/factor

db4
Doug Coleman 2009-11-12 03:01:21 -06:00
parent aec676edec 88be646eee
commit e2fc8b11f1
14 changed files with 239 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile
View File

@ -44,6 +44,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
vm/compaction.o \
vm/contexts.o \
vm/data_heap.o \
vm/data_heap_checker.o \
vm/debug.o \
vm/dispatch.o \
vm/errors.o \

126
basis/cpu/ppc/ppc.factor
View File

@ -256,35 +256,22 @@ M: ppc %double>single-float FRSP ;
M: ppc %unbox-alien ( dst src -- )
alien-offset LWZ ;
M:: ppc %unbox-any-c-ptr ( dst src temp -- )
M:: ppc %unbox-any-c-ptr ( dst src -- )
[
{ "is-byte-array" "end" "start" } [ define-label ] each
! Address is computed in dst
"end" define-label
0 dst LI
! Load object into scratch-reg
scratch-reg src MR
! We come back here with displaced aliens
"start" resolve-label
! Is the object f?
0 scratch-reg \ f type-number CMPI
! If so, done
0 src \ f type-number CMPI
"end" get BEQ
! Compute tag in dst register
dst src tag-mask get ANDI
! Is the object an alien?
0 scratch-reg header-offset LWZ
0 0 alien type-number tag-fixnum CMPI
"is-byte-array" get BNE
! If so, load the offset
0 scratch-reg alien-offset LWZ
! Add it to address being computed
dst dst 0 ADD
! Now recurse on the underlying alien
scratch-reg scratch-reg underlying-alien-offset LWZ
"start" get B
"is-byte-array" resolve-label
! Add byte array address to address being computed
dst dst scratch-reg ADD
! Add an offset to start of byte array's data area
dst dst byte-array-offset ADDI
0 dst alien type-number CMPI
! Add an offset to start of byte array's data
dst src byte-array-offset ADDI
"end" get BNE
! If so, load the offset and add it to the address
dst src alien-offset LWZ
"end" resolve-label
] with-scope ;
@ -293,53 +280,84 @@ M:: ppc %unbox-any-c-ptr ( dst src temp -- )
M:: ppc %box-alien ( dst src temp -- )
[
"f" define-label
dst %load-immediate
dst \ f type-number %load-immediate
0 src 0 CMPI
"f" get BEQ
dst 5 cells alien temp %allot
temp \ f type-number %load-immediate
temp dst 1 alien@ STW
temp dst 2 alien@ STW
displacement dst 3 alien@ STW
displacement dst 4 alien@ STW
src dst 3 alien@ STW
src dst 4 alien@ STW
"f" resolve-label
] with-scope ;
M:: ppc %box-displaced-alien ( dst displacement base displacement' base' base-class -- )
M:: ppc %box-displaced-alien ( dst displacement base temp base-class -- )
! This is ridiculous
[
"end" define-label
"alloc" define-label
"simple-case" define-label
"not-f" define-label
"not-alien" define-label
! If displacement is zero, return the base
dst base MR
0 displacement 0 CMPI
"end" get BEQ
! Quickly use displacement' before its needed for real, as allot temporary
displacement' :> temp
dst 4 cells alien temp %allot
! If base is already a displaced alien, unpack it
0 base \ f type-number CMPI
"simple-case" get BEQ
temp base header-offset LWZ
0 temp alien type-number tag-fixnum CMPI
"simple-case" get BNE
! displacement += base.displacement
temp base 3 alien@ LWZ
displacement' displacement temp ADD
! base = base.base
base' base 1 alien@ LWZ
"alloc" get B
"simple-case" resolve-label
displacement' displacement MR
base' base MR
"alloc" resolve-label
! Store underlying-alien slot
base' dst 1 alien@ STW
! Store offset
displacement' dst 3 alien@ STW
! Store expired slot (its ok to clobber displacement')
! Displacement is non-zero, we're going to be allocating a new
! object
dst 5 cells alien temp %allot
! Set expired to f
temp \ f type-number %load-immediate
temp dst 2 alien@ STW
! Is base f?
0 base \ f type-number CMPI
"not-f" get BNE
! Yes, it is f. Fill in new object
base dst 1 alien@ STW
displacement dst 3 alien@ STW
displacement dst 4 alien@ STW
"end" get B
"not-f" resolve-label
! Check base type
temp base tag-mask get ANDI
! Is base an alien?
0 temp alien type-number CMPI
"not-alien" get BNE
! Yes, it is an alien. Set new alien's base to base.base
temp base 1 alien@ LWZ
temp dst 1 alien@ STW
! Compute displacement
temp base 3 alien@ LWZ
temp temp displacement ADD
temp dst 3 alien@ STW
! Compute address
temp base 4 alien@ LWZ
temp temp displacement ADD
temp dst 4 alien@ STW
! We are done
"end" get B
! Is base a byte array? It has to be, by now...
"not-alien" resolve-label
base dst 1 alien@ STW
displacement dst 3 alien@ STW
temp base byte-array-offset ADDI
temp temp displacement ADD
temp dst 4 alien@ STW
"end" resolve-label
] with-scope ;

5
basis/tools/memory/memory.factor
View File

@ -4,8 +4,7 @@ USING: accessors arrays assocs classes classes.struct
combinators combinators.smart continuations fry generalizations
generic grouping io io.styles kernel make math math.parser
math.statistics memory namespaces parser prettyprint sequences
sorting specialized-arrays splitting strings system vm words ;
SPECIALIZED-ARRAY: gc-event
sorting splitting strings system vm words ;
IN: tools.memory
<PRIVATE
@ -101,7 +100,7 @@ SYMBOL: gc-events
: collect-gc-events ( quot -- )
enable-gc-events
[ ] [ disable-gc-events drop ] cleanup
disable-gc-events byte-array>gc-event-array gc-events set ; inline
disable-gc-events [ gc-event memory>struct ] map gc-events set ; inline
<PRIVATE

15
vm/arrays.cpp
View File

@ -3,7 +3,6 @@
namespace factor
{
/* make a new array with an initial element */
array *factor_vm::allot_array(cell capacity, cell fill_)
{
data_root<object> fill(fill_,this);
@ -12,12 +11,13 @@ array *factor_vm::allot_array(cell capacity, cell fill_)
return new_array;
}
/* push a new array on the stack */
void factor_vm::primitive_array()
{
cell initial = dpop();
cell size = unbox_array_size();
dpush(tag<array>(allot_array(size,initial)));
data_root<object> fill(dpop(),this);
cell capacity = unbox_array_size();
array *new_array = allot_uninitialized_array<array>(capacity);
memset_cell(new_array->data(),fill.value(),capacity * sizeof(cell));
dpush(tag<array>(new_array));
}
cell factor_vm::allot_array_1(cell obj_)
@ -54,9 +54,10 @@ cell factor_vm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
void factor_vm::primitive_resize_array()
{
array *a = untag_check<array>(dpop());
data_root<array> a(dpop(),this);
a.untag_check(this);
cell capacity = unbox_array_size();
dpush(tag<array>(reallot_array(a,capacity)));
dpush(tag<array>(reallot_array(a.untagged(),capacity)));
}
void growable_array::add(cell elt_)

5
vm/byte_arrays.cpp
View File

@ -24,9 +24,10 @@ void factor_vm::primitive_uninitialized_byte_array()
void factor_vm::primitive_resize_byte_array()
{
byte_array *array = untag_check<byte_array>(dpop());
data_root<byte_array> array(dpop(),this);
array.untag_check(this);
cell capacity = unbox_array_size();
dpush(tag<byte_array>(reallot_array(array,capacity)));
dpush(tag<byte_array>(reallot_array(array.untagged(),capacity)));
}
void growable_byte_array::append_bytes(void *elts, cell len)

10
vm/byte_arrays.hpp
View File

@ -15,14 +15,8 @@ struct growable_byte_array {
template<typename Type> byte_array *factor_vm::byte_array_from_value(Type *value)
{
return byte_array_from_values(value,1);
}
template<typename Type> byte_array *factor_vm::byte_array_from_values(Type *values, cell len)
{
cell size = sizeof(Type) * len;
byte_array *data = allot_uninitialized_array<byte_array>(size);
memcpy(data->data<char>(),values,size);
byte_array *data = allot_uninitialized_array<byte_array>(sizeof(Type));
memcpy(data->data<char>(),value,sizeof(Type));
return data;
}

101
vm/data_heap_checker.cpp Normal file
View File

@ -0,0 +1,101 @@
#include "master.hpp"
/* A tool to debug write barriers. Call check_data_heap() to ensure that all
cards that should be marked are actually marked. */
namespace factor
{
enum generation {
nursery_generation,
aging_generation,
tenured_generation
};
inline generation generation_of(factor_vm *parent, object *obj)
{
if(parent->data->nursery->contains_p(obj))
return nursery_generation;
else if(parent->data->aging->contains_p(obj))
return aging_generation;
else if(parent->data->tenured->contains_p(obj))
return tenured_generation;
else
{
critical_error("Bad object",(cell)obj);
return (generation)-1;
}
}
struct slot_checker {
factor_vm *parent;
object *obj;
generation gen;
explicit slot_checker(factor_vm *parent_, object *obj_, generation gen_) :
parent(parent_), obj(obj_), gen(gen_) {}
void check_write_barrier(cell *slot_ptr, generation target, char mask)
{
cell object_card_pointer = parent->cards_offset + ((cell)obj >> card_bits);
cell slot_card_pointer = parent->cards_offset + ((cell)slot_ptr >> card_bits);
char slot_card_value = *(char *)slot_card_pointer;
if((slot_card_value & mask) != mask)
{
printf("card not marked\n");
printf("source generation: %d\n",gen);
printf("target generation: %d\n",target);
printf("object: 0x%lx\n",(cell)obj);
printf("object type: %ld\n",obj->type());
printf("slot pointer: 0x%lx\n",(cell)slot_ptr);
printf("slot value: 0x%lx\n",*slot_ptr);
printf("card of object: 0x%lx\n",object_card_pointer);
printf("card of slot: 0x%lx\n",slot_card_pointer);
printf("\n");
parent->factorbug();
}
}
void operator()(cell *slot_ptr)
{
if(!immediate_p(*slot_ptr))
{
generation target = generation_of(parent,untag<object>(*slot_ptr));
switch(gen)
{
case nursery_generation:
break;
case aging_generation:
if(target == nursery_generation)
check_write_barrier(slot_ptr,target,card_points_to_nursery);
break;
case tenured_generation:
if(target == nursery_generation)
check_write_barrier(slot_ptr,target,card_points_to_nursery);
else if(target == aging_generation)
check_write_barrier(slot_ptr,target,card_points_to_aging);
break;
}
}
}
};
struct object_checker {
factor_vm *parent;
explicit object_checker(factor_vm *parent_) : parent(parent_) {}
void operator()(object *obj)
{
slot_checker checker(parent,obj,generation_of(parent,obj));
obj->each_slot(checker);
}
};
void factor_vm::check_data_heap()
{
object_checker checker(this);
each_object(checker);
}
}

2
vm/debug.cpp
View File

@ -288,7 +288,7 @@ struct data_reference_object_visitor {
void operator()(object *obj)
{
data_reference_slot_visitor visitor(look_for,obj,parent);
parent->do_slots(obj,visitor);
obj->each_slot(visitor);
}
};

22
vm/gc.cpp
View File

@ -270,11 +270,25 @@ void factor_vm::primitive_disable_gc_events()
{
if(gc_events)
{
byte_array *data = byte_array_from_values(&gc_events->front(),gc_events->size());
dpush(tag<byte_array>(data));
growable_array result(this);
delete gc_events;
gc_events = NULL;
std::vector<gc_event> *gc_events = this->gc_events;
this->gc_events = NULL;
std::vector<gc_event>::const_iterator iter = gc_events->begin();
std::vector<gc_event>::const_iterator end = gc_events->end();
for(; iter != end; iter++)
{
gc_event event = *iter;
byte_array *obj = byte_array_from_value(&event);
result.add(tag<byte_array>(obj));
}
result.trim();
dpush(result.elements.value());
delete this->gc_events;
}
else
dpush(false_object);

4
vm/image.cpp
View File

@ -138,7 +138,7 @@ void factor_vm::relocate_object(object *object,
cell type = object->type();
/* Tuple relocation is a bit trickier; we have to fix up the
layout object before we can get the tuple size, so do_slots is
layout object before we can get the tuple size, so each_slot is
out of the question */
if(type == TUPLE_TYPE)
{
@ -154,7 +154,7 @@ void factor_vm::relocate_object(object *object,
else
{
object_fixupper fixupper(this,data_relocation_base);
do_slots(object,fixupper);
object->each_slot(fixupper);
switch(type)
{

4
vm/layouts.hpp
View File

@ -102,7 +102,9 @@ struct object {
cell size() const;
cell binary_payload_start() const;
cell *slots() const { return (cell *)this; }
cell *slots() const { return (cell *)this; }
template<typename Iterator> void each_slot(Iterator &iter);
/* Only valid for objects in tenured space; must cast to free_heap_block
to do anything with it if its free */

15
vm/objects.hpp
View File

@ -98,4 +98,19 @@ inline static bool save_env_p(cell i)
return (i >= OBJ_FIRST_SAVE && i <= OBJ_LAST_SAVE);
}
template<typename Iterator> void object::each_slot(Iterator &iter)
{
cell scan = (cell)this;
cell payload_start = binary_payload_start();
cell end = scan + payload_start;
scan += sizeof(cell);
while(scan < end)
{
iter((cell *)scan);
scan += sizeof(cell);
}
}
}

5
vm/strings.cpp
View File

@ -157,9 +157,10 @@ string* factor_vm::reallot_string(string *str_, cell capacity)
void factor_vm::primitive_resize_string()
{
string* str = untag_check<string>(dpop());
data_root<string> str(dpop(),this);
str.untag_check(this);
cell capacity = unbox_array_size();
dpush(tag<string>(reallot_string(str,capacity)));
dpush(tag<string>(reallot_string(str.untagged(),capacity)));
}
void factor_vm::primitive_string_nth()

30
vm/vm.hpp
View File

@ -262,11 +262,16 @@ struct factor_vm
inline void write_barrier(object *obj, cell size)
{
char *start = (char *)obj;
for(cell offset = 0; offset < size; offset += card_size)
write_barrier((cell *)(start + offset));
cell start = (cell)obj & -card_size;
cell end = ((cell)obj + size + card_size - 1) & -card_size;
for(cell offset = start; offset < end; offset += card_size)
write_barrier((cell *)offset);
}
// data heap checker
void check_data_heap();
// gc
void end_gc();
void start_gc_again();
@ -374,7 +379,6 @@ struct factor_vm
void primitive_resize_byte_array();
template<typename Type> byte_array *byte_array_from_value(Type *value);
template<typename Type> byte_array *byte_array_from_values(Type *values, cell len);
//tuples
void primitive_tuple();
@ -586,24 +590,6 @@ struct factor_vm
void save_callstack_bottom(stack_frame *callstack_bottom);
template<typename Iterator> void iterate_callstack(context *ctx, Iterator &iterator);
/* 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. */
template<typename Iterator> void do_slots(object *obj, Iterator &iter)
{
cell scan = (cell)obj;
cell payload_start = obj->binary_payload_start();
cell end = scan + payload_start;
scan += sizeof(cell);
while(scan < end)
{
iter((cell *)scan);
scan += sizeof(cell);
}
}
//alien
char *pinned_alien_offset(cell obj);
cell allot_alien(cell delegate_, cell displacement);