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

Cleaning up VM code

db4
Slava Pestov 2009-05-02 09:19:09 -05:00
parent b8b44911a7
commit 58512cbbdb
37 changed files with 713 additions and 913 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
README.txt
View File

@ -20,7 +20,7 @@ implementation. It is not an introduction to the language itself.
* 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
@ -138,7 +138,7 @@ usage documentation, enter the following in the UI listener:
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

2
core/generic/standard/standard.factor
View File

@ -44,7 +44,7 @@ M: standard-combination inline-cache-quot ( word methods -- )
#! 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> ;

52
vmpp/alien.cpp
View File

@ -9,10 +9,10 @@ char *alien_offset(CELL object)
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;
@ -33,7 +33,7 @@ char *pinned_alien_offset(CELL object)
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;
@ -52,24 +52,24 @@ char *unbox_alien(void)
}
/* 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 */
@ -183,35 +183,28 @@ void box_medium_struct(CELL x1, CELL x2, CELL x3, CELL x4, CELL size)
/* 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));
}
}
@ -227,8 +220,5 @@ void primitive_dll_validp(void)
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);
}

110
vmpp/arrays.cpp
View File

@ -1,13 +1,13 @@
#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
@ -15,9 +15,9 @@ F_ARRAY *allot_array(CELL capacity, CELL fill)
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 */
@ -28,43 +28,36 @@ void primitive_array(void)
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)
@ -74,43 +67,16 @@ 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);
gc_root<F_OBJECT> elt(elt_);
if(count == array_capacity(array.untagged()))
array = reallot_array(array.untagged(),count * 2);
if(array->count == array_capacity(underlying))
{
underlying = reallot_array(underlying,array->count * 2);
array->array = tag_array(underlying);
}
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);
}

44
vmpp/arrays.hpp
View File

@ -6,7 +6,6 @@ INLINE CELL tag_array(F_ARRAY *array)
}
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);
@ -15,41 +14,12 @@ CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4);
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;
gc_root<F_ARRAY> array;
growable_array() : count(0), array(allot_array(2,F)) {}
void add(CELL elt);
void trim();
};
/* 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)
void growable_array_append(F_GROWABLE_ARRAY *result, F_ARRAY *elts);
#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;

36
vmpp/byte_arrays.cpp
View File

@ -26,18 +26,34 @@ void primitive_resize_byte_array(void)
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);
}

26
vmpp/byte_arrays.hpp
View File

@ -7,22 +7,14 @@ void primitive_uninitialized_byte_array(void);
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;
growable_byte_array() : count(0), array(allot_byte_array(2)) { }
void append_bytes(void *elts, CELL len);
void append_byte_array(CELL elts);
void trim();
};
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;
}
void growable_byte_array_append(F_GROWABLE_BYTE_ARRAY *result, void *elts, CELL len);
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));
}

26
vmpp/callstack.cpp
View File

@ -28,9 +28,7 @@ void iterate_callstack_object(F_CALLSTACK *stack, CALLSTACK_ITER iterator)
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;
}
@ -158,17 +156,15 @@ void stack_frame_to_array(F_STACK_FRAME *frame)
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));
}
@ -208,18 +204,12 @@ void primitive_innermost_stack_frame_scan(void)
void primitive_set_innermost_stack_frame_quot(void)
{
F_CALLSTACK *callstack = untag_callstack(dpop());
F_QUOTATION *quot = untag_quotation(dpop());
gc_root<F_CALLSTACK> callstack(dpop());
gc_root<F_QUOTATION> quot(dpop());
REGISTER_UNTAGGED(callstack);
REGISTER_UNTAGGED(quot);
jit_compile(quot.value(),true);
jit_compile(tag_quotation(quot),true);
UNREGISTER_UNTAGGED(F_QUOTATION,quot);
UNREGISTER_UNTAGGED(F_CALLSTACK,callstack);
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;

48
vmpp/code_block.cpp
View File

@ -454,47 +454,37 @@ F_CODE_BLOCK *allot_code_block(CELL size)
/* 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 */

7
vmpp/code_block.hpp
View File

@ -84,9 +84,4 @@ INLINE bool stack_traces_p(void)
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);

71
vmpp/code_heap.cpp
View File

@ -15,15 +15,14 @@ bool in_code_heap_p(CELL ptr)
}
/* 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);
@ -58,40 +57,32 @@ void update_code_heap_words(void)
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));
gc_root<F_ARRAY> pair(array_nth(alist.untagged(),i));
F_WORD *word = untag_word(array_nth(pair,0));
gc_root<F_WORD> word(array_nth(pair.untagged(),0));
gc_root<F_OBJECT> data(array_nth(pair.untagged(),1));
CELL data = array_nth(pair,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,
@ -100,17 +91,14 @@ void primitive_modify_code_heap(void)
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();
@ -184,10 +172,7 @@ void fixup_object_xts(void)
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);

2
vmpp/code_heap.hpp
View File

@ -5,7 +5,7 @@ void init_code_heap(CELL size);
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);

31
vmpp/data_gc.cpp
View File

@ -179,7 +179,7 @@ void copy_registered_locals(void)
}
/* 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);
@ -595,7 +595,7 @@ void primitive_gc(void)
void primitive_gc_stats(void)
{
GROWABLE_ARRAY(stats);
growable_array stats;
CELL i;
u64 total_gc_time = 0;
@ -603,25 +603,24 @@ void primitive_gc_stats(void)
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)

27
vmpp/data_gc.hpp
View File

@ -46,24 +46,24 @@ registers) does not run out of memory */
* 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 */
@ -72,20 +72,20 @@ INLINE void *allot_object(CELL type, CELL a)
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);
@ -96,10 +96,15 @@ INLINE void *allot_object(CELL type, CELL a)
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);

21
vmpp/data_heap.cpp
View File

@ -301,19 +301,18 @@ void primitive_data_room(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
@ -364,7 +363,7 @@ void primitive_end_scan(void)
CELL find_all_words(void)
{
GROWABLE_ARRAY(words);
growable_array words;
begin_scan();
@ -372,14 +371,12 @@ CELL find_all_words(void)
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();
}

10
vmpp/data_heap.hpp
View File

@ -2,16 +2,16 @@
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;
@ -31,7 +31,7 @@ typedef struct {
CELL *decks;
CELL *decks_end;
} F_DATA_HEAP;
};
extern F_DATA_HEAP *data_heap;

38
vmpp/dispatch.cpp
View File

@ -167,39 +167,35 @@ void primitive_reset_dispatch_stats(void)
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]);
}

4
vmpp/dispatch.hpp
View File

@ -8,6 +8,6 @@ void primitive_mega_cache_miss(void);
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);

12
vmpp/factor.cpp
View File

@ -152,18 +152,14 @@ void init_factor(F_PARAMETERS *p)
/* 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)

19
vmpp/generic_arrays.hpp
View File

@ -41,7 +41,7 @@ template <typename T> CELL array_size(T *array)
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;
}
@ -51,29 +51,24 @@ template <typename T> bool reallot_array_in_place_p(T *array, CELL capacity)
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);

158
vmpp/inline_cache.cpp
View File

@ -33,16 +33,14 @@ void deallocate_inline_cache(CELL return_address)
/* 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? */
@ -76,7 +74,16 @@ static void update_pic_count(CELL type)
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)
@ -84,43 +91,34 @@ static void jit_emit_check(F_JIT *jit, CELL klass)
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
@ -128,21 +126,26 @@ static F_CODE_BLOCK *compile_inline_cache(F_FIXNUM index, CELL generic_word, CEL
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]);
push(generic_word.value());
push(methods.value());
push(tag_fixnum(index));
push(cache_entries.value());
word_jump(userenv[PIC_MISS_WORD]);
}
F_CODE_BLOCK *code = jit_make_code_block(&jit);
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);
jit_dispose(&jit);
UNREGISTER_ROOT(cache_entries);
UNREGISTER_ROOT(methods);
UNREGISTER_ROOT(generic_word);
return code;
}
@ -154,23 +157,21 @@ static XT megamorphic_call_stub(CELL generic_word)
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)
@ -194,35 +195,33 @@ XT inline_cache_miss(CELL return_address)
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.value());
CELL method = lookup_method(object.value(),methods.value());
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);
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. */
@ -244,14 +243,13 @@ void primitive_reset_inline_cache_stats(void)
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());
}

10
vmpp/io.cpp
View File

@ -85,11 +85,11 @@ void primitive_fread(void)
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))
@ -104,13 +104,11 @@ void primitive_fread(void)
{
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;
}
}

149
vmpp/jit.cpp
View File

@ -1,68 +1,26 @@
#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;
if(stack_traces_p()) literal(owner.value());
}
/* 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);
}
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);
@ -79,45 +37,78 @@ static F_REL rel_to_emit(F_JIT *jit, CELL code_template, bool *rel_p)
*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));
UNREGISTER_ROOT(code_template);
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_;
}
/* 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());
}

130
vmpp/jit.hpp
View File

@ -1,92 +1,58 @@
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);
}
/* Allocates memory */
INLINE void jit_word_call(F_JIT *jit, CELL word)
{
jit_emit_with(jit,userenv[JIT_WORD_CALL],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);
if(array_nth(untag_array_fast(code_template),1) != F)
jit_add_literal(jit,T);
jit_emit(jit,code_template);
UNREGISTER_ROOT(code_template);
}
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 push(CELL literal) {
emit_with(userenv[JIT_PUSH_IMMEDIATE],literal);
}
else
return jit->position;
}
INLINE void jit_set_position(F_JIT *jit, F_FIXNUM position)
{
if(jit->computing_offset_p)
jit->position = position;
}
void word_jump(CELL word) {
emit_with(userenv[JIT_WORD_JUMP],word);
}
void word_call(CELL word) {
emit_with(userenv[JIT_WORD_CALL],word);
}
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());
}
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;
}
void set_position(F_FIXNUM position_) {
if(computing_offset_p)
position = position_;
}
F_CODE_BLOCK *code_block();
};

1
vmpp/layouts.hpp
View File

@ -81,6 +81,7 @@ INLINE CELL tag_fixnum(F_FIXNUM untagged)
typedef void *XT;
struct F_OBJECT {
static const CELL type_number = TYPE_COUNT;
CELL header;
};

24
vmpp/local_roots.hpp
View File

@ -7,28 +7,19 @@ extern CELL gc_locals;
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;
@ -36,9 +27,6 @@ extern CELL extra_roots;
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 */

4
vmpp/master.hpp
View File

@ -21,10 +21,10 @@
#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"
@ -50,8 +50,8 @@
#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"

2
vmpp/math.hpp
View File

@ -96,7 +96,7 @@ INLINE double untag_float(CELL tagged)
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);
}

28
vmpp/profiler.cpp
View File

@ -8,16 +8,14 @@ void init_profiler(void)
}
/* 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 */
@ -32,22 +30,18 @@ static void set_profiling(bool profiling)
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);
}

265
vmpp/quotations.cpp
View File

@ -33,70 +33,67 @@ includes stack shufflers, some fixnum arithmetic words, and words such as tag,
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;
}
}
@ -104,78 +101,66 @@ static bool jit_stack_frame_p(F_ARRAY *array)
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);
set_position(i);
CELL obj = array_nth(untag_array_fast(array),i);
REGISTER_ROOT(obj);
gc_root<F_OBJECT> obj(array_nth(array.untagged(),i));
F_WORD *word;
F_WRAPPER *wrapper;
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++;
@ -185,80 +170,77 @@ static void jit_iterate_quotation(F_JIT *jit, CELL array, CELL compiling, CELL r
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)
@ -272,56 +254,26 @@ void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code)
}
/* Allocates memory */
void jit_compile(CELL quot, bool relocate)
void jit_compile(CELL quot_, bool relocating)
{
if(untag_quotation(quot)->compiledp != F)
return;
gc_root<F_QUOTATION> quot(quot_);
if(quot->compiledp != F) return;
CELL array = untag_quotation(quot)->array;
quotation_jit jit(quot.value(),true,relocating);
jit.iterate_quotation();
REGISTER_ROOT(quot);
REGISTER_ROOT(array);
F_CODE_BLOCK *compiled = jit.code_block();
set_quot_xt(quot.untagged(),compiled);
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);
if(relocating) relocate_code_block(compiled);
}
F_FIXNUM quot_code_offset_to_scan(CELL quot, CELL offset)
{
CELL array = untag_quotation(quot)->array;
REGISTER_ROOT(array);
F_JIT jit;
jit_init(&jit,QUOTATION_TYPE,quot);
jit_compute_position(&jit,offset);
jit_iterate_quotation(&jit,array,false,false);
jit_dispose(&jit);
UNREGISTER_ROOT(array);
return jit_get_position(&jit);
}
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)
@ -332,7 +284,7 @@ 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;
@ -349,26 +301,33 @@ void primitive_quotation_xt(void)
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();
}

31
vmpp/quotations.hpp
View File

@ -5,12 +5,37 @@ INLINE CELL tag_quotation(F_QUOTATION *quotation)
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);

16
vmpp/run.cpp
View File

@ -231,19 +231,19 @@ void primitive_load_locals(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);
}
}

98
vmpp/strings.cpp
View File

@ -17,20 +17,21 @@ CELL string_nth(F_STRING* string, CELL index)
}
}
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
@ -40,9 +41,8 @@ void set_string_nth_slow(F_STRING* string, CELL index, CELL ch)
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
@ -60,10 +60,10 @@ void set_string_nth(F_STRING* string, CELL index, CELL ch)
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;
@ -72,32 +72,28 @@ F_STRING* allot_string_internal(CELL capacity)
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)
@ -112,9 +108,11 @@ static bool reallot_string_in_place_p(F_STRING *string, CELL capacity)
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);
@ -124,42 +122,31 @@ F_STRING* reallot_string(F_STRING* string, CELL 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();
}
}
@ -175,18 +162,16 @@ void primitive_resize_string(void)
#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) \
{ \
@ -236,17 +221,16 @@ F_BYTE_ARRAY *allot_c_string(CELL capacity, CELL size)
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; \
} \

51
vmpp/tagged.hpp
View File

@ -7,26 +7,49 @@ template <typename T> CELL tag(T *value)
}
template <typename T>
class tagged
struct tagged
{
CELL value;
public:
explicit tagged(CELL tagged) : value(tagged) {}
explicit tagged(T *untagged) : value(::tag(untagged)) {}
CELL value_;
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; }
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();
}

31
vmpp/tuples.cpp
View File

@ -1,23 +1,20 @@
#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));
@ -26,10 +23,10 @@ void primitive_tuple(void)
/* 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());
}

36
vmpp/words.cpp
View File

@ -1,16 +1,15 @@
#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);
@ -19,18 +18,13 @@ F_WORD *allot_word(CELL vocab, CELL name)
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 ) */
@ -51,15 +45,15 @@ void primitive_word_xt(void)
}
/* 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;
}
@ -76,7 +70,7 @@ void primitive_optimized_p(void)
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));
}

2
vmpp/words.hpp
View File

@ -4,7 +4,7 @@ F_WORD *allot_word(CELL vocab, CELL name);
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)
{