diff options
| -rw-r--r-- | Sjit/Compile.dcl | 17 | ||||
| -rw-r--r-- | Sjit/Compile.icl | 43 | ||||
| -rw-r--r-- | Sjit/Run.dcl | 1 | ||||
| -rw-r--r-- | Sjit/Run.icl | 51 | ||||
| -rw-r--r-- | Sjit/Syntax.icl | 22 | ||||
| -rw-r--r-- | sjit_c.c | 118 | ||||
| -rw-r--r-- | test/fib.test | 2 | ||||
| -rw-r--r-- | test/tak.result | 1 | ||||
| -rw-r--r-- | test/tak.test | 2 |
9 files changed, 139 insertions, 118 deletions
diff --git a/Sjit/Compile.dcl b/Sjit/Compile.dcl index d373e42..e630178 100644 --- a/Sjit/Compile.dcl +++ b/Sjit/Compile.dcl @@ -13,17 +13,24 @@ from Sjit.Syntax import :: Function | Call !Int | Jmp !Int - | JmpTrue !Int + | JmpCond !Cond !Int | Ret | Halt - | IAdd - | IMul - | ISub - | IDiv + | Op !Op | PlaceHolder !Int !Int // only used during compilation +:: Op + = OAdd | OMul + | OSub | ODiv + +:: Cond + = CEq | CNe + | CLt | CLe + | CGt | CGe + | CTrue + :: Program :== {!Instr} :: CompileState = diff --git a/Sjit/Compile.icl b/Sjit/Compile.icl index 527676f..b5ea1bf 100644 --- a/Sjit/Compile.icl +++ b/Sjit/Compile.icl @@ -98,13 +98,10 @@ where Pop n -> 0-n Call _ -> 0 Jmp _ -> 0 - JmpTrue _ -> 0 + JmpCond c _ -> if (c=:CTrue) -1 -2 Ret -> -1 Halt -> -2 - IAdd -> -1 - IMul -> -1 - ISub -> -1 - IDiv -> -1 + Op _ -> -1 PlaceHolder _ n -> n reserve :: !Int !CompileState -> m (!Int, !CompileState) | Monad m @@ -152,20 +149,38 @@ where # args = if (args=:[]) [Int 0] args = foldM (flip expr) cs (reverse args) >>= \cs -> case get f cs.funs of Nothing -> case f of - "+" -> gen [IAdd] cs - "-" -> gen [ISub] cs - "*" -> gen [IMul] cs - "/" -> gen [IDiv] cs - _ -> Left ("undefined function '" +++ toString f +++ "'") + "+" -> gen [Op OAdd] cs + "-" -> gen [Op OSub] cs + "*" -> gen [Op OMul] cs + "/" -> gen [Op ODiv] cs + _ -> Left ("undefined function '" +++ toString f +++ "'") Just f -> case length args of 1 -> gen [Call f] cs n -> gen [Pop (n-1),Call f] cs + expr (If (App cond [a,b]) t e) cs | isJust condop = + expr a cs >>= + expr b >>= + reserve -2 >>= \(jmpcond,cs=:{sp=orgsp}) -> + expr e cs >>= + reserve 0 >>= \(jmpend,cs) -> + fillPlaceHolder jmpcond (JmpCond (fromJust condop) cs.pc) {cs & sp=orgsp} >>= + expr t >>= \cs -> + fillPlaceHolder jmpend (Jmp cs.pc) cs + where + condop = case cond of + "==" -> Just CEq + "<>" -> Just CNe + "<" -> Just CLt + "<=" -> Just CLe + ">" -> Just CGt + ">=" -> Just CGe + _ -> Nothing expr (If b t e) cs = expr b cs >>= - reserve -1 >>= \(jmptrue,cs=:{sp=orgsp}) -> + reserve -1 >>= \(jmpcond,cs=:{sp=orgsp}) -> expr e cs >>= reserve 0 >>= \(jmpend,cs) -> - fillPlaceHolder jmptrue (JmpTrue cs.pc) {cs & sp=orgsp} >>= + fillPlaceHolder jmpcond (JmpCond CTrue cs.pc) {cs & sp=orgsp} >>= expr t >>= \cs -> fillPlaceHolder jmpend (Jmp cs.pc) cs @@ -198,8 +213,8 @@ gEncode{|EITHER|} _ fr (RIGHT r) i arr = fr r i arr gEncode{|CONS of {gcd_index}|} fx (CONS x) i arr = fx x (i+1) {arr & [i]=gcd_index} gEncode{|OBJECT|} fx (OBJECT x) i arr = fx x i arr -derive gEncodedSize Instr -derive gEncode Instr +derive gEncodedSize Cond, Op, Instr +derive gEncode Cond, Op, Instr encode :: !a -> *{#Int} | gEncodedSize{|*|}, gEncode{|*|} a encode x diff --git a/Sjit/Run.dcl b/Sjit/Run.dcl index aff22fc..371f4f5 100644 --- a/Sjit/Run.dcl +++ b/Sjit/Run.dcl @@ -2,5 +2,4 @@ definition module Sjit.Run from Sjit.Compile import :: CompileState -interpret :: !CompileState -> Int exec :: !CompileState -> Int diff --git a/Sjit/Run.icl b/Sjit/Run.icl index ad03e02..8bd3972 100644 --- a/Sjit/Run.icl +++ b/Sjit/Run.icl @@ -7,57 +7,6 @@ from Data.Map import :: Map(..), get import Sjit.Compile -interpret :: !CompileState -> Int -interpret cs = exec 0 [] -where - prog = get_program cs - sz = size prog - - exec :: !Int ![Int] -> Int - exec i stack - | i < 0 || i >= sz = abort "out of bounds\n" - | otherwise = case prog.[i] of - PushI n -> exec (i+1) [n:stack] - PushRef r -> exec (i+1) [stack!!r:stack] - Put n -> case stack of - [val:stack] -> exec (i+1) (take (n-1) stack ++ [val:drop n stack]) - Pop n -> exec (i+1) (drop n stack) - Call f -> exec f [i+1:stack] - Jmp f -> exec f stack - JmpTrue f -> case stack of - [0:stack] -> exec (i+1) stack - [_:stack] -> exec f stack - Ret -> case stack of - [ret:stack] -> exec ret stack - Halt -> case stack of - [r] -> r - _ -> abort (toString (length stack) +++ " values left on stack\n") - - IAdd -> case stack of - [a:b:stack] -> exec (i+1) [a+b:stack] - IMul -> case stack of - [a:b:stack] -> exec (i+1) [a*b:stack] - ISub -> case stack of - [a:b:stack] -> exec (i+1) [a-b:stack] - IDiv -> case stack of - [a:b:stack] -> exec (i+1) [a/b:stack] - - get_program :: !CompileState -> Program - get_program cs - # prog = loop 0 cs.blocks (createArray (sum [size b \\ b <|- cs.blocks]) Halt) - # prog & [1] = Call (fromJust (get "main" cs.funs)) - = prog - where - loop :: !Int ![!Program!] !*Program -> .Program - loop i [!b:bs!] prog - # (i,prog) = copy i 0 (size b-1) b prog - = loop i bs prog - where - copy :: !Int !Int !Int !Program !*Program -> *(!Int, !*Program) - copy i _ -1 _ prog = (i, prog) - copy i bi n b prog = copy (i+1) (bi+1) (n-1) b {prog & [i]=b.[bi]} - loop _ [!!] prog = prog - exec :: !CompileState -> Int exec {jitst} = exec jitst.code_start where diff --git a/Sjit/Syntax.icl b/Sjit/Syntax.icl index 90aeb39..e382696 100644 --- a/Sjit/Syntax.icl +++ b/Sjit/Syntax.icl @@ -5,9 +5,12 @@ import StdEnv import Control.Applicative import Control.Monad import Data.Either +from Data.Foldable import class Foldable(foldr1) from Data.Func import $ import Data.Functor import Data.GenEq +from Data.List import instance Foldable [] +import Data.Maybe import Text.Parsers.Simple.Core :: Token @@ -60,13 +63,15 @@ where n | isFunnyIdent n # (i,n) = readIdent isFunnyIdent [] i e s - -> lex [TIdent n:tks] i e s + # tk = case n of + "=" -> TEq + n -> TIdent n + -> lex [tk:tks] i e s n | isDigit n # (i,n) = readInt [] i e s -> lex [TInt n:tks] i e s - '=' -> lex [TEq: tks] (i+1) e s ',' -> lex [TComma: tks] (i+1) e s '(' -> lex [TParenOpen: tks] (i+1) e s ')' -> lex [TParenClose:tks] (i+1) e s @@ -77,7 +82,7 @@ where isIdent c = isAlpha c || c == '_' isFunnyIdent :: !Char -> Bool - isFunnyIdent c = isMember c ['+-*/'] + isFunnyIdent c = isMember c ['+-*/<>='] readIdent :: !(Char -> Bool) ![Char] !Int !Int !String -> (!Int, !String) readIdent ok cs i e s @@ -102,12 +107,19 @@ where expr :: Parser Token Expr expr - = leftAssoc (tok "+" <|> tok "-") - $ leftAssoc (tok "*" <|> tok "/") + = rightAssoc (toks ["==","<>","<","<=",">",">="]) + $ leftAssoc (toks ["+","-"]) + $ leftAssoc (toks ["*","/"]) $ noInfix where tok :: !String -> Parser Token String tok s = pToken (TIdent s) $> s + toks = foldr1 (<|>) o map tok + + rightAssoc :: !(Parser Token String) !(Parser Token Expr) -> Parser Token Expr + rightAssoc opp exprp = exprp >>= \e1 -> + optional (opp >>= \op -> rightAssoc opp exprp >>= \e -> pure (op,e)) >>= + pure o maybe e1 (\(op,e2) -> App op [e1,e2]) leftAssoc :: !(Parser Token String) !(Parser Token Expr) -> Parser Token Expr leftAssoc opp exprp = exprp >>= \e1 -> @@ -12,18 +12,27 @@ enum instr { Call, Jmp, - JmpTrue, + JmpCond, Ret, Halt, - IAdd, - IMul, - ISub, - IDiv + Op }; -static inline uint32_t instr_size(enum instr instr) { - switch (instr) { +enum op { + OAdd, OMul, + OSub, ODiv +}; + +enum cond { + CEq, CNe, + CLt, CLe, + CGt, CGe, + CTrue +}; + +static inline uint32_t instr_size(uint64_t *pgm) { + switch (*pgm) { case PushRef: return 5+1; case PushI: return 7+1; case Put: return 1+5; @@ -31,17 +40,25 @@ static inline uint32_t instr_size(enum instr instr) { case Call: return 5; case Jmp: return 5; - case JmpTrue: return 1+3+6; + case JmpCond: switch (pgm[1]) { + case CTrue: return 1+3+6; + default: return 1+1+3+6; + } case Ret: return 1; case Halt: return 1+1; - case IAdd: - case ISub: return 1+4+3+4; - case IMul: return 1+4+4+4; - case IDiv: return 1+4+3+3+4; + case Op: switch (pgm[1]) { + case OAdd: + case OSub: return 1+4+3+4; + case OMul: return 1+4+4+4; + case ODiv: return 1+4+3+3+4; + default: + fprintf(stderr,"unknown operator %d\n",(int)pgm[1]); + exit(1); + } default: - fprintf(stderr,"unknown instruction %d\n",instr); + fprintf(stderr,"unknown instruction %d\n",(int)*pgm); exit(1); } } @@ -127,21 +144,41 @@ static inline void gen_instr(char *full_code, char **code_p, uint64_t **pgm_p, u pgm+=2; code+=5; break; - case JmpTrue: - arg=pgm[1]; + case JmpCond: + { + enum cond cond=pgm[1]; + arg=pgm[2]; #ifdef DEBUG_JIT_INSTRUCTIONS - fprintf(stderr,"JmpTrue %lu -> %d\n",arg,mapping[arg]-(uint32_t)(&code[10]-full_code)); + fprintf(stderr,"JmpCond %d %lu -> %d\n",(int)cond,arg,mapping[arg]-(uint32_t)(&code[10]-full_code)); #endif code[0]='\x59'; /* pop rcx */ - code[1]='\x48'; /* test rcx,rcx */ - code[2]='\x85'; - code[3]='\xc9'; - code[4]='\x0f'; /* jne ARG */ - code[5]='\x85'; - *(uint32_t*)&code[6]=mapping[arg]-(&code[10]-full_code); - pgm+=2; - code+=10; + if (cond==CTrue) { + code[1]='\x48'; /* test rcx,rcx */ + code[2]='\x85'; + code[3]='\xc9'; + code+=4; + } else { + code[1]='\x58'; /* pop rax */ + code[2]='\x48'; /* cmp rax,rcx */ + code[3]='\x3b'; + code[4]='\xc1'; + code+=5; + } + code[0]='\x0f'; /* jcc */ + switch (cond) { + case CEq: code[1]='\x84'; break; + case CTrue: + case CNe: code[1]='\x85'; break; + case CLt: code[1]='\x8c'; break; + case CLe: code[1]='\x8e'; break; + case CGt: code[1]='\x8f'; break; + case CGe: code[1]='\x8d'; break; + } + *(uint32_t*)&code[2]=mapping[arg]-(&code[6]-full_code); + pgm+=3; + code+=6; break; + } case Ret: #ifdef DEBUG_JIT_INSTRUCTIONS fprintf(stderr,"Ret\n"); @@ -160,32 +197,30 @@ static inline void gen_instr(char *full_code, char **code_p, uint64_t **pgm_p, u code+=2; break; - case IAdd: - case IMul: - case ISub: - case IDiv: + case Op: + arg=pgm[1]; #ifdef DEBUG_JIT_INSTRUCTIONS - fprintf(stderr,"I<Op>\n"); + fprintf(stderr,"Op %d\n",(int)arg); #endif /* pop rax */ code[0]='\x58'; /* mov rcx,[rsp] */ code[1]='\x48'; code[2]='\x8b'; code[3]='\x0c'; code[4]='\x24'; - switch (*pgm) { - case IAdd: - case ISub: + switch (arg) { + case OAdd: + case OSub: /* {add,sub} rax,rcx */ code[5]='\x48'; - code[6]=*pgm==IAdd ? '\x01' : '\x29'; + code[6]=arg==OAdd ? '\x01' : '\x29'; code[7]='\xc8'; code+=8; break; - case IMul: + case OMul: /* imul rax,rcx */ code[5]='\x48'; code[6]='\x0f'; code[7]='\xaf'; code[8]='\xc1'; code+=9; break; - case IDiv: + case ODiv: /* xor rdx,rdx */ code[5]='\x48'; code[6]='\x31'; code[7]='\xd2'; /* idiv rcx */ @@ -195,7 +230,7 @@ static inline void gen_instr(char *full_code, char **code_p, uint64_t **pgm_p, u } /* mov [rsp],rax */ code[0]='\x48'; code[1]='\x89'; code[2]='\x04'; code[3]='\x24'; - pgm++; + pgm+=2; code+=4; break; @@ -222,19 +257,20 @@ char *jit_append(char *code_block, uint32_t code_len, char *code_ptr, uint64_t *pgm_p=pgm; for (i=n_instr; i<n_instr+len; i++) { - enum instr instr=(enum instr)*pgm_p; - mapping[i]=code_i; - code_i+=instr_size(instr); + code_i+=instr_size(pgm_p); - switch (instr) { + switch (*pgm_p) { + case JmpCond: + pgm_p+=3; + break; case PushRef: case PushI: case Put: case Pop: case Call: case Jmp: - case JmpTrue: + case Op: pgm_p+=2; break; default: diff --git a/test/fib.test b/test/fib.test index cb5a5fa..e005688 100644 --- a/test/fib.test +++ b/test/fib.test @@ -1,2 +1,2 @@ -fib n = if n (if (n-1) (fib(n-1) + fib(n-2)) 1) 1 +fib n = if (n < 2) 1 (fib(n-1) + fib(n-2)) fib(30) diff --git a/test/tak.result b/test/tak.result new file mode 100644 index 0000000..ec63514 --- /dev/null +++ b/test/tak.result @@ -0,0 +1 @@ +9 diff --git a/test/tak.test b/test/tak.test new file mode 100644 index 0000000..62a86b0 --- /dev/null +++ b/test/tak.test @@ -0,0 +1,2 @@ +tak x y z = if (x <= y) z tak(tak(x-1,y,z), tak(y-1,z,x), tak(z-1,x,y)) +tak(24,16,8) |