diff --git a/Makefile b/Makefile index 52914d128a..6aee3e329d 100755 --- a/Makefile +++ b/Makefile @@ -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 \ diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 0fb99374a0..a7eb3bb4a5 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -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 ; diff --git a/basis/tools/memory/memory.factor b/basis/tools/memory/memory.factor index c147426a6f..cf7e3ee38d 100644 --- a/basis/tools/memory/memory.factor +++ b/basis/tools/memory/memory.factor @@ -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 gc-event-array gc-events set ; inline + disable-gc-events [ gc-event memory>struct ] map gc-events set ; inline 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(allot_array(size,initial))); + data_root fill(dpop(),this); + cell capacity = unbox_array_size(); + array *new_array = allot_uninitialized_array(capacity); + memset_cell(new_array->data(),fill.value(),capacity * sizeof(cell)); + dpush(tag(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(dpop()); + data_root a(dpop(),this); + a.untag_check(this); cell capacity = unbox_array_size(); - dpush(tag(reallot_array(a,capacity))); + dpush(tag(reallot_array(a.untagged(),capacity))); } void growable_array::add(cell elt_) diff --git a/vm/byte_arrays.cpp b/vm/byte_arrays.cpp index b317c39f62..7cfe6c2ff0 100644 --- a/vm/byte_arrays.cpp +++ b/vm/byte_arrays.cpp @@ -24,9 +24,10 @@ void factor_vm::primitive_uninitialized_byte_array() void factor_vm::primitive_resize_byte_array() { - byte_array *array = untag_check(dpop()); + data_root array(dpop(),this); + array.untag_check(this); cell capacity = unbox_array_size(); - dpush(tag(reallot_array(array,capacity))); + dpush(tag(reallot_array(array.untagged(),capacity))); } void growable_byte_array::append_bytes(void *elts, cell len) diff --git a/vm/byte_arrays.hpp b/vm/byte_arrays.hpp index a3d6fcf941..a96baff6ec 100755 --- a/vm/byte_arrays.hpp +++ b/vm/byte_arrays.hpp @@ -15,14 +15,8 @@ struct growable_byte_array { template byte_array *factor_vm::byte_array_from_value(Type *value) { - return byte_array_from_values(value,1); -} - -template byte_array *factor_vm::byte_array_from_values(Type *values, cell len) -{ - cell size = sizeof(Type) * len; - byte_array *data = allot_uninitialized_array(size); - memcpy(data->data(),values,size); + byte_array *data = allot_uninitialized_array(sizeof(Type)); + memcpy(data->data(),value,sizeof(Type)); return data; } diff --git a/vm/data_heap_checker.cpp b/vm/data_heap_checker.cpp new file mode 100644 index 0000000000..fb05508e3f --- /dev/null +++ b/vm/data_heap_checker.cpp @@ -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(*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); +} + +} diff --git a/vm/debug.cpp b/vm/debug.cpp index 376b9b8346..aa16b39a81 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -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); } }; diff --git a/vm/gc.cpp b/vm/gc.cpp index a9372535d4..32ca44ae1c 100755 --- a/vm/gc.cpp +++ b/vm/gc.cpp @@ -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(data)); + growable_array result(this); - delete gc_events; - gc_events = NULL; + std::vector *gc_events = this->gc_events; + this->gc_events = NULL; + + std::vector::const_iterator iter = gc_events->begin(); + std::vector::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(obj)); + } + + result.trim(); + dpush(result.elements.value()); + + delete this->gc_events; } else dpush(false_object); diff --git a/vm/image.cpp b/vm/image.cpp index 0a84c2d337..db91b4f1ea 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -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) { diff --git a/vm/layouts.hpp b/vm/layouts.hpp index f9aace963b..048c9c460f 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -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 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 */ diff --git a/vm/objects.hpp b/vm/objects.hpp index c4e8547ce6..69ff451914 100644 --- a/vm/objects.hpp +++ b/vm/objects.hpp @@ -98,4 +98,19 @@ inline static bool save_env_p(cell i) return (i >= OBJ_FIRST_SAVE && i <= OBJ_LAST_SAVE); } +template 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); + } +} + } diff --git a/vm/strings.cpp b/vm/strings.cpp index 9e135e6779..d9a32517a4 100644 --- a/vm/strings.cpp +++ b/vm/strings.cpp @@ -157,9 +157,10 @@ string* factor_vm::reallot_string(string *str_, cell capacity) void factor_vm::primitive_resize_string() { - string* str = untag_check(dpop()); + data_root str(dpop(),this); + str.untag_check(this); cell capacity = unbox_array_size(); - dpush(tag(reallot_string(str,capacity))); + dpush(tag(reallot_string(str.untagged(),capacity))); } void factor_vm::primitive_string_nth() diff --git a/vm/vm.hpp b/vm/vm.hpp index a0caf26529..0e4762d6c5 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -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 byte_array *byte_array_from_value(Type *value); - template 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 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 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);