diff --git a/src/compiler/GF/Compile/GenerateBC.hs b/src/compiler/GF/Compile/GenerateBC.hs index bab6cd4f4..0e26994fe 100644 --- a/src/compiler/GF/Compile/GenerateBC.hs +++ b/src/compiler/GF/Compile/GenerateBC.hs @@ -64,7 +64,10 @@ compileEquations gr st (i:is) eqs bs = whilePP eqs Map.empty compileBody gr st avs fvs e bs es = let (heap,bs1,instrs) = compileFun gr st avs fvs e 0 bs es - in (bs1,(if heap > 0 then (ALLOC heap :) else id) (instrs ++ [RET st])) + in (bs1,((if heap > 0 then (ALLOC heap :) else id) . + (instrs ++) . + (if st == 0 then (UPDATE :) else id)) + [RET st]) compileFun gr st avs fvs (App e1 e2) h0 bs es = compileFun gr st avs fvs e1 h0 bs (e2:es) @@ -110,11 +113,14 @@ compileArg gr st st0 avs fvs e@(Q(m,id)) h0 bs es = Ok (_,Just _) -> if null es then let h1 = h0 + 2 - in (h1,bs,SET_VALUE h0,PUSH_VALUE h0,[PUT_FUN (i2i id)]) + in (h1,bs,SET_VALUE h0,PUSH_VALUE h0,[PUT_FUN (i2i id),SET_PAD]) else let es_fvs = nub (foldr freeVars [] es) - h1 = h0 + 1 + length es_fvs + h1 = h0 + 1 + length is (bs1,b) = compileBody gr 0 [] (zip es_fvs [0..]) e bs es - in (h1,(ENTER:b):bs1,SET_VALUE h0,PUSH_VALUE h0,PUT_CLOSURE (length bs) : map (fst . compileVar st st0 avs fvs) es_fvs) + is = if null es_fvs + then [SET_PAD] + else map (fst . compileVar st st0 avs fvs) es_fvs + in (h1,(ENTER:b):bs1,SET_VALUE h0,PUSH_VALUE h0,PUT_CLOSURE (length bs) : is) _ -> let h1 = h0 + 2 + length es (h2,bs2,is1,is2,is3) = compileArgs gr st st avs fvs h1 bs es in (h2,bs2,SET_VALUE h0,PUSH_VALUE h0,PUT_CONSTR (i2i id) : is1 ++ is3) diff --git a/src/runtime/c/pgf/data.h b/src/runtime/c/pgf/data.h index f2e646a50..d725a052b 100644 --- a/src/runtime/c/pgf/data.h +++ b/src/runtime/c/pgf/data.h @@ -121,11 +121,13 @@ typedef enum { PGF_INSTR_SET_VALUE, PGF_INSTR_SET_ARG_VAR, PGF_INSTR_SET_FREE_VAR, + PGF_INSTR_SET_PAD, PGF_INSTR_PUSH_VALUE, PGF_INSTR_PUSH_ARG_VAR, PGF_INSTR_PUSH_FREE_VAR, PGF_INSTR_TAIL_CALL, PGF_INSTR_FAIL, + PGF_INSTR_UPDATE, PGF_INSTR_RET } PgfInstruction; diff --git a/src/runtime/c/pgf/evaluator.c b/src/runtime/c/pgf/evaluator.c index fca499a98..0e94792d0 100644 --- a/src/runtime/c/pgf/evaluator.c +++ b/src/runtime/c/pgf/evaluator.c @@ -40,7 +40,7 @@ typedef struct { PgfLiteral lit; } PgfValueLit; -static PgfClosure* +PgfClosure* pgf_evaluate_indirection(PgfEvalState* state, PgfClosure* closure) { PgfIndirection* indir = (PgfIndirection*) closure; diff --git a/src/runtime/c/pgf/evaluator.h b/src/runtime/c/pgf/evaluator.h index b2cffd167..6a24b72c7 100644 --- a/src/runtime/c/pgf/evaluator.h +++ b/src/runtime/c/pgf/evaluator.h @@ -23,6 +23,9 @@ typedef struct { PgfClosure* args[]; } PgfValue; +PgfClosure* +pgf_evaluate_indirection(PgfEvalState* state, PgfClosure* closure); + PgfClosure* pgf_evaluate_value(PgfEvalState* state, PgfClosure* closure); diff --git a/src/runtime/c/pgf/jit.c b/src/runtime/c/pgf/jit.c index 24e9ee0d8..77ef98399 100644 --- a/src/runtime/c/pgf/jit.c +++ b/src/runtime/c/pgf/jit.c @@ -405,6 +405,13 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr, 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); @@ -572,6 +579,27 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr, curr_offset++; break; } + case PGF_INSTR_SET_FREE_VAR: { + size_t index = pgf_read_int(rdr); +#ifdef PGF_JIT_DEBUG + gu_printf(out, err, "SET_FREE_VAR %d\n", index); +#endif + + jit_getarg_p(JIT_V0, closure_arg); + jit_ldxi_p(JIT_V0, JIT_V0, sizeof(PgfClosure)+index*sizeof(PgfClosure*)); + jit_stxi_p(curr_offset*sizeof(void*), JIT_V1, JIT_V0); + curr_offset++; + break; + } + case PGF_INSTR_SET_PAD: { +#ifdef PGF_JIT_DEBUG + gu_printf(out, err, "SET_PAD\n"); +#endif + jit_movi_p(JIT_V0, NULL); + 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 @@ -649,6 +677,17 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr, gu_printf(out, err, "FAIL\n"); #endif break; + case PGF_INSTR_UPDATE: { +#ifdef PGF_JIT_DEBUG + gu_printf(out, err, "UPDATE\n"); +#endif + + jit_getarg_p(JIT_V0, closure_arg); + jit_movi_p(JIT_V2, pgf_evaluate_indirection); + jit_stxi_p(0, JIT_V0, JIT_V2); + jit_stxi_p(sizeof(PgfClosure), JIT_V0, JIT_V1); + break; + } case PGF_INSTR_RET: { size_t count = pgf_read_int(rdr); diff --git a/src/runtime/haskell/PGF/Binary.hs b/src/runtime/haskell/PGF/Binary.hs index 2064e9a3b..64707f386 100644 --- a/src/runtime/haskell/PGF/Binary.hs +++ b/src/runtime/haskell/PGF/Binary.hs @@ -153,12 +153,14 @@ instance Binary Instr where 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 + 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 instance Binary Type where diff --git a/src/runtime/haskell/PGF/ByteCode.hs b/src/runtime/haskell/PGF/ByteCode.hs index 2e317d4c0..158de0358 100644 --- a/src/runtime/haskell/PGF/ByteCode.hs +++ b/src/runtime/haskell/PGF/ByteCode.hs @@ -23,12 +23,13 @@ data Instr | SET_VALUE {-# UNPACK #-} !Int | SET_ARG_VAR {-# UNPACK #-} !Int | SET_FREE_VAR {-# UNPACK #-} !Int + | SET_PAD | PUSH_VALUE {-# UNPACK #-} !Int | PUSH_ARG_VAR {-# UNPACK #-} !Int | PUSH_FREE_VAR {-# UNPACK #-} !Int | TAIL_CALL CId - | UPDATE | FAIL + | UPDATE | RET {-# UNPACK #-} !Int ppCode :: Int -> [[Instr]] -> Doc @@ -52,11 +53,13 @@ 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 (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 (FAIL ) = text "FAIL" +ppInstr (UPDATE ) = text "UPDATE" ppInstr (RET n) = text "RET " <+> int n ppLabel l = text (let s = show l in replicate (3-length s) '0' ++ s)