diff options
| author | kr.angelov <kr.angelov@gmail.com> | 2014-09-05 10:09:43 +0000 |
|---|---|---|
| committer | kr.angelov <kr.angelov@gmail.com> | 2014-09-05 10:09:43 +0000 |
| commit | 86b5f78c579ce5fcc9c96370644c41c35a421070 (patch) | |
| tree | 8a3034c3e366c901f8bb06ee3733d096fdb8b95a /src/runtime | |
| parent | a21ffc194185165ab487e0553cd5c4d0a36a8a9d (diff) | |
full support for recursive def rules in the C runtime
Diffstat (limited to 'src/runtime')
| -rw-r--r-- | src/runtime/c/pgf/data.h | 11 | ||||
| -rw-r--r-- | src/runtime/c/pgf/jit.c | 528 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/Binary.hs | 41 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/ByteCode.hs | 65 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/Data.hs | 10 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/Expr.hs | 4 | ||||
| -rw-r--r-- | src/runtime/haskell/PGF/Printer.hs | 12 |
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 ';' |
