Cleaning up VM code

README.txt

@@ -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

core/generic/standard/standard.factor

@@ -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> ;

vmpp/alien.cpp

@@ -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);
+	gc_root<F_OBJECT> delegate(delegate_);
-	F_ALIEN *alien = (F_ALIEN *)allot_object(ALIEN_TYPE,sizeof(F_ALIEN));
+	gc_root<F_ALIEN> alien(allot<F_ALIEN>(sizeof(F_ALIEN)));
-	UNREGISTER_ROOT(delegate);
 
-	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(
+	gc_root<F_BYTE_ARRAY> path(tag_object(string_to_native_alien(untag_string(dpop()))));
-		untag_string(dpop())));
+	gc_root<F_DLL> dll(allot<F_DLL>(sizeof(F_DLL)));
-	REGISTER_ROOT(path);
+	dll->path = path.value();
-	F_DLL *dll = (F_DLL *)allot_object(DLL_TYPE,sizeof(F_DLL));
+	ffi_dlopen(dll.untagged());
-	UNREGISTER_ROOT(path);
+	dpush(dll.value());
-	dll->path = path;
-	ffi_dlopen(dll);
-	dpush(tag_object(dll));
 }
 
 /* look up a symbol in a native library */
 void primitive_dlsym(void)
 {
-	CELL dll = dpop();
+	gc_root<F_OBJECT> dll(dpop());
-	REGISTER_ROOT(dll);
 	F_SYMBOL *sym = unbox_symbol_string();
-	UNREGISTER_ROOT(dll);
 
-	F_DLL *d;
+	if(dll.value() == F)
-
-	if(dll == 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
-	{
+		dpush(tagged<F_DLL>(dll)->dll == NULL ? F : T);
-		F_DLL *d = untag_dll(dll);
-		dpush(d->dll == NULL ? F : T);
-	}
 }

vmpp/arrays.cpp

@@ -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);
+	gc_root<F_OBJECT> fill(fill_);
-	F_ARRAY* array = allot_array_internal<F_ARRAY>(capacity);
+	gc_root<F_ARRAY> array(allot_array_internal<F_ARRAY>(capacity));
-	UNREGISTER_ROOT(fill);
+
-	if(fill == 0)
+	if(fill.value() == tag_fixnum(0))
-		memset((void*)AREF(array,0),'\0',capacity * CELLS);
+		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);
+	gc_root<F_OBJECT> obj(obj_);
-	F_ARRAY *a = allot_array_internal<F_ARRAY>(1);
+	gc_root<F_ARRAY> a(allot_array_internal<F_ARRAY>(1));
-	UNREGISTER_ROOT(obj);
+	set_array_nth(a.untagged(),0,obj.value());
-	set_array_nth(a,0,obj);
+	return a.value();
-	return tag_array(a);
 }
 
-CELL allot_array_2(CELL v1, CELL v2)
+CELL allot_array_2(CELL v1_, CELL v2_)
 {
-	REGISTER_ROOT(v1);
+	gc_root<F_OBJECT> v1(v1_);
-	REGISTER_ROOT(v2);
+	gc_root<F_OBJECT> v2(v2_);
-	F_ARRAY *a = allot_array_internal<F_ARRAY>(2);
+	gc_root<F_ARRAY> a(allot_array_internal<F_ARRAY>(2));
-	UNREGISTER_ROOT(v2);
+	set_array_nth(a.untagged(),0,v1.value());
-	UNREGISTER_ROOT(v1);
+	set_array_nth(a.untagged(),1,v2.value());
-	set_array_nth(a,0,v1);
+	return a.value();
-	set_array_nth(a,1,v2);
-	return tag_array(a);
 }
 
-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);
+	gc_root<F_OBJECT> v1(v1_);
-	REGISTER_ROOT(v2);
+	gc_root<F_OBJECT> v2(v2_);
-	REGISTER_ROOT(v3);
+	gc_root<F_OBJECT> v3(v3_);
-	REGISTER_ROOT(v4);
+	gc_root<F_OBJECT> v4(v4_);
-	F_ARRAY *a = allot_array_internal<F_ARRAY>(4);
+	gc_root<F_ARRAY> a(allot_array_internal<F_ARRAY>(4));
-	UNREGISTER_ROOT(v4);
+	set_array_nth(a.untagged(),0,v1.value());
-	UNREGISTER_ROOT(v3);
+	set_array_nth(a.untagged(),1,v2.value());
-	UNREGISTER_ROOT(v2);
+	set_array_nth(a.untagged(),2,v3.value());
-	UNREGISTER_ROOT(v1);
+	set_array_nth(a.untagged(),3,v4.value());
-	set_array_nth(a,0,v1);
+	return a.value();
-	set_array_nth(a,1,v2);
-	set_array_nth(a,2,v3);
-	set_array_nth(a,3,v4);
-	return tag_array(a);
 }
 
 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);
+	gc_root<F_OBJECT> elt(elt_);
-	REGISTER_ROOT(elt);
+	if(count == array_capacity(array.untagged()))
+		array = reallot_array(array.untagged(),count * 2);
 
-	if(array->count == array_capacity(underlying))
+	set_array_nth(array.untagged(),count++,elt.value());
-	{
-		underlying = reallot_array(underlying,array->count * 2);
-		array->array = tag_array(underlying);
-	}
-
-	UNREGISTER_ROOT(elt);
-	set_array_nth(underlying,array->count++,elt);
 }
 
-void growable_array_append(F_GROWABLE_ARRAY *array, F_ARRAY *elts)
+void growable_array::trim()
 {
-	REGISTER_UNTAGGED(elts);
+	array = reallot_array(array.untagged(),count);
-
-	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;
 }

vmpp/arrays.hpp

@@ -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 growable_array {
-struct F_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;

vmpp/byte_arrays.cpp

@@ -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;
+	CELL new_size = count + len;
-	F_BYTE_ARRAY *underlying = untag_byte_array_fast(array->array);
 
-	if(new_size >= array_capacity(underlying))
+	if(new_size >= array_capacity(array.untagged()))
-	{
+		array = reallot_array(array.untagged(),new_size * 2);
-		underlying = reallot_array(underlying,new_size * 2);
-		array->array = tag_object(underlying);
-	}
 
-	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);
 }

vmpp/byte_arrays.hpp

@@ -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));
-}

vmpp/callstack.cpp

@@ -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(
+	F_CALLSTACK *callstack = allot<F_CALLSTACK>(callstack_size(size));
-		CALLSTACK_TYPE,
-		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());
+	gc_root<F_CALLSTACK> callstack(dpop());
-	F_QUOTATION *quot = untag_quotation(dpop());
+	gc_root<F_QUOTATION> quot(dpop());
 
-	REGISTER_UNTAGGED(callstack);
+	jit_compile(quot.value(),true);
-	REGISTER_UNTAGGED(quot);
 
-	jit_compile(tag_quotation(quot),true);
+	F_STACK_FRAME *inner = innermost_stack_frame(callstack.untagged());
-
-	UNREGISTER_UNTAGGED(F_QUOTATION,quot);
-	UNREGISTER_UNTAGGED(F_CALLSTACK,callstack);
-
-	F_STACK_FRAME *inner = innermost_stack_frame(callstack);
 	type_check(QUOTATION_TYPE,frame_executing(inner));
 
 	CELL offset = (char *)FRAME_RETURN_ADDRESS(inner) - (char *)inner->xt;

vmpp/code_block.cpp

@@ -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,
+	CELL code_,
-	F_ARRAY *labels,
+	CELL labels_,
-	CELL relocation,
+	CELL relocation_,
-	CELL literals)
+	CELL literals_)
 {
-#ifdef FACTOR_DEBUG
+	gc_root<F_BYTE_ARRAY> code(code_);
-	type_check(ARRAY_TYPE,literals);
+	gc_root<F_OBJECT> labels(labels_);
-	type_check(BYTE_ARRAY_TYPE,relocation);
+	gc_root<F_BYTE_ARRAY> relocation(relocation_);
-	assert(untag_header(code->header) == BYTE_ARRAY_TYPE);
+	gc_root<F_ARRAY> literals(literals_);
-#endif
-
-	CELL code_length = align8(array_capacity(code));
-
-	REGISTER_ROOT(literals);
-	REGISTER_ROOT(relocation);
-	REGISTER_UNTAGGED(code);
-	REGISTER_UNTAGGED(labels);
 
+	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.value();
-	compiled->relocation = relocation;
+
+	/* 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 */

vmpp/code_block.hpp

@@ -84,9 +84,4 @@ INLINE bool stack_traces_p(void)
 	return userenv[STACK_TRACES_ENV] != F;
 }
 
-F_CODE_BLOCK *add_code_block(
+F_CODE_BLOCK *add_code_block(CELL type, CELL code, CELL labels, CELL relocation, CELL literals);
-	CELL type,
-	F_BYTE_ARRAY *code,
-	F_ARRAY *labels,
-	CELL relocation,
-	CELL literals);

vmpp/code_heap.cpp

@@ -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);
+	gc_root<F_WORD> word(word_);
-	REGISTER_UNTAGGED(word);
+	gc_root<F_QUOTATION> def(def_);
-	jit_compile(def,relocate);
-	UNREGISTER_UNTAGGED(F_WORD,word);
-	UNREGISTER_ROOT(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);
+		switch(data.type())
-
-		if(type_of(data) == QUOTATION_TYPE)
 		{
-			REGISTER_UNTAGGED(alist);
+		case QUOTATION_TYPE:
-			REGISTER_UNTAGGED(word);
+			jit_compile_word(word.value(),data.value(),false);
-			jit_compile_word(word,data,false);
+			break;
-			UNREGISTER_UNTAGGED(F_WORD,word);
+		case ARRAY_TYPE:
-			UNREGISTER_UNTAGGED(F_ARRAY,alist);
+			F_ARRAY *compiled_data = data.as<F_ARRAY>().untagged();
-		}
+			CELL literals = array_nth(compiled_data,0);
-		else if(type_of(data) == ARRAY_TYPE)
+			CELL relocation = array_nth(compiled_data,1);
-		{
+			CELL labels = array_nth(compiled_data,2);
-			F_ARRAY *compiled_code = untag_array(data);
+			CELL code = array_nth(compiled_data,3);
-
-			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);
 
 			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.value());
-		update_word_xt(word);
-		UNREGISTER_UNTAGGED(F_ARRAY,alist);
 	}
 
 	update_code_heap_words();
@@ -184,10 +172,7 @@ void fixup_object_xts(void)
 	while((obj = next_object()) != F)
 	{
 		if(type_of(obj) == WORD_TYPE)
-		{
+			update_word_xt(obj);
-			F_WORD *word = untag_word_fast(obj);
-			update_word_xt(word);
-		}
 		else if(type_of(obj) == QUOTATION_TYPE)
 		{
 			F_QUOTATION *quot = untag_quotation_fast(obj);

vmpp/code_heap.hpp

@@ -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);
 

vmpp/data_gc.cpp

@@ -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));
+		stats.add(allot_cell(s->collections));
-		GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->gc_time)));
+		stats.add(tag_bignum(long_long_to_bignum(s->gc_time)));
-		GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->max_gc_time)));
+		stats.add(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));
+		stats.add(allot_cell(s->collections == 0 ? 0 : s->gc_time / s->collections));
-		GROWABLE_ARRAY_ADD(stats,allot_cell(s->object_count));
+		stats.add(allot_cell(s->object_count));
-		GROWABLE_ARRAY_ADD(stats,tag_bignum(long_long_to_bignum(s->bytes_copied)));
+		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)));
+	stats.add(tag_bignum(ulong_long_to_bignum(total_gc_time)));
-	GROWABLE_ARRAY_ADD(stats,tag_bignum(ulong_long_to_bignum(cards_scanned)));
+	stats.add(tag_bignum(ulong_long_to_bignum(cards_scanned)));
-	GROWABLE_ARRAY_ADD(stats,tag_bignum(ulong_long_to_bignum(decks_scanned)));
+	stats.add(tag_bignum(ulong_long_to_bignum(decks_scanned)));
-	GROWABLE_ARRAY_ADD(stats,tag_bignum(ulong_long_to_bignum(card_scan_time)));
+	stats.add(tag_bignum(ulong_long_to_bignum(card_scan_time)));
-	GROWABLE_ARRAY_ADD(stats,allot_cell(code_heap_scans));
+	stats.add(allot_cell(code_heap_scans));
 
-	GROWABLE_ARRAY_TRIM(stats);
+	stats.trim();
-	GROWABLE_ARRAY_DONE(stats);
+	dpush(stats.array.value());
-	dpush(stats);
 }
 
 void clear_gc_stats(void)

vmpp/data_gc.hpp

@@ -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);
+		nursery.here = h + align8(size);
-		object = (CELL*)h;
+		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);

vmpp/data_heap.cpp

@@ -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));
+		a.add(tag_fixnum((z->end - z->here) >> 10));
-		GROWABLE_ARRAY_ADD(a,tag_fixnum((z->size) >> 10));
+		a.add(tag_fixnum((z->size) >> 10));
 	}
 
-	GROWABLE_ARRAY_TRIM(a);
+	a.trim();
-	GROWABLE_ARRAY_DONE(a);
+	dpush(a.array.value());
-	dpush(a);
 }
 
 /* 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);
+	words.trim();
-	GROWABLE_ARRAY_DONE(words);
+	return words.array.value();
-
-	return words;
 }

vmpp/data_heap.hpp

@@ -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;
 

vmpp/dispatch.cpp

@@ -167,39 +167,35 @@ void primitive_reset_dispatch_stats(void)
 
 void primitive_dispatch_stats(void)
 {
-	GROWABLE_ARRAY(stats);
+	growable_array stats;
-	GROWABLE_ARRAY_ADD(stats,allot_cell(megamorphic_cache_hits));
+	stats.add(allot_cell(megamorphic_cache_hits));
-	GROWABLE_ARRAY_ADD(stats,allot_cell(megamorphic_cache_misses));
+	stats.add(allot_cell(megamorphic_cache_misses));
-	GROWABLE_ARRAY_TRIM(stats);
+	stats.trim();
-	GROWABLE_ARRAY_DONE(stats);
+	dpush(stats.array.value());
-	dpush(stats);
 }
 
-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));
+	gc_root<F_ARRAY> methods(methods_);
-	jit_emit(jit,userenv[type]);
+	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);
+	push(methods.value());
-	jit_push(jit,tag_fixnum(index));
+	push(tag_fixnum(index));
-	jit_push(jit,cache);
+	push(cache.value());
-	jit_word_call(jit,userenv[MEGA_MISS_WORD]);
+	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]);
+	emit(userenv[JIT_EPILOG]);
-	jit_emit(jit,userenv[JIT_EXECUTE_JUMP]);
+	emit(userenv[JIT_EXECUTE_JUMP]);
 }

vmpp/dispatch.hpp

@@ -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);

vmpp/factor.cpp

@@ -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++)
-	{
+		args.add(tag_object(from_native_string(argv[i])));
-		REGISTER_UNTAGGED(args);
-		CELL arg = tag_object(from_native_string(argv[i]));
-		UNREGISTER_UNTAGGED(F_ARRAY,args);
-		set_array_nth(args,i,arg);
-	}
 
-	userenv[ARGS_ENV] = tag_array(args);
+	args.trim();
+	userenv[ARGS_ENV] = args.array.value();
 }
 
 void start_factor(F_PARAMETERS *p)

vmpp/generic_arrays.hpp

@@ -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
+	gc_root<T> array(array_);
-	CELL header = untag_header(array->header);
-	assert(header == T::type_number);
-#endif
 
-	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);
 

vmpp/inline_cache.cpp

@@ -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;
 
 	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
+	gc_root<F_WORD> generic_word(generic_word_);
-	type_check(WORD_TYPE,generic_word);
+	gc_root<F_ARRAY> methods(methods_);
-	type_check(ARRAY_TYPE,cache_entries);
+	gc_root<F_ARRAY> cache_entries(cache_entries_);
-#endif
-
-	REGISTER_ROOT(generic_word);
-	REGISTER_ROOT(methods);
-	REGISTER_ROOT(cache_entries);
-
-	CELL inline_cache_type = determine_inline_cache_type(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);
+		CELL klass = array_nth(cache_entries.untagged(),i);
-		jit_emit_check(&jit,klass);
+		emit_check(klass);
 
 		/* Yes? Jump to method */
-		CELL method = array_nth(untag_array_fast(cache_entries),i + 1);
+		CELL method = array_nth(cache_entries.untagged(),i + 1);
-		jit_emit_with(&jit,userenv[PIC_HIT],method);
+		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);
+	push(generic_word.value());
-	jit_push(&jit,methods);
+	push(methods.value());
-	jit_push(&jit,tag_fixnum(index));
+	push(tag_fixnum(index));
-	jit_push(&jit,cache_entries);
+	push(cache_entries.value());
-	jit_word_jump(&jit,userenv[PIC_MISS_WORD]);
+	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)
+	gc_root<F_ARRAY> cache_entries(cache_entries_);
-		return allot_array_2(klass,method);
+	gc_root<F_OBJECT> klass(klass_);
-	else
+	gc_root<F_WORD> method(method_);
-	{
+
-		F_ARRAY *cache_entries_array = untag_array_fast(cache_entries);
+	CELL pic_size = array_capacity(cache_entries.untagged());
-		CELL pic_size = array_capacity(cache_entries_array);
+	gc_root<F_ARRAY> new_cache_entries(reallot_array(cache_entries.untagged(),pic_size + 2));
-		cache_entries_array = reallot_array(cache_entries_array,pic_size + 2);
+	set_array_nth(new_cache_entries.untagged(),pic_size,klass.value());
-		set_array_nth(cache_entries_array,pic_size,klass);
+	set_array_nth(new_cache_entries.untagged(),pic_size + 1,method.value());
-		set_array_nth(cache_entries_array,pic_size + 1,method);
+	return new_cache_entries.value();
-		return tag_array(cache_entries_array);
-	}
 }
 
 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();
+	gc_root<F_ARRAY> methods(dpop());
-	CELL generic_word = dpop();
+	gc_root<F_WORD> generic_word(dpop());
-	CELL object = get(ds - index * CELLS);
+	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);
+		CELL klass = object_class(object.value());
-		REGISTER_ROOT(cache_entries);
+		CELL method = lookup_method(object.value(),methods.value());
-		REGISTER_ROOT(methods);
 
-		CELL klass = object_class(object);
+		gc_root<F_ARRAY> new_cache_entries(add_inline_cache_entry(
-		CELL method = lookup_method(object,methods);
+							   cache_entries.value(),
-
+							   klass,
-		cache_entries = add_inline_cache_entry(cache_entries,klass,method);
+							   method));
-		xt = compile_inline_cache(index,generic_word,methods,cache_entries) + 1;
+		xt = compile_inline_cache(index,
-
+					  generic_word.value(),
-		UNREGISTER_ROOT(methods);
+					  methods.value(),
-		UNREGISTER_ROOT(cache_entries);
+					  new_cache_entries.value()) + 1;
-		UNREGISTER_ROOT(generic_word);
 	}
 
 	/* 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 stats;
-	GROWABLE_ARRAY_ADD(stats,allot_cell(cold_call_to_ic_transitions));
+	stats.add(allot_cell(cold_call_to_ic_transitions));
-	GROWABLE_ARRAY_ADD(stats,allot_cell(ic_to_pic_transitions));
+	stats.add(allot_cell(ic_to_pic_transitions));
-	GROWABLE_ARRAY_ADD(stats,allot_cell(pic_to_mega_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]));
+		stats.add(allot_cell(pic_counts[i]));
-	GROWABLE_ARRAY_TRIM(stats);
+	stats.trim();
-	GROWABLE_ARRAY_DONE(stats);
+	dpush(stats.array.value());
-	dpush(stats);
 }

vmpp/io.cpp

@@ -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.untagged() + 1,c);
-				memcpy(new_buf + 1, buf + 1,c);
 				buf = new_buf;
 			}
-			dpush(tag_object(buf));
+			dpush(buf.value());
 			break;
 		}
 	}

vmpp/jit.cpp

@@ -1,68 +1,26 @@
 #include "master.hpp"
 
 /* Simple code generator used by:
-- profiler (profiler.c),
+- profiler (profiler.cpp),
-- quotation compiler (quotations.c),
+- quotation compiler (quotations.cpp),
-- megamorphic caches (dispatch.c),
+- megamorphic caches (dispatch.cpp),
-- polymorphic inline caches (inline_cache.c) */
+- 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;
+	if(stack_traces_p()) literal(owner.value());
-	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.
+F_REL jit::rel_to_emit(CELL code_template, bool *rel_p)
-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_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
+	gc_root<F_ARRAY> code_template(code_template_);
-	type_check(ARRAY_TYPE,code_template);
-#endif
-
-	REGISTER_ROOT(code_template);
 
 	bool rel_p;
-	F_REL rel = rel_to_emit(jit,code_template,&rel_p);
+	F_REL rel = rel_to_emit(code_template.value(),&rel_p);
-	if(rel_p) growable_byte_array_append(&jit->relocation,&rel,sizeof(F_REL));
+	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--;
+			position--;
-			jit->computing_offset_p = false;
+			computing_offset_p = false;
 		}
-		else if(jit->offset < size)
+		else if(offset < size)
 		{
-			jit->position++;
+			position++;
-			jit->computing_offset_p = false;
+			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());
-
-	UNREGISTER_ROOT(code_template);
 }
 
+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());
+}
+
+

vmpp/jit.hpp

@@ -1,92 +1,58 @@
-typedef struct {
+struct jit {
 	CELL type;
-	CELL owner;
+	gc_root<F_OBJECT> owner;
-	F_GROWABLE_BYTE_ARRAY code;
+	growable_byte_array code;
-	F_GROWABLE_BYTE_ARRAY relocation;
+	growable_byte_array relocation;
-	F_GROWABLE_ARRAY literals;
+	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);
+	void push(CELL literal) {
+		emit_with(userenv[JIT_PUSH_IMMEDIATE],literal);
+	}
 
-INLINE F_BYTE_ARRAY *code_to_emit(CELL code_template)
+	void word_jump(CELL word) {
-{
+		emit_with(userenv[JIT_WORD_JUMP],word);
-	return untag_byte_array_fast(array_nth(untag_array_fast(code_template),0));
+	}
-}
 
-void jit_emit(F_JIT *jit, CELL code_template);
+	void word_call(CELL word) {
+		emit_with(userenv[JIT_WORD_CALL],word);
+	}
 
-/* Allocates memory */
+	void emit_subprimitive(CELL word) {
-INLINE void jit_add_literal(F_JIT *jit, CELL literal)
+		gc_root<F_ARRAY> code_template(untagged<F_WORD>(word)->subprimitive);
-{
+		if(array_nth(code_template.untagged(),1) != F) literal(T);
-#ifdef FACTOR_DEBUG
+		emit(code_template.value());
-	type_of(literal);
+	}
-#endif
-	growable_array_add(&jit->literals,literal);
-}
 
-/* Allocates memory */
+	void emit_class_lookup(F_FIXNUM index, CELL type);
-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 */
+	F_FIXNUM get_position() {
-INLINE void jit_push(F_JIT *jit, CELL literal)
+		if(computing_offset_p)
-{
-	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,
+			/* If this is still on, emit() didn't clear it,
 			   so the offset was out of bounds */
 			return -1;
 		}
 		else
-		return jit->position;
+			return position;
-}
+	}
 
-INLINE void jit_set_position(F_JIT *jit, F_FIXNUM position)
+        void set_position(F_FIXNUM position_) {
-{
+		if(computing_offset_p)
-	if(jit->computing_offset_p)
+			position = position_;
-		jit->position = position;
+	}
-}
+
+	
+	F_CODE_BLOCK *code_block();
+};

vmpp/layouts.hpp

@@ -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;
 };
 

vmpp/local_roots.hpp

@@ -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 */

vmpp/master.hpp

@@ -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"

vmpp/math.hpp

@@ -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);
 }

vmpp/profiler.cpp

@@ -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);
+	gc_root<F_WORD> word(word_);
-	F_JIT jit;
+
-	jit_init(&jit,WORD_TYPE,word);
+	jit jit(WORD_TYPE,word.value());
-	jit_emit_with(&jit,userenv[JIT_PROFILING],word);
+	jit.emit_with(userenv[JIT_PROFILING],word.value());
-	F_CODE_BLOCK *block = jit_make_code_block(&jit);
+
-	jit_dispose(&jit);
+	return jit.code_block();
-	UNREGISTER_ROOT(word);
-	return 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();
+	gc_root<F_ARRAY> words(find_all_words());
-
-	REGISTER_ROOT(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);
 }

vmpp/quotations.cpp

@@ -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)
+	return (i + 2) == array_capacity(array.untagged())
-		&& type_of(array_nth(array,i)) == FIXNUM_TYPE
+		&& type_of(array_nth(array.untagged(),i)) == FIXNUM_TYPE
-		&& array_nth(array,i + 1) == userenv[JIT_PRIMITIVE_WORD];
+		&& 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)
+	return (i + 3) == array_capacity(array.untagged())
-		&& type_of(array_nth(array,i)) == QUOTATION_TYPE
+		&& type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE
-		&& type_of(array_nth(array,i + 1)) == QUOTATION_TYPE
+		&& type_of(array_nth(array.untagged(),i + 1)) == QUOTATION_TYPE
-		&& array_nth(array,i + 2) == userenv[JIT_IF_WORD];
+		&& 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)
+	return (i + 2) <= array_capacity(array.untagged())
-		&& type_of(array_nth(array,i)) == QUOTATION_TYPE
+		&& type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE
-		&& array_nth(array,i + 1) == userenv[JIT_DIP_WORD];
+		&& 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)
+	return (i + 2) <= array_capacity(array.untagged())
-		&& type_of(array_nth(array,i)) == QUOTATION_TYPE
+		&& type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE
-		&& array_nth(array,i + 1) == userenv[JIT_2DIP_WORD];
+		&& 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)
+	return (i + 2) <= array_capacity(array.untagged())
-		&& type_of(array_nth(array,i)) == QUOTATION_TYPE
+		&& type_of(array_nth(array.untagged(),i)) == QUOTATION_TYPE
-		&& array_nth(array,i + 1) == userenv[JIT_3DIP_WORD];
+		&& 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)
+	return (i + 3) < array_capacity(array.untagged())
-		&& type_of(array_nth(array,i)) == ARRAY_TYPE
+		&& type_of(array_nth(array.untagged(),i)) == ARRAY_TYPE
-		&& type_of(array_nth(array,i + 1)) == FIXNUM_TYPE
+		&& type_of(array_nth(array.untagged(),i + 1)) == FIXNUM_TYPE
-		&& type_of(array_nth(array,i + 2)) == ARRAY_TYPE
+		&& type_of(array_nth(array.untagged(),i + 2)) == ARRAY_TYPE
-		&& array_nth(array,i + 3) == userenv[MEGA_LOOKUP_WORD];
+		&& 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(untagged<F_WORD>(obj)->subprimitive == F)
-			if(word->subprimitive == F)
 				return true;
 		}
 		else if(type_of(obj) == QUOTATION_TYPE)
 		{
-			if(jit_fast_dip_p(array,i)
+			if(fast_dip_p(i) || fast_2dip_p(i) || fast_3dip_p(i))
-				|| jit_fast_2dip_p(array,i)
-				|| jit_fast_3dip_p(array,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));
+	set_position(0);
-
-	jit_set_position(jit,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);
+		gc_root<F_OBJECT> obj(array_nth(array.untagged(),i));
-		REGISTER_ROOT(obj);
 
-		F_WORD *word;
+		switch(obj.type())
-		F_WRAPPER *wrapper;
-
-		switch(type_of(obj))
 		{
 		case WORD_TYPE:
-			word = untag_word_fast(obj);
-
 			/* Intrinsics */
-			if(word->subprimitive != F)
+			if(obj.as<F_WORD>()->subprimitive != F)
-				jit_emit_subprimitive(jit,obj);
+				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;
+					if(stack_frame) emit(userenv[JIT_EPILOG]);
-					jit_emit(jit,userenv[JIT_EXECUTE_JUMP]);
+					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;
+					if(stack_frame) emit(userenv[JIT_EPILOG]);
-					jit_word_jump(jit,obj);
+					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);
+			push(obj.as<F_WRAPPER>()->object);
-			jit_push(jit,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]);
+				emit(userenv[JIT_SAVE_STACK]);
-				jit_emit_with(jit,userenv[JIT_PRIMITIVE],obj);
+				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(array.untagged(),i),relocate);
-					jit_compile(array_nth(untag_array_fast(array),i + 1),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));
+				emit_with(userenv[JIT_IF_1],array_nth(array.untagged(),i));
-				jit_emit_with(jit,userenv[JIT_IF_2],array_nth(untag_array_fast(array),i + 1));
+				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_compile(obj.value(),relocate);
-				jit_emit_with(jit,userenv[JIT_DIP],obj);
+				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_compile(obj.value(),relocate);
-				jit_emit_with(jit,userenv[JIT_2DIP],obj);
+				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_compile(obj.value(),relocate);
-				jit_emit_with(jit,userenv[JIT_3DIP],obj);
+				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,
+				emit_mega_cache_lookup(
-					array_nth(untag_array_fast(array),i),
+					array_nth(array.untagged(),i),
-					untag_fixnum_fast(array_nth(untag_array_fast(array),i + 1)),
+					untag_fixnum_fast(array_nth(array.untagged(),i + 1)),
-					array_nth(untag_array_fast(array),i + 2));
+					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]);
+			emit(userenv[JIT_EPILOG]);
-		jit_emit(jit,userenv[JIT_RETURN]);
+		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)
+	gc_root<F_QUOTATION> quot(quot_);
-		return;
+	if(quot->compiledp != F) return;
 
-	CELL array = untag_quotation(quot)->array;
+	quotation_jit jit(quot.value(),true,relocating);
+	jit.iterate_quotation();
 
-	REGISTER_ROOT(quot);
+	F_CODE_BLOCK *compiled = jit.code_block();
-	REGISTER_ROOT(array);
+	set_quot_xt(quot.untagged(),compiled);
 
-	F_JIT jit;
+	if(relocating) relocate_code_block(compiled);
-	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)
+F_FASTCALL CELL lazy_jit_compile_impl(CELL quot_, F_STACK_FRAME *stack)
-{
-	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)
 {
+	gc_root<F_QUOTATION> quot(quot_);
 	stack_chain->callstack_top = stack;
-	REGISTER_ROOT(quot);
+	jit_compile(quot.value(),true);
-	jit_compile(quot,true);
+	return quot.value();
-	UNREGISTER_ROOT(quot);
-	return quot;
 }
 
 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();
+	gc_root<F_ARRAY> words(find_all_words());
-
-	REGISTER_ROOT(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));
+		gc_root<F_WORD> word(array_nth(words.untagged(),i));
-		REGISTER_UNTAGGED(word);
 
-		if(!word->code || !word_optimized_p(word))
+		if(!word->code || !word_optimized_p(word.untagged()))
-			jit_compile_word(word,word->def,false);
+			jit_compile_word(word.value(),word->def,false);
 
-		UNREGISTER_UNTAGGED(F_WORD,word);
+		update_word_xt(word.value());
-		update_word_xt(word);
 
 	}
 
-	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();
+}

vmpp/quotations.hpp

@@ -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);
+

vmpp/run.cpp

@@ -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(object.type(),size);
-		void *new_obj = allot_object(type_of(object),size);
-		UNREGISTER_ROOT(object);
 
-		CELL tag = TAG(object);
+		CELL tag = TAG(object.value());
-		memcpy(new_obj,(void*)UNTAG(object),size);
+		memcpy(new_obj,object.untagged(),size);
 		return RETAG(new_obj,tag);
 	}
 }

vmpp/strings.cpp

@@ -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 */
+/* Allocates memory */
-F_STRING* allot_string_internal(CELL capacity)
+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 */
+/* Allocates memory */
-void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill)
+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++)
-		{
+			set_string_nth(string.untagged(),i,fill);
-			REGISTER_UNTAGGED(string);
-			set_string_nth(string,i,fill);
-			UNREGISTER_UNTAGGED(F_STRING,string);
-		}
 	}
 }
 
-/* untagged */
+/* Allocates memory */
 F_STRING *allot_string(CELL capacity, CELL fill)
 {
-	F_STRING* string = allot_string_internal(capacity);
+	gc_root<F_STRING> string(allot_string_internal(capacity));
-	REGISTER_UNTAGGED(string);
+	fill_string(string.untagged(),0,capacity,fill);
-	fill_string(string,0,capacity,fill);
+	return string.untagged();
-	UNREGISTER_UNTAGGED(F_STRING,string);
-	return string;
 }
 
 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);
+		gc_root<F_STRING> new_string(allot_string_internal(capacity));
-		F_STRING *new_string = allot_string_internal(capacity);
-		UNREGISTER_UNTAGGED(F_STRING,string);
 
-		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);
+		fill_string(new_string.untagged(),to_copy,capacity,'\0');
-		REGISTER_UNTAGGED(new_string);
+		return new_string.untagged();
-		fill_string(new_string,to_copy,capacity,'\0');
-		UNREGISTER_UNTAGGED(F_STRING,new_string);
-		UNREGISTER_UNTAGGED(F_STRING,string);
-
-		return new_string;
 	}
 }
 
@@ -176,17 +163,15 @@ void primitive_resize_string(void)
 	F_STRING *memory_to_##type##_string(const type *string, CELL length) \
 	{ \
 		REGISTER_C_STRING(string); \
-		F_STRING *s = allot_string_internal(length); \
+		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.untagged(),i,(utype)*string);	\
-			set_string_nth(s,i,(utype)*string); \
-			UNREGISTER_UNTAGGED(F_STRING,s);    \
 			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))) \
+		if(check && !check_string(s.untagged(),sizeof(type)))	\
-			general_error(ERROR_C_STRING,tag_object(s),F,NULL); \
+			general_error(ERROR_C_STRING,s.value(),F,NULL);	\
-		REGISTER_UNTAGGED(s); \
 		_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; \
 	} \

vmpp/tagged.hpp

@@ -7,26 +7,49 @@ template <typename T> CELL tag(T *value)
 }
 
 template <typename T>
-class tagged
+struct tagged
 {
-	CELL value;
+	CELL value_;
-public:
-	explicit tagged(CELL tagged) : value(tagged) {}
-	explicit tagged(T *untagged) : value(::tag(untagged)) {}
 
-	CELL tag() const { return value; }
+	T *untag_check() const {
-	T *untag() const { type_check(T::type_number,value); }
+		if(T::type_number != TYPE_COUNT)
-	T *untag_fast() const { return (T *)(UNTAG(value)); }
+			type_check(T::type_number,value_);
-	T *operator->() const { return untag_fast(); }
+		return untagged();
-	CELL *operator&() const { return &value; }
+	}
+	
+	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();
 }

vmpp/tuples.cpp

@@ -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);
+	gc_root<F_TUPLE_LAYOUT> layout(layout_);
-	F_TUPLE *tuple = (F_TUPLE *)allot_object(TUPLE_TYPE,tuple_size(layout));
+	gc_root<F_TUPLE> tuple(allot<F_TUPLE>(tuple_size(layout.untagged())));
-	UNREGISTER_UNTAGGED(F_TUPLE_LAYOUT,layout);
+	tuple->layout = layout.value();
-	tuple->layout = tag_array((F_ARRAY *)layout);
+	return tuple.untagged();
-	return tuple;
 }
 
 void primitive_tuple(void)
 {
-	F_TUPLE_LAYOUT *layout = untag_tuple_layout(dpop());
+	gc_root<F_TUPLE_LAYOUT> layout(dpop());
-	F_FIXNUM size = untag_fixnum_fast(layout->size);
+	F_TUPLE *tuple = allot_tuple(layout.value());
-
-	F_TUPLE *tuple = allot_tuple(layout);
 	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());
+	gc_root<F_TUPLE_LAYOUT> layout(dpop());
-	F_FIXNUM size = untag_fixnum_fast(layout->size);
+	gc_root<F_TUPLE> tuple(allot_tuple(layout.value()));
-	F_TUPLE *tuple = allot_tuple(layout);
+	CELL size = untag_fixnum_fast(layout.untagged()->size) * CELLS;
-	memcpy(tuple + 1,(CELL *)(ds - CELLS * (size - 1)),CELLS * size);
+	memcpy(tuple.untagged() + 1,(CELL *)(ds - (size - CELLS)),size);
-	ds -= CELLS * size;
+	ds -= size;
-	dpush(tag_tuple(tuple));
+	dpush(tuple.value());
 }

vmpp/words.cpp

@@ -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);
+	gc_root<F_OBJECT> vocab(vocab_);
-	REGISTER_ROOT(name);
+	gc_root<F_OBJECT> name(name_);
-	F_WORD *word = (F_WORD *)allot_object(WORD_TYPE,sizeof(F_WORD));
+
-	UNREGISTER_ROOT(name);
+	gc_root<F_WORD> word(allot<F_WORD>(sizeof(F_WORD)));
-	UNREGISTER_ROOT(vocab);
 
 	word->hashcode = tag_fixnum((rand() << 16) ^ rand());
-	word->vocabulary = vocab;
+	word->vocabulary = vocab.value();
-	word->name = name;
+	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.value(),word->def,true);
-	jit_compile_word(word,word->def,true);
+	update_word_xt(word.value());
-	UNREGISTER_UNTAGGED(F_WORD,word);
-
-	REGISTER_UNTAGGED(word);
-	update_word_xt(word);
-	UNREGISTER_UNTAGGED(F_WORD,word);
 
 	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(word.value());
-			F_CODE_BLOCK *profiling = compile_profiling_stub(tag_object(word));
-			UNREGISTER_UNTAGGED(F_WORD,word);
 			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));
 }

vmpp/words.hpp

@@ -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)
 {