msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

using instruction RET was wrong; now use EVAL

Browse Source
This commit is contained in:
kr.angelov
2014-10-06 15:57:42 +00:00
parent 2bc0734b6e
commit 8d09f62efc
5 changed files with 11 additions and 46 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
src/compiler/GF/Compile/GenerateBC.hs
View File

@@ -101,10 +101,10 @@ compileFun gr arity st vs (Q (m,id)) h0 bs args =
diff = c_arity-n_args
in if diff <= 0
then let h1 = h0 + 2 + n_args
in (h1,bs,PUT_CONSTR (i2i id):is1++[RET h0 (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
in (h1,bs,PUT_CONSTR (i2i id):is1++[EVAL (HEAP h0) (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
else let h1 = h0 + 1 + n_args
is2 = [SET (FREE_VAR i) | i <- [0..n_args-1]] ++ [SET (ARG_VAR (i+1)) | i <- [0..diff-1]]
b = CHECK_ARGS diff : ALLOC (c_arity+2) : PUT_CONSTR (i2i id) : is2 ++ [RET h0 (TailCall diff (diff+1) (diff+1))]
b = CHECK_ARGS diff : ALLOC (c_arity+2) : PUT_CONSTR (i2i id) : is2 ++ [EVAL (HEAP h0) (TailCall diff (diff+1) (diff+1))]
in (h1,b:bs,PUT_CLOSURE (length bs):is1++[EVAL (HEAP h0) (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
compileFun gr arity st vs (QC qid) h0 bs args =
compileFun gr arity st vs (Q qid) h0 bs args
@@ -114,13 +114,13 @@ compileFun gr arity st vs (Vr x) h0 bs args =
in (h0,bs,is1++[EVAL arg (if arity == 0 then (UpdateCall st st1) else (TailCall arity st st1))])
compileFun gr arity st vs (EInt n) h0 bs _ =
let h1 = h0 + 2
in (h1,bs,[PUT_LIT (LInt n), RET h0 (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
in (h1,bs,[PUT_LIT (LInt n), EVAL (HEAP h0) (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
compileFun gr arity st vs (K s) h0 bs _ =
let h1 = h0 + 2
in (h1,bs,[PUT_LIT (LStr s), RET h0 (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
in (h1,bs,[PUT_LIT (LStr s), EVAL (HEAP h0) (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
compileFun gr arity st vs (EFloat d) h0 bs _ =
let h1 = h0 + 2
in (h1,bs,[PUT_LIT (LFlt d), RET h0 (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
in (h1,bs,[PUT_LIT (LFlt d), EVAL (HEAP h0) (if arity == 0 then (UpdateCall st st) else (TailCall arity st st))])
compileFun gr arity st vs (Typed e _) h0 bs args =
compileFun gr arity st vs e h0 bs args
compileFun gr arity st vs (Let (x, (_, e1)) e2) h0 bs args =
@@ -139,7 +139,7 @@ compileArg gr st vs (Q(m,id)) h0 bs =
in if c_arity == 0
then (h1,bs,HEAP h0,[PUT_CONSTR (i2i id)])
else let is2 = [SET (ARG_VAR (i+1)) | i <- [0..c_arity-1]]
b = CHECK_ARGS c_arity : ALLOC (c_arity+2) : PUT_CONSTR (i2i id) : is2 ++ [RET h0 (TailCall c_arity (c_arity+1) (c_arity+1))]
b = CHECK_ARGS c_arity : ALLOC (c_arity+2) : PUT_CONSTR (i2i id) : is2 ++ [EVAL (HEAP h0) (TailCall c_arity (c_arity+1) (c_arity+1))]
in (h1,b:bs,HEAP h0,[PUT_CLOSURE (length bs),SET_PAD])
compileArg gr st vs (QC qid) h0 bs =
compileArg gr st vs (Q qid) h0 bs
@@ -185,7 +185,7 @@ compileArg gr st vs e h0 bs =
in (h2,bs1,HEAP h1,is1 ++ (PUT_CONSTR (i2i id) : is2))
else let h2 = h1 + 1 + n_args
is2 = [SET (FREE_VAR i) | i <- [0..n_args-1]] ++ [SET (ARG_VAR (i+1)) | i <- [0..diff-1]]
b = CHECK_ARGS diff : ALLOC (c_arity+2) : PUT_CONSTR (i2i id) : is2 ++ [RET h0 (TailCall diff (diff+1) (diff+1))]
b = CHECK_ARGS diff : ALLOC (c_arity+2) : PUT_CONSTR (i2i id) : is2 ++ [EVAL (HEAP h0) (TailCall diff (diff+1) (diff+1))]
in (h2,b:bs1,HEAP h1,is1 ++ (PUT_CLOSURE (length bs):is2))
Nothing -> compileLambda gr st vs [] e h0 bs

5
src/runtime/c/pgf/data.h
View File

@@ -118,9 +118,8 @@ typedef enum {
PGF_INSTR_SET_PAD = 8,
PGF_INSTR_PUSH = 9,
PGF_INSTR_EVAL = 10,
PGF_INSTR_RET = 13,
PGF_INSTR_DROP = 15,
PGF_INSTR_FAIL = 16
PGF_INSTR_DROP = 13,
PGF_INSTR_FAIL = 14
} PgfInstruction;
struct PgfPGF {

29
src/runtime/c/pgf/jit.c
View File

@@ -1085,35 +1085,6 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
}
break;
}
case PGF_INSTR_RET: {
size_t h = pgf_read_int(rdr);
if (h > 0)
jit_addi_p(JIT_VHEAP, JIT_VHEAP, h*sizeof(PgfClosure*));
size_t a, b;
if (mod == 1) {
a = pgf_read_int(rdr);
b = pgf_read_int(rdr);
#ifdef PGF_JIT_DEBUG
gu_printf(out, err, "RET hp(%d) tail(%d,%d)\n", h, a, b);
#endif
} else {
a = 0;
b = pgf_read_int(rdr);
#ifdef PGF_JIT_DEBUG
gu_printf(out, err, "RET hp(%d) update(%d)\n", h, b);
#endif
jit_movi_p(JIT_R0, abstr->eval_gates->evaluate_indirection);
jit_str_p(JIT_VCLOS, JIT_R0);
jit_stxi_p(offsetof(PgfIndirection,val), JIT_VCLOS, JIT_VHEAP);
}
if (b-(a+1) > 0)
jit_addi_p(JIT_SP, JIT_SP, (b-(a+1))*sizeof(PgfClosure*));
jit_bare_ret(a*sizeof(PgfClosure*));
break;
}
case PGF_INSTR_DROP: {
size_t n = pgf_read_int(rdr);
size_t target = pgf_read_int(rdr);

6
src/runtime/haskell/PGF/Binary.hs
View File

@@ -168,10 +168,8 @@ instance Binary Instr where
put (EVAL (ARG_VAR n) (UpdateCall b c)) = putWord8 49 >> put n >> put (b,c)
put (EVAL (FREE_VAR n) (UpdateCall b c)) = putWord8 50 >> put n >> put (b,c)
put (EVAL (GLOBAL id) (UpdateCall b c)) = putWord8 51 >> put id >> put (b,c)
put (RET h (TailCall a b c)) = putWord8 53 >> put h >> put a >> put b
put (RET h (UpdateCall b c)) = putWord8 54 >> put h >> put b
put (DROP n l ) = putWord8 60 >> put (n,l)
put (FAIL ) = putWord8 64
put (DROP n l ) = putWord8 52 >> put (n,l)
put (FAIL ) = putWord8 56
instance Binary Type where
put (DTyp hypos cat exps) = put (hypos,cat,exps)

3
src/runtime/haskell/PGF/ByteCode.hs
View File

@@ -26,7 +26,6 @@ data Instr
| SET_PAD
| PUSH IVal
| EVAL IVal TailInfo
| RET {-# UNPACK #-} !Int TailInfo
| DROP {-# UNPACK #-} !Int {-# UNPACK #-} !CodeLabel
| FAIL
@@ -60,8 +59,6 @@ ppInstr (SET v) = text "SET " <+> ppIVal v
ppInstr (SET_PAD ) = text "SET_PAD"
ppInstr (PUSH v) = text "PUSH " <+> ppIVal v
ppInstr (EVAL v ti) = text "EVAL " <+> ppIVal v <+> ppTailInfo ti
ppInstr (RET h (TailCall a b c)) = text "RET " <+> ppIVal (HEAP h) <+> text "tail" <> parens (int a <> comma <> int b)
ppInstr (RET h (UpdateCall b c)) = text "RET " <+> ppIVal (HEAP h) <+> text "update" <> parens (int b)
ppInstr (DROP n l ) = text "DROP " <+> int n <+> ppLabel l
ppInstr (FAIL ) = text "FAIL"