summaryrefslogtreecommitdiff
path: root/src/runtime
diff options
context:
space:
mode:
authorkr.angelov <kr.angelov@gmail.com>2014-09-05 10:09:43 +0000
committerkr.angelov <kr.angelov@gmail.com>2014-09-05 10:09:43 +0000
commit86b5f78c579ce5fcc9c96370644c41c35a421070 (patch)
tree8a3034c3e366c901f8bb06ee3733d096fdb8b95a /src/runtime
parenta21ffc194185165ab487e0553cd5c4d0a36a8a9d (diff)
full support for recursive def rules in the C runtime
Diffstat (limited to 'src/runtime')
-rw-r--r--src/runtime/c/pgf/data.h11
-rw-r--r--src/runtime/c/pgf/jit.c528
-rw-r--r--src/runtime/haskell/PGF/Binary.hs41
-rw-r--r--src/runtime/haskell/PGF/ByteCode.hs65
-rw-r--r--src/runtime/haskell/PGF/Data.hs10
-rw-r--r--src/runtime/haskell/PGF/Expr.hs4
-rw-r--r--src/runtime/haskell/PGF/Printer.hs12
7 files changed, 378 insertions, 293 deletions
diff --git a/src/runtime/c/pgf/data.h b/src/runtime/c/pgf/data.h
index bbf3351cb..f2e646a50 100644
--- a/src/runtime/c/pgf/data.h
+++ b/src/runtime/c/pgf/data.h
@@ -104,21 +104,26 @@ typedef struct {
} PgfAbstr;
typedef enum {
- PGF_INSTR_EVAL,
+ 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_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_VARIABLE,
+ PGF_INSTR_SET_ARG_VAR,
+ PGF_INSTR_SET_FREE_VAR,
PGF_INSTR_PUSH_VALUE,
- PGF_INSTR_PUSH_VARIABLE,
+ PGF_INSTR_PUSH_ARG_VAR,
+ PGF_INSTR_PUSH_FREE_VAR,
PGF_INSTR_TAIL_CALL,
PGF_INSTR_FAIL,
PGF_INSTR_RET
diff --git a/src/runtime/c/pgf/jit.c b/src/runtime/c/pgf/jit.c
index 0efaa7fd2..24e9ee0d8 100644
--- a/src/runtime/c/pgf/jit.c
+++ b/src/runtime/c/pgf/jit.c
@@ -14,7 +14,7 @@ struct PgfJitState {
jit_insn *buf;
char *save_ip_ptr;
GuBuf* call_patches;
- GuBuf* label_patches;
+ GuBuf* segment_patches;
};
#define _jit (rdr->jit_state->jit)
@@ -25,9 +25,10 @@ typedef struct {
} PgfCallPatch;
typedef struct {
- size_t label;
+ size_t segment;
jit_insn *ref;
-} PgfLabelPatch;
+ bool is_abs;
+} PgfSegmentPatch;
// Between two calls to pgf_jit_make_space we are not allowed
// to emit more that JIT_CODE_WINDOW bytes. This is not quite
@@ -78,7 +79,7 @@ pgf_new_jit(PgfReader* rdr)
{
PgfJitState* state = gu_new(PgfJitState, rdr->tmp_pool);
state->call_patches = gu_new_buf(PgfCallPatch, rdr->tmp_pool);
- state->label_patches = gu_new_buf(PgfLabelPatch, rdr->tmp_pool);
+ state->segment_patches = gu_new_buf(PgfSegmentPatch, rdr->tmp_pool);
state->buf = NULL;
state->save_ip_ptr = NULL;
return state;
@@ -333,282 +334,345 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
absfun->function = jit_get_ip().ptr;
- jit_prolog(2);
-
- int es_arg = jit_arg_p();
- int closure_arg = jit_arg_p();
-
- size_t n_instrs = pgf_read_len(rdr);
+ size_t n_segments = pgf_read_len(rdr);
gu_return_on_exn(rdr->err, );
-
- size_t curr_offset = 0;
- size_t curr_label = 0;
-
- gu_buf_flush(rdr->jit_state->label_patches);
-
- for (size_t i = 0; i < n_instrs; i++) {
- size_t labels_count = gu_buf_length(rdr->jit_state->label_patches);
- if (labels_count > 0) {
- PgfLabelPatch* patch =
- gu_buf_index(rdr->jit_state->label_patches, PgfLabelPatch, labels_count-1);
- if (patch->label == curr_label) {
- jit_patch(patch->ref);
- gu_buf_trim_n(rdr->jit_state->label_patches, 1);
+
+ gu_buf_flush(rdr->jit_state->segment_patches);
+
+ int es_arg = 0;
+ int closure_arg = 0;
+
+ for (size_t segment = 0; segment < n_segments; segment++) {
+ size_t n_instrs = pgf_read_len(rdr);
+ gu_return_on_exn(rdr->err, );
+
+ size_t curr_offset = 0;
+
+ size_t n_patches = gu_buf_length(rdr->jit_state->segment_patches);
+ if (n_patches > 0) {
+ PgfSegmentPatch* patch =
+ gu_buf_index(rdr->jit_state->segment_patches, PgfSegmentPatch, n_patches-1);
+ if (patch->segment == segment) {
+ if (patch->is_abs)
+ jit_patch_movi(patch->ref,jit_get_ip().ptr);
+ else
+ jit_patch(patch->ref);
+ gu_buf_trim_n(rdr->jit_state->segment_patches, 1);
}
}
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "%04d ", curr_label);
+ gu_printf(out, err, "%03d ", segment);
#endif
- curr_label++;
- uint8_t opcode = pgf_read_tag(rdr);
- switch (opcode) {
- case PGF_INSTR_EVAL: {
- size_t index = pgf_read_int(rdr);
+ for (size_t label = 0; label < n_instrs; label++) {
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "EVAL %d\n", index);
+ if (label > 0)
+ gu_printf(out, err, " ");
#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_CASE: {
- PgfCId id = pgf_read_cid(rdr, rdr->opool);
- int offset = pgf_read_int(rdr);
-#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "CASE %s %04d\n", id, curr_label+offset);
-#endif
- jit_insn *jump=
- jit_bnei_i(jit_forward(), JIT_V0, (int) jit_forward());
-
- PgfLabelPatch label_patch;
- label_patch.label = curr_label+offset;
- label_patch.ref = jump;
- gu_buf_push(rdr->jit_state->label_patches, PgfLabelPatch, label_patch);
-
- PgfCallPatch call_patch;
- call_patch.cid = id;
- call_patch.ref = jump-6;
- gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, call_patch);
-
- jit_prepare(2);
- jit_pusharg_p(JIT_V1);
- jit_getarg_p(JIT_V2, es_arg);
- jit_pusharg_p(JIT_V2);
- jit_finish(pgf_evaluate_save_variables);
- break;
- }
- case PGF_INSTR_CASE_INT: {
- int n = pgf_read_int(rdr);
- int offset = pgf_read_int(rdr);
+ uint8_t opcode = pgf_read_tag(rdr);
+ switch (opcode) {
+ case PGF_INSTR_ENTER: {
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "CASE_INT %d %04d\n", n, curr_label+offset);
+ gu_printf(out, err, "ENTER\n");
#endif
- break;
- }
- case PGF_INSTR_CASE_STR: {
- GuString s = pgf_read_string(rdr);
- int offset = pgf_read_int(rdr);
+
+ jit_prolog(2);
+ es_arg = jit_arg_p();
+ 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, "CASE_STR %s %04d\n", s, curr_label+offset);
+ gu_printf(out, err, "EVAL_ARG_VAR %d\n", index);
#endif
- break;
- }
- case PGF_INSTR_CASE_FLT: {
- double d = pgf_read_double(rdr);
- int offset = 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*));
+ 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_CASE: {
+ PgfCId id = pgf_read_cid(rdr, rdr->opool);
+ int target = pgf_read_int(rdr);
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "CASE_FLT %f %04d\n", d, curr_label+offset);
+ gu_printf(out, err, "CASE %s %03d\n", id, target);
#endif
- break;
- }
- case PGF_INSTR_ALLOC: {
- size_t size = pgf_read_int(rdr);
-#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "ALLOC %d\n", size);
-#endif
- jit_prepare(2);
- jit_movi_ui(JIT_V0, size*sizeof(void*));
- jit_pusharg_ui(JIT_V0);
- jit_getarg_p(JIT_V0, es_arg);
- jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,pool));
- jit_pusharg_p(JIT_V0);
- jit_finish(gu_malloc);
- jit_retval_p(JIT_V1);
-
- curr_offset = 0;
- break;
- }
- case PGF_INSTR_PUT_CONSTR: {
- PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
+ jit_insn *jump=
+ jit_bnei_i(jit_forward(), JIT_V0, (int) jit_forward());
+
+ PgfSegmentPatch label_patch;
+ label_patch.segment = target;
+ label_patch.ref = jump;
+ label_patch.is_abs = false;
+ gu_buf_push(rdr->jit_state->segment_patches, PgfSegmentPatch, label_patch);
+
+ PgfCallPatch call_patch;
+ call_patch.cid = id;
+ call_patch.ref = jump-6;
+ gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, call_patch);
+
+ jit_prepare(2);
+ jit_pusharg_p(JIT_V1);
+ jit_getarg_p(JIT_V2, es_arg);
+ jit_pusharg_p(JIT_V2);
+ jit_finish(pgf_evaluate_save_variables);
+ break;
+ }
+ case PGF_INSTR_CASE_INT: {
+ int n = pgf_read_int(rdr);
+ int target = pgf_read_int(rdr);
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "PUT_CONSTR %s\n", id);
+ gu_printf(out, err, "CASE_INT %d %03d\n", n, target);
+#endif
+ break;
+ }
+ case PGF_INSTR_CASE_STR: {
+ 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);
+#endif
+ break;
+ }
+ case PGF_INSTR_CASE_FLT: {
+ 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);
+#endif
+ break;
+ }
+ case PGF_INSTR_ALLOC: {
+ size_t size = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+ gu_printf(out, err, "ALLOC %d\n", size);
+#endif
+ jit_prepare(2);
+ jit_movi_ui(JIT_V0, size*sizeof(void*));
+ jit_pusharg_ui(JIT_V0);
+ jit_getarg_p(JIT_V0, es_arg);
+ jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,pool));
+ jit_pusharg_p(JIT_V0);
+ jit_finish(gu_malloc);
+ jit_retval_p(JIT_V1);
+
+ curr_offset = 0;
+ break;
+ }
+ 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);
#endif
- jit_movi_p(JIT_V0, pgf_evaluate_value);
- jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
- curr_offset++;
-
- PgfCallPatch patch;
- patch.cid = id;
- patch.ref = jit_movi_p(JIT_V0, jit_forward());
- jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
- curr_offset++;
+ jit_movi_p(JIT_V0, pgf_evaluate_value);
+ jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
+ curr_offset++;
+
+ PgfCallPatch patch;
+ patch.cid = id;
+ patch.ref = jit_movi_p(JIT_V0, jit_forward());
+ jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
+ curr_offset++;
- gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);
- break;
- }
- case PGF_INSTR_PUT_CLOSURE: {
- size_t addr = pgf_read_int(rdr);
+ gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);
+ break;
+ }
+ case PGF_INSTR_PUT_FUN: {
+ PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "PUT_CLOSURE %d\n", addr);
+ gu_printf(out, err, "PUT_FUN %s\n", id);
#endif
- break;
- }
- case PGF_INSTR_PUT_INT: {
- size_t n = pgf_read_int(rdr);
+
+ PgfCallPatch patch;
+ patch.cid = id;
+ patch.ref = jit_movi_p(JIT_V0, jit_forward());
+ jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfAbsFun,function));
+ jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
+ curr_offset++;
+
+ gu_buf_push(rdr->jit_state->call_patches, PgfCallPatch, patch);
+ break;
+ }
+ case PGF_INSTR_PUT_CLOSURE: {
+ size_t target = pgf_read_int(rdr);
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "PUT_INT %d\n", n);
+ gu_printf(out, err, "PUT_CLOSURE %03d\n", target);
#endif
- break;
- }
- case PGF_INSTR_PUT_STR: {
- size_t addr = pgf_read_int(rdr);
+
+ PgfSegmentPatch patch;
+ patch.segment = target;
+ patch.ref = jit_movi_p(JIT_V0, jit_forward());
+ patch.is_abs = true;
+ jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
+ curr_offset++;
+
+ gu_buf_push(rdr->jit_state->segment_patches, PgfSegmentPatch, patch);
+ break;
+ }
+ case PGF_INSTR_PUT_INT: {
+ size_t n = pgf_read_int(rdr);
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "PUT_STR %d\n", addr);
+ gu_printf(out, err, "PUT_INT %d\n", n);
#endif
- break;
- }
- case PGF_INSTR_PUT_FLT: {
- size_t addr = pgf_read_int(rdr);
+ break;
+ }
+ case PGF_INSTR_PUT_STR: {
+ size_t addr = pgf_read_int(rdr);
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "PUT_FLT %d\n", addr);
+ gu_printf(out, err, "PUT_STR %d\n", addr);
#endif
-
- break;
- }
- case PGF_INSTR_SET_VALUE: {
- size_t offset = pgf_read_int(rdr);
+ break;
+ }
+ case PGF_INSTR_PUT_FLT: {
+ size_t addr = pgf_read_int(rdr);
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "SET_VALUE %d\n", offset);
+ gu_printf(out, err, "PUT_FLT %d\n", addr);
#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_VARIABLE: {
- size_t index = pgf_read_int(rdr);
+
+ break;
+ }
+ case PGF_INSTR_SET_VALUE: {
+ size_t offset = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+ gu_printf(out, err, "SET_VALUE %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);
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "SET_VARIABLE %d\n", index);
+ gu_printf(out, err, "SET_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_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
- curr_offset++;
- break;
- }
- case PGF_INSTR_PUSH_VALUE: {
- size_t offset = 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*));
+ jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0);
+ 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);
+ gu_printf(out, err, "PUSH_VALUE %d\n", 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);
- if (offset == 0) {
- jit_str_p(JIT_RET, JIT_V1);
- } else {
- jit_addi_p(JIT_V0, JIT_V1, offset*sizeof(void*));
+ 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*));
+ jit_str_p(JIT_RET, JIT_V0);
+ }
+ break;
+ }
+ case PGF_INSTR_PUSH_ARG_VAR: {
+ size_t index = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+ gu_printf(out, err, "PUSH_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_extend);
+ jit_ldxi_p(JIT_V0, JIT_RET, -(index+1)*sizeof(PgfClosure*));
jit_str_p(JIT_RET, JIT_V0);
+ break;
}
- break;
- }
- case PGF_INSTR_PUSH_VARIABLE: {
- size_t index = pgf_read_int(rdr);
+ case PGF_INSTR_PUSH_FREE_VAR: {
+ size_t index = pgf_read_int(rdr);
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "PUSH_VARIABLE %d\n", index);
+ gu_printf(out, err, "PUSH_FREE_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_extend);
- jit_ldxi_p(JIT_V0, JIT_RET, -(index+1)*sizeof(PgfClosure*));
- jit_str_p(JIT_RET, JIT_V0);
- break;
- }
- case PGF_INSTR_TAIL_CALL: {
- PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
-#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "TAIL_CALL %s\n", 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);
-
- 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 PGF_INSTR_FAIL:
+ 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);
+ break;
+ }
+ case PGF_INSTR_TAIL_CALL: {
+ PgfCId id = pgf_read_cid(rdr, rdr->tmp_pool);
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "FAIL\n");
+ gu_printf(out, err, "TAIL_CALL %s\n", id);
#endif
- break;
- case PGF_INSTR_RET: {
- size_t count = pgf_read_int(rdr);
+
+ 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);
+ 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 PGF_INSTR_FAIL:
#ifdef PGF_JIT_DEBUG
- gu_printf(out, err, "RET %d\n", count);
+ gu_printf(out, err, "FAIL\n");
#endif
+ break;
+ case PGF_INSTR_RET: {
+ size_t count = pgf_read_int(rdr);
- jit_prepare(2);
- jit_movi_ui(JIT_V0, count);
- jit_pusharg_p(JIT_V0);
- jit_getarg_p(JIT_V0, es_arg);
- jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
- jit_pusharg_p(JIT_V0);
- jit_finish(gu_buf_trim_n);
+#ifdef PGF_JIT_DEBUG
+ gu_printf(out, err, "RET %d\n", count);
+#endif
- jit_movr_p(JIT_RET, JIT_V1);
- jit_ret();
- break;
- }
- default:
- gu_impossible();
+ if (count > 0) {
+ jit_prepare(2);
+ jit_movi_ui(JIT_V0, count);
+ jit_pusharg_p(JIT_V0);
+ jit_getarg_p(JIT_V0, es_arg);
+ jit_ldxi_p(JIT_V0, JIT_V0, offsetof(PgfEvalState,stack));
+ jit_pusharg_p(JIT_V0);
+ jit_finish(gu_buf_trim_n);
+ }
+
+ jit_movr_p(JIT_RET, JIT_V1);
+ jit_ret();
+ break;
+ }
+ default:
+ gu_impossible();
+ }
}
}
}
diff --git a/src/runtime/haskell/PGF/Binary.hs b/src/runtime/haskell/PGF/Binary.hs
index b5c301e3b..2064e9a3b 100644
--- a/src/runtime/haskell/PGF/Binary.hs
+++ b/src/runtime/haskell/PGF/Binary.hs
@@ -136,24 +136,29 @@ instance Binary Equation where
get = liftM2 Equ get get
instance Binary Instr where
- put (EVAL n) = putWord8 0 >> put n
- put (CASE id l ) = putWord8 1 >> put (id,l)
- put (CASE_INT n l ) = putWord8 2 >> put (n,l)
- put (CASE_STR s l ) = putWord8 3 >> put (s,l)
- put (CASE_FLT d l ) = putWord8 4 >> put (d,l)
- put (ALLOC n) = putWord8 5 >> put n
- put (PUT_CONSTR id) = putWord8 6 >> put id
- put (PUT_CLOSURE l) = putWord8 7 >> put l
- put (PUT_INT n) = putWord8 8 >> put n
- put (PUT_STR s) = putWord8 9 >> put s
- put (PUT_FLT d) = putWord8 10 >> put d
- put (SET_VALUE n) = putWord8 11 >> put n
- put (SET_VARIABLE n) = putWord8 12 >> put n
- put (PUSH_VALUE n)= putWord8 13 >> put n
- put (PUSH_VARIABLE n)= putWord8 14 >> put n
- put (TAIL_CALL id) = putWord8 15 >> put id
- put (FAIL ) = putWord8 16
- put (RET n) = putWord8 17 >> put n
+ 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 (PUSH_VALUE n) = putWord8 17 >> put n
+ put (PUSH_ARG_VAR n) = putWord8 18 >> put n
+ put (PUSH_FREE_VAR n)= putWord8 19 >> put n
+ put (TAIL_CALL id) = putWord8 20 >> put id
+ put (FAIL ) = putWord8 21
+ put (RET n) = putWord8 22 >> put n
instance Binary Type where
diff --git a/src/runtime/haskell/PGF/ByteCode.hs b/src/runtime/haskell/PGF/ByteCode.hs
index bcf21ed9b..2e317d4c0 100644
--- a/src/runtime/haskell/PGF/ByteCode.hs
+++ b/src/runtime/haskell/PGF/ByteCode.hs
@@ -6,46 +6,57 @@ import Text.PrettyPrint
type CodeLabel = Int
data Instr
- = EVAL {-# UNPACK #-} !Int
+ = 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
| 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_VARIABLE {-# UNPACK #-} !Int
- | PUSH_VALUE {-# UNPACK #-} !Int
- | PUSH_VARIABLE {-# UNPACK #-} !Int
+ | SET_VALUE {-# UNPACK #-} !Int
+ | SET_ARG_VAR {-# UNPACK #-} !Int
+ | SET_FREE_VAR {-# UNPACK #-} !Int
+ | PUSH_VALUE {-# UNPACK #-} !Int
+ | PUSH_ARG_VAR {-# UNPACK #-} !Int
+ | PUSH_FREE_VAR {-# UNPACK #-} !Int
| TAIL_CALL CId
+ | UPDATE
| FAIL
| RET {-# UNPACK #-} !Int
-ppCode :: CodeLabel -> [Instr] -> Doc
-ppCode l [] = empty
-ppCode l (i:is) = ppLabel l <+> ppInstr l i $$ ppCode (l+1) is
+ppCode :: Int -> [[Instr]] -> Doc
+ppCode l [] = empty
+ppCode l (is:iss) = ppLabel l <+> vcat (map ppInstr is) $$ ppCode (l+1) iss
-ppInstr l (EVAL n) = text "EVAL " <+> int n
-ppInstr l (CASE id o ) = text "CASE " <+> ppCId id <+> ppLabel (l+o+1)
-ppInstr l (CASE_INT n o ) = text "CASE_INT " <+> int n <+> ppLabel (l+o+1)
-ppInstr l (CASE_STR s o ) = text "CASE_STR " <+> text (show s) <+> ppLabel (l+o+1)
-ppInstr l (CASE_FLT d o ) = text "CASE_FLT " <+> double d <+> ppLabel (l+o+1)
-ppInstr l (ALLOC n) = text "ALLOC " <+> int n
-ppInstr l (PUT_CONSTR id) = text "PUT_CONSTR " <+> ppCId id
-ppInstr l (PUT_CLOSURE c) = text "PUT_CLOSURE " <+> ppLabel c
-ppInstr l (PUT_INT n ) = text "PUT_INT " <+> int n
-ppInstr l (PUT_STR s ) = text "PUT_STR " <+> text (show s)
-ppInstr l (PUT_FLT d ) = text "PUT_FLT " <+> double d
-ppInstr l (SET_VALUE n) = text "SET_VALUE " <+> int n
-ppInstr l (SET_VARIABLE n) = text "SET_VARIABLE" <+> int n
-ppInstr l (PUSH_VALUE n) = text "PUSH_VALUE " <+> int n
-ppInstr l (PUSH_VARIABLE n)= text "PUSH_VARIABLE"<+> int n
-ppInstr l (TAIL_CALL id) = text "TAIL_CALL " <+> ppCId id
-ppInstr l (FAIL ) = text "FAIL"
-ppInstr l (RET n) = text "RET " <+> int n
+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 (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 (FAIL ) = text "FAIL"
+ppInstr (RET n) = text "RET " <+> int n
-ppLabel l = text (let s = show l in replicate (4-length s) '0' ++ s)
+ppLabel l = text (let s = show l in replicate (3-length s) '0' ++ s)
diff --git a/src/runtime/haskell/PGF/Data.hs b/src/runtime/haskell/PGF/Data.hs
index 76dbc616a..e9263cc1c 100644
--- a/src/runtime/haskell/PGF/Data.hs
+++ b/src/runtime/haskell/PGF/Data.hs
@@ -28,11 +28,11 @@ data PGF = PGF {
data Abstr = Abstr {
aflags :: Map.Map CId Literal, -- ^ value of a flag
- funs :: Map.Map CId (Type,Int,Maybe ([Equation],[Instr]),Double),-- ^ type, arrity and definition of function + probability
- cats :: Map.Map CId ([Hypo],[(Double, CId)],Double) -- ^ 1. context of a category
- -- 2. functions of a category. The functions are stored
- -- in decreasing probability order.
- -- 3. probability
+ funs :: Map.Map CId (Type,Int,Maybe ([Equation],[[Instr]]),Double),-- ^ type, arrity and definition of function + probability
+ cats :: Map.Map CId ([Hypo],[(Double, CId)],Double) -- ^ 1. context of a category
+ -- 2. functions of a category. The functions are stored
+ -- in decreasing probability order.
+ -- 3. probability
}
data Concr = Concr {
diff --git a/src/runtime/haskell/PGF/Expr.hs b/src/runtime/haskell/PGF/Expr.hs
index 0b4ccc554..80a615e67 100644
--- a/src/runtime/haskell/PGF/Expr.hs
+++ b/src/runtime/haskell/PGF/Expr.hs
@@ -325,8 +325,8 @@ data Value
| VClosure Env Expr
| VImplArg Value
-type Sig = ( Map.Map CId (Type,Int,Maybe ([Equation],[Instr]),Double) -- type and def of a fun
- , Int -> Maybe Expr -- lookup for metavariables
+type Sig = ( Map.Map CId (Type,Int,Maybe ([Equation],[[Instr]]),Double) -- type and def of a fun
+ , Int -> Maybe Expr -- lookup for metavariables
)
type Env = [Value]
diff --git a/src/runtime/haskell/PGF/Printer.hs b/src/runtime/haskell/PGF/Printer.hs
index 1aabce09d..a9985cdeb 100644
--- a/src/runtime/haskell/PGF/Printer.hs
+++ b/src/runtime/haskell/PGF/Printer.hs
@@ -29,13 +29,13 @@ ppFlag flag value = text "flag" <+> ppCId flag <+> char '=' <+> ppLit value <+>
ppCat :: CId -> ([Hypo],[(Double,CId)],Double) -> Doc
ppCat c (hyps,_,_) = text "cat" <+> ppCId c <+> hsep (snd (mapAccumL (ppHypo 4) [] hyps)) <+> char ';'
-ppFun :: CId -> (Type,Int,Maybe ([Equation],[Instr]),Double) -> Doc
+ppFun :: CId -> (Type,Int,Maybe ([Equation],[[Instr]]),Double) -> Doc
ppFun f (t,_,Just (eqs,code),_) = text "fun" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';' $$
- if null eqs
- then empty
- else text "def" <+> vcat [let scope = foldl pattScope [] patts
- ds = map (ppPatt 9 scope) patts
- in ppCId f <+> hsep ds <+> char '=' <+> ppExpr 0 scope res <+> char ';' | Equ patts res <- eqs] $$
+ (if null eqs
+ then empty
+ else text "def" <+> vcat [let scope = foldl pattScope [] patts
+ ds = map (ppPatt 9 scope) patts
+ in ppCId f <+> hsep ds <+> char '=' <+> ppExpr 0 scope res <+> char ';' | Equ patts res <- eqs]) $$
ppCode 0 code
ppFun f (t,_,Nothing,_) = text "data" <+> ppCId f <+> colon <+> ppType 0 [] t <+> char ';'