* Compiling the Factor VM
-The Factor runtime is written in GNU C99, and is built with GNU make and
+The Factor runtime is written in GNU C++, and is built with GNU make and
gcc.
Factor supports various platforms. For an up-to-date list, see
The Factor source tree is organized as follows:
build-support/ - scripts used for compiling Factor
- vm/ - sources for the Factor VM, written in C
+ vm/ - sources for the Factor VM, written in C++
core/ - Factor core library
basis/ - Factor basis library, compiler, tools
extra/ - more libraries and applications
#! Direct calls to the generic word (not tail calls or indirect calls)
#! will jump to the inline cache entry point instead of the megamorphic
#! dispatch entry point.
- combination get #>> [ f inline-cache-miss ] 3curry [ ] like ;
+ combination get #>> [ { } inline-cache-miss ] 3curry [ ] like ;
: make-empty-cache ( -- array )
mega-cache-size get f <array> ;
switch(type_of(object))
{
case BYTE_ARRAY_TYPE:
- byte_array = untag_byte_array_fast(object);
+ byte_array = untagged<F_BYTE_ARRAY>(object);
return (char *)(byte_array + 1);
case ALIEN_TYPE:
- alien = untag_alien_fast(object);
+ alien = untagged<F_ALIEN>(object);
if(alien->expired != F)
general_error(ERROR_EXPIRED,object,F,NULL);
return alien_offset(alien->alien) + alien->displacement;
switch(type_of(object))
{
case ALIEN_TYPE:
- alien = untag_alien_fast(object);
+ alien = untagged<F_ALIEN>(object);
if(alien->expired != F)
general_error(ERROR_EXPIRED,object,F,NULL);
return pinned_alien_offset(alien->alien) + alien->displacement;
}
/* make an alien */
-CELL allot_alien(CELL delegate, CELL displacement)
+CELL allot_alien(CELL delegate_, CELL displacement)
{
- REGISTER_ROOT(delegate);
- F_ALIEN *alien = (F_ALIEN *)allot_object(ALIEN_TYPE,sizeof(F_ALIEN));
- UNREGISTER_ROOT(delegate);
+ gc_root<F_OBJECT> delegate(delegate_);
+ gc_root<F_ALIEN> alien(allot<F_ALIEN>(sizeof(F_ALIEN)));
- if(type_of(delegate) == ALIEN_TYPE)
+ if(delegate.isa(ALIEN_TYPE))
{
- F_ALIEN *delegate_alien = untag_alien_fast(delegate);
+ tagged<F_ALIEN> delegate_alien = delegate.as<F_ALIEN>();
displacement += delegate_alien->displacement;
alien->alien = delegate_alien->alien;
}
else
- alien->alien = delegate;
+ alien->alien = delegate.value();
alien->displacement = displacement;
alien->expired = F;
- return tag_object(alien);
+
+ return alien.value();
}
/* make an alien and push */
/* open a native library and push a handle */
void primitive_dlopen(void)
{
- CELL path = tag_object(string_to_native_alien(
- untag_string(dpop())));
- REGISTER_ROOT(path);
- F_DLL *dll = (F_DLL *)allot_object(DLL_TYPE,sizeof(F_DLL));
- UNREGISTER_ROOT(path);
- dll->path = path;
- ffi_dlopen(dll);
- dpush(tag_object(dll));
+ gc_root<F_BYTE_ARRAY> path(tag_object(string_to_native_alien(untag_string(dpop()))));
+ gc_root<F_DLL> dll(allot<F_DLL>(sizeof(F_DLL)));
+ dll->path = path.value();
+ ffi_dlopen(dll.untagged());
+ dpush(dll.value());
}
/* look up a symbol in a native library */
void primitive_dlsym(void)
{
- CELL dll = dpop();
- REGISTER_ROOT(dll);
+ gc_root<F_OBJECT> dll(dpop());
F_SYMBOL *sym = unbox_symbol_string();
- UNREGISTER_ROOT(dll);
-
- F_DLL *d;
- if(dll == F)
+ if(dll.value() == F)
box_alien(ffi_dlsym(NULL,sym));
else
{
- d = untag_dll(dll);
+ tagged<F_DLL> d = dll.as<F_DLL>();
if(d->dll == NULL)
dpush(F);
else
- box_alien(ffi_dlsym(d,sym));
+ box_alien(ffi_dlsym(d.untagged(),sym));
}
}
if(dll == F)
dpush(T);
else
- {
- F_DLL *d = untag_dll(dll);
- dpush(d->dll == NULL ? F : T);
- }
+ dpush(tagged<F_DLL>(dll)->dll == NULL ? F : T);
}
#include "master.hpp"
/* make a new array with an initial element */
-F_ARRAY *allot_array(CELL capacity, CELL fill)
+F_ARRAY *allot_array(CELL capacity, CELL fill_)
{
- REGISTER_ROOT(fill);
- F_ARRAY* array = allot_array_internal<F_ARRAY>(capacity);
- UNREGISTER_ROOT(fill);
- if(fill == 0)
- memset((void*)AREF(array,0),'\0',capacity * CELLS);
+ gc_root<F_OBJECT> fill(fill_);
+ gc_root<F_ARRAY> array(allot_array_internal<F_ARRAY>(capacity));
+
+ if(fill.value() == tag_fixnum(0))
+ memset((void*)AREF(array.untagged(),0),'\0',capacity * CELLS);
else
{
/* No need for write barrier here. Either the object is in
and the write barrier is already hit for us in that case. */
CELL i;
for(i = 0; i < capacity; i++)
- put(AREF(array,i),fill);
+ put(AREF(array.untagged(),i),fill.value());
}
- return array;
+ return array.untagged();
}
/* push a new array on the stack */
dpush(tag_array(allot_array(size,initial)));
}
-CELL allot_array_1(CELL obj)
+CELL allot_array_1(CELL obj_)
{
- REGISTER_ROOT(obj);
- F_ARRAY *a = allot_array_internal<F_ARRAY>(1);
- UNREGISTER_ROOT(obj);
- set_array_nth(a,0,obj);
- return tag_array(a);
+ gc_root<F_OBJECT> obj(obj_);
+ gc_root<F_ARRAY> a(allot_array_internal<F_ARRAY>(1));
+ set_array_nth(a.untagged(),0,obj.value());
+ return a.value();
}
-CELL allot_array_2(CELL v1, CELL v2)
+CELL allot_array_2(CELL v1_, CELL v2_)
{
- REGISTER_ROOT(v1);
- REGISTER_ROOT(v2);
- F_ARRAY *a = allot_array_internal<F_ARRAY>(2);
- UNREGISTER_ROOT(v2);
- UNREGISTER_ROOT(v1);
- set_array_nth(a,0,v1);
- set_array_nth(a,1,v2);
- return tag_array(a);
+ gc_root<F_OBJECT> v1(v1_);
+ gc_root<F_OBJECT> v2(v2_);
+ gc_root<F_ARRAY> a(allot_array_internal<F_ARRAY>(2));
+ set_array_nth(a.untagged(),0,v1.value());
+ set_array_nth(a.untagged(),1,v2.value());
+ return a.value();
}
-CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4)
+CELL allot_array_4(CELL v1_, CELL v2_, CELL v3_, CELL v4_)
{
- REGISTER_ROOT(v1);
- REGISTER_ROOT(v2);
- REGISTER_ROOT(v3);
- REGISTER_ROOT(v4);
- F_ARRAY *a = allot_array_internal<F_ARRAY>(4);
- UNREGISTER_ROOT(v4);
- UNREGISTER_ROOT(v3);
- UNREGISTER_ROOT(v2);
- UNREGISTER_ROOT(v1);
- set_array_nth(a,0,v1);
- set_array_nth(a,1,v2);
- set_array_nth(a,2,v3);
- set_array_nth(a,3,v4);
- return tag_array(a);
+ gc_root<F_OBJECT> v1(v1_);
+ gc_root<F_OBJECT> v2(v2_);
+ gc_root<F_OBJECT> v3(v3_);
+ gc_root<F_OBJECT> v4(v4_);
+ gc_root<F_ARRAY> a(allot_array_internal<F_ARRAY>(4));
+ set_array_nth(a.untagged(),0,v1.value());
+ set_array_nth(a.untagged(),1,v2.value());
+ set_array_nth(a.untagged(),2,v3.value());
+ set_array_nth(a.untagged(),3,v4.value());
+ return a.value();
}
void primitive_resize_array(void)
dpush(tag_array(reallot_array(array,capacity)));
}
-void growable_array_add(F_GROWABLE_ARRAY *array, CELL elt)
+void growable_array::add(CELL elt_)
{
- F_ARRAY *underlying = untag_array_fast(array->array);
- REGISTER_ROOT(elt);
-
- if(array->count == array_capacity(underlying))
- {
- underlying = reallot_array(underlying,array->count * 2);
- array->array = tag_array(underlying);
- }
+ gc_root<F_OBJECT> elt(elt_);
+ if(count == array_capacity(array.untagged()))
+ array = reallot_array(array.untagged(),count * 2);
- UNREGISTER_ROOT(elt);
- set_array_nth(underlying,array->count++,elt);
+ set_array_nth(array.untagged(),count++,elt.value());
}
-void growable_array_append(F_GROWABLE_ARRAY *array, F_ARRAY *elts)
+void growable_array::trim()
{
- REGISTER_UNTAGGED(elts);
-
- F_ARRAY *underlying = untag_array_fast(array->array);
-
- 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_array(underlying);
- }
-
- UNREGISTER_UNTAGGED(F_ARRAY,elts);
-
- write_barrier(array->array);
-
- memcpy((void *)AREF(underlying,array->count),
- (void *)AREF(elts,0),
- elts_size * CELLS);
-
- array->count += elts_size;
+ array = reallot_array(array.untagged(),count);
}
}
F_ARRAY *allot_array(CELL capacity, CELL fill);
-F_BYTE_ARRAY *allot_byte_array(CELL size);
CELL allot_array_1(CELL obj);
CELL allot_array_2(CELL v1, CELL v2);
void primitive_array(void);
void primitive_resize_array(void);
-/* Macros to simulate a vector in C */
-struct F_GROWABLE_ARRAY {
+struct growable_array {
CELL count;
- CELL array;
-};
-
-/* Allocates memory */
-INLINE F_GROWABLE_ARRAY make_growable_array(void)
-{
- F_GROWABLE_ARRAY result;
- result.count = 0;
- result.array = tag_array(allot_array(2,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) \
- growable_array_add(&result##_g,elt)
+ gc_root<F_ARRAY> array;
-void growable_array_append(F_GROWABLE_ARRAY *result, F_ARRAY *elts);
+ growable_array() : count(0), array(allot_array(2,F)) {}
-#define GROWABLE_ARRAY_APPEND(result,elts) \
- growable_array_append(&result##_g,elts)
-
-INLINE void growable_array_trim(F_GROWABLE_ARRAY *array)
-{
- array->array = tag_array(reallot_array(untag_array_fast(array->array),array->count));
-}
-
-#define GROWABLE_ARRAY_TRIM(result) growable_array_trim(&result##_g)
-
-#define GROWABLE_ARRAY_DONE(result) \
- UNREGISTER_ROOT(result##_g.array); \
- CELL result = result##_g.array;
+ void add(CELL elt);
+ void trim();
+};
dpush(tag_object(reallot_array(array,capacity)));
}
-void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *array, void *elts, CELL len)
+void growable_byte_array::append_bytes(void *elts, CELL len)
{
- CELL new_size = array->count + len;
- F_BYTE_ARRAY *underlying = untag_byte_array_fast(array->array);
+ CELL new_size = count + len;
- if(new_size >= array_capacity(underlying))
- {
- underlying = reallot_array(underlying,new_size * 2);
- array->array = tag_object(underlying);
- }
+ if(new_size >= array_capacity(array.untagged()))
+ array = reallot_array(array.untagged(),new_size * 2);
- memcpy((void *)BREF(underlying,array->count),elts,len);
+ memcpy((void *)BREF(array.untagged(),count),elts,len);
- array->count += len;
+ count += len;
+}
+
+void growable_byte_array::append_byte_array(CELL byte_array_)
+{
+ gc_root<F_BYTE_ARRAY> byte_array(byte_array_);
+
+ CELL len = array_capacity(byte_array.untagged());
+ CELL new_size = count + len;
+
+ if(new_size >= array_capacity(array.untagged()))
+ array = reallot_array(array.untagged(),new_size * 2);
+
+ memcpy((void *)BREF(array.untagged(),count),byte_array.untagged() + 1,len);
+
+ count += len;
+}
+
+void growable_byte_array::trim()
+{
+ array = reallot_array(array.untagged(),count);
}
void primitive_resize_byte_array(void);
/* Macros to simulate a byte vector in C */
-struct F_GROWABLE_BYTE_ARRAY {
+struct growable_byte_array {
CELL count;
- CELL array;
-};
+ gc_root<F_BYTE_ARRAY> array;
-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(2));
- return result;
-}
+ growable_byte_array() : count(0), array(allot_byte_array(2)) { }
-void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *result, void *elts, CELL len);
+ void append_bytes(void *elts, CELL len);
+ void append_byte_array(CELL elts);
-INLINE void growable_byte_array_trim(F_GROWABLE_BYTE_ARRAY *byte_array)
-{
- byte_array->array = tag_object(reallot_array(untag_byte_array_fast(byte_array->array),byte_array->count));
-}
+ void trim();
+};
F_CALLSTACK *allot_callstack(CELL size)
{
- F_CALLSTACK *callstack = (F_CALLSTACK *)allot_object(
- CALLSTACK_TYPE,
- callstack_size(size));
+ F_CALLSTACK *callstack = allot<F_CALLSTACK>(callstack_size(size));
callstack->length = tag_fixnum(size);
return callstack;
}
void primitive_callstack_to_array(void)
{
- F_CALLSTACK *stack = untag_callstack(dpop());
+ gc_root<F_CALLSTACK> callstack(dpop());
frame_count = 0;
- iterate_callstack_object(stack,count_stack_frame);
+ iterate_callstack_object(callstack.untagged(),count_stack_frame);
- REGISTER_UNTAGGED(stack);
array = allot_array_internal<F_ARRAY>(frame_count);
- UNREGISTER_UNTAGGED(F_CALLSTACK,stack);
frame_index = 0;
- iterate_callstack_object(stack,stack_frame_to_array);
+ iterate_callstack_object(callstack.untagged(),stack_frame_to_array);
dpush(tag_array(array));
}
void primitive_set_innermost_stack_frame_quot(void)
{
- F_CALLSTACK *callstack = untag_callstack(dpop());
- F_QUOTATION *quot = untag_quotation(dpop());
-
- REGISTER_UNTAGGED(callstack);
- REGISTER_UNTAGGED(quot);
-
- jit_compile(tag_quotation(quot),true);
+ gc_root<F_CALLSTACK> callstack(dpop());
+ gc_root<F_QUOTATION> quot(dpop());
- UNREGISTER_UNTAGGED(F_QUOTATION,quot);
- UNREGISTER_UNTAGGED(F_CALLSTACK,callstack);
+ jit_compile(quot.value(),true);
- F_STACK_FRAME *inner = innermost_stack_frame(callstack);
+ F_STACK_FRAME *inner = innermost_stack_frame(callstack.untagged());
type_check(QUOTATION_TYPE,frame_executing(inner));
CELL offset = (char *)FRAME_RETURN_ADDRESS(inner) - (char *)inner->xt;
/* Might GC */
F_CODE_BLOCK *add_code_block(
CELL type,
- F_BYTE_ARRAY *code,
- F_ARRAY *labels,
- CELL relocation,
- CELL literals)
+ CELL code_,
+ CELL labels_,
+ CELL relocation_,
+ CELL literals_)
{
-#ifdef FACTOR_DEBUG
- type_check(ARRAY_TYPE,literals);
- type_check(BYTE_ARRAY_TYPE,relocation);
- assert(untag_header(code->header) == BYTE_ARRAY_TYPE);
-#endif
-
- CELL code_length = align8(array_capacity(code));
-
- REGISTER_ROOT(literals);
- REGISTER_ROOT(relocation);
- REGISTER_UNTAGGED(code);
- REGISTER_UNTAGGED(labels);
+ gc_root<F_BYTE_ARRAY> code(code_);
+ gc_root<F_OBJECT> labels(labels_);
+ gc_root<F_BYTE_ARRAY> relocation(relocation_);
+ gc_root<F_ARRAY> literals(literals_);
+ CELL code_length = align8(array_capacity(code.untagged()));
F_CODE_BLOCK *compiled = allot_code_block(code_length);
- UNREGISTER_UNTAGGED(F_ARRAY,labels);
- UNREGISTER_UNTAGGED(F_BYTE_ARRAY,code);
- UNREGISTER_ROOT(relocation);
- UNREGISTER_ROOT(literals);
-
- /* slight space optimization */
- if(type_of(literals) == ARRAY_TYPE && array_capacity(untag_array_fast(literals)) == 0)
- literals = F;
-
/* compiled header */
compiled->block.type = type;
compiled->block.last_scan = NURSERY;
compiled->block.needs_fixup = true;
- compiled->literals = literals;
- compiled->relocation = relocation;
+ compiled->relocation = relocation.value();
+
+ /* slight space optimization */
+ if(literals.type() == ARRAY_TYPE && array_capacity(literals.untagged()) == 0)
+ compiled->literals = F;
+ else
+ compiled->literals = literals.value();
/* code */
- memcpy(compiled + 1,code + 1,code_length);
+ memcpy(compiled + 1,code.untagged() + 1,code_length);
/* fixup labels */
- if(labels) fixup_labels(labels,compiled);
+ if(labels.value() != F)
+ fixup_labels(labels.as<F_ARRAY>().untagged(),compiled);
/* next time we do a minor GC, we have to scan the code heap for
literals */
return userenv[STACK_TRACES_ENV] != F;
}
-F_CODE_BLOCK *add_code_block(
- CELL type,
- F_BYTE_ARRAY *code,
- F_ARRAY *labels,
- CELL relocation,
- CELL literals);
+F_CODE_BLOCK *add_code_block(CELL type, CELL code, CELL labels, CELL relocation, CELL literals);
}
/* Compile a word definition with the non-optimizing compiler. Allocates memory */
-void jit_compile_word(F_WORD *word, CELL def, bool relocate)
+void jit_compile_word(CELL word_, CELL def_, bool relocate)
{
- REGISTER_ROOT(def);
- REGISTER_UNTAGGED(word);
- jit_compile(def,relocate);
- UNREGISTER_UNTAGGED(F_WORD,word);
- UNREGISTER_ROOT(def);
+ gc_root<F_WORD> word(word_);
+ gc_root<F_QUOTATION> def(def_);
- word->code = untag_quotation(def)->code;
+ jit_compile(def.value(),relocate);
+
+ word->code = def->code;
if(word->direct_entry_def != F)
jit_compile(word->direct_entry_def,relocate);
void primitive_modify_code_heap(void)
{
- F_ARRAY *alist = untag_array(dpop());
+ gc_root<F_ARRAY> alist(dpop());
+
+ CELL count = array_capacity(alist.untagged());
- CELL count = untag_fixnum_fast(alist->capacity);
if(count == 0)
return;
CELL i;
for(i = 0; i < count; i++)
{
- F_ARRAY *pair = untag_array(array_nth(alist,i));
-
- F_WORD *word = untag_word(array_nth(pair,0));
+ gc_root<F_ARRAY> pair(array_nth(alist.untagged(),i));
- CELL data = array_nth(pair,1);
+ gc_root<F_WORD> word(array_nth(pair.untagged(),0));
+ gc_root<F_OBJECT> data(array_nth(pair.untagged(),1));
- if(type_of(data) == QUOTATION_TYPE)
+ switch(data.type())
{
- REGISTER_UNTAGGED(alist);
- REGISTER_UNTAGGED(word);
- jit_compile_word(word,data,false);
- UNREGISTER_UNTAGGED(F_WORD,word);
- UNREGISTER_UNTAGGED(F_ARRAY,alist);
- }
- else if(type_of(data) == ARRAY_TYPE)
- {
- F_ARRAY *compiled_code = untag_array(data);
-
- 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_BYTE_ARRAY *code = untag_byte_array(array_nth(compiled_code,3));
-
- REGISTER_UNTAGGED(alist);
- REGISTER_UNTAGGED(word);
+ case QUOTATION_TYPE:
+ jit_compile_word(word.value(),data.value(),false);
+ break;
+ case ARRAY_TYPE:
+ F_ARRAY *compiled_data = data.as<F_ARRAY>().untagged();
+ CELL literals = array_nth(compiled_data,0);
+ CELL relocation = array_nth(compiled_data,1);
+ CELL labels = array_nth(compiled_data,2);
+ CELL code = array_nth(compiled_data,3);
F_CODE_BLOCK *compiled = add_code_block(
WORD_TYPE,
relocation,
literals);
- UNREGISTER_UNTAGGED(F_WORD,word);
- UNREGISTER_UNTAGGED(F_ARRAY,alist);
-
word->code = compiled;
+ break;
+ default:
+ critical_error("Expected a quotation or an array",data.value());
+ break;
}
- else
- critical_error("Expected a quotation or an array",data);
- REGISTER_UNTAGGED(alist);
- update_word_xt(word);
- UNREGISTER_UNTAGGED(F_ARRAY,alist);
+ update_word_xt(word.value());
}
update_code_heap_words();
while((obj = next_object()) != F)
{
if(type_of(obj) == WORD_TYPE)
- {
- F_WORD *word = untag_word_fast(obj);
- update_word_xt(word);
- }
+ update_word_xt(obj);
else if(type_of(obj) == QUOTATION_TYPE)
{
F_QUOTATION *quot = untag_quotation_fast(obj);
bool in_code_heap_p(CELL ptr);
-void jit_compile_word(F_WORD *word, CELL def, bool relocate);
+void jit_compile_word(CELL word, CELL def, bool relocate);
typedef void (*CODE_HEAP_ITERATOR)(F_CODE_BLOCK *compiled);
}
/* Copy roots over at the start of GC, namely various constants, stacks,
-the user environment and extra roots registered with REGISTER_ROOT */
+the user environment and extra roots registered by local_roots.hpp */
void copy_roots(void)
{
copy_handle(&T);
void primitive_gc_stats(void)
{
- GROWABLE_ARRAY(stats);
+ growable_array stats;
CELL i;
u64 total_gc_time = 0;
for(i = 0; i < MAX_GEN_COUNT; i++)
{
F_GC_STATS *s = &gc_stats[i];
- GROWABLE_ARRAY_ADD(stats,allot_cell(s->collections));
- GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->gc_time)));
- GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->max_gc_time)));
- GROWABLE_ARRAY_ADD(stats,allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections));
- GROWABLE_ARRAY_ADD(stats,allot_cell(s->object_count));
- GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->bytes_copied)));
+ stats.add(allot_cell(s->collections));
+ stats.add(tag_bignum(long_long_to_bignum(s->gc_time)));
+ stats.add(tag_bignum(long_long_to_bignum(s->max_gc_time)));
+ stats.add(allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections));
+ stats.add(allot_cell(s->object_count));
+ stats.add(tag_bignum(long_long_to_bignum(s->bytes_copied)));
total_gc_time += s->gc_time;
}
- GROWABLE_ARRAY_ADD(stats,tag_bignum(ulong_long_to_bignum(total_gc_time)));
- GROWABLE_ARRAY_ADD(stats,tag_bignum(ulong_long_to_bignum(cards_scanned)));
- GROWABLE_ARRAY_ADD(stats,tag_bignum(ulong_long_to_bignum(decks_scanned)));
- GROWABLE_ARRAY_ADD(stats,tag_bignum(ulong_long_to_bignum(card_scan_time)));
- GROWABLE_ARRAY_ADD(stats,allot_cell(code_heap_scans));
+ stats.add(tag_bignum(ulong_long_to_bignum(total_gc_time)));
+ stats.add(tag_bignum(ulong_long_to_bignum(cards_scanned)));
+ stats.add(tag_bignum(ulong_long_to_bignum(decks_scanned)));
+ stats.add(tag_bignum(ulong_long_to_bignum(card_scan_time)));
+ stats.add(allot_cell(code_heap_scans));
- GROWABLE_ARRAY_TRIM(stats);
- GROWABLE_ARRAY_DONE(stats);
- dpush(stats);
+ stats.trim();
+ dpush(stats.array.value());
}
void clear_gc_stats(void)
* It is up to the caller to fill in the object's fields in a meaningful
* fashion!
*/
-INLINE void *allot_object(CELL type, CELL a)
+INLINE void *allot_object(CELL header, CELL size)
{
#ifdef GC_DEBUG
if(!gc_off)
gc();
#endif
- CELL *object;
+ F_OBJECT *object;
- if(nursery.size - ALLOT_BUFFER_ZONE > a)
+ if(nursery.size - ALLOT_BUFFER_ZONE > size)
{
/* If there is insufficient room, collect the nursery */
- if(nursery.here + ALLOT_BUFFER_ZONE + a > nursery.end)
+ if(nursery.here + ALLOT_BUFFER_ZONE + size > nursery.end)
garbage_collection(NURSERY,false,0);
CELL h = nursery.here;
- nursery.here = h + align8(a);
- object = (CELL*)h;
+ nursery.here = h + align8(size);
+ object = (F_OBJECT *)h;
}
/* If the object is bigger than the nursery, allocate it in
tenured space */
F_ZONE *tenured = &data_heap->generations[TENURED];
/* If tenured space does not have enough room, collect */
- if(tenured->here + a > tenured->end)
+ if(tenured->here + size > tenured->end)
{
gc();
tenured = &data_heap->generations[TENURED];
}
/* If it still won't fit, grow the heap */
- if(tenured->here + a > tenured->end)
+ if(tenured->here + size > tenured->end)
{
- garbage_collection(TENURED,true,a);
+ garbage_collection(TENURED,true,size);
tenured = &data_heap->generations[TENURED];
}
- object = (CELL *)allot_zone(tenured,a);
+ object = (F_OBJECT *)allot_zone(tenured,size);
/* We have to do this */
allot_barrier((CELL)object);
write_barrier((CELL)object);
}
- *object = tag_header(type);
+ object->header = header;
return object;
}
+template<typename T> T *allot(CELL size)
+{
+ return (T *)allot_object(tag_header(T::type_number),size);
+}
+
void copy_reachable_objects(CELL scan, CELL *end);
void primitive_gc(void);
dpush(tag_fixnum((data_heap->cards_end - data_heap->cards) >> 10));
dpush(tag_fixnum((data_heap->decks_end - data_heap->decks) >> 10));
- GROWABLE_ARRAY(a);
+ growable_array a;
CELL gen;
for(gen = 0; gen < data_heap->gen_count; gen++)
{
F_ZONE *z = (gen == NURSERY ? &nursery : &data_heap->generations[gen]);
- GROWABLE_ARRAY_ADD(a,tag_fixnum((z->end - z->here) >> 10));
- GROWABLE_ARRAY_ADD(a,tag_fixnum((z->size) >> 10));
+ a.add(tag_fixnum((z->end - z->here) >> 10));
+ a.add(tag_fixnum((z->size) >> 10));
}
- GROWABLE_ARRAY_TRIM(a);
- GROWABLE_ARRAY_DONE(a);
- dpush(a);
+ a.trim();
+ dpush(a.array.value());
}
/* A heap walk allows useful things to be done, like finding all
CELL find_all_words(void)
{
- GROWABLE_ARRAY(words);
+ growable_array words;
begin_scan();
while((obj = next_object()) != F)
{
if(type_of(obj) == WORD_TYPE)
- GROWABLE_ARRAY_ADD(words,obj);
+ words.add(obj);
}
/* End heap scan */
gc_off = false;
- GROWABLE_ARRAY_TRIM(words);
- GROWABLE_ARRAY_DONE(words);
-
- return words;
+ words.trim();
+ return words.array.value();
}
extern bool secure_gc;
/* generational copying GC divides memory into zones */
-typedef struct {
+struct F_ZONE {
/* allocation pointer is 'here'; its offset is hardcoded in the
- compiler backends*/
+ compiler backends */
CELL start;
CELL here;
CELL size;
CELL end;
-} F_ZONE;
+};
-typedef struct {
+struct F_DATA_HEAP {
F_SEGMENT *segment;
CELL young_size;
CELL *decks;
CELL *decks_end;
-} F_DATA_HEAP;
+};
extern F_DATA_HEAP *data_heap;
void primitive_dispatch_stats(void)
{
- GROWABLE_ARRAY(stats);
- GROWABLE_ARRAY_ADD(stats,allot_cell(megamorphic_cache_hits));
- GROWABLE_ARRAY_ADD(stats,allot_cell(megamorphic_cache_misses));
- GROWABLE_ARRAY_TRIM(stats);
- GROWABLE_ARRAY_DONE(stats);
- dpush(stats);
+ growable_array stats;
+ stats.add(allot_cell(megamorphic_cache_hits));
+ stats.add(allot_cell(megamorphic_cache_misses));
+ stats.trim();
+ dpush(stats.array.value());
}
-void jit_emit_class_lookup(F_JIT *jit, F_FIXNUM index, CELL type)
+void quotation_jit::emit_mega_cache_lookup(CELL methods_, F_FIXNUM index, CELL cache_)
{
- jit_emit_with(jit,userenv[PIC_LOAD],tag_fixnum(-index * CELLS));
- jit_emit(jit,userenv[type]);
-}
+ gc_root<F_ARRAY> methods(methods_);
+ gc_root<F_ARRAY> cache(cache_);
-void jit_emit_mega_cache_lookup(F_JIT *jit, CELL methods, F_FIXNUM index, CELL cache)
-{
/* Generate machine code to determine the object's class. */
- jit_emit_class_lookup(jit,index,PIC_HI_TAG_TUPLE);
+ emit_class_lookup(index,PIC_HI_TAG_TUPLE);
/* Do a cache lookup. */
- jit_emit_with(jit,userenv[MEGA_LOOKUP],cache);
+ emit_with(userenv[MEGA_LOOKUP],cache.value());
/* If we end up here, the cache missed. */
- jit_emit(jit,userenv[JIT_PROLOG]);
+ emit(userenv[JIT_PROLOG]);
/* Push index, method table and cache on the stack. */
- jit_push(jit,methods);
- jit_push(jit,tag_fixnum(index));
- jit_push(jit,cache);
- jit_word_call(jit,userenv[MEGA_MISS_WORD]);
+ push(methods.value());
+ push(tag_fixnum(index));
+ push(cache.value());
+ word_call(userenv[MEGA_MISS_WORD]);
/* Now the new method has been stored into the cache, and its on
the stack. */
- jit_emit(jit,userenv[JIT_EPILOG]);
- jit_emit(jit,userenv[JIT_EXECUTE_JUMP]);
+ emit(userenv[JIT_EPILOG]);
+ emit(userenv[JIT_EXECUTE_JUMP]);
}
void primitive_reset_dispatch_stats(void);
void primitive_dispatch_stats(void);
-void jit_emit_class_lookup(F_JIT *jit, F_FIXNUM index, CELL type);
+void jit_emit_class_lookup(jit *jit, F_FIXNUM index, CELL type);
-void jit_emit_mega_cache_lookup(F_JIT *jit, CELL methods, F_FIXNUM index, CELL cache);
+void jit_emit_mega_cache_lookup(jit *jit, CELL methods, F_FIXNUM index, CELL cache);
/* May allocate memory */
void pass_args_to_factor(int argc, F_CHAR **argv)
{
- F_ARRAY *args = allot_array(argc,F);
+ growable_array args;
int i;
for(i = 1; i < argc; i++)
- {
- REGISTER_UNTAGGED(args);
- CELL arg = tag_object(from_native_string(argv[i]));
- UNREGISTER_UNTAGGED(F_ARRAY,args);
- set_array_nth(args,i,arg);
- }
+ args.add(tag_object(from_native_string(argv[i])));
- userenv[ARGS_ENV] = tag_array(args);
+ args.trim();
+ userenv[ARGS_ENV] = args.array.value();
}
void start_factor(F_PARAMETERS *p)
template <typename T> T *allot_array_internal(CELL capacity)
{
- T *array = (T *)allot_object(T::type_number,array_size<T>(capacity));
+ T *array = allot<T>(array_size<T>(capacity));
array->capacity = tag_fixnum(capacity);
return array;
}
return in_zone(&nursery,(CELL)array) && capacity <= array_capacity(array);
}
-template <typename T> T *reallot_array(T *array, CELL capacity)
+template <typename T> T *reallot_array(T *array_, CELL capacity)
{
-#ifdef FACTOR_DEBUG
- CELL header = untag_header(array->header);
- assert(header == T::type_number);
-#endif
+ gc_root<T> array(array_);
- if(reallot_array_in_place_p(array,capacity))
+ if(reallot_array_in_place_p(array.untagged(),capacity))
{
array->capacity = tag_fixnum(capacity);
- return array;
+ return array.untagged();
}
else
{
- CELL to_copy = array_capacity(array);
+ CELL to_copy = array_capacity(array.untagged());
if(capacity < to_copy)
to_copy = capacity;
- REGISTER_UNTAGGED(array);
T *new_array = allot_array_internal<T>(capacity);
- UNREGISTER_UNTAGGED(T,array);
- memcpy(new_array + 1,array + 1,to_copy * T::element_size);
+ memcpy(new_array + 1,array.untagged() + 1,to_copy * T::element_size);
memset((char *)(new_array + 1) + to_copy * T::element_size,
0,(capacity - to_copy) * T::element_size);
/* Figure out what kind of type check the PIC needs based on the methods
it contains */
-static CELL determine_inline_cache_type(CELL cache_entries)
+static CELL determine_inline_cache_type(F_ARRAY *cache_entries)
{
- F_ARRAY *array = untag_array_fast(cache_entries);
-
- bool seen_hi_tag = false, seen_tuple = false;
+ bool seen_hi_tag = false, seen_tuple = false;
CELL i;
- for(i = 0; i < array_capacity(array); i += 2)
+ for(i = 0; i < array_capacity(cache_entries); i += 2)
{
- CELL klass = array_nth(array,i);
+ CELL klass = array_nth(cache_entries,i);
F_FIXNUM type;
/* Is it a tuple layout? */
pic_counts[type - PIC_TAG]++;
}
-static void jit_emit_check(F_JIT *jit, CELL klass)
+struct inline_cache_jit : public jit {
+ F_FIXNUM index;
+
+ inline_cache_jit(CELL generic_word_) : jit(PIC_TYPE,generic_word_) {};
+
+ void emit_check(CELL klass);
+ void compile_inline_cache(F_FIXNUM index, CELL generic_word_, CELL methods_, CELL cache_entries_);
+};
+
+void inline_cache_jit::emit_check(CELL klass)
{
CELL code_template;
if(TAG(klass) == FIXNUM_TYPE && untag_fixnum_fast(klass) < HEADER_TYPE)
else
code_template = userenv[PIC_CHECK];
- jit_emit_with(jit,code_template,klass);
+ emit_with(code_template,klass);
}
/* index: 0 = top of stack, 1 = item underneath, etc
cache_entries: array of class/method pairs */
-static F_CODE_BLOCK *compile_inline_cache(F_FIXNUM index, CELL generic_word, CELL methods, CELL cache_entries)
+void inline_cache_jit::compile_inline_cache(F_FIXNUM index, CELL generic_word_, CELL methods_, CELL cache_entries_)
{
-#ifdef FACTOR_DEBUG
- type_check(WORD_TYPE,generic_word);
- type_check(ARRAY_TYPE,cache_entries);
-#endif
-
- REGISTER_ROOT(generic_word);
- REGISTER_ROOT(methods);
- REGISTER_ROOT(cache_entries);
-
- CELL inline_cache_type = determine_inline_cache_type(cache_entries);
+ gc_root<F_WORD> generic_word(generic_word_);
+ gc_root<F_ARRAY> methods(methods_);
+ gc_root<F_ARRAY> cache_entries(cache_entries_);
+ CELL inline_cache_type = determine_inline_cache_type(cache_entries.untagged());
update_pic_count(inline_cache_type);
- F_JIT jit;
- jit_init(&jit,PIC_TYPE,generic_word);
-
/* Generate machine code to determine the object's class. */
- jit_emit_class_lookup(&jit,index,inline_cache_type);
+ emit_class_lookup(index,inline_cache_type);
/* Generate machine code to check, in turn, if the class is one of the cached entries. */
CELL i;
- for(i = 0; i < array_capacity(untag_array_fast(cache_entries)); i += 2)
+ for(i = 0; i < array_capacity(cache_entries.untagged()); i += 2)
{
/* Class equal? */
- CELL klass = array_nth(untag_array_fast(cache_entries),i);
- jit_emit_check(&jit,klass);
+ CELL klass = array_nth(cache_entries.untagged(),i);
+ emit_check(klass);
/* Yes? Jump to method */
- CELL method = array_nth(untag_array_fast(cache_entries),i + 1);
- jit_emit_with(&jit,userenv[PIC_HIT],method);
+ CELL method = array_nth(cache_entries.untagged(),i + 1);
+ emit_with(userenv[PIC_HIT],method);
}
/* Generate machine code to handle a cache miss, which ultimately results in
The inline-cache-miss primitive call receives enough information to
reconstruct the PIC. */
- jit_push(&jit,generic_word);
- jit_push(&jit,methods);
- jit_push(&jit,tag_fixnum(index));
- jit_push(&jit,cache_entries);
- jit_word_jump(&jit,userenv[PIC_MISS_WORD]);
-
- F_CODE_BLOCK *code = jit_make_code_block(&jit);
- relocate_code_block(code);
-
- jit_dispose(&jit);
+ push(generic_word.value());
+ push(methods.value());
+ push(tag_fixnum(index));
+ push(cache_entries.value());
+ word_jump(userenv[PIC_MISS_WORD]);
+}
- UNREGISTER_ROOT(cache_entries);
- UNREGISTER_ROOT(methods);
- UNREGISTER_ROOT(generic_word);
+static F_CODE_BLOCK *compile_inline_cache(F_FIXNUM index,
+ CELL generic_word_,
+ CELL methods_,
+ CELL cache_entries_)
+{
+ gc_root<F_WORD> generic_word(generic_word_);
+ gc_root<F_ARRAY> methods(methods_);
+ gc_root<F_ARRAY> cache_entries(cache_entries_);
+ inline_cache_jit jit(generic_word.value());
+ jit.compile_inline_cache(index,generic_word.value(),methods.value(),cache_entries.value());
+ F_CODE_BLOCK *code = jit.code_block();
+ relocate_code_block(code);
return code;
}
static CELL inline_cache_size(CELL cache_entries)
{
- return (cache_entries == F ? 0 : array_capacity(untag_array(cache_entries)) / 2);
+ return array_capacity(untag_array(cache_entries)) / 2;
}
/* Allocates memory */
-static CELL add_inline_cache_entry(CELL cache_entries, CELL klass, CELL method)
+static CELL add_inline_cache_entry(CELL cache_entries_, CELL klass_, CELL method_)
{
- if(cache_entries == F)
- return allot_array_2(klass,method);
- else
- {
- F_ARRAY *cache_entries_array = untag_array_fast(cache_entries);
- CELL pic_size = array_capacity(cache_entries_array);
- cache_entries_array = reallot_array(cache_entries_array,pic_size + 2);
- set_array_nth(cache_entries_array,pic_size,klass);
- set_array_nth(cache_entries_array,pic_size + 1,method);
- return tag_array(cache_entries_array);
- }
+ gc_root<F_ARRAY> cache_entries(cache_entries_);
+ gc_root<F_OBJECT> klass(klass_);
+ gc_root<F_WORD> method(method_);
+
+ CELL pic_size = array_capacity(cache_entries.untagged());
+ gc_root<F_ARRAY> new_cache_entries(reallot_array(cache_entries.untagged(),pic_size + 2));
+ set_array_nth(new_cache_entries.untagged(),pic_size,klass.value());
+ set_array_nth(new_cache_entries.untagged(),pic_size + 1,method.value());
+ return new_cache_entries.value();
}
static void update_pic_transitions(CELL pic_size)
instead of leaving dead PICs around until the next GC. */
deallocate_inline_cache(return_address);
- CELL cache_entries = dpop();
+ gc_root<F_ARRAY> cache_entries(dpop());
F_FIXNUM index = untag_fixnum_fast(dpop());
- CELL methods = dpop();
- CELL generic_word = dpop();
- CELL object = get(ds - index * CELLS);
+ gc_root<F_ARRAY> methods(dpop());
+ gc_root<F_WORD> generic_word(dpop());
+ gc_root<F_OBJECT> object(get(ds - index * CELLS));
XT xt;
- CELL pic_size = inline_cache_size(cache_entries);
+ CELL pic_size = inline_cache_size(cache_entries.value());
update_pic_transitions(pic_size);
if(pic_size >= max_pic_size)
- xt = megamorphic_call_stub(generic_word);
+ xt = megamorphic_call_stub(generic_word.value());
else
{
- REGISTER_ROOT(generic_word);
- REGISTER_ROOT(cache_entries);
- REGISTER_ROOT(methods);
-
- CELL klass = object_class(object);
- CELL method = lookup_method(object,methods);
-
- cache_entries = add_inline_cache_entry(cache_entries,klass,method);
- xt = compile_inline_cache(index,generic_word,methods,cache_entries) + 1;
-
- UNREGISTER_ROOT(methods);
- UNREGISTER_ROOT(cache_entries);
- UNREGISTER_ROOT(generic_word);
+ CELL klass = object_class(object.value());
+ CELL method = lookup_method(object.value(),methods.value());
+
+ gc_root<F_ARRAY> new_cache_entries(add_inline_cache_entry(
+ cache_entries.value(),
+ klass,
+ method));
+ xt = compile_inline_cache(index,
+ generic_word.value(),
+ methods.value(),
+ new_cache_entries.value()) + 1;
}
/* Install the new stub. */
void primitive_inline_cache_stats(void)
{
- GROWABLE_ARRAY(stats);
- GROWABLE_ARRAY_ADD(stats,allot_cell(cold_call_to_ic_transitions));
- GROWABLE_ARRAY_ADD(stats,allot_cell(ic_to_pic_transitions));
- GROWABLE_ARRAY_ADD(stats,allot_cell(pic_to_mega_transitions));
+ growable_array stats;
+ stats.add(allot_cell(cold_call_to_ic_transitions));
+ stats.add(allot_cell(ic_to_pic_transitions));
+ stats.add(allot_cell(pic_to_mega_transitions));
CELL i;
for(i = 0; i < 4; i++)
- GROWABLE_ARRAY_ADD(stats,allot_cell(pic_counts[i]));
- GROWABLE_ARRAY_TRIM(stats);
- GROWABLE_ARRAY_DONE(stats);
- dpush(stats);
+ stats.add(allot_cell(pic_counts[i]));
+ stats.trim();
+ dpush(stats.array.value());
}
return;
}
- F_BYTE_ARRAY *buf = allot_byte_array(size);
+ gc_root<F_BYTE_ARRAY> buf(allot_array_internal<F_BYTE_ARRAY>(size));
for(;;)
{
- int c = fread(buf + 1,1,size,file);
+ int c = fread(buf.untagged() + 1,1,size,file);
if(c <= 0)
{
if(feof(file))
{
if(c != size)
{
- REGISTER_UNTAGGED(buf);
F_BYTE_ARRAY *new_buf = allot_byte_array(c);
- UNREGISTER_UNTAGGED(F_BYTE_ARRAY,buf);
- memcpy(new_buf + 1, buf + 1,c);
+ memcpy(new_buf + 1, buf.untagged() + 1,c);
buf = new_buf;
}
- dpush(tag_object(buf));
+ dpush(buf.value());
break;
}
}
#include "master.hpp"
/* Simple code generator used by:
-- profiler (profiler.c),
-- quotation compiler (quotations.c),
-- megamorphic caches (dispatch.c),
-- polymorphic inline caches (inline_cache.c) */
+- profiler (profiler.cpp),
+- quotation compiler (quotations.cpp),
+- megamorphic caches (dispatch.cpp),
+- polymorphic inline caches (inline_cache.cpp) */
/* Allocates memory */
-void jit_init(F_JIT *jit, CELL jit_type, CELL owner)
+jit::jit(CELL type_, CELL owner_)
+ : type(type_),
+ owner(owner_),
+ code(),
+ relocation(),
+ literals(),
+ computing_offset_p(false),
+ position(0),
+ offset(0)
{
- jit->owner = owner;
- REGISTER_ROOT(jit->owner);
-
- jit->type = jit_type;
-
- jit->code = make_growable_byte_array();
- REGISTER_ROOT(jit->code.array);
- jit->relocation = make_growable_byte_array();
- REGISTER_ROOT(jit->relocation.array);
- jit->literals = make_growable_array();
- REGISTER_ROOT(jit->literals.array);
-
- if(stack_traces_p())
- growable_array_add(&jit->literals,jit->owner);
-
- jit->computing_offset_p = false;
-}
-
-/* Facility to convert compiled code offsets to quotation offsets.
-Call jit_compute_offset() with the compiled code offset, then emit
-code, and at the end jit->position is the quotation position. */
-void jit_compute_position(F_JIT *jit, CELL offset)
-{
- jit->computing_offset_p = true;
- jit->position = 0;
- jit->offset = offset;
-}
-
-/* Allocates memory */
-F_CODE_BLOCK *jit_make_code_block(F_JIT *jit)
-{
- growable_byte_array_trim(&jit->code);
- growable_byte_array_trim(&jit->relocation);
- growable_array_trim(&jit->literals);
-
- F_CODE_BLOCK *code = add_code_block(
- jit->type,
- untag_byte_array_fast(jit->code.array),
- NULL, /* no labels */
- jit->relocation.array,
- jit->literals.array);
-
- return code;
-}
-
-void jit_dispose(F_JIT *jit)
-{
- UNREGISTER_ROOT(jit->literals.array);
- UNREGISTER_ROOT(jit->relocation.array);
- UNREGISTER_ROOT(jit->code.array);
- UNREGISTER_ROOT(jit->owner);
+ if(stack_traces_p()) literal(owner.value());
}
-static F_REL rel_to_emit(F_JIT *jit, CELL code_template, bool *rel_p)
+F_REL jit::rel_to_emit(CELL code_template, bool *rel_p)
{
F_ARRAY *quadruple = untag_array_fast(code_template);
CELL rel_class = array_nth(quadruple,1);
*rel_p = true;
return (untag_fixnum_fast(rel_type) << 28)
| (untag_fixnum_fast(rel_class) << 24)
- | ((jit->code.count + untag_fixnum_fast(offset)));
+ | ((code.count + untag_fixnum_fast(offset)));
}
}
/* Allocates memory */
-void jit_emit(F_JIT *jit, CELL code_template)
+void jit::emit(CELL code_template_)
{
-#ifdef FACTOR_DEBUG
- type_check(ARRAY_TYPE,code_template);
-#endif
-
- REGISTER_ROOT(code_template);
+ gc_root<F_ARRAY> code_template(code_template_);
bool rel_p;
- F_REL rel = rel_to_emit(jit,code_template,&rel_p);
- if(rel_p) growable_byte_array_append(&jit->relocation,&rel,sizeof(F_REL));
+ F_REL rel = rel_to_emit(code_template.value(),&rel_p);
+ if(rel_p) relocation.append_bytes(&rel,sizeof(F_REL));
- F_BYTE_ARRAY *code = code_to_emit(code_template);
+ gc_root<F_BYTE_ARRAY> insns(array_nth(code_template.untagged(),0));
- if(jit->computing_offset_p)
+ if(computing_offset_p)
{
- CELL size = array_capacity(code);
+ CELL size = array_capacity(insns.untagged());
- if(jit->offset == 0)
+ if(offset == 0)
{
- jit->position--;
- jit->computing_offset_p = false;
+ position--;
+ computing_offset_p = false;
}
- else if(jit->offset < size)
+ else if(offset < size)
{
- jit->position++;
- jit->computing_offset_p = false;
+ position++;
+ computing_offset_p = false;
}
else
- jit->offset -= size;
+ offset -= size;
}
- growable_byte_array_append(&jit->code,code + 1,array_capacity(code));
+ code.append_byte_array(insns.value());
+}
+
+void jit::emit_with(CELL code_template_, CELL argument_) {
+ gc_root<F_ARRAY> code_template(code_template_);
+ gc_root<F_OBJECT> argument(argument_);
+ literal(argument.value());
+ emit(code_template.value());
+}
+
+void jit::emit_class_lookup(F_FIXNUM index, CELL type)
+{
+ emit_with(userenv[PIC_LOAD],tag_fixnum(-index * CELLS));
+ emit(userenv[type]);
+}
+
+/* Facility to convert compiled code offsets to quotation offsets.
+Call jit_compute_offset() with the compiled code offset, then emit
+code, and at the end jit->position is the quotation position. */
+void jit::compute_position(CELL offset_)
+{
+ computing_offset_p = true;
+ position = 0;
+ offset = offset_;
+}
- UNREGISTER_ROOT(code_template);
+/* Allocates memory */
+F_CODE_BLOCK *jit::code_block()
+{
+ code.trim();
+ relocation.trim();
+ literals.trim();
+
+ return add_code_block(
+ type,
+ code.array.value(),
+ F, /* no labels */
+ relocation.array.value(),
+ literals.array.value());
}
+
-typedef struct {
+struct jit {
CELL type;
- CELL owner;
- F_GROWABLE_BYTE_ARRAY code;
- F_GROWABLE_BYTE_ARRAY relocation;
- F_GROWABLE_ARRAY literals;
+ gc_root<F_OBJECT> owner;
+ growable_byte_array code;
+ growable_byte_array relocation;
+ growable_array literals;
bool computing_offset_p;
F_FIXNUM position;
CELL offset;
-} F_JIT;
-void jit_init(F_JIT *jit, CELL jit_type, CELL owner);
+ jit(CELL jit_type, CELL owner);
+ void compute_position(CELL offset);
-void jit_compute_position(F_JIT *jit, CELL offset);
+ F_REL rel_to_emit(CELL code_template, bool *rel_p);
+ void emit(CELL code_template);
-F_CODE_BLOCK *jit_make_code_block(F_JIT *jit);
+ void literal(CELL literal) { literals.add(literal); }
+ void emit_with(CELL code_template_, CELL literal_);
-void jit_dispose(F_JIT *jit);
-
-INLINE F_BYTE_ARRAY *code_to_emit(CELL code_template)
-{
- return untag_byte_array_fast(array_nth(untag_array_fast(code_template),0));
-}
-
-void jit_emit(F_JIT *jit, CELL code_template);
-
-/* Allocates memory */
-INLINE void jit_add_literal(F_JIT *jit, CELL literal)
-{
-#ifdef FACTOR_DEBUG
- type_of(literal);
-#endif
- growable_array_add(&jit->literals,literal);
-}
-
-/* Allocates memory */
-INLINE void jit_emit_with(F_JIT *jit, CELL code_template, CELL argument)
-{
- REGISTER_ROOT(code_template);
- jit_add_literal(jit,argument);
- UNREGISTER_ROOT(code_template);
- jit_emit(jit,code_template);
-}
-
-/* Allocates memory */
-INLINE void jit_push(F_JIT *jit, CELL literal)
-{
- jit_emit_with(jit,userenv[JIT_PUSH_IMMEDIATE],literal);
-}
-
-/* Allocates memory */
-INLINE void jit_word_jump(F_JIT *jit, CELL word)
-{
- jit_emit_with(jit,userenv[JIT_WORD_JUMP],word);
-}
+ void push(CELL literal) {
+ emit_with(userenv[JIT_PUSH_IMMEDIATE],literal);
+ }
-/* Allocates memory */
-INLINE void jit_word_call(F_JIT *jit, CELL word)
-{
- jit_emit_with(jit,userenv[JIT_WORD_CALL],word);
-}
+ void word_jump(CELL word) {
+ emit_with(userenv[JIT_WORD_JUMP],word);
+ }
-/* Allocates memory */
-INLINE void jit_emit_subprimitive(F_JIT *jit, CELL word)
-{
- CELL code_template = untag_word_fast(word)->subprimitive;
- REGISTER_ROOT(code_template);
+ void word_call(CELL word) {
+ emit_with(userenv[JIT_WORD_CALL],word);
+ }
- if(array_nth(untag_array_fast(code_template),1) != F)
- jit_add_literal(jit,T);
+ void emit_subprimitive(CELL word) {
+ gc_root<F_ARRAY> code_template(untagged<F_WORD>(word)->subprimitive);
+ if(array_nth(code_template.untagged(),1) != F) literal(T);
+ emit(code_template.value());
+ }
- jit_emit(jit,code_template);
- UNREGISTER_ROOT(code_template);
-}
+ void emit_class_lookup(F_FIXNUM index, CELL type);
+
+ F_FIXNUM get_position() {
+ if(computing_offset_p)
+ {
+ /* If this is still on, emit() didn't clear it,
+ so the offset was out of bounds */
+ return -1;
+ }
+ else
+ return position;
+ }
-INLINE F_FIXNUM jit_get_position(F_JIT *jit)
-{
- if(jit->computing_offset_p)
- {
- /* If this is still on, jit_emit() didn't clear it,
- so the offset was out of bounds */
- return -1;
+ void set_position(F_FIXNUM position_) {
+ if(computing_offset_p)
+ position = position_;
}
- else
- return jit->position;
-}
-INLINE void jit_set_position(F_JIT *jit, F_FIXNUM position)
-{
- if(jit->computing_offset_p)
- jit->position = position;
-}
+
+ F_CODE_BLOCK *code_block();
+};
typedef void *XT;
struct F_OBJECT {
+ static const CELL type_number = TYPE_COUNT;
CELL header;
};
DEFPUSHPOP(gc_local_,gc_locals)
template <typename T>
-class gc_root : public tagged<T>
+struct gc_root : public tagged<T>
{
void push() { gc_local_push((CELL)this); }
-public:
+
explicit gc_root(CELL value_) : tagged<T>(value_) { push(); }
explicit gc_root(T *value_) : tagged<T>(value_) { push(); }
- gc_root(const gc_root<T>& copy) : tagged<T>(copy.untag()) {}
+
+ const gc_root<T>& operator=(const T *x) { tagged<T>::operator=(x); return *this; }
+ const gc_root<T>& operator=(const CELL &x) { tagged<T>::operator=(x); return *this; }
+
~gc_root() { CELL old = gc_local_pop(); assert(old == (CELL)this); }
};
-#define REGISTER_ROOT(obj) \
- { \
- if(!immediate_p(obj)) \
- check_data_pointer(obj); \
- gc_local_push((CELL)&(obj)); \
- }
-#define UNREGISTER_ROOT(obj) \
- { \
- if(gc_local_pop() != (CELL)&(obj)) \
- critical_error("Mismatched REGISTER_ROOT/UNREGISTER_ROOT",0); \
- }
-
/* Extra roots: stores pointers to objects in the heap. Requires extra work
(you have to unregister before accessing the object) but more flexible. */
extern F_SEGMENT *extra_roots_region;
DEFPUSHPOP(root_,extra_roots)
-#define REGISTER_UNTAGGED(obj) root_push(obj ? RETAG(obj,OBJECT_TYPE) : 0)
-#define UNREGISTER_UNTAGGED(type,obj) obj = (type *)UNTAG(root_pop())
-
/* We ignore strings which point outside the data heap, but we might be given
a char* which points inside the data heap, in which case it is a root, for
example if we call unbox_char_string() the result is placed in a byte array */
#include <sys/param.h>
#include "layouts.hpp"
-#include "tagged.hpp"
#include "platform.hpp"
#include "primitives.hpp"
#include "run.hpp"
+#include "tagged.hpp"
#include "profiler.hpp"
#include "errors.hpp"
#include "bignumint.hpp"
#include "image.hpp"
#include "callstack.hpp"
#include "alien.hpp"
-#include "quotations.hpp"
#include "jit.hpp"
+#include "quotations.hpp"
#include "dispatch.hpp"
#include "inline_cache.hpp"
#include "factor.hpp"
INLINE CELL allot_float(double n)
{
- F_FLOAT* flo = (F_FLOAT *)allot_object(FLOAT_TYPE,sizeof(F_FLOAT));
+ F_FLOAT *flo = allot<F_FLOAT>(sizeof(F_FLOAT));
flo->n = n;
return RETAG(flo,FLOAT_TYPE);
}
}
/* Allocates memory */
-F_CODE_BLOCK *compile_profiling_stub(CELL word)
+F_CODE_BLOCK *compile_profiling_stub(CELL word_)
{
- REGISTER_ROOT(word);
- F_JIT jit;
- jit_init(&jit,WORD_TYPE,word);
- jit_emit_with(&jit,userenv[JIT_PROFILING],word);
- F_CODE_BLOCK *block = jit_make_code_block(&jit);
- jit_dispose(&jit);
- UNREGISTER_ROOT(word);
- return block;
+ gc_root<F_WORD> word(word_);
+
+ jit jit(WORD_TYPE,word.value());
+ jit.emit_with(userenv[JIT_PROFILING],word.value());
+
+ return jit.code_block();
}
/* Allocates memory */
and allocate profiling blocks if necessary */
gc();
- CELL words = find_all_words();
-
- REGISTER_ROOT(words);
+ gc_root<F_ARRAY> words(find_all_words());
CELL i;
- CELL length = array_capacity(untag_array_fast(words));
+ CELL length = array_capacity(words.untagged());
for(i = 0; i < length; i++)
{
- F_WORD *word = untag_word(array_nth(untag_array(words),i));
+ tagged<F_WORD> word(array_nth(words.untagged(),i));
if(profiling)
word->counter = tag_fixnum(0);
- update_word_xt(word);
+ update_word_xt(word.value());
}
- UNREGISTER_ROOT(words);
-
/* Update XTs in code heap */
iterate_code_heap(relocate_code_block);
}
slot and eq?. A primitive call is relatively expensive (two subroutine calls)
so this results in a big speedup for relatively little effort. */
-static bool jit_primitive_call_p(F_ARRAY *array, CELL i)
+bool quotation_jit::primitive_call_p(CELL i)
{
- return (i + 2) == array_capacity(array)
- && type_of(array_nth(array,i)) == FIXNUM_TYPE
- && array_nth(array,i + 1) == userenv[JIT_PRIMITIVE_WORD];
+ return (i + 2) == array_capacity(array.untagged())
+ && type_of(array_nth(array.untagged(),i)) == FIXNUM_TYPE
+ && array_nth(array.untagged(),i + 1) == userenv[JIT_PRIMITIVE_WORD];
}
-static bool jit_fast_if_p(F_ARRAY *array, CELL i)
+bool quotation_jit::fast_if_p(CELL i)
{
- return (i + 3) == array_capacity(array)
- && type_of(array_nth(array,i)) == QUOTATION_TYPE
- && type_of(array_nth(array,i + 1)) == QUOTATION_TYPE
- && array_nth(array,i + 2) == userenv[JIT_IF_WORD];
+ return (i + 3) == array_capacity(array.untagged())
+ && type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE
+ && type_of(array_nth(array.untagged(),i + 1)) == QUOTATION_TYPE
+ && array_nth(array.untagged(),i + 2) == userenv[JIT_IF_WORD];
}
-static bool jit_fast_dip_p(F_ARRAY *array, CELL i)
+bool quotation_jit::fast_dip_p(CELL i)
{
- return (i + 2) <= array_capacity(array)
- && type_of(array_nth(array,i)) == QUOTATION_TYPE
- && array_nth(array,i + 1) == userenv[JIT_DIP_WORD];
+ return (i + 2) <= array_capacity(array.untagged())
+ && type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE
+ && array_nth(array.untagged(),i + 1) == userenv[JIT_DIP_WORD];
}
-static bool jit_fast_2dip_p(F_ARRAY *array, CELL i)
+bool quotation_jit::fast_2dip_p(CELL i)
{
- return (i + 2) <= array_capacity(array)
- && type_of(array_nth(array,i)) == QUOTATION_TYPE
- && array_nth(array,i + 1) == userenv[JIT_2DIP_WORD];
+ return (i + 2) <= array_capacity(array.untagged())
+ && type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE
+ && array_nth(array.untagged(),i + 1) == userenv[JIT_2DIP_WORD];
}
-static bool jit_fast_3dip_p(F_ARRAY *array, CELL i)
+bool quotation_jit::fast_3dip_p(CELL i)
{
- return (i + 2) <= array_capacity(array)
- && type_of(array_nth(array,i)) == QUOTATION_TYPE
- && array_nth(array,i + 1) == userenv[JIT_3DIP_WORD];
+ return (i + 2) <= array_capacity(array.untagged())
+ && type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE
+ && array_nth(array.untagged(),i + 1) == userenv[JIT_3DIP_WORD];
}
-static bool jit_mega_lookup_p(F_ARRAY *array, CELL i)
+bool quotation_jit::mega_lookup_p(CELL i)
{
- return (i + 3) < array_capacity(array)
- && type_of(array_nth(array,i)) == ARRAY_TYPE
- && type_of(array_nth(array,i + 1)) == FIXNUM_TYPE
- && type_of(array_nth(array,i + 2)) == ARRAY_TYPE
- && array_nth(array,i + 3) == userenv[MEGA_LOOKUP_WORD];
+ return (i + 3) < array_capacity(array.untagged())
+ && type_of(array_nth(array.untagged(),i)) == ARRAY_TYPE
+ && type_of(array_nth(array.untagged(),i + 1)) == FIXNUM_TYPE
+ && type_of(array_nth(array.untagged(),i + 2)) == ARRAY_TYPE
+ && array_nth(array.untagged(),i + 3) == userenv[MEGA_LOOKUP_WORD];
}
-static bool jit_stack_frame_p(F_ARRAY *array)
+bool quotation_jit::stack_frame_p()
{
- F_FIXNUM length = array_capacity(array);
+ F_FIXNUM length = array_capacity(array.untagged());
F_FIXNUM i;
for(i = 0; i < length - 1; i++)
{
- CELL obj = array_nth(array,i);
+ CELL obj = array_nth(array.untagged(),i);
if(type_of(obj) == WORD_TYPE)
{
- F_WORD *word = untag_word_fast(obj);
- if(word->subprimitive == F)
+ if(untagged<F_WORD>(obj)->subprimitive == F)
return true;
}
else if(type_of(obj) == QUOTATION_TYPE)
{
- if(jit_fast_dip_p(array,i)
- || jit_fast_2dip_p(array,i)
- || jit_fast_3dip_p(array,i))
+ if(fast_dip_p(i) || fast_2dip_p(i) || fast_3dip_p(i))
return true;
}
}
return false;
}
-#define TAIL_CALL { \
- if(stack_frame) jit_emit(jit,userenv[JIT_EPILOG]); \
- tail_call = true; \
- }
-
/* Allocates memory */
-static void jit_iterate_quotation(F_JIT *jit, CELL array, CELL compiling, CELL relocate)
+void quotation_jit::iterate_quotation()
{
- REGISTER_ROOT(array);
+ bool stack_frame = stack_frame_p();
- bool stack_frame = jit_stack_frame_p(untag_array_fast(array));
-
- jit_set_position(jit,0);
+ set_position(0);
if(stack_frame)
- jit_emit(jit,userenv[JIT_PROLOG]);
+ emit(userenv[JIT_PROLOG]);
CELL i;
- CELL length = array_capacity(untag_array_fast(array));
+ CELL length = array_capacity(array.untagged());
bool tail_call = false;
for(i = 0; i < length; i++)
{
- jit_set_position(jit,i);
-
- CELL obj = array_nth(untag_array_fast(array),i);
- REGISTER_ROOT(obj);
+ set_position(i);
- F_WORD *word;
- F_WRAPPER *wrapper;
+ gc_root<F_OBJECT> obj(array_nth(array.untagged(),i));
- switch(type_of(obj))
+ switch(obj.type())
{
case WORD_TYPE:
- word = untag_word_fast(obj);
-
/* Intrinsics */
- if(word->subprimitive != F)
- jit_emit_subprimitive(jit,obj);
+ if(obj.as<F_WORD>()->subprimitive != F)
+ emit_subprimitive(obj.value());
/* The (execute) primitive is special-cased */
- else if(obj == userenv[JIT_EXECUTE_WORD])
+ else if(obj.value() == userenv[JIT_EXECUTE_WORD])
{
if(i == length - 1)
{
- TAIL_CALL;
- jit_emit(jit,userenv[JIT_EXECUTE_JUMP]);
+ if(stack_frame) emit(userenv[JIT_EPILOG]);
+ tail_call = true;
+ emit(userenv[JIT_EXECUTE_JUMP]);
}
else
- jit_emit(jit,userenv[JIT_EXECUTE_CALL]);
+ emit(userenv[JIT_EXECUTE_CALL]);
}
/* Everything else */
else
{
if(i == length - 1)
{
- TAIL_CALL;
- jit_word_jump(jit,obj);
+ if(stack_frame) emit(userenv[JIT_EPILOG]);
+ tail_call = true;
+ word_jump(obj.value());
}
else
- jit_word_call(jit,obj);
+ word_call(obj.value());
}
break;
case WRAPPER_TYPE:
- wrapper = untag_wrapper_fast(obj);
- jit_push(jit,wrapper->object);
+ push(obj.as<F_WRAPPER>()->object);
break;
case FIXNUM_TYPE:
/* Primitive calls */
- if(jit_primitive_call_p(untag_array_fast(array),i))
+ if(primitive_call_p(i))
{
- jit_emit(jit,userenv[JIT_SAVE_STACK]);
- jit_emit_with(jit,userenv[JIT_PRIMITIVE],obj);
+ emit(userenv[JIT_SAVE_STACK]);
+ emit_with(userenv[JIT_PRIMITIVE],obj.value());
i++;
case QUOTATION_TYPE:
/* 'if' preceeded by two literal quotations (this is why if and ? are
mutually recursive in the library, but both still work) */
- if(jit_fast_if_p(untag_array_fast(array),i))
+ if(fast_if_p(i))
{
- TAIL_CALL;
+ if(stack_frame) emit(userenv[JIT_EPILOG]);
+ tail_call = true;
if(compiling)
{
- jit_compile(array_nth(untag_array_fast(array),i),relocate);
- jit_compile(array_nth(untag_array_fast(array),i + 1),relocate);
+ jit_compile(array_nth(array.untagged(),i),relocate);
+ jit_compile(array_nth(array.untagged(),i + 1),relocate);
}
- jit_emit_with(jit,userenv[JIT_IF_1],array_nth(untag_array_fast(array),i));
- jit_emit_with(jit,userenv[JIT_IF_2],array_nth(untag_array_fast(array),i + 1));
+ emit_with(userenv[JIT_IF_1],array_nth(array.untagged(),i));
+ emit_with(userenv[JIT_IF_2],array_nth(array.untagged(),i + 1));
i += 2;
break;
}
/* dip */
- else if(jit_fast_dip_p(untag_array_fast(array),i))
+ else if(fast_dip_p(i))
{
if(compiling)
- jit_compile(obj,relocate);
- jit_emit_with(jit,userenv[JIT_DIP],obj);
+ jit_compile(obj.value(),relocate);
+ emit_with(userenv[JIT_DIP],obj.value());
i++;
break;
}
/* 2dip */
- else if(jit_fast_2dip_p(untag_array_fast(array),i))
+ else if(fast_2dip_p(i))
{
if(compiling)
- jit_compile(obj,relocate);
- jit_emit_with(jit,userenv[JIT_2DIP],obj);
+ jit_compile(obj.value(),relocate);
+ emit_with(userenv[JIT_2DIP],obj.value());
i++;
break;
}
/* 3dip */
- else if(jit_fast_3dip_p(untag_array_fast(array),i))
+ else if(fast_3dip_p(i))
{
if(compiling)
- jit_compile(obj,relocate);
- jit_emit_with(jit,userenv[JIT_3DIP],obj);
+ jit_compile(obj.value(),relocate);
+ emit_with(userenv[JIT_3DIP],obj.value());
i++;
break;
}
case ARRAY_TYPE:
/* Method dispatch */
- if(jit_mega_lookup_p(untag_array_fast(array),i))
+ if(mega_lookup_p(i))
{
- jit_emit_mega_cache_lookup(jit,
- array_nth(untag_array_fast(array),i),
- untag_fixnum_fast(array_nth(untag_array_fast(array),i + 1)),
- array_nth(untag_array_fast(array),i + 2));
+ emit_mega_cache_lookup(
+ array_nth(array.untagged(),i),
+ untag_fixnum_fast(array_nth(array.untagged(),i + 1)),
+ array_nth(array.untagged(),i + 2));
i += 3;
tail_call = true;
break;
}
default:
- jit_push(jit,obj);
+ push(obj.value());
break;
}
-
- UNREGISTER_ROOT(obj);
}
if(!tail_call)
{
- jit_set_position(jit,length);
+ set_position(length);
if(stack_frame)
- jit_emit(jit,userenv[JIT_EPILOG]);
- jit_emit(jit,userenv[JIT_RETURN]);
+ emit(userenv[JIT_EPILOG]);
+ emit(userenv[JIT_RETURN]);
}
-
- UNREGISTER_ROOT(array);
}
void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code)
}
/* Allocates memory */
-void jit_compile(CELL quot, bool relocate)
-{
- if(untag_quotation(quot)->compiledp != F)
- return;
-
- CELL array = untag_quotation(quot)->array;
-
- REGISTER_ROOT(quot);
- REGISTER_ROOT(array);
-
- F_JIT jit;
- jit_init(&jit,QUOTATION_TYPE,quot);
-
- jit_iterate_quotation(&jit,array,true,relocate);
-
- F_CODE_BLOCK *compiled = jit_make_code_block(&jit);
-
- set_quot_xt(untag_quotation_fast(quot),compiled);
-
- if(relocate) relocate_code_block(compiled);
-
- jit_dispose(&jit);
-
- UNREGISTER_ROOT(array);
- UNREGISTER_ROOT(quot);
-}
-
-F_FIXNUM quot_code_offset_to_scan(CELL quot, CELL offset)
+void jit_compile(CELL quot_, bool relocating)
{
- CELL array = untag_quotation(quot)->array;
- REGISTER_ROOT(array);
+ gc_root<F_QUOTATION> quot(quot_);
+ if(quot->compiledp != F) return;
- F_JIT jit;
- jit_init(&jit,QUOTATION_TYPE,quot);
- jit_compute_position(&jit,offset);
- jit_iterate_quotation(&jit,array,false,false);
- jit_dispose(&jit);
+ quotation_jit jit(quot.value(),true,relocating);
+ jit.iterate_quotation();
- UNREGISTER_ROOT(array);
+ F_CODE_BLOCK *compiled = jit.code_block();
+ set_quot_xt(quot.untagged(),compiled);
- return jit_get_position(&jit);
+ if(relocating) relocate_code_block(compiled);
}
-F_FASTCALL CELL lazy_jit_compile_impl(CELL quot, F_STACK_FRAME *stack)
+F_FASTCALL CELL lazy_jit_compile_impl(CELL quot_, F_STACK_FRAME *stack)
{
+ gc_root<F_QUOTATION> quot(quot_);
stack_chain->callstack_top = stack;
- REGISTER_ROOT(quot);
- jit_compile(quot,true);
- UNREGISTER_ROOT(quot);
- return quot;
+ jit_compile(quot.value(),true);
+ return quot.value();
}
void primitive_jit_compile(void)
/* push a new quotation on the stack */
void primitive_array_to_quotation(void)
{
- F_QUOTATION *quot = (F_QUOTATION *)allot_object(QUOTATION_TYPE,sizeof(F_QUOTATION));
+ F_QUOTATION *quot = allot<F_QUOTATION>(sizeof(F_QUOTATION));
quot->array = dpeek();
quot->xt = (void *)lazy_jit_compile;
quot->compiledp = F;
void compile_all_words(void)
{
- CELL words = find_all_words();
-
- REGISTER_ROOT(words);
+ gc_root<F_ARRAY> words(find_all_words());
CELL i;
- CELL length = array_capacity(untag_array(words));
+ CELL length = array_capacity(words.untagged());
for(i = 0; i < length; i++)
{
- F_WORD *word = untag_word(array_nth(untag_array(words),i));
- REGISTER_UNTAGGED(word);
+ gc_root<F_WORD> word(array_nth(words.untagged(),i));
- if(!word->code || !word_optimized_p(word))
- jit_compile_word(word,word->def,false);
+ if(!word->code || !word_optimized_p(word.untagged()))
+ jit_compile_word(word.value(),word->def,false);
- UNREGISTER_UNTAGGED(F_WORD,word);
- update_word_xt(word);
+ update_word_xt(word.value());
}
- UNREGISTER_ROOT(words);
-
iterate_code_heap(relocate_code_block);
}
+
+/* Allocates memory */
+F_FIXNUM quot_code_offset_to_scan(CELL quot_, CELL offset)
+{
+ gc_root<F_QUOTATION> quot(quot_);
+ gc_root<F_ARRAY> array(quot->array);
+
+ quotation_jit jit(quot.value(),false,false);
+ jit.compute_position(offset);
+ jit.iterate_quotation();
+
+ return jit.get_position();
+}
return RETAG(quotation,QUOTATION_TYPE);
}
+struct quotation_jit : public jit {
+ gc_root<F_ARRAY> array;
+ bool compiling, relocate;
+
+ quotation_jit(CELL quot, bool compiling_, bool relocate_)
+ : jit(QUOTATION_TYPE,quot),
+ array(owner.as<F_QUOTATION>().untagged()->array),
+ compiling(compiling_),
+ relocate(relocate_) {};
+
+ void emit_mega_cache_lookup(CELL methods, F_FIXNUM index, CELL cache);
+ bool primitive_call_p(CELL i);
+ bool fast_if_p(CELL i);
+ bool fast_dip_p(CELL i);
+ bool fast_2dip_p(CELL i);
+ bool fast_3dip_p(CELL i);
+ bool mega_lookup_p(CELL i);
+ bool stack_frame_p();
+ void iterate_quotation();
+};
+
void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code);
void jit_compile(CELL quot, bool relocate);
F_FIXNUM quot_code_offset_to_scan(CELL quot, CELL offset);
-void primitive_array_to_quotation(void);
-void primitive_quotation_xt(void);
+
void primitive_jit_compile(void);
-void compile_all_words(void);
F_FASTCALL CELL lazy_jit_compile_impl(CELL quot, F_STACK_FRAME *stack);
+
+void compile_all_words(void);
+
+void primitive_array_to_quotation(void);
+void primitive_quotation_xt(void);
+
rs += CELLS * count;
}
-static CELL clone_object(CELL object)
+static CELL clone_object(CELL object_)
{
- CELL size = object_size(object);
+ gc_root<F_OBJECT> object(object_);
+
+ CELL size = object_size(object.value());
if(size == 0)
- return object;
+ return object.value();
else
{
- REGISTER_ROOT(object);
- void *new_obj = allot_object(type_of(object),size);
- UNREGISTER_ROOT(object);
+ void *new_obj = allot_object(object.type(),size);
- CELL tag = TAG(object);
- memcpy(new_obj,(void*)UNTAG(object),size);
+ CELL tag = TAG(object.value());
+ memcpy(new_obj,object.untagged(),size);
return RETAG(new_obj,tag);
}
}
}
}
-void set_string_nth_fast(F_STRING* string, CELL index, CELL ch)
+void set_string_nth_fast(F_STRING *string, CELL index, CELL ch)
{
bput(SREF(string,index),ch);
}
-void set_string_nth_slow(F_STRING* string, CELL index, CELL ch)
+void set_string_nth_slow(F_STRING *string_, CELL index, CELL ch)
{
+ gc_root<F_STRING> string(string_);
+
F_BYTE_ARRAY *aux;
- bput(SREF(string,index),(ch & 0x7f) | 0x80);
+ bput(SREF(string.untagged(),index),(ch & 0x7f) | 0x80);
if(string->aux == F)
{
- REGISTER_UNTAGGED(string);
/* We don't need to pre-initialize the
byte array with any data, since we
only ever read from the aux vector
aux = allot_array_internal<F_BYTE_ARRAY>(
untag_fixnum_fast(string->length)
* sizeof(u16));
- UNREGISTER_UNTAGGED(F_STRING,string);
- write_barrier((CELL)string);
+ write_barrier(string.value());
string->aux = tag_object(aux);
}
else
set_string_nth_slow(string,index,ch);
}
-/* untagged */
-F_STRING* allot_string_internal(CELL capacity)
+/* Allocates memory */
+F_STRING *allot_string_internal(CELL capacity)
{
- F_STRING *string = (F_STRING *)allot_object(STRING_TYPE,string_size(capacity));
+ F_STRING *string = allot<F_STRING>(string_size(capacity));
string->length = tag_fixnum(capacity);
string->hashcode = F;
return string;
}
-/* allocates memory */
-void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
+/* Allocates memory */
+void fill_string(F_STRING *string_, CELL start, CELL capacity, CELL fill)
{
+ gc_root<F_STRING> string(string_);
+
if(fill <= 0x7f)
- memset((void *)SREF(string,start),fill,capacity - start);
+ memset((void *)SREF(string.untagged(),start),fill,capacity - start);
else
{
CELL i;
for(i = start; i < capacity; i++)
- {
- REGISTER_UNTAGGED(string);
- set_string_nth(string,i,fill);
- UNREGISTER_UNTAGGED(F_STRING,string);
- }
+ set_string_nth(string.untagged(),i,fill);
}
}
-/* untagged */
+/* Allocates memory */
F_STRING *allot_string(CELL capacity, CELL fill)
{
- F_STRING* string = allot_string_internal(capacity);
- REGISTER_UNTAGGED(string);
- fill_string(string,0,capacity,fill);
- UNREGISTER_UNTAGGED(F_STRING,string);
- return string;
+ gc_root<F_STRING> string(allot_string_internal(capacity));
+ fill_string(string.untagged(),0,capacity,fill);
+ return string.untagged();
}
void primitive_string(void)
return in_zone(&nursery,(CELL)string) && capacity <= string_capacity(string);
}
-F_STRING* reallot_string(F_STRING* string, CELL capacity)
+F_STRING* reallot_string(F_STRING *string_, CELL capacity)
{
- if(reallot_string_in_place_p(string,capacity))
+ gc_root<F_STRING> string(string_);
+
+ if(reallot_string_in_place_p(string.untagged(),capacity))
{
string->length = tag_fixnum(capacity);
aux->capacity = tag_fixnum(capacity * 2);
}
- return string;
+ return string.untagged();
}
else
{
- CELL to_copy = string_capacity(string);
+ CELL to_copy = string_capacity(string.untagged());
if(capacity < to_copy)
to_copy = capacity;
- REGISTER_UNTAGGED(string);
- F_STRING *new_string = allot_string_internal(capacity);
- UNREGISTER_UNTAGGED(F_STRING,string);
+ gc_root<F_STRING> new_string(allot_string_internal(capacity));
- memcpy(new_string + 1,string + 1,to_copy);
+ memcpy(new_string.untagged() + 1,string.untagged() + 1,to_copy);
if(string->aux != F)
{
- REGISTER_UNTAGGED(string);
- REGISTER_UNTAGGED(new_string);
F_BYTE_ARRAY *new_aux = allot_byte_array(capacity * sizeof(u16));
- UNREGISTER_UNTAGGED(F_STRING,new_string);
- UNREGISTER_UNTAGGED(F_STRING,string);
- write_barrier((CELL)new_string);
+ write_barrier(new_string.value());
new_string->aux = tag_object(new_aux);
F_BYTE_ARRAY *aux = untag_byte_array_fast(string->aux);
memcpy(new_aux + 1,aux + 1,to_copy * sizeof(u16));
}
- REGISTER_UNTAGGED(string);
- REGISTER_UNTAGGED(new_string);
- fill_string(new_string,to_copy,capacity,'\0');
- UNREGISTER_UNTAGGED(F_STRING,new_string);
- UNREGISTER_UNTAGGED(F_STRING,string);
-
- return new_string;
+ fill_string(new_string.untagged(),to_copy,capacity,'\0');
+ return new_string.untagged();
}
}
#define MEMORY_TO_STRING(type,utype) \
F_STRING *memory_to_##type##_string(const type *string, CELL length) \
{ \
- REGISTER_C_STRING(string); \
- F_STRING *s = allot_string_internal(length); \
- UNREGISTER_C_STRING(type,string); \
+ REGISTER_C_STRING(string); \
+ gc_root<F_STRING> s(allot_string_internal(length)); \
+ UNREGISTER_C_STRING(type,string); \
CELL i; \
for(i = 0; i < length; i++) \
{ \
- REGISTER_UNTAGGED(s); \
- set_string_nth(s,i,(utype)*string); \
- UNREGISTER_UNTAGGED(F_STRING,s); \
+ set_string_nth(s.untagged(),i,(utype)*string); \
string++; \
} \
- return s; \
+ return s.untagged(); \
} \
F_STRING *from_##type##_string(const type *str) \
{ \
F_STRING *str = untag_string(dpop()); \
type##_string_to_memory(str,address); \
} \
- F_BYTE_ARRAY *string_to_##type##_alien(F_STRING *s, bool check) \
+ F_BYTE_ARRAY *string_to_##type##_alien(F_STRING *s_, bool check) \
{ \
- CELL capacity = string_capacity(s); \
+ gc_root<F_STRING> s(s_); \
+ CELL capacity = string_capacity(s.untagged()); \
F_BYTE_ARRAY *_c_str; \
- if(check && !check_string(s,sizeof(type))) \
- general_error(ERROR_C_STRING,tag_object(s),F,NULL); \
- REGISTER_UNTAGGED(s); \
+ if(check && !check_string(s.untagged(),sizeof(type))) \
+ general_error(ERROR_C_STRING,s.value(),F,NULL); \
_c_str = allot_c_string(capacity,sizeof(type)); \
- UNREGISTER_UNTAGGED(F_STRING,s); \
type *c_str = (type*)(_c_str + 1); \
- type##_string_to_memory(s,c_str); \
+ type##_string_to_memory(s.untagged(),c_str); \
c_str[capacity] = 0; \
return _c_str; \
} \
}
template <typename T>
-class tagged
+struct tagged
{
- CELL value;
-public:
- explicit tagged(CELL tagged) : value(tagged) {}
- explicit tagged(T *untagged) : value(::tag(untagged)) {}
-
- CELL tag() const { return value; }
- T *untag() const { type_check(T::type_number,value); }
- T *untag_fast() const { return (T *)(UNTAG(value)); }
- T *operator->() const { return untag_fast(); }
- CELL *operator&() const { return &value; }
+ CELL value_;
+
+ T *untag_check() const {
+ if(T::type_number != TYPE_COUNT)
+ type_check(T::type_number,value_);
+ return untagged();
+ }
+
+ explicit tagged(CELL tagged) : value_(tagged) {
+#ifdef FACTOR_DEBUG
+ untag_check();
+#endif
+ }
+
+ explicit tagged(T *untagged) : value_(::tag(untagged)) {
+#ifdef FACTOR_DEBUG
+ untag_check();
+#endif
+ }
+
+ CELL value() const { return value_; }
+ T *untagged() const { return (T *)(UNTAG(value_)); }
+
+ T *operator->() const { return untagged(); }
+ CELL *operator&() const { return &value_; }
+
+ const tagged<T>& operator=(const T *x) { value_ = tag(x); return *this; }
+ const tagged<T>& operator=(const CELL &x) { value_ = x; return *this; }
+
+ CELL type() const { return type_of(value_); }
+ bool isa(CELL type_) const { return type() == type_; }
+
+ template<typename X> tagged<X> as() { return tagged<X>(value_); }
};
-template <typename T> T *untag(CELL value)
+template <typename T> T *untag_check(CELL value)
{
- return tagged<T>(value).untag();
+ return tagged<T>(value).untag_check();
}
-template <typename T> T *untag_fast(CELL value)
+template <typename T> T *untagged(CELL value)
{
- return tagged<T>(value).untag_fast();
+ return tagged<T>(value).untagged();
}
#include "master.hpp"
/* push a new tuple on the stack */
-F_TUPLE *allot_tuple(F_TUPLE_LAYOUT *layout)
+F_TUPLE *allot_tuple(CELL layout_)
{
- REGISTER_UNTAGGED(layout);
- F_TUPLE *tuple = (F_TUPLE *)allot_object(TUPLE_TYPE,tuple_size(layout));
- UNREGISTER_UNTAGGED(F_TUPLE_LAYOUT,layout);
- tuple->layout = tag_array((F_ARRAY *)layout);
- return tuple;
+ gc_root<F_TUPLE_LAYOUT> layout(layout_);
+ gc_root<F_TUPLE> tuple(allot<F_TUPLE>(tuple_size(layout.untagged())));
+ tuple->layout = layout.value();
+ return tuple.untagged();
}
void primitive_tuple(void)
{
- F_TUPLE_LAYOUT *layout = untag_tuple_layout(dpop());
- F_FIXNUM size = untag_fixnum_fast(layout->size);
-
- F_TUPLE *tuple = allot_tuple(layout);
+ gc_root<F_TUPLE_LAYOUT> layout(dpop());
+ F_TUPLE *tuple = allot_tuple(layout.value());
F_FIXNUM i;
- for(i = size - 1; i >= 0; i--)
+ for(i = tuple_size(layout.untagged()) - 1; i >= 0; i--)
put(AREF(tuple,i),F);
dpush(tag_tuple(tuple));
/* push a new tuple on the stack, filling its slots from the stack */
void primitive_tuple_boa(void)
{
- F_TUPLE_LAYOUT *layout = untag_tuple_layout(dpop());
- F_FIXNUM size = untag_fixnum_fast(layout->size);
- F_TUPLE *tuple = allot_tuple(layout);
- memcpy(tuple + 1,(CELL *)(ds - CELLS * (size - 1)),CELLS * size);
- ds -= CELLS * size;
- dpush(tag_tuple(tuple));
+ gc_root<F_TUPLE_LAYOUT> layout(dpop());
+ gc_root<F_TUPLE> tuple(allot_tuple(layout.value()));
+ CELL size = untag_fixnum_fast(layout.untagged()->size) * CELLS;
+ memcpy(tuple.untagged() + 1,(CELL *)(ds - (size - CELLS)),size);
+ ds -= size;
+ dpush(tuple.value());
}
#include "master.hpp"
-F_WORD *allot_word(CELL vocab, CELL name)
+F_WORD *allot_word(CELL vocab_, CELL name_)
{
- REGISTER_ROOT(vocab);
- REGISTER_ROOT(name);
- F_WORD *word = (F_WORD *)allot_object(WORD_TYPE,sizeof(F_WORD));
- UNREGISTER_ROOT(name);
- UNREGISTER_ROOT(vocab);
+ gc_root<F_OBJECT> vocab(vocab_);
+ gc_root<F_OBJECT> name(name_);
+
+ gc_root<F_WORD> word(allot<F_WORD>(sizeof(F_WORD)));
word->hashcode = tag_fixnum((rand() << 16) ^ rand());
- word->vocabulary = vocab;
- word->name = name;
+ word->vocabulary = vocab.value();
+ word->name = name.value();
word->def = userenv[UNDEFINED_ENV];
word->props = F;
word->counter = tag_fixnum(0);
word->profiling = NULL;
word->code = NULL;
- REGISTER_UNTAGGED(word);
- jit_compile_word(word,word->def,true);
- UNREGISTER_UNTAGGED(F_WORD,word);
-
- REGISTER_UNTAGGED(word);
- update_word_xt(word);
- UNREGISTER_UNTAGGED(F_WORD,word);
+ jit_compile_word(word.value(),word->def,true);
+ update_word_xt(word.value());
if(profiling_p)
relocate_code_block(word->profiling);
- return word;
+ return word.untagged();
}
/* <word> ( name vocabulary -- word ) */
}
/* Allocates memory */
-void update_word_xt(F_WORD *word)
+void update_word_xt(CELL word_)
{
+ gc_root<F_WORD> word(word_);
+
if(profiling_p)
{
if(!word->profiling)
{
- REGISTER_UNTAGGED(word);
- F_CODE_BLOCK *profiling = compile_profiling_stub(tag_object(word));
- UNREGISTER_UNTAGGED(F_WORD,word);
+ F_CODE_BLOCK *profiling = compile_profiling_stub(word.value());
word->profiling = profiling;
}
void primitive_wrapper(void)
{
- F_WRAPPER *wrapper = (F_WRAPPER *)allot_object(WRAPPER_TYPE,sizeof(F_WRAPPER));
+ F_WRAPPER *wrapper = allot<F_WRAPPER>(sizeof(F_WRAPPER));
wrapper->object = dpeek();
drepl(tag_object(wrapper));
}
void primitive_word(void);
void primitive_word_xt(void);
-void update_word_xt(F_WORD *word);
+void update_word_xt(CELL word);
INLINE bool word_optimized_p(F_WORD *word)
{
projects / factor.git / commitdiff