diff --git a/Makefile b/Makefile index a346bdfa0a..753c89c3d7 100644 --- a/Makefile +++ b/Makefile @@ -13,7 +13,7 @@ CFLAGS = -Wall FFI_TEST_CFLAGS = -fPIC ifdef DEBUG - CFLAGS += -g + CFLAGS += -g -DFACTOR_DEBUG else CFLAGS += -O3 endif diff --git a/vm/bignumint.h b/vm/bignumint.h index a101473fc6..7c835686c2 100644 --- a/vm/bignumint.h +++ b/vm/bignumint.h @@ -64,7 +64,7 @@ typedef F_FIXNUM bignum_length_type; #define BIGNUM_LENGTH(bignum) (untag_fixnum_fast((bignum)->capacity) - 1) -#define BIGNUM_NEGATIVE_P(bignum) (array_nth(bignum,0) != 0) +#define BIGNUM_NEGATIVE_P(bignum) (get(AREF(bignum,0)) != 0) #define BIGNUM_SET_NEGATIVE_P(bignum,neg) put(AREF(bignum,0),neg) #define BIGNUM_ZERO_P(bignum) \ diff --git a/vm/code_block.c b/vm/code_block.c index 100670bbe8..e7d8bec0ac 100644 --- a/vm/code_block.c +++ b/vm/code_block.c @@ -184,6 +184,13 @@ void update_word_references(F_CODE_BLOCK *compiled) } } +INLINE void check_code_address(CELL address) +{ +#ifdef FACTOR_DEBUG + assert(address >= code_heap.segment->start && address < code_heap.segment->end); +#endif +} + /* Update references to words. This is done after a new code block is added to the heap. */ @@ -191,6 +198,8 @@ is added to the heap. */ collections */ void mark_code_block(F_CODE_BLOCK *compiled) { + check_code_address((CELL)compiled); + mark_block(&compiled->block); copy_handle(&compiled->literals); @@ -287,6 +296,11 @@ void *get_rel_symbol(F_ARRAY *literals, CELL index) /* Compute an address to store at a relocation */ void relocate_code_block_step(F_REL rel, CELL index, F_CODE_BLOCK *compiled) { +#ifdef FACTOR_DEBUG + type_check(ARRAY_TYPE,compiled->literals); + type_check(BYTE_ARRAY_TYPE,compiled->relocation); +#endif + CELL offset = REL_OFFSET(rel) + (CELL)(compiled + 1); F_ARRAY *literals = untag_object(compiled->literals); F_FIXNUM absolute_value; @@ -410,6 +424,12 @@ F_CODE_BLOCK *add_code_block( CELL relocation, CELL literals) { +#ifdef FACTOR_DEBUG + type_check(ARRAY_TYPE,literals); + type_check(BYTE_ARRAY_TYPE,relocation); + assert(hi_tag(code) == ARRAY_TYPE); +#endif + CELL code_format = compiled_code_format(); CELL code_length = align8(array_capacity(code) * code_format); @@ -436,6 +456,11 @@ F_CODE_BLOCK *add_code_block( compiled->literals = literals; compiled->relocation = relocation; +#ifdef FACTOR_DEBUG + type_check(ARRAY_TYPE,compiled->literals); + type_check(BYTE_ARRAY_TYPE,compiled->relocation); +#endif + /* code */ deposit_integers((CELL)(compiled + 1),code,code_format); diff --git a/vm/code_heap.c b/vm/code_heap.c index 1901c592e6..0c63abfbe0 100755 --- a/vm/code_heap.c +++ b/vm/code_heap.c @@ -97,7 +97,7 @@ void primitive_modify_code_heap(void) { F_ARRAY *compiled_code = untag_array(data); - F_ARRAY *literals = untag_array(array_nth(compiled_code,0)); + CELL literals = array_nth(compiled_code,0); CELL relocation = array_nth(compiled_code,1); F_ARRAY *labels = untag_array(array_nth(compiled_code,2)); F_ARRAY *code = untag_array(array_nth(compiled_code,3)); @@ -110,7 +110,7 @@ void primitive_modify_code_heap(void) code, labels, relocation, - tag_object(literals)); + literals); UNREGISTER_UNTAGGED(word); UNREGISTER_UNTAGGED(alist); diff --git a/vm/data_gc.c b/vm/data_gc.c index 872358d362..458f01aaee 100755 --- a/vm/data_gc.c +++ b/vm/data_gc.c @@ -1,5 +1,16 @@ #include "master.h" +INLINE void check_data_pointer(CELL pointer) +{ +#ifdef FACTOR_DEBUG + if(!growing_data_heap) + { + assert(pointer >= data_heap->segment->start + && pointer < data_heap->segment->end); + } +#endif +} + /* Scan all the objects in the card */ void copy_card(F_CARD *ptr, CELL gen, CELL here) { @@ -211,6 +222,8 @@ INLINE CELL copy_object_impl(CELL pointer) /* Follow a chain of forwarding pointers */ CELL resolve_forwarding(CELL untagged, CELL tag) { + check_data_pointer(untagged); + CELL header = get(untagged); /* another forwarding pointer */ if(TAG(header) == GC_COLLECTED) @@ -218,6 +231,7 @@ CELL resolve_forwarding(CELL untagged, CELL tag) /* we've found the destination */ else { + check_header(header); CELL pointer = RETAG(untagged,tag); if(should_copy(untagged)) pointer = RETAG(copy_object_impl(pointer),tag); @@ -231,21 +245,30 @@ pointer address without copying anything; otherwise, install a new forwarding pointer. */ INLINE CELL copy_object(CELL pointer) { + check_data_pointer(pointer); + CELL tag = TAG(pointer); CELL header = get(UNTAG(pointer)); if(TAG(header) == GC_COLLECTED) return resolve_forwarding(UNTAG(header),tag); else + { + check_header(header); return RETAG(copy_object_impl(pointer),tag); + } } void copy_handle(CELL *handle) { CELL pointer = *handle; - if(!immediate_p(pointer) && should_copy(pointer)) - *handle = copy_object(pointer); + if(!immediate_p(pointer)) + { + check_data_pointer(pointer); + if(should_copy(pointer)) + *handle = copy_object(pointer); + } } CELL copy_next_from_nursery(CELL scan) @@ -264,9 +287,12 @@ CELL copy_next_from_nursery(CELL scan) { CELL pointer = *obj; - if(!immediate_p(pointer) - && (pointer >= nursery_start && pointer < nursery_end)) - *obj = copy_object(pointer); + if(!immediate_p(pointer)) + { + check_data_pointer(pointer); + if(pointer >= nursery_start && pointer < nursery_end) + *obj = copy_object(pointer); + } } } @@ -292,10 +318,13 @@ CELL copy_next_from_aging(CELL scan) { CELL pointer = *obj; - if(!immediate_p(pointer) - && !(pointer >= newspace_start && pointer < newspace_end) - && !(pointer >= tenured_start && pointer < tenured_end)) - *obj = copy_object(pointer); + if(!immediate_p(pointer)) + { + check_data_pointer(pointer); + if(!(pointer >= newspace_start && pointer < newspace_end) + && !(pointer >= tenured_start && pointer < tenured_end)) + *obj = copy_object(pointer); + } } } @@ -318,8 +347,12 @@ CELL copy_next_from_tenured(CELL scan) { CELL pointer = *obj; - if(!immediate_p(pointer) && !(pointer >= newspace_start && pointer < newspace_end)) - *obj = copy_object(pointer); + if(!immediate_p(pointer)) + { + check_data_pointer(pointer); + if(!(pointer >= newspace_start && pointer < newspace_end)) + *obj = copy_object(pointer); + } } } @@ -474,6 +507,7 @@ void garbage_collection(CELL gen, copy_roots(); /* collect objects referenced from older generations */ copy_cards(); + /* do some tracing */ copy_reachable_objects(scan,&newspace->here); diff --git a/vm/data_gc.h b/vm/data_gc.h index a1184d53d4..31d7eddebb 100755 --- a/vm/data_gc.h +++ b/vm/data_gc.h @@ -93,7 +93,7 @@ INLINE void *allot_object(CELL type, CELL a) #ifdef GC_DEBUG if(!gc_off) { - if(gc_count++ % 1000 == 0) + if(gc_count++ % 100 == 0) gc(); } diff --git a/vm/factor.c b/vm/factor.c index 9b5d3de602..27ec80a4eb 100755 --- a/vm/factor.c +++ b/vm/factor.c @@ -118,7 +118,10 @@ void init_factor(F_PARAMETERS *p) init_stacks(p->ds_size,p->rs_size); load_image(p); init_c_io(); + +#ifndef FACTOR_DEBUG init_signals(); +#endif if(p->console) open_console(); diff --git a/vm/master.h b/vm/master.h index e2cafd9a87..c5375186bc 100644 --- a/vm/master.h +++ b/vm/master.h @@ -2,7 +2,11 @@ #define __FACTOR_MASTER_H__ #ifndef WINCE - #include +#include +#endif + +#ifdef FACTOR_DEBUG +#include #endif #include diff --git a/vm/profiler.c b/vm/profiler.c index acafecdff5..1fe5b110f7 100755 --- a/vm/profiler.c +++ b/vm/profiler.c @@ -48,7 +48,8 @@ void update_word_xt(F_WORD *word) word->xt = (XT)(word->code + 1); } -void set_profiling(bool profiling) +/* Allocates memory */ +static void set_profiling(bool profiling) { if(profiling == profiling_p) return; diff --git a/vm/quotations.c b/vm/quotations.c index 48979256ff..a6da41d458 100755 --- a/vm/quotations.c +++ b/vm/quotations.c @@ -204,6 +204,8 @@ void jit_compile(CELL quot, bool relocate) for(i = 0; i < length; i++) { CELL obj = array_nth(untag_object(array),i); + REGISTER_ROOT(obj); + F_WORD *word; F_WRAPPER *wrapper; @@ -325,6 +327,8 @@ void jit_compile(CELL quot, bool relocate) EMIT(userenv[JIT_PUSH_IMMEDIATE]) break; } + + UNREGISTER_ROOT(obj); } if(!tail_call) @@ -339,6 +343,10 @@ void jit_compile(CELL quot, bool relocate) GROWABLE_BYTE_ARRAY_TRIM(relocation); GROWABLE_ARRAY_TRIM(code); + GROWABLE_ARRAY_DONE(literals); + GROWABLE_BYTE_ARRAY_DONE(relocation); + GROWABLE_ARRAY_DONE(code); + F_CODE_BLOCK *compiled = add_code_block( QUOTATION_TYPE, untag_object(code), @@ -351,10 +359,6 @@ void jit_compile(CELL quot, bool relocate) if(relocate) relocate_code_block(compiled); - GROWABLE_ARRAY_DONE(literals); - GROWABLE_BYTE_ARRAY_DONE(relocation); - GROWABLE_ARRAY_DONE(code); - UNREGISTER_ROOT(array); UNREGISTER_ROOT(quot); } @@ -536,10 +540,13 @@ void compile_all_words(void) { F_WORD *word = untag_word(array_nth(untag_array(words),i)); REGISTER_UNTAGGED(word); + if(word->optimizedp == F) jit_compile_word(word,word->def,false); + UNREGISTER_UNTAGGED(word); update_word_xt(word); + } UNREGISTER_ROOT(words); diff --git a/vm/run.h b/vm/run.h index fb6e437404..ba183fb6d4 100755 --- a/vm/run.h +++ b/vm/run.h @@ -129,8 +129,16 @@ INLINE CELL tag_header(CELL cell) return cell << TAG_BITS; } +INLINE void check_header(CELL cell) +{ +#ifdef FACTOR_DEBUG + assert(TAG(cell) == FIXNUM_TYPE && untag_fixnum_fast(cell) < TYPE_COUNT); +#endif +} + INLINE CELL untag_header(CELL cell) { + check_header(cell); return cell >> TAG_BITS; } diff --git a/vm/types.c b/vm/types.c index 1985f51567..644c205460 100755 --- a/vm/types.c +++ b/vm/types.c @@ -224,7 +224,7 @@ void growable_array_append(F_GROWABLE_ARRAY *array, F_ARRAY *elts) UNREGISTER_UNTAGGED(elts); - write_barrier((CELL)array->array); + write_barrier(array->array); memcpy((void *)AREF(underlying,array->count), (void *)AREF(elts,0), diff --git a/vm/types.h b/vm/types.h index 01176d6191..f3039f945c 100755 --- a/vm/types.h +++ b/vm/types.h @@ -40,25 +40,37 @@ INLINE CELL tag_boolean(CELL untagged) DEFINE_UNTAG(F_ARRAY,ARRAY_TYPE,array) +INLINE CELL array_capacity(F_ARRAY* array) +{ +#ifdef FACTOR_DEBUG + CELL header = untag_header(array->header); + assert(header == ARRAY_TYPE || header == BIGNUM_TYPE || header == BYTE_ARRAY_TYPE); +#endif + return array->capacity >> TAG_BITS; +} + #define AREF(array,index) ((CELL)(array) + sizeof(F_ARRAY) + (index) * CELLS) #define UNAREF(array,ptr) (((CELL)(ptr)-(CELL)(array)-sizeof(F_ARRAY)) / CELLS) INLINE CELL array_nth(F_ARRAY *array, CELL slot) { +#ifdef FACTOR_DEBUG + assert(slot < array_capacity(array)); + assert(untag_header(array->header) == ARRAY_TYPE); +#endif return get(AREF(array,slot)); } INLINE void set_array_nth(F_ARRAY *array, CELL slot, CELL value) { +#ifdef FACTOR_DEBUG + assert(slot < array_capacity(array)); + assert(untag_header(array->header) == ARRAY_TYPE); +#endif put(AREF(array,slot),value); write_barrier((CELL)array); } -INLINE CELL array_capacity(F_ARRAY* array) -{ - return array->capacity >> TAG_BITS; -} - #define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + (index)) #define SREF(string,index) ((CELL)string + sizeof(F_STRING) + (index)) @@ -164,11 +176,12 @@ typedef struct { CELL array; } F_GROWABLE_ARRAY; +/* Allocates memory */ INLINE F_GROWABLE_ARRAY make_growable_array(void) { F_GROWABLE_ARRAY result; result.count = 0; - result.array = tag_object(allot_array(ARRAY_TYPE,10000,F)); + result.array = tag_object(allot_array(ARRAY_TYPE,100,F)); return result; } @@ -185,14 +198,16 @@ void growable_array_append(F_GROWABLE_ARRAY *result, F_ARRAY *elts); #define GROWABLE_ARRAY_APPEND(result,elts) \ growable_array_append(&result##_g,elts) -INLINE CELL growable_array_trim(F_GROWABLE_ARRAY *array) +INLINE void growable_array_trim(F_GROWABLE_ARRAY *array) { - return tag_object(reallot_array(untag_object(array->array),array->count)); + array->array = tag_object(reallot_array(untag_object(array->array),array->count)); } -#define GROWABLE_ARRAY_TRIM(result) CELL result = growable_array_trim(&result##_g) +#define GROWABLE_ARRAY_TRIM(result) growable_array_trim(&result##_g) -#define GROWABLE_ARRAY_DONE(result) UNREGISTER_ROOT(result##_g.array) +#define GROWABLE_ARRAY_DONE(result) \ + UNREGISTER_ROOT(result##_g.array); \ + CELL result = result##_g.array; /* Macros to simulate a byte vector in C */ typedef struct { @@ -204,7 +219,7 @@ INLINE F_GROWABLE_BYTE_ARRAY make_growable_byte_array(void) { F_GROWABLE_BYTE_ARRAY result; result.count = 0; - result.array = tag_object(allot_byte_array(10000)); + result.array = tag_object(allot_byte_array(100)); return result; } @@ -217,11 +232,13 @@ void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *result, void *elts, CELL #define GROWABLE_BYTE_ARRAY_APPEND(result,elts,len) \ growable_byte_array_append(&result##_g,elts,len) -INLINE CELL growable_byte_array_trim(F_GROWABLE_BYTE_ARRAY *byte_array) +INLINE void growable_byte_array_trim(F_GROWABLE_BYTE_ARRAY *byte_array) { - return tag_object(reallot_byte_array(untag_object(byte_array->array),byte_array->count)); + byte_array->array = tag_object(reallot_byte_array(untag_object(byte_array->array),byte_array->count)); } -#define GROWABLE_BYTE_ARRAY_TRIM(result) CELL result = growable_byte_array_trim(&result##_g) +#define GROWABLE_BYTE_ARRAY_TRIM(result) growable_byte_array_trim(&result##_g) -#define GROWABLE_BYTE_ARRAY_DONE(result) UNREGISTER_ROOT(result##_g.array); +#define GROWABLE_BYTE_ARRAY_DONE(result) \ + UNREGISTER_ROOT(result##_g.array); \ + CELL result = result##_g.array;