Split off parts of quotations.c into jit.c, which is a general codegen facility used by the non-optimizing compiler, and soon to be the profiler and PICs

Makefile

@@ -41,6 +41,7 @@ DLL_OBJS = $(PLAF_DLL_OBJS) \
 	vm/factor.o \
 	vm/image.o \
 	vm/io.o \
+	vm/jit.o \
 	vm/math.o \
 	vm/primitives.o \
 	vm/profiler.o \

vm/data_gc.c

@@ -1,16 +1,5 @@
 #include "master.h"
 
-INLINE void check_data_pointer(CELL pointer)
-{
-#ifdef FACTOR_DEBUG
-	if(!growing_data_heap)
-	{
-		assert(pointer >= data_heap->segment->start
-		       && pointer < data_heap->segment->end);
-	}
-#endif
-}
-
 /* Scan all the objects in the card */
 void copy_card(F_CARD *ptr, CELL gen, CELL here)
 {

vm/data_gc.h

@@ -153,3 +153,14 @@ void primitive_gc_stats(void);
 void clear_gc_stats(void);
 void primitive_clear_gc_stats(void);
 void primitive_become(void);
+
+INLINE void check_data_pointer(CELL pointer)
+{
+#ifdef FACTOR_DEBUG
+	if(!growing_data_heap)
+	{
+		assert(pointer >= data_heap->segment->start
+		       && pointer < data_heap->segment->end);
+	}
+#endif
+}

vm/data_heap.h

@@ -135,3 +135,4 @@ INLINE void do_slots(CELL obj, void (* iter)(CELL *))
 		scan += CELLS;
 	}
 }
+

vm/jit.c

@@ -0,0 +1,79 @@
+#include "master.h"
+
+/* Allocates memory */
+void jit_init(F_JIT *jit, CELL jit_type, CELL owner)
+{
+	jit->owner = owner;
+	REGISTER_ROOT(jit->owner);
+
+	jit->type = jit_type;
+	jit->code_format = compiled_code_format();
+
+	jit->code = make_growable_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);
+}
+
+/* Allocates memory */
+F_CODE_BLOCK *jit_make_code_block(F_JIT *jit)
+{
+	growable_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_object(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 template, bool *rel_p)
+{
+	F_ARRAY *quadruple = untag_object(template);
+	CELL rel_class = array_nth(quadruple,1);
+	CELL rel_type = array_nth(quadruple,2);
+	CELL offset = array_nth(quadruple,3);
+
+	if(rel_class == F)
+	{
+		*rel_p = false;
+		return 0;
+	}
+	else
+	{
+		*rel_p = true;
+		return (to_fixnum(rel_type) << 28)
+			| (to_fixnum(rel_class) << 24)
+			| ((jit->code.count + to_fixnum(offset)) * jit->code_format);
+	}
+}
+
+/* Allocates memory */
+void jit_emit(F_JIT *jit, CELL template)
+{
+	REGISTER_ROOT(template);
+	bool rel_p;
+	F_REL rel = rel_to_emit(jit,template,&rel_p);
+	if(rel_p) growable_byte_array_append(&jit->relocation,&rel,sizeof(F_REL));
+	growable_array_append(&jit->code,code_to_emit(template));
+	UNREGISTER_ROOT(template);
+}
+

vm/jit.h

@@ -0,0 +1,46 @@
+typedef struct {
+	CELL type;
+	CELL owner;
+	CELL code_format;
+	F_GROWABLE_ARRAY code;
+	F_GROWABLE_BYTE_ARRAY relocation;
+	F_GROWABLE_ARRAY literals;
+} F_JIT;
+
+void jit_init(F_JIT *jit, CELL jit_type, CELL owner);
+F_CODE_BLOCK *jit_make_code_block(F_JIT *jit);
+void jit_dispose(F_JIT *jit);
+
+INLINE F_ARRAY *code_to_emit(CELL template)
+{
+	return untag_object(array_nth(untag_object(template),0));
+}
+
+void jit_emit(F_JIT *jit, CELL template);
+
+/* Allocates memory */
+INLINE void jit_add_literal(F_JIT *jit, CELL literal)
+{
+	growable_array_add(&jit->literals,literal);
+}
+
+/* Allocates memory */
+INLINE void jit_emit_with(F_JIT *jit, CELL template, CELL argument)
+{
+	REGISTER_ROOT(template);
+	jit_add_literal(jit,argument);
+	UNREGISTER_ROOT(template);
+	jit_emit(jit,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);
+}

vm/local_roots.h

@@ -19,7 +19,12 @@ CELL gc_locals;
 
 DEFPUSHPOP(gc_local_,gc_locals)
 
-#define REGISTER_ROOT(obj) gc_local_push((CELL)&(obj))
+#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))			\

vm/master.h

@@ -31,8 +31,8 @@
 #include "bignum.h"
 #include "write_barrier.h"
 #include "data_heap.h"
-#include "local_roots.h"
 #include "data_gc.h"
+#include "local_roots.h"
 #include "debug.h"
 #include "types.h"
 #include "math.h"
@@ -46,6 +46,7 @@
 #include "alien.h"
 #include "quotations.h"
 #include "dispatch.h"
+#include "jit.h"
 #include "factor.h"
 #include "utilities.h"
 

vm/quotations.c

@@ -39,14 +39,14 @@ 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. */
 
-bool jit_primitive_call_p(F_ARRAY *array, CELL i)
+static bool jit_primitive_call_p(F_ARRAY *array, 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];
 }
 
-bool jit_fast_if_p(F_ARRAY *array, CELL i)
+static bool jit_fast_if_p(F_ARRAY *array, CELL i)
 {
 	return (i + 3) == array_capacity(array)
 		&& type_of(array_nth(array,i)) == QUOTATION_TYPE
@@ -54,42 +54,42 @@ bool jit_fast_if_p(F_ARRAY *array, CELL i)
 		&& array_nth(array,i + 2) == userenv[JIT_IF_WORD];
 }
 
-bool jit_fast_dispatch_p(F_ARRAY *array, CELL i)
+static bool jit_fast_dispatch_p(F_ARRAY *array, CELL i)
 {
 	return (i + 2) == array_capacity(array)
 		&& type_of(array_nth(array,i)) == ARRAY_TYPE
 		&& array_nth(array,i + 1) == userenv[JIT_DISPATCH_WORD];
 }
 
-bool jit_fast_dip_p(F_ARRAY *array, CELL i)
+static bool jit_fast_dip_p(F_ARRAY *array, 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];
 }
 
-bool jit_fast_2dip_p(F_ARRAY *array, CELL i)
+static bool jit_fast_2dip_p(F_ARRAY *array, 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];
 }
 
-bool jit_fast_3dip_p(F_ARRAY *array, CELL i)
+static bool jit_fast_3dip_p(F_ARRAY *array, 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];
 }
 
-bool jit_ignore_declare_p(F_ARRAY *array, CELL i)
+static bool jit_ignore_declare_p(F_ARRAY *array, CELL i)
 {
 	return (i + 1) < array_capacity(array)
 		&& type_of(array_nth(array,i)) == ARRAY_TYPE
 		&& array_nth(array,i + 1) == userenv[JIT_DECLARE_WORD];
 }
 
-bool jit_stack_frame_p(F_ARRAY *array)
+static bool jit_stack_frame_p(F_ARRAY *array)
 {
 	F_FIXNUM length = array_capacity(array);
 	F_FIXNUM i;
@@ -125,51 +125,9 @@ void set_quot_xt(F_QUOTATION *quot, F_CODE_BLOCK *code)
 	quot->compiledp = T;
 }
 
-F_ARRAY *code_to_emit(CELL template)
+#define EMIT_TAIL_CALL { \
-{
+		if(stack_frame) jit_emit(&jit,userenv[JIT_EPILOG]); \
-	return untag_object(array_nth(untag_object(template),0));
+		tail_call = true; \
-}
-
-F_REL rel_to_emit(CELL template, CELL code_format, CELL code_length, bool *rel_p)
-{
-	F_ARRAY *quadruple = untag_object(template);
-	CELL rel_class = array_nth(quadruple,1);
-	CELL rel_type = array_nth(quadruple,2);
-	CELL offset = array_nth(quadruple,3);
-
-	if(rel_class == F)
-	{
-		*rel_p = false;
-		return 0;
-	}
-	else
-	{
-		*rel_p = true;
-		return (to_fixnum(rel_type) << 28)
-			| (to_fixnum(rel_class) << 24)
-			| ((code_length + to_fixnum(offset)) * code_format);
-	}
-}
-
-static void jit_emit(CELL template, CELL code_format,
-		     F_GROWABLE_ARRAY *code, F_GROWABLE_BYTE_ARRAY *relocation)
-{
-	REGISTER_ROOT(template);
-	bool rel_p;
-	F_REL rel = rel_to_emit(template,code_format,code->count,&rel_p);
-	if(rel_p) growable_byte_array_append(relocation,&rel,sizeof(F_REL));
-	growable_array_append(code,code_to_emit(template));
-	UNREGISTER_ROOT(template);
-}
-
-#define EMIT(template) { jit_emit(template,code_format,&code_g,&relocation_g); }
-
-#define EMIT_LITERAL GROWABLE_ARRAY_ADD(literals,obj);
-
-#define EMIT_TAIL_CALL(template) { \
-		if(stack_frame) EMIT(userenv[JIT_EPILOG]); \
-		tail_call = true;		  \
-		EMIT(template);			  \
 	}
 
 /* Might GC */
@@ -178,24 +136,18 @@ void jit_compile(CELL quot, bool relocate)
 	if(untag_quotation(quot)->compiledp != F)
 		return;
 
-	CELL code_format = compiled_code_format();
-
 	CELL array = untag_quotation(quot)->array;
 
 	REGISTER_ROOT(quot);
 	REGISTER_ROOT(array);
 
-	GROWABLE_ARRAY(code);
+	F_JIT jit;
-	GROWABLE_BYTE_ARRAY(relocation);
+	jit_init(&jit,QUOTATION_TYPE,quot);
-	GROWABLE_ARRAY(literals);
-
-	if(stack_traces_p())
-		GROWABLE_ARRAY_ADD(literals,quot);
 
 	bool stack_frame = jit_stack_frame_p(untag_object(array));
 
 	if(stack_frame)
-		EMIT(userenv[JIT_PROLOG])
+		jit_emit(&jit,userenv[JIT_PROLOG]);
 
 	CELL i;
 	CELL length = array_capacity(untag_object(array));
@@ -219,39 +171,43 @@ void jit_compile(CELL quot, bool relocate)
 			{
 				REGISTER_UNTAGGED(word);
 				if(array_nth(untag_object(word->subprimitive),1) != F)
-					GROWABLE_ARRAY_ADD(literals,T);
+					jit_add_literal(&jit,T);
 				UNREGISTER_UNTAGGED(word);
 
-				EMIT(word->subprimitive)
+				jit_emit(&jit,word->subprimitive);
 			}
+			/* The (execute) primitive is special-cased */
 			else if(obj == userenv[JIT_EXECUTE_WORD])
 			{
 				if(i == length - 1)
-					EMIT_TAIL_CALL(userenv[JIT_EXECUTE_JUMP])
+				{
+					EMIT_TAIL_CALL;
+					jit_emit(&jit,userenv[JIT_EXECUTE_JUMP]);
+				}
 				else
-					EMIT(userenv[JIT_EXECUTE_CALL])
+					jit_emit(&jit,userenv[JIT_EXECUTE_CALL]);
 			}
+			/* Everything else */
 			else
 			{
-				EMIT_LITERAL
-
 				if(i == length - 1)
-					EMIT_TAIL_CALL(userenv[JIT_WORD_JUMP])
+				{
+					EMIT_TAIL_CALL;
+					jit_word_jump(&jit,obj);
+				}
 				else
-					EMIT(userenv[JIT_WORD_CALL])
+					jit_emit_with(&jit,userenv[JIT_WORD_CALL],obj);
 			}
 			break;
 		case WRAPPER_TYPE:
 			wrapper = untag_object(obj);
-			GROWABLE_ARRAY_ADD(literals,wrapper->object);
+			jit_push(&jit,wrapper->object);
-			EMIT(userenv[JIT_PUSH_IMMEDIATE])
 			break;
 		case FIXNUM_TYPE:
 			if(jit_primitive_call_p(untag_object(array),i))
 			{
-				EMIT(userenv[JIT_SAVE_STACK])
+				jit_emit(&jit,userenv[JIT_SAVE_STACK]);
-				EMIT_LITERAL
+				jit_emit_with(&jit,userenv[JIT_PRIMITIVE],obj);
-				EMIT(userenv[JIT_PRIMITIVE])
 
 				i++;
 
@@ -261,18 +217,13 @@ void jit_compile(CELL quot, bool relocate)
 		case QUOTATION_TYPE:
 			if(jit_fast_if_p(untag_object(array),i))
 			{
-				if(stack_frame)
+				EMIT_TAIL_CALL;
-					EMIT(userenv[JIT_EPILOG])
-
-				tail_call = true;
 
 				jit_compile(array_nth(untag_object(array),i),relocate);
 				jit_compile(array_nth(untag_object(array),i + 1),relocate);
 
-				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i));
+				jit_emit_with(&jit,userenv[JIT_IF_1],array_nth(untag_object(array),i));
-				EMIT(userenv[JIT_IF_1])
+				jit_emit_with(&jit,userenv[JIT_IF_2],array_nth(untag_object(array),i + 1));
-				GROWABLE_ARRAY_ADD(literals,array_nth(untag_object(array),i + 1));
-				EMIT(userenv[JIT_IF_2])
 
 				i += 2;
 
@@ -281,38 +232,29 @@ void jit_compile(CELL quot, bool relocate)
 			else if(jit_fast_dip_p(untag_object(array),i))
 			{
 				jit_compile(obj,relocate);
-
+				jit_emit_with(&jit,userenv[JIT_DIP],obj);
-				EMIT_LITERAL
-				EMIT(userenv[JIT_DIP])
-
 				i++;
 				break;
 			}
 			else if(jit_fast_2dip_p(untag_object(array),i))
 			{
 				jit_compile(obj,relocate);
-
+				jit_emit_with(&jit,userenv[JIT_2DIP],obj);
-				EMIT_LITERAL
-				EMIT(userenv[JIT_2DIP])
-
 				i++;
 				break;
 			}
 			else if(jit_fast_3dip_p(untag_object(array),i))
 			{
 				jit_compile(obj,relocate);
-
+				jit_emit_with(&jit,userenv[JIT_3DIP],obj);
-				EMIT_LITERAL
-				EMIT(userenv[JIT_3DIP])
-
 				i++;
 				break;
 			}
 		case ARRAY_TYPE:
 			if(jit_fast_dispatch_p(untag_object(array),i))
 			{
-				EMIT_LITERAL
+				EMIT_TAIL_CALL;
-				EMIT_TAIL_CALL(userenv[JIT_DISPATCH])
+				jit_emit_with(&jit,userenv[JIT_DISPATCH],obj);
 
 				i++;
 				break;
@@ -323,8 +265,7 @@ void jit_compile(CELL quot, bool relocate)
 				break;
 			}
 		default:
-			EMIT_LITERAL
+			jit_push(&jit,obj);
-			EMIT(userenv[JIT_PUSH_IMMEDIATE])
 			break;
 		}
 
@@ -334,31 +275,18 @@ void jit_compile(CELL quot, bool relocate)
 	if(!tail_call)
 	{
 		if(stack_frame)
-			EMIT(userenv[JIT_EPILOG])
+			jit_emit(&jit,userenv[JIT_EPILOG]);
-
+		jit_emit(&jit,userenv[JIT_RETURN]);
-		EMIT(userenv[JIT_RETURN])
 	}
 
-	GROWABLE_ARRAY_TRIM(literals);
+	F_CODE_BLOCK *compiled = jit_make_code_block(&jit);
-	GROWABLE_BYTE_ARRAY_TRIM(relocation);
-	GROWABLE_ARRAY_TRIM(code);
-
-	GROWABLE_ARRAY_DONE(literals);
-	GROWABLE_BYTE_ARRAY_DONE(relocation);
-	GROWABLE_ARRAY_DONE(code);
-
-	F_CODE_BLOCK *compiled = add_code_block(
-		QUOTATION_TYPE,
-		untag_object(code),
-		NULL,
-		relocation,
-		literals);
-
 	set_quot_xt(untag_object(quot),compiled);
 
 	if(relocate)
 		relocate_code_block(compiled);
 
+	jit_dispose(&jit);
+
 	UNREGISTER_ROOT(array);
 	UNREGISTER_ROOT(quot);
 }
@@ -405,7 +333,6 @@ F_FIXNUM quot_code_offset_to_scan(CELL quot, F_FIXNUM offset)
 		switch(type_of(obj))
 		{
 		case WORD_TYPE:
-			/* Intrinsics */
 			word = untag_object(obj);
 			if(word->subprimitive != F)
 				COUNT(word->subprimitive,i)

vm/types.c

@@ -171,6 +171,10 @@ CELL allot_array_4(CELL v1, CELL v2, CELL v3, CELL v4)
 
 F_ARRAY *reallot_array(F_ARRAY* array, CELL capacity)
 {
+#ifdef FACTOR_DEBUG
+	assert(untag_header(array->header) == ARRAY_TYPE);
+#endif
+
 	CELL to_copy = array_capacity(array);
 	if(capacity < to_copy)
 		to_copy = capacity;
@@ -267,6 +271,10 @@ void primitive_uninitialized_byte_array(void)
 
 F_BYTE_ARRAY *reallot_byte_array(F_BYTE_ARRAY *array, CELL capacity)
 {
+#ifdef FACTOR_DEBUG
+	assert(untag_header(array->header) == BYTE_ARRAY_TYPE);
+#endif
+
 	CELL to_copy = array_capacity(array);
 	if(capacity < to_copy)
 		to_copy = capacity;