a major revision of the bytecode generator and JIT compiler. the effect is that now we can compute with lambda functions and with true tail recursion

9 files changed, 364 insertions, 227 deletions

diff --git a/src/runtime/c/pgf/data.h b/src/runtime/c/pgf/data.h
index d725a052b..dc6965174 100644
--- a/src/runtime/c/pgf/data.h
+++ b/src/runtime/c/pgf/data.h
@@ -105,27 +105,18 @@ typedef struct {
 
 typedef enum {
   PGF_INSTR_ENTER,
-  PGF_INSTR_EVAL_ARG_VAR,
-  PGF_INSTR_EVAL_FREE_VAR,
   PGF_INSTR_CASE,
-  PGF_INSTR_CASE_INT,
-  PGF_INSTR_CASE_STR,
-  PGF_INSTR_CASE_FLT,
+  PGF_INSTR_CASE_LIT,
   PGF_INSTR_ALLOC,
   PGF_INSTR_PUT_CONSTR,
   PGF_INSTR_PUT_FUN,
   PGF_INSTR_PUT_CLOSURE,
-  PGF_INSTR_PUT_INT,
-  PGF_INSTR_PUT_STR,
-  PGF_INSTR_PUT_FLT,
-  PGF_INSTR_SET_VALUE,
-  PGF_INSTR_SET_ARG_VAR,
-  PGF_INSTR_SET_FREE_VAR,
+  PGF_INSTR_PUT_LIT,
+  PGF_INSTR_SET,
   PGF_INSTR_SET_PAD,
-  PGF_INSTR_PUSH_VALUE,
-  PGF_INSTR_PUSH_ARG_VAR,
-  PGF_INSTR_PUSH_FREE_VAR,
-  PGF_INSTR_TAIL_CALL,
+  PGF_INSTR_PUSH,
+  PGF_INSTR_EVAL,
+  PGF_INSTR_CALL,
   PGF_INSTR_FAIL,
   PGF_INSTR_UPDATE,
   PGF_INSTR_RET
diff --git a/src/runtime/c/pgf/evaluator.c b/src/runtime/c/pgf/evaluator.c
index 0e94792d0..a3f22e274 100644
--- a/src/runtime/c/pgf/evaluator.c
+++ b/src/runtime/c/pgf/evaluator.c
@@ -268,6 +268,17 @@ pgf_evaluate_save_variables(PgfEvalState* state, PgfValue* val)
 	}
 }
 
+void
+pgf_evaluate_slide(PgfEvalState* state, size_t a, size_t b)
+{
+	size_t len = gu_buf_length(state->stack);
+	for (size_t i = 0; i < b-a; i++) {
+		PgfClosure* c = gu_buf_get(state->stack, PgfClosure*, len-(b-a)+i);
+		gu_buf_set(state->stack, PgfClosure*, len-b+i, c);
+	}
+	gu_buf_trim_n(state->stack, a);
+}
+
 static PgfExpr
 pgf_value2expr(PgfEvalState* state, int level, PgfClosure* clos, GuPool* pool)
 {
diff --git a/src/runtime/c/pgf/evaluator.h b/src/runtime/c/pgf/evaluator.h
index 6a24b72c7..3962e772f 100644
--- a/src/runtime/c/pgf/evaluator.h
+++ b/src/runtime/c/pgf/evaluator.h
@@ -32,4 +32,7 @@ pgf_evaluate_value(PgfEvalState* state, PgfClosure* closure);
 void
 pgf_evaluate_save_variables(PgfEvalState* state, PgfValue* val);
 
+void
+pgf_evaluate_slide(PgfEvalState* state, size_t a, size_t b);
+
 #endif
diff --git a/src/runtime/c/pgf/jit.c b/src/runtime/c/pgf/jit.c
index 77ef98399..1a9e25e6f 100644
--- a/src/runtime/c/pgf/jit.c
+++ b/src/runtime/c/pgf/jit.c
@@ -317,6 +317,29 @@ pgf_jit_predicate(PgfReader* rdr, PgfAbstr* abstr,
 #endif
 }
 
+static void
+pgf_jit_compile_slide(PgfReader* rdr, int es_arg, size_t a, size_t b)
+{
+	if (a == b) {
+		jit_prepare(2);
+		jit_movi_i(JIT_V1, a);
+		jit_pusharg_p(JIT_V1);
+		jit_getarg_p(JIT_V1, es_arg);
+		jit_ldxi_p(JIT_V1, JIT_V1, offsetof(PgfEvalState,stack));
+		jit_pusharg_p(JIT_V1);
+		jit_finish(gu_buf_trim_n);
+	} else {
+		jit_prepare(3);
+		jit_movi_i(JIT_V1, b);
+		jit_pusharg_p(JIT_V1);
+		jit_movi_i(JIT_V1, a);
+		jit_pusharg_p(JIT_V1);
+		jit_getarg_p(JIT_V1, es_arg);
+		jit_pusharg_p(JIT_V1);
+		jit_finish(pgf_evaluate_slide);
+	}
+}
+
 void
 pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
                  PgfAbsFun* absfun)
@@ -371,7 +394,9 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
 				gu_printf(out, err, "    ");
 #endif
 
-			uint8_t opcode = pgf_read_tag(rdr);
+			uint8_t tag = pgf_read_tag(rdr);
+			uint8_t opcode = tag >> 3;
+			uint8_t mod    = tag & 0x07;
 			switch (opcode) {
 			case PGF_INSTR_ENTER: {
 #ifdef PGF_JIT_DEBUG
@@ -383,40 +408,11 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
 				closure_arg = jit_arg_p();
 				break;
 			}
-			case PGF_INSTR_EVAL_ARG_VAR: {
-				size_t index = pgf_read_int(rdr);
-#ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "EVAL_ARG_VAR %d\n", index);
-#endif
-
-				jit_getarg_p(JIT_V0, es_arg);
-				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
-				jit_prepare(1);
-				jit_pusharg_p(JIT_V0);
-				jit_finish(gu_buf_last);
-				jit_ldxi_p(JIT_V0, JIT_RET, -index*sizeof(PgfClosure*));
-				jit_prepare(2);
-				jit_pusharg_p(JIT_V0);
-				jit_getarg_p(JIT_V2, es_arg);
-				jit_pusharg_p(JIT_V2);
-				jit_ldr_p(JIT_V0, JIT_V0);
-				jit_finishr(JIT_V0);
-				jit_retval_p(JIT_V1);
-				jit_ldxi_p(JIT_V0, JIT_V1, offsetof(PgfValue, absfun));
-				break;
-			}
-			case PGF_INSTR_EVAL_FREE_VAR: {
-				size_t index = pgf_read_int(rdr);
-#ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "EVAL_FREE_VAR %d\n", index);
-#endif
-				break;
-			}
 			case PGF_INSTR_CASE: {
 				PgfCId id  = pgf_read_cid(rdr, rdr->opool);
 				int target = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "CASE         %s %03d\n", id, target);
+				gu_printf(out, err, "CASE        %s %03d\n", id, target);
 #endif
 				jit_insn *jump= 
 					jit_bnei_i(jit_forward(), JIT_V0, (int) jit_forward());
@@ -439,34 +435,41 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
 				jit_finish(pgf_evaluate_save_variables);
 				break;
 			}
-			case PGF_INSTR_CASE_INT: {
-				int n      = pgf_read_int(rdr);
-				int target = pgf_read_int(rdr);
+			case PGF_INSTR_CASE_LIT: {
+				switch (mod) {
+				case 0: {
+					int n      = pgf_read_int(rdr);
+					int target = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "CASE_INT     %d %03d\n", n, target);
+					gu_printf(out, err, "CASE_LIT    %d %03d\n", n, target);
 #endif
-				break;
-			}
-			case PGF_INSTR_CASE_STR: {
-				GuString s = pgf_read_string(rdr);
-				int target = pgf_read_int(rdr);
+					break;
+				}
+				case 1: {
+					GuString s = pgf_read_string(rdr);
+					int target = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "CASE_STR     %s %03d\n", s, target);
+					gu_printf(out, err, "CASE_LIT    %s %03d\n", s, target);
 #endif
-				break;
-			}
-			case PGF_INSTR_CASE_FLT: {
-				double d   = pgf_read_double(rdr);
-				int target = pgf_read_int(rdr);
+					break;
+				}
+				case 2: {
+					double d   = pgf_read_double(rdr);
+					int target = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "CASE_FLT     %f %03d\n", d, target);
+					gu_printf(out, err, "CASE_LIT    %f %03d\n", d, target);
 #endif
+					break;
+				}
+				default:
+					gu_impossible();
+				}
 				break;
 			}
 			case PGF_INSTR_ALLOC: {
 				size_t size = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "ALLOC        %d\n", size);
+				gu_printf(out, err, "ALLOC       %d\n", size);
 #endif
 				jit_prepare(2);
 				jit_movi_ui(JIT_V0, size*sizeof(void*));
@@ -483,7 +486,7 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
 			case PGF_INSTR_PUT_CONSTR: {
 				PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "PUT_CONSTR   %s\n", id);
+				gu_printf(out, err, "PUT_CONSTR  %s\n", id);
 #endif
 
 				jit_movi_p(JIT_V0, pgf_evaluate_value);
@@ -502,7 +505,7 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
 			case PGF_INSTR_PUT_FUN: {
 				PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "PUT_FUN      %s\n", id);
+				gu_printf(out, err, "PUT_FUN     %s\n", id);
 #endif
 				
 				PgfCallPatch patch;
@@ -518,7 +521,7 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
 			case PGF_INSTR_PUT_CLOSURE: {
 				size_t target = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "PUT_CLOSURE  %03d\n", target);
+				gu_printf(out, err, "PUT_CLOSURE %03d\n", target);
 #endif
 
 				PgfSegmentPatch patch;
@@ -531,62 +534,72 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
 				gu_buf_push(rdr->jit_state->segment_patches, PgfSegmentPatch, patch);
 				break;
 			}
-			case PGF_INSTR_PUT_INT: {
-				size_t n = pgf_read_int(rdr);
+			case PGF_INSTR_PUT_LIT: {
+				switch (mod) {
+				case 0: {
+					size_t n = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "PUT_INT      %d\n", n);
+					gu_printf(out, err, "PUT_LIT     %d\n", n);
 #endif
-				break;
-			}
-			case PGF_INSTR_PUT_STR: {
-				size_t addr = pgf_read_int(rdr);
+					break;
+				}
+				case 1: {
+					GuString s = pgf_read_string(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "PUT_STR      %d\n", addr);
+					gu_printf(out, err, "PUT_LIT     \"%s\"\n", s);
 #endif
-				break;
-			}
-			case PGF_INSTR_PUT_FLT: {
-				size_t addr = pgf_read_int(rdr);
+					break;
+				}
+				case 2: {
+					double d = pgf_read_double(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "PUT_FLT      %d\n", addr);
+					gu_printf(out, err, "PUT_LIT     %f\n", d);
 #endif
-				
+					break;
+				}
+				default:
+					gu_impossible();
+				}
 				break;
 			}
-			case PGF_INSTR_SET_VALUE: {
-				size_t offset = pgf_read_int(rdr);
+			case PGF_INSTR_SET: {
+				switch (mod) {
+				case 0: {
+					size_t offset = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "SET_VALUE    %d\n", offset);
+					gu_printf(out, err, "SET         hp(%d)\n", offset);
 #endif
-				jit_addi_p(JIT_V0, JIT_V1, offset*sizeof(void*));
-				jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
-				curr_offset++;
-				break;
-			}
-			case PGF_INSTR_SET_ARG_VAR: {
-				size_t index = pgf_read_int(rdr);
+					jit_addi_p(JIT_V0, JIT_V1, offset*sizeof(void*));
+					break;
+				}
+				case 1: {
+					size_t index = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "SET_ARG_VAR  %d\n", index);
+					gu_printf(out, err, "SET         stk(%d)\n", index);
 #endif
 
-				jit_getarg_p(JIT_V0, es_arg);
-				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
-				jit_prepare(1);
-				jit_pusharg_p(JIT_V0);
-				jit_finish(gu_buf_last);
-				jit_ldxi_p(JIT_V0, JIT_RET, -index*sizeof(PgfClosure*));
-				jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
-				curr_offset++;
-				break;
-			}
-			case PGF_INSTR_SET_FREE_VAR: {
-				size_t index = pgf_read_int(rdr);
+					jit_getarg_p(JIT_V0, es_arg);
+					jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
+					jit_prepare(1);
+					jit_pusharg_p(JIT_V0);
+					jit_finish(gu_buf_last);
+					jit_ldxi_p(JIT_V0, JIT_RET, -index*sizeof(PgfClosure*));
+					break;
+				}
+				case 2: {
+					size_t index = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "SET_FREE_VAR  %d\n", index);
+					gu_printf(out, err, "SET         env(%d)\n", index);
 #endif
 
-				jit_getarg_p(JIT_V0, closure_arg);
-				jit_ldxi_p(JIT_V0, JIT_V0, sizeof(PgfClosure)+index*sizeof(PgfClosure*));
+					jit_getarg_p(JIT_V0, closure_arg);
+					jit_ldxi_p(JIT_V0, JIT_V0, sizeof(PgfClosure)+index*sizeof(PgfClosure*));
+					break;
+				}
+				default:
+					gu_impossible();
+				}
+				
 				jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
 				curr_offset++;
 				break;
@@ -600,76 +613,174 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
 				curr_offset++;
 				break;
 			}
-			case PGF_INSTR_PUSH_VALUE: {
-				size_t offset = pgf_read_int(rdr);
-#ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "PUSH_VALUE   %d\n", offset);
-#endif
-
+			case PGF_INSTR_PUSH: {
 				jit_getarg_p(JIT_V0, es_arg);
 				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
 				jit_prepare(1);
 				jit_pusharg_p(JIT_V0);
 				jit_finish(gu_buf_extend);
-				if (offset == 0) {
-					jit_str_p(JIT_RET, JIT_V1);
-				} else {
-					jit_addi_p(JIT_V0, JIT_V1, offset*sizeof(void*));
+
+				switch (mod) {
+				case 0: {
+					size_t offset = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+					gu_printf(out, err, "PUSH        hp(%d)\n", offset);
+#endif
+
+					if (offset == 0) {
+						jit_str_p(JIT_RET, JIT_V1);
+					} else {
+						jit_addi_p(JIT_V0, JIT_V1, offset*sizeof(void*));
+						jit_str_p(JIT_RET, JIT_V0);
+					}
+					break;
+				}
+				case 1: {
+					size_t index = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+					gu_printf(out, err, "PUSH        stk(%d)\n", index);
+#endif
+
+					jit_ldxi_p(JIT_V0, JIT_RET, -(index+1)*sizeof(PgfClosure*));
 					jit_str_p(JIT_RET, JIT_V0);
+					break;
 				}
-				break;
-			}
-			case PGF_INSTR_PUSH_ARG_VAR: {
-				size_t index = pgf_read_int(rdr);
+				case 2: {
+					size_t index = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "PUSH_ARG_VAR %d\n", index);
+					gu_printf(out, err, "PUSH        env(%d)\n", index);
 #endif
 
-				jit_getarg_p(JIT_V0, es_arg);
-				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
-				jit_prepare(1);
-				jit_pusharg_p(JIT_V0);
-				jit_finish(gu_buf_extend);
-				jit_ldxi_p(JIT_V0, JIT_RET, -(index+1)*sizeof(PgfClosure*));
-				jit_str_p(JIT_RET, JIT_V0);
+					jit_getarg_p(JIT_V0, closure_arg);				
+					jit_ldxi_p(JIT_V0, JIT_V0, sizeof(PgfClosure)+index*sizeof(PgfClosure*));
+					jit_str_p(JIT_RET, JIT_V0);
+					break;
+				}
+				default:
+					gu_impossible();
+				}
 				break;
 			}
-			case PGF_INSTR_PUSH_FREE_VAR: {
-				size_t index = pgf_read_int(rdr);
+			case PGF_INSTR_EVAL: {
+				switch (mod & 0x3) {
+				case 0: {
+					size_t offset = pgf_read_int(rdr);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "PUSH_FREE_VAR %d\n", index);
+					gu_printf(out, err, "EVAL        hp(%d)", offset);
 #endif
 
-				jit_getarg_p(JIT_V0, es_arg);
-				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
-				jit_prepare(1);
-				jit_pusharg_p(JIT_V0);
-				jit_finish(gu_buf_extend);
-				jit_getarg_p(JIT_V0, closure_arg);				
-				jit_ldxi_p(JIT_V0, JIT_V0, sizeof(PgfClosure)+index*sizeof(PgfClosure*));
-				jit_str_p(JIT_RET, JIT_V0);
+					jit_addi_p(JIT_V0, JIT_V1, offset*sizeof(void*));
+					break;
+				}
+				case 1: {
+					size_t index = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+					gu_printf(out, err, "EVAL        stk(%d)", index);
+#endif
+
+					jit_getarg_p(JIT_V0, es_arg);
+					jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
+					jit_prepare(1);
+					jit_pusharg_p(JIT_V0);
+					jit_finish(gu_buf_last);
+					jit_ldxi_p(JIT_V0, JIT_RET, -index*sizeof(PgfClosure*));
+					break;
+				}
+				case 2: {
+					size_t index = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+					gu_printf(out, err, "EVAL        env(%d)", index);
+#endif
+					break;
+				}
+				default:
+					gu_impossible();
+				}
+
+				switch (mod >> 2) {
+				case 0: {
+#ifdef PGF_JIT_DEBUG
+					gu_printf(out, err, "\n");
+#endif
+
+					jit_prepare(2);
+					jit_pusharg_p(JIT_V0);
+					jit_getarg_p(JIT_V2, es_arg);
+					jit_pusharg_p(JIT_V2);
+					jit_ldr_p(JIT_V0, JIT_V0);
+					jit_finishr(JIT_V0);
+					jit_retval_p(JIT_V1);
+					jit_ldxi_p(JIT_V0, JIT_V1, offsetof(PgfValue, absfun));
+					break;
+				}
+				case 1: {
+					size_t a = pgf_read_int(rdr);
+					size_t b = pgf_read_int(rdr);
+
+#ifdef PGF_JIT_DEBUG
+					gu_printf(out, err, " tail(%d,%d)\n", a, b);
+#endif
+
+					pgf_jit_compile_slide(rdr, es_arg, a, b);
+				    jit_setarg_p(JIT_V0, closure_arg);
+					jit_ldr_p(JIT_RET, JIT_V0);
+					jit_tail_finishr(JIT_RET);
+					break;
+				}
+				default:
+					gu_impossible();
+				}
 				break;
 			}
-			case PGF_INSTR_TAIL_CALL: {
+			case PGF_INSTR_CALL: {
 				PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "TAIL_CALL    %s\n", id);
+				gu_printf(out, err, "CALL        %s", id);
 #endif
 				
-				jit_getarg_p(JIT_V0, es_arg);
-				jit_getarg_p(JIT_V1, closure_arg);
-				jit_prepare(2);
-				jit_pusharg_p(JIT_V1);
-				jit_pusharg_p(JIT_V0);
+				switch (mod >> 2) {
+				case 0: {
+#ifdef PGF_JIT_DEBUG
+					gu_printf(out, err, "\n");
+#endif
 
-				PgfCallPatch patch;
-				patch.cid = id;
-				patch.ref = jit_movi_p(JIT_V0, jit_forward());
-				gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);			
-				jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfAbsFun,function));
+					jit_getarg_p(JIT_V0, es_arg);
+					jit_getarg_p(JIT_V1, closure_arg);
+					jit_prepare(2);
+					jit_pusharg_p(JIT_V1);
+					jit_pusharg_p(JIT_V0);
 
-				jit_finishr(JIT_V0);
-				jit_retval_p(JIT_V1);
+					PgfCallPatch patch;
+					patch.cid = id;
+					patch.ref = jit_movi_p(JIT_V0, jit_forward());
+					gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);			
+					jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfAbsFun,function));
+
+					jit_finishr(JIT_V0);
+					jit_retval_p(JIT_V1);
+					break;
+				}
+				case 1: {
+					size_t a = pgf_read_int(rdr);
+					size_t b = pgf_read_int(rdr);
+
+#ifdef PGF_JIT_DEBUG
+					gu_printf(out, err, " tail(%d,%d)\n", a, b);
+#endif
+
+					pgf_jit_compile_slide(rdr, es_arg, a, b);
+
+					PgfCallPatch patch;
+					patch.cid = id;
+					patch.ref = jit_movi_p(JIT_V0, jit_forward());
+					gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);			
+					jit_ldxi_p(JIT_RET, JIT_V0, offsetof(PgfAbsFun,function));
+					jit_tail_finishr(JIT_RET);
+					break;
+				}
+				default:
+					gu_impossible();
+				}
 				break;
 			}
 			case PGF_INSTR_FAIL:
@@ -692,7 +803,7 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
 				size_t count = pgf_read_int(rdr);
 
 #ifdef PGF_JIT_DEBUG
-				gu_printf(out, err, "RET          %d\n", count);
+				gu_printf(out, err, "RET         %d\n", count);
 #endif
 
 				if (count > 0) {
diff --git a/src/runtime/c/pgf/lightning/core-common.h b/src/runtime/c/pgf/lightning/core-common.h
index b60f0bf31..04dbb2c7b 100644
--- a/src/runtime/c/pgf/lightning/core-common.h
+++ b/src/runtime/c/pgf/lightning/core-common.h
@@ -474,6 +474,12 @@ typedef union jit_code {
 #endif
 #endif
 
+#ifndef jit_setarg_p
+#ifdef JIT_FP
+#define jit_setarg_p(reg, ofs)		jit_stxi_p((ofs), JIT_FP, (reg));
+#endif
+#endif
+
 
 /* Common definitions when sizeof(long) = sizeof(int) */
 #ifndef jit_addi_l
diff --git a/src/runtime/c/pgf/lightning/i386/core-32.h b/src/runtime/c/pgf/lightning/i386/core-32.h
index 9b1810761..561fab5fb 100644
--- a/src/runtime/c/pgf/lightning/i386/core-32.h
+++ b/src/runtime/c/pgf/lightning/i386/core-32.h
@@ -108,6 +108,16 @@ struct jit_local_state {
 #define jit_finish(sub)  (_jitl.finish_ref = jit_calli((sub)), ADDLir(sizeof(long) * _jitl.argssize, JIT_SP), _jitl.argssize = 0, _jitl.finish_ref)
 #define jit_finishr(reg) (jit_callr((reg)), ADDLir(sizeof(long) * _jitl.argssize, JIT_SP), _jitl.argssize = 0)
 
+#ifdef __APPLE__
+#define jit_tail_finishr(reg)	jit_base_tail_finishr(-12, reg)
+#else
+#define jit_tail_finishr(reg)	jit_base_tail_finishr(_jitl.alloca_offset, reg)
+#endif
+
+#define jit_base_tail_finishr(ofs, reg)						  \
+  (((ofs) < 0 ? LEAVE_() : POPLr(_EBP)),				  \
+   POPLr(_EDI), POPLr(_ESI), POPLr(_EBX), jit_jmpr(reg))
+
 #define	jit_arg_c()		((_jitl.framesize += sizeof(int)) - sizeof(int))
 #define	jit_arg_uc()		((_jitl.framesize += sizeof(int)) - sizeof(int))
 #define	jit_arg_s()		((_jitl.framesize += sizeof(int)) - sizeof(int))
diff --git a/src/runtime/haskell/PGF/Binary.hs b/src/runtime/haskell/PGF/Binary.hs
index 64707f386..ae9a7e358 100644
--- a/src/runtime/haskell/PGF/Binary.hs
+++ b/src/runtime/haskell/PGF/Binary.hs
@@ -136,32 +136,36 @@ instance Binary Equation where
   get = liftM2 Equ get get

 

 instance Binary Instr where

-  put (ENTER         ) = putWord8 0

-  put (EVAL_ARG_VAR n) = putWord8 1  >> put n

-  put (EVAL_FREE_VAR n)= putWord8 2  >> put n

-  put (CASE id l     ) = putWord8 3  >> put (id,l)

-  put (CASE_INT n l  ) = putWord8 4  >> put (n,l)

-  put (CASE_STR s l  ) = putWord8 5  >> put (s,l)

-  put (CASE_FLT d l  ) = putWord8 6  >> put (d,l)

-  put (ALLOC        n) = putWord8 7  >> put n

-  put (PUT_CONSTR  id) = putWord8 8  >> put id

-  put (PUT_FUN     id) = putWord8 9  >> put id

-  put (PUT_CLOSURE  l) = putWord8 10  >> put l

-  put (PUT_INT      n) = putWord8 11  >> put n

-  put (PUT_STR      s) = putWord8 12  >> put s

-  put (PUT_FLT      d) = putWord8 13 >> put d

-  put (SET_VALUE    n) = putWord8 14 >> put n

-  put (SET_ARG_VAR  n) = putWord8 15 >> put n

-  put (SET_FREE_VAR n) = putWord8 16 >> put n

-  put (SET_PAD       ) = putWord8 17

-  put (PUSH_VALUE   n) = putWord8 18 >> put n

-  put (PUSH_ARG_VAR n) = putWord8 19 >> put n

-  put (PUSH_FREE_VAR n)= putWord8 20 >> put n

-  put (TAIL_CALL   id) = putWord8 21 >> put id

-  put (FAIL          ) = putWord8 22

-  put (UPDATE        ) = putWord8 23

-  put (RET          n) = putWord8 24 >> put n

-

+  put (ENTER              ) = putWord8 0

+  put (CASE id l          ) = putWord8 8  >> put (id,l)

+  put (CASE_LIT (LInt n) l) = putWord8 16  >> put (n,l)

+  put (CASE_LIT (LStr s) l) = putWord8 17  >> put (s,l)

+  put (CASE_LIT (LFlt d) l) = putWord8 18  >> put (d,l)

+  put (ALLOC             n) = putWord8 24  >> put n

+  put (PUT_CONSTR       id) = putWord8 32  >> put id

+  put (PUT_FUN          id) = putWord8 40 >> put id

+  put (PUT_CLOSURE       l) = putWord8 48  >> put l

+  put (PUT_LIT   (LInt  n)) = putWord8 56  >> put n

+  put (PUT_LIT   (LStr  s)) = putWord8 57 >> put s

+  put (PUT_LIT   (LFlt  d)) = putWord8 58 >> put d

+  put (SET    (HEAP     n)) = putWord8 64 >> put n

+  put (SET    (ARG_VAR  n)) = putWord8 65 >> put n

+  put (SET    (FREE_VAR n)) = putWord8 66 >> put n

+  put (SET_PAD            ) = putWord8 72

+  put (PUSH   (HEAP     n)) = putWord8 80 >> put n

+  put (PUSH   (ARG_VAR  n)) = putWord8 81 >> put n

+  put (PUSH   (FREE_VAR n)) = putWord8 82 >> put n

+  put (EVAL (HEAP     n) RecCall       ) = putWord8 88 >> put n

+  put (EVAL (ARG_VAR  n) RecCall       ) = putWord8 89 >> put n

+  put (EVAL (FREE_VAR n) RecCall       ) = putWord8 90 >> put n

+  put (EVAL (HEAP     n) (TailCall a b)) = putWord8 92 >> put n >> put a >> put b

+  put (EVAL (ARG_VAR  n) (TailCall a b)) = putWord8 93 >> put n >> put a >> put b

+  put (EVAL (FREE_VAR n) (TailCall a b)) = putWord8 94 >> put n >> put a >> put b

+  put (CALL id           RecCall       ) = putWord8 96 >> put id

+  put (CALL id           (TailCall a b)) = putWord8 100 >> put id >> put a >> put b

+  put (FAIL               ) = putWord8 104

+  put (UPDATE             ) = putWord8 112

+  put (RET               n) = putWord8 120 >> put n

 

 instance Binary Type where

   put (DTyp hypos cat exps) = put (hypos,cat,exps)

diff --git a/src/runtime/haskell/PGF/ByteCode.hs b/src/runtime/haskell/PGF/ByteCode.hs
index 158de0358..f5fc343b7 100644
--- a/src/runtime/haskell/PGF/ByteCode.hs
+++ b/src/runtime/haskell/PGF/ByteCode.hs
@@ -1,65 +1,76 @@
-module PGF.ByteCode(CodeLabel, Instr(..), ppCode, ppInstr) where
+module PGF.ByteCode(Literal(..),
+                    CodeLabel, Instr(..), IVal(..), TailInfo(..),
+                    ppLit, ppCode, ppInstr
+                   ) where
 
 import PGF.CId
 import Text.PrettyPrint
 
+data Literal =
+   LStr String                      -- ^ string constant
+ | LInt Int                         -- ^ integer constant
+ | LFlt Double                      -- ^ floating point constant
+ deriving (Eq,Ord,Show)
+
 type CodeLabel = Int
 
 data Instr
   = ENTER
-  | EVAL_ARG_VAR   {-# UNPACK #-} !Int
-  | EVAL_FREE_VAR  {-# UNPACK #-} !Int
   | CASE CId     {-# UNPACK #-} !CodeLabel
-  | CASE_INT Int    {-# UNPACK #-} !CodeLabel
-  | CASE_STR String {-# UNPACK #-} !CodeLabel
-  | CASE_FLT Double {-# UNPACK #-} !CodeLabel
+  | CASE_LIT Literal  {-# UNPACK #-} !CodeLabel
   | ALLOC  {-# UNPACK #-} !Int
   | PUT_CONSTR CId
   | PUT_FUN CId
   | PUT_CLOSURE   {-# UNPACK #-} !CodeLabel
-  | PUT_INT {-# UNPACK #-} !Int
-  | PUT_STR String
-  | PUT_FLT {-# UNPACK #-} !Double
-  | SET_VALUE      {-# UNPACK #-} !Int
-  | SET_ARG_VAR    {-# UNPACK #-} !Int
-  | SET_FREE_VAR   {-# UNPACK #-} !Int
+  | PUT_LIT Literal
+  | SET IVal
   | SET_PAD
-  | PUSH_VALUE     {-# UNPACK #-} !Int
-  | PUSH_ARG_VAR   {-# UNPACK #-} !Int
-  | PUSH_FREE_VAR  {-# UNPACK #-} !Int
-  | TAIL_CALL    CId
+  | PUSH IVal
+  | EVAL IVal TailInfo
+  | CALL CId  TailInfo
   | FAIL
   | UPDATE
   | RET {-# UNPACK #-} !Int
 
+data IVal
+  = HEAP     {-# UNPACK #-} !Int
+  | ARG_VAR  {-# UNPACK #-} !Int
+  | FREE_VAR {-# UNPACK #-} !Int
+
+data TailInfo
+  = RecCall
+  | TailCall {-# UNPACK #-} !Int {-# UNPACK #-} !Int
+
+ppLit (LStr s) = text (show s)
+ppLit (LInt n) = int n
+ppLit (LFlt d) = double d
+
 ppCode :: Int -> [[Instr]] -> Doc
 ppCode l []       = empty
 ppCode l (is:iss) = ppLabel l <+> vcat (map ppInstr is) $$ ppCode (l+1) iss
 
 ppInstr (ENTER          ) = text "ENTER"
-ppInstr (EVAL_ARG_VAR  n) = text "EVAL_ARG_VAR " <+> int n
-ppInstr (EVAL_FREE_VAR n) = text "EVAL_FREE_VAR" <+> int n
-ppInstr (CASE id l      ) = text "CASE         " <+> ppCId id <+> ppLabel l
-ppInstr (CASE_INT n l   ) = text "CASE_INT     " <+> int n <+> ppLabel l
-ppInstr (CASE_STR str l ) = text "CASE_STR     " <+> text (show str) <+> ppLabel l
-ppInstr (CASE_FLT d l   ) = text "CASE_FLT     " <+> double d <+> ppLabel l
-ppInstr (ALLOC         n) = text "ALLOC        " <+> int n
-ppInstr (PUT_CONSTR   id) = text "PUT_CONSTR   " <+> ppCId id
-ppInstr (PUT_FUN      id) = text "PUT_FUN      " <+> ppCId id
-ppInstr (PUT_CLOSURE   l) = text "PUT_CLOSURE  " <+> ppLabel l
-ppInstr (PUT_INT n      ) = text "PUT_INT      " <+> int n
-ppInstr (PUT_STR str    ) = text "PUT_STR      " <+> text (show str)
-ppInstr (PUT_FLT d      ) = text "PUT_FLT      " <+> double d
-ppInstr (SET_VALUE     n) = text "SET_VALUE    " <+> int n
-ppInstr (SET_ARG_VAR   n) = text "SET_ARG_VAR  " <+> int n
-ppInstr (SET_FREE_VAR  n) = text "SET_FREE_VAR " <+> int n
+ppInstr (CASE id l      ) = text "CASE       " <+> ppCId id <+> ppLabel l
+ppInstr (CASE_LIT lit l ) = text "CASE_LIT   " <+> ppLit lit <+> ppLabel l
+ppInstr (ALLOC         n) = text "ALLOC      " <+> int n
+ppInstr (PUT_CONSTR   id) = text "PUT_CONSTR " <+> ppCId id
+ppInstr (PUT_FUN      id) = text "PUT_FUN    " <+> ppCId id
+ppInstr (PUT_CLOSURE   l) = text "PUT_CLOSURE" <+> ppLabel l
+ppInstr (PUT_LIT lit    ) = text "PUT_LIT    " <+> ppLit lit
+ppInstr (SET           v) = text "SET        " <+> ppIVal v
 ppInstr (SET_PAD        ) = text "SET_PAD"
-ppInstr (PUSH_VALUE    n) = text "PUSH_VALUE   " <+> int n
-ppInstr (PUSH_ARG_VAR  n) = text "PUSH_ARG_VAR " <+> int n
-ppInstr (PUSH_FREE_VAR n) = text "PUSH_FREE_VAR" <+> int n
-ppInstr (TAIL_CALL    id) = text "TAIL_CALL    " <+> ppCId id
+ppInstr (PUSH          v) = text "PUSH       " <+> ppIVal v
+ppInstr (EVAL       v ti) = text "EVAL       " <+> ppIVal v <+> ppTailInfo ti
+ppInstr (CALL       v ti) = text "CALL       " <+> ppCId v  <+> ppTailInfo ti
 ppInstr (FAIL           ) = text "FAIL"
 ppInstr (UPDATE         ) = text "UPDATE"
-ppInstr (RET           n) = text "RET          " <+> int n
+ppInstr (RET           n) = text "RET        " <+> int n
+
+ppIVal (HEAP     n) = text "hp"  <> parens (int n)
+ppIVal (ARG_VAR  n) = text "stk" <> parens (int n)
+ppIVal (FREE_VAR n) = text "env" <> parens (int n)
+
+ppTailInfo RecCall        = empty
+ppTailInfo (TailCall a b) = text "tail" <> parens (int a <> comma <> int b)
 
 ppLabel l = text (let s = show l in replicate (3-length s) '0' ++ s)
diff --git a/src/runtime/haskell/PGF/Expr.hs b/src/runtime/haskell/PGF/Expr.hs
index 80a615e67..27b0623ea 100644
--- a/src/runtime/haskell/PGF/Expr.hs
+++ b/src/runtime/haskell/PGF/Expr.hs
@@ -31,12 +31,6 @@ import Control.Monad
 import qualified Text.PrettyPrint as PP

 import qualified Text.ParserCombinators.ReadP as RP

 

-data Literal = 

-   LStr String                      -- ^ string constant

- | LInt Int                         -- ^ integer constant

- | LFlt Double                      -- ^ floating point constant

- deriving (Eq,Ord,Show)

-

 type MetaId = Int

 

 data BindType = 

@@ -274,10 +268,6 @@ pattScope scope (PTilde e)   = scope
 ppBind Explicit x = ppCId x

 ppBind Implicit x = PP.braces (ppCId x)

 

-ppLit (LStr s) = PP.text (show s)

-ppLit (LInt n) = PP.int n

-ppLit (LFlt d) = PP.double d

-

 ppMeta :: MetaId -> PP.Doc

 ppMeta n

   | n == 0    = PP.char '?'