diff --git a/vm/code_block.c b/vm/code_block.c index 8dda8bc16e..c04e13d691 100644 --- a/vm/code_block.c +++ b/vm/code_block.c @@ -224,7 +224,8 @@ void mark_object_code_block(CELL scan) { case WORD_TYPE: word = (F_WORD *)scan; - mark_code_block(word->code); + if(word->code) + mark_code_block(word->code); if(word->profiling) mark_code_block(word->profiling); break; diff --git a/vm/data_gc.c b/vm/data_gc.c index 50f38bc881..0b210310a2 100755 --- a/vm/data_gc.c +++ b/vm/data_gc.c @@ -550,6 +550,7 @@ void primitive_gc_stats(void) GROWABLE_ARRAY_ADD(stats,allot_cell(code_heap_scans)); GROWABLE_ARRAY_TRIM(stats); + GROWABLE_ARRAY_DONE(stats); dpush(stats); } diff --git a/vm/data_gc.h b/vm/data_gc.h index 52d8b603ad..b59cb0eb9e 100755 --- a/vm/data_gc.h +++ b/vm/data_gc.h @@ -82,8 +82,10 @@ registers) does not run out of memory */ * It is up to the caller to fill in the object's fields in a meaningful * fashion! */ +int count; INLINE void *allot_object(CELL type, CELL a) { + if(!gc_off) { if(count++ % 100 == 0) { printf("!\n"); gc(); } } CELL *object; if(HAVE_NURSERY_P && nursery.size - ALLOT_BUFFER_ZONE > a) diff --git a/vm/data_heap.c b/vm/data_heap.c index eb8add544e..44232ab6b0 100644 --- a/vm/data_heap.c +++ b/vm/data_heap.c @@ -366,6 +366,7 @@ CELL find_all_words(void) gc_off = false; GROWABLE_ARRAY_TRIM(words); + GROWABLE_ARRAY_DONE(words); return words; } diff --git a/vm/local_roots.h b/vm/local_roots.h index e852f9e54d..6d9658dbd3 100644 --- a/vm/local_roots.h +++ b/vm/local_roots.h @@ -19,10 +19,10 @@ CELL gc_locals; DEFPUSHPOP(gc_local_,gc_locals) -#define REGISTER_ROOT(obj) gc_local_push((CELL)&obj) +#define REGISTER_ROOT(obj) gc_local_push((CELL)&(obj)) #define UNREGISTER_ROOT(obj) \ { \ - if(gc_local_pop() != (CELL)&obj) \ + if(gc_local_pop() != (CELL)&(obj)) \ critical_error("Mismatched REGISTER_ROOT/UNREGISTER_ROOT",0); \ } diff --git a/vm/quotations.c b/vm/quotations.c index 7835d46e14..48979256ff 100755 --- a/vm/quotations.c +++ b/vm/quotations.c @@ -89,45 +89,6 @@ bool jit_ignore_declare_p(F_ARRAY *array, CELL i) && array_nth(array,i + 1) == userenv[JIT_DECLARE_WORD]; } -F_ARRAY *code_to_emit(CELL code) -{ - return untag_object(array_nth(untag_object(code),0)); -} - -F_REL rel_to_emit(CELL code, CELL code_format, CELL code_length, bool *rel_p) -{ - F_ARRAY *quadruple = untag_object(code); - CELL rel_class = array_nth(quadruple,1); - CELL rel_type = array_nth(quadruple,2); - CELL offset = array_nth(quadruple,3); - - if(rel_class == F) - { - *rel_p = false; - return 0; - } - else - { - *rel_p = true; - return (to_fixnum(rel_type) << 28) - | (to_fixnum(rel_class) << 24) - | ((code_length + to_fixnum(offset)) * code_format); - } -} - -#define EMIT(name) { \ - bool rel_p; \ - F_REL rel = rel_to_emit(name,code_format,code_count,&rel_p); \ - if(rel_p) GROWABLE_BYTE_ARRAY_APPEND(relocation,&rel,sizeof(F_REL)); \ - GROWABLE_ARRAY_APPEND(code,code_to_emit(name)); \ - } - -#define EMIT_TAIL_CALL(name) { \ - if(stack_frame) EMIT(userenv[JIT_EPILOG]); \ - tail_call = true; \ - EMIT(name); \ - } - bool jit_stack_frame_p(F_ARRAY *array) { F_FIXNUM length = array_capacity(array); @@ -164,6 +125,53 @@ void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code) quot->compiledp = T; } +F_ARRAY *code_to_emit(CELL template) +{ + return untag_object(array_nth(untag_object(template),0)); +} + +F_REL rel_to_emit(CELL template, CELL code_format, CELL code_length, bool *rel_p) +{ + F_ARRAY *quadruple = untag_object(template); + CELL rel_class = array_nth(quadruple,1); + CELL rel_type = array_nth(quadruple,2); + CELL offset = array_nth(quadruple,3); + + if(rel_class == F) + { + *rel_p = false; + return 0; + } + else + { + *rel_p = true; + return (to_fixnum(rel_type) << 28) + | (to_fixnum(rel_class) << 24) + | ((code_length + to_fixnum(offset)) * code_format); + } +} + +static void jit_emit(CELL template, CELL code_format, + F_GROWABLE_ARRAY *code, F_GROWABLE_BYTE_ARRAY *relocation) +{ + REGISTER_ROOT(template); + bool rel_p; + F_REL rel = rel_to_emit(template,code_format,code->count,&rel_p); + if(rel_p) growable_byte_array_append(relocation,&rel,sizeof(F_REL)); + growable_array_append(code,code_to_emit(template)); + UNREGISTER_ROOT(template); +} + +#define EMIT(template) { jit_emit(template,code_format,&code_g,&relocation_g); } + +#define EMIT_LITERAL GROWABLE_ARRAY_ADD(literals,obj); + +#define EMIT_TAIL_CALL(template) { \ + if(stack_frame) EMIT(userenv[JIT_EPILOG]); \ + tail_call = true; \ + EMIT(template); \ + } + /* Might GC */ void jit_compile(CELL quot, bool relocate) { @@ -172,19 +180,14 @@ void jit_compile(CELL quot, bool relocate) CELL code_format = compiled_code_format(); - REGISTER_ROOT(quot); - CELL array = untag_quotation(quot)->array; + + REGISTER_ROOT(quot); REGISTER_ROOT(array); GROWABLE_ARRAY(code); - REGISTER_ROOT(code); - GROWABLE_BYTE_ARRAY(relocation); - REGISTER_ROOT(relocation); - GROWABLE_ARRAY(literals); - REGISTER_ROOT(literals); if(stack_traces_p()) GROWABLE_ARRAY_ADD(literals,quot); @@ -192,7 +195,7 @@ void jit_compile(CELL quot, bool relocate) bool stack_frame = jit_stack_frame_p(untag_object(array)); if(stack_frame) - EMIT(userenv[JIT_PROLOG]); + EMIT(userenv[JIT_PROLOG]) CELL i; CELL length = array_capacity(untag_object(array)); @@ -212,12 +215,12 @@ void jit_compile(CELL quot, bool relocate) /* Intrinsics */ if(word->subprimitive != F) { + REGISTER_UNTAGGED(word); if(array_nth(untag_object(word->subprimitive),1) != F) - { GROWABLE_ARRAY_ADD(literals,T); - } + UNREGISTER_UNTAGGED(word); - EMIT(word->subprimitive); + EMIT(word->subprimitive) } else if(obj == userenv[JIT_EXECUTE_WORD]) { @@ -228,7 +231,7 @@ void jit_compile(CELL quot, bool relocate) } else { - GROWABLE_ARRAY_ADD(literals,obj); + EMIT_LITERAL if(i == length - 1) EMIT_TAIL_CALL(userenv[JIT_WORD_JUMP]) @@ -239,14 +242,14 @@ void jit_compile(CELL quot, bool relocate) case WRAPPER_TYPE: wrapper = untag_object(obj); GROWABLE_ARRAY_ADD(literals,wrapper->object); - EMIT(userenv[JIT_PUSH_IMMEDIATE]); + EMIT(userenv[JIT_PUSH_IMMEDIATE]) break; case FIXNUM_TYPE: if(jit_primitive_call_p(untag_object(array),i)) { - EMIT(userenv[JIT_SAVE_STACK]); - GROWABLE_ARRAY_ADD(literals,obj); - EMIT(userenv[JIT_PRIMITIVE]); + EMIT(userenv[JIT_SAVE_STACK]) + EMIT_LITERAL + EMIT(userenv[JIT_PRIMITIVE]) i++; @@ -257,7 +260,7 @@ void jit_compile(CELL quot, bool relocate) if(jit_fast_if_p(untag_object(array),i)) { if(stack_frame) - EMIT(userenv[JIT_EPILOG]); + EMIT(userenv[JIT_EPILOG]) tail_call = true; @@ -265,9 +268,9 @@ void jit_compile(CELL quot, bool relocate) jit_compile(array_nth(untag_object(array),i + 1),relocate); GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i)); - EMIT(userenv[JIT_IF_1]); + EMIT(userenv[JIT_IF_1]) GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i + 1)); - EMIT(userenv[JIT_IF_2]); + EMIT(userenv[JIT_IF_2]) i += 2; @@ -277,8 +280,8 @@ void jit_compile(CELL quot, bool relocate) { jit_compile(obj,relocate); - GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i)); - EMIT(userenv[JIT_DIP]); + EMIT_LITERAL + EMIT(userenv[JIT_DIP]) i++; break; @@ -287,8 +290,8 @@ void jit_compile(CELL quot, bool relocate) { jit_compile(obj,relocate); - GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i)); - EMIT(userenv[JIT_2DIP]); + EMIT_LITERAL + EMIT(userenv[JIT_2DIP]) i++; break; @@ -297,8 +300,8 @@ void jit_compile(CELL quot, bool relocate) { jit_compile(obj,relocate); - GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i)); - EMIT(userenv[JIT_3DIP]); + EMIT_LITERAL + EMIT(userenv[JIT_3DIP]) i++; break; @@ -306,8 +309,8 @@ void jit_compile(CELL quot, bool relocate) case ARRAY_TYPE: if(jit_fast_dispatch_p(untag_object(array),i)) { - GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i)); - EMIT_TAIL_CALL(userenv[JIT_DISPATCH]); + EMIT_LITERAL + EMIT_TAIL_CALL(userenv[JIT_DISPATCH]) i++; break; @@ -318,8 +321,8 @@ void jit_compile(CELL quot, bool relocate) break; } default: - GROWABLE_ARRAY_ADD(literals,obj); - EMIT(userenv[JIT_PUSH_IMMEDIATE]); + EMIT_LITERAL + EMIT(userenv[JIT_PUSH_IMMEDIATE]) break; } } @@ -327,14 +330,14 @@ void jit_compile(CELL quot, bool relocate) if(!tail_call) { if(stack_frame) - EMIT(userenv[JIT_EPILOG]); + EMIT(userenv[JIT_EPILOG]) - EMIT(userenv[JIT_RETURN]); + EMIT(userenv[JIT_RETURN]) } - GROWABLE_ARRAY_TRIM(code); GROWABLE_ARRAY_TRIM(literals); GROWABLE_BYTE_ARRAY_TRIM(relocation); + GROWABLE_ARRAY_TRIM(code); F_CODE_BLOCK *compiled = add_code_block( QUOTATION_TYPE, @@ -348,9 +351,10 @@ void jit_compile(CELL quot, bool relocate) if(relocate) relocate_code_block(compiled); - UNREGISTER_ROOT(literals); - UNREGISTER_ROOT(relocation); - UNREGISTER_ROOT(code); + GROWABLE_ARRAY_DONE(literals); + GROWABLE_BYTE_ARRAY_DONE(relocation); + GROWABLE_ARRAY_DONE(code); + UNREGISTER_ROOT(array); UNREGISTER_ROOT(quot); } diff --git a/vm/types.c b/vm/types.c index 889de38016..1985f51567 100755 --- a/vm/types.c +++ b/vm/types.c @@ -192,41 +192,45 @@ void primitive_resize_array(void) dpush(tag_object(reallot_array(array,capacity))); } -F_ARRAY *growable_array_add(F_ARRAY *result, CELL elt, CELL *result_count) +void growable_array_add(F_GROWABLE_ARRAY *array, CELL elt) { + F_ARRAY *underlying = untag_object(array->array); REGISTER_ROOT(elt); - if(*result_count == array_capacity(result)) + if(array->count == array_capacity(underlying)) { - result = reallot_array(result,*result_count * 2); + underlying = reallot_array(underlying,array->count * 2); + array->array = tag_object(underlying); } UNREGISTER_ROOT(elt); - set_array_nth(result,*result_count,elt); - (*result_count)++; - - return result; + set_array_nth(underlying,array->count++,elt); } -F_ARRAY *growable_array_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_count) +void growable_array_append(F_GROWABLE_ARRAY *array, F_ARRAY *elts) { REGISTER_UNTAGGED(elts); - CELL elts_size = array_capacity(elts); - CELL new_size = *result_count + elts_size; + F_ARRAY *underlying = untag_object(array->array); - if(new_size >= array_capacity(result)) - result = reallot_array(result,new_size * 2); + CELL elts_size = array_capacity(elts); + CELL new_size = array->count + elts_size; + + if(new_size >= array_capacity(underlying)) + { + underlying = reallot_array(underlying,new_size * 2); + array->array = tag_object(underlying); + } UNREGISTER_UNTAGGED(elts); - write_barrier((CELL)result); + write_barrier((CELL)array->array); - memcpy((void *)AREF(result,*result_count),(void *)AREF(elts,0),elts_size * CELLS); + memcpy((void *)AREF(underlying,array->count), + (void *)AREF(elts,0), + elts_size * CELLS); - *result_count += elts_size; - - return result; + array->count += elts_size; } /* Byte arrays */ @@ -283,18 +287,20 @@ void primitive_resize_byte_array(void) dpush(tag_object(reallot_byte_array(array,capacity))); } -F_BYTE_ARRAY *growable_byte_array_append(F_BYTE_ARRAY *result, void *elts, CELL len, CELL *result_count) +void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *array, void *elts, CELL len) { - CELL new_size = *result_count + len; + CELL new_size = array->count + len; + F_BYTE_ARRAY *underlying = untag_object(array->array); - if(new_size >= byte_array_capacity(result)) - result = reallot_byte_array(result,new_size * 2); + if(new_size >= byte_array_capacity(underlying)) + { + underlying = reallot_byte_array(underlying,new_size * 2); + array->array = tag_object(underlying); + } - memcpy((void *)BREF(result,*result_count),elts,len); + memcpy((void *)BREF(underlying,array->count),elts,len); - *result_count = new_size; - - return result; + array->count += len; } /* Tuples */ diff --git a/vm/types.h b/vm/types.h index 2775f57bb2..01176d6191 100755 --- a/vm/types.h +++ b/vm/types.h @@ -77,12 +77,6 @@ INLINE CELL tag_tuple(F_TUPLE *tuple) return RETAG(tuple,TUPLE_TYPE); } -INLINE F_TUPLE *untag_tuple(CELL object) -{ - type_check(TUPLE_TYPE,object); - return untag_object(object); -} - INLINE CELL tuple_size(F_TUPLE_LAYOUT *layout) { CELL size = untag_fixnum_fast(layout->size); @@ -165,32 +159,69 @@ void primitive_word_xt(void); void primitive_wrapper(void); /* Macros to simulate a vector in C */ -#define GROWABLE_ARRAY(result) \ - CELL result##_count = 0; \ - CELL result = tag_object(allot_array(ARRAY_TYPE,100,F)) +typedef struct { + CELL count; + CELL array; +} F_GROWABLE_ARRAY; -F_ARRAY *growable_array_add(F_ARRAY *result, CELL elt, CELL *result_count); +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)); + return result; +} + +#define GROWABLE_ARRAY(result) F_GROWABLE_ARRAY result##_g = make_growable_array(); \ + REGISTER_ROOT(result##_g.array) + +void growable_array_add(F_GROWABLE_ARRAY *result, CELL elt); #define GROWABLE_ARRAY_ADD(result,elt) \ - result = tag_object(growable_array_add(untag_object(result),elt,&result##_count)) + growable_array_add(&result##_g,elt) -F_ARRAY *growable_array_append(F_ARRAY *result, F_ARRAY *elts, CELL *result_count); +void growable_array_append(F_GROWABLE_ARRAY *result, F_ARRAY *elts); #define GROWABLE_ARRAY_APPEND(result,elts) \ - result = tag_object(growable_array_append(untag_object(result),elts,&result##_count)) + growable_array_append(&result##_g,elts) -#define GROWABLE_ARRAY_TRIM(result) \ - result = tag_object(reallot_array(untag_object(result),result##_count)) +INLINE CELL growable_array_trim(F_GROWABLE_ARRAY *array) +{ + return 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_DONE(result) UNREGISTER_ROOT(result##_g.array) /* Macros to simulate a byte vector in C */ -#define GROWABLE_BYTE_ARRAY(result) \ - CELL result##_count = 0; \ - CELL result = tag_object(allot_byte_array(100)) +typedef struct { + CELL count; + CELL array; +} F_GROWABLE_BYTE_ARRAY; -F_ARRAY *growable_byte_array_append(F_BYTE_ARRAY *result, void *elts, CELL len, CELL *result_count); +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)); + return result; +} + +#define GROWABLE_BYTE_ARRAY(result) \ + F_GROWABLE_BYTE_ARRAY result##_g = make_growable_byte_array(); \ + REGISTER_ROOT(result##_g.array) + +void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *result, void *elts, CELL len); #define GROWABLE_BYTE_ARRAY_APPEND(result,elts,len) \ - result = tag_object(growable_byte_array_append(untag_object(result),elts,len,&result##_count)) + growable_byte_array_append(&result##_g,elts,len) -#define GROWABLE_BYTE_ARRAY_TRIM(result) \ - result = tag_object(reallot_byte_array(untag_object(result),result##_count)) +INLINE CELL growable_byte_array_trim(F_GROWABLE_BYTE_ARRAY *byte_array) +{ + return 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_DONE(result) UNREGISTER_ROOT(result##_g.array);