diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | Sjit/Compile.dcl | 44 | ||||
| -rw-r--r-- | Sjit/Compile.icl (renamed from sjit.icl) | 129 | ||||
| -rw-r--r-- | Sjit/Run.dcl | 6 | ||||
| -rw-r--r-- | Sjit/Run.icl | 63 | ||||
| -rw-r--r-- | Sjit/Syntax.dcl | 12 | ||||
| -rw-r--r-- | Sjit/Syntax.icl | 1 | ||||
| -rw-r--r-- | isjit.icl | 32 |
9 files changed, 164 insertions, 127 deletions
@@ -1,4 +1,4 @@ *.abc *.o -sjit +isjit @@ -2,7 +2,7 @@ CLM:=clm CLMFLAGS:=-IL Platform -nr -nt override CFLAGS:=-Wall -Wextra -Werror -Ofast $(CFLAGS) -BIN:=sjit +BIN:=isjit all: $(BIN) diff --git a/Sjit/Compile.dcl b/Sjit/Compile.dcl new file mode 100644 index 0000000..4bc1ed5 --- /dev/null +++ b/Sjit/Compile.dcl @@ -0,0 +1,44 @@ +definition module Sjit.Compile + +from Data.Map import :: Map +from Data.Maybe import :: Maybe +from Sjit.Syntax import :: Function + +:: Instr + = PushRef !Int + | PushI !Int + | Put !Int + | Pop !Int + + | Call !Int + | Ret + | Halt + + | IAddRet + | IMulRet + | ISubRet + | IDivRet + +:: Program :== {!Instr} + +:: CompileState = + { vars :: !Map String Int + , funs :: !Map String Int + , sp :: !Int + , pc :: !Int + , blocks :: ![!Program!] + , jitst :: !JITState + } + +:: JITState = + { n_instr :: !Int + , code_start :: !Int + , code_len :: !Int + , code_ptr :: !Int + , mapping :: !Int + } + +appendProgram :: !Bool !Program !JITState -> JITState +bootstrap :: (!Program, !CompileState) +compile :: !Function !CompileState -> CompileState +compile_all :: !(Maybe CompileState) ![Function] -> CompileState diff --git a/sjit.icl b/Sjit/Compile.icl index 6b94745..31b6523 100644 --- a/sjit.icl +++ b/Sjit/Compile.icl @@ -1,4 +1,4 @@ -module sjit +implementation module Sjit.Compile import StdEnv import StdGeneric @@ -7,54 +7,10 @@ import StdOverloadedList from Data.Func import mapSt, $ from Data.Map import :: Map(..), get, put, newMap, fromList -import System.CommandLine -import code from "sjit_c." - -:: Expr - = Int !Int - | Var !String - | App !String ![Expr] - -:: Function = - { fun_name :: !String - , fun_args :: ![String] - , fun_expr :: !Expr - } - -:: Instr - = PushRef !Int - | PushI !Int - | Put !Int - | Pop !Int - - | Call !Int - | Ret - | Halt - - | IAddRet - | IMulRet - | ISubRet - | IDivRet +import Sjit.Syntax -:: Program :== {!Instr} - -:: CompileState = - { vars :: !Map String Int - , funs :: !Map String Int - , sp :: !Int - , pc :: !Int - , blocks :: ![!Program!] - , jitst :: !JITState - } - -:: JITState = - { n_instr :: !Int - , code_start :: !Int - , code_len :: !Int - , code_ptr :: !Int - , mapping :: !Int - } +import code from "sjit_c." appendProgram :: !Bool !Program !JITState -> JITState appendProgram is_main prog jitst @@ -158,53 +114,6 @@ compile_all mcs funs Nothing -> snd bootstrap = foldl (flip compile) cs funs -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] - Ret -> case stack of - [ret:stack] -> exec ret stack - Halt -> case stack of - [r] -> r - _ -> abort (toString (length stack) +++ " values left on stack\n") - - IAddRet -> case stack of - [ret:a:b:stack] -> exec ret [a:a+b:stack] - IMulRet -> case stack of - [ret:a:b:stack] -> exec ret [a:a*b:stack] - ISubRet -> case stack of - [ret:a:b:stack] -> exec ret [a:a-b:stack] - IDivRet -> case stack of - [ret:a:b:stack] -> exec ret [a: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 - generic gEncodedSize a :: !a -> Int gEncodedSize{|Int|} _ = 1 gEncodedSize{|{!}|} fx xs = 1 + sum [fx x \\ x <-: xs] @@ -215,8 +124,6 @@ gEncodedSize{|EITHER|} _ fr (RIGHT r) = fr r gEncodedSize{|CONS|} fx (CONS x) = fx x + 1 gEncodedSize{|OBJECT|} fx (OBJECT x) = fx x -derive gEncodedSize Instr - generic gEncode a :: !a !Int !*{#Int} -> (!Int, !*{#Int}) gEncode{|Int|} n i arr = (i+1, {arr & [i]=n}) gEncode{|{!}|} fx xs i arr = walk 0 (i+1) {arr & [i]=sz} @@ -236,38 +143,10 @@ 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 encode :: !a -> *{#Int} | gEncodedSize{|*|}, gEncode{|*|} a encode x # (_,arr) = gEncode{|*|} x 0 (createArray (gEncodedSize{|*|} x) -1) = arr - -exec :: !CompileState -> Int -exec {jitst} = exec jitst.code_start -where - exec :: !Int -> Int - exec _ = code { - ccall jit_exec "p:I" - } - -import Text.GenPrint -derive gPrint Instr - -Start w -# (io,w) = stdio w -# io = Foldl (\io b -> io <<< " " <<< printToString b <<< "\n") (io <<< "Program blocks:\n") comp_state.blocks -# io = io <<< "Interpreted result: " <<< interpreted_result <<< "\n" -# io = io <<< "JIT-compiled result: " <<< jit_compiled_result <<< "\n" -# (_,w) = fclose io w -= setReturnCode (if (interpreted_result==jit_compiled_result) 0 1) w -where - interpreted_result = interpret comp_state - jit_compiled_result = exec comp_state - -comp_state =: compile_all Nothing - [ {fun_name="id", fun_args=["x"], fun_expr=Var "x"} - , {fun_name="const", fun_args=["x","y"], fun_expr=Var "x"} - , {fun_name="seven", fun_args=[], fun_expr=App "const" [Int 7, Int 10]} - , {fun_name="main", fun_args=[], fun_expr=App "+" [App "seven" [], App "const" [Int 5, Int 10]]} - ] diff --git a/Sjit/Run.dcl b/Sjit/Run.dcl new file mode 100644 index 0000000..aff22fc --- /dev/null +++ b/Sjit/Run.dcl @@ -0,0 +1,6 @@ +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 new file mode 100644 index 0000000..b5858ec --- /dev/null +++ b/Sjit/Run.icl @@ -0,0 +1,63 @@ +implementation module Sjit.Run + +import StdEnv +import StdMaybe + +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] + Ret -> case stack of + [ret:stack] -> exec ret stack + Halt -> case stack of + [r] -> r + _ -> abort (toString (length stack) +++ " values left on stack\n") + + IAddRet -> case stack of + [ret:a:b:stack] -> exec ret [a:a+b:stack] + IMulRet -> case stack of + [ret:a:b:stack] -> exec ret [a:a*b:stack] + ISubRet -> case stack of + [ret:a:b:stack] -> exec ret [a:a-b:stack] + IDivRet -> case stack of + [ret:a:b:stack] -> exec ret [a: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 + exec :: !Int -> Int + exec _ = code { + ccall jit_exec "p:I" + } diff --git a/Sjit/Syntax.dcl b/Sjit/Syntax.dcl new file mode 100644 index 0000000..a289b5a --- /dev/null +++ b/Sjit/Syntax.dcl @@ -0,0 +1,12 @@ +definition module Sjit.Syntax + +:: Expr + = Int !Int + | Var !String + | App !String ![Expr] + +:: Function = + { fun_name :: !String + , fun_args :: ![String] + , fun_expr :: !Expr + } diff --git a/Sjit/Syntax.icl b/Sjit/Syntax.icl new file mode 100644 index 0000000..e512e0c --- /dev/null +++ b/Sjit/Syntax.icl @@ -0,0 +1 @@ +implementation module Sjit.Syntax diff --git a/isjit.icl b/isjit.icl new file mode 100644 index 0000000..72d95dd --- /dev/null +++ b/isjit.icl @@ -0,0 +1,32 @@ +module isjit + +import StdEnv +import StdMaybe +import StdOverloadedList + +import System.CommandLine + +import Sjit.Compile +import Sjit.Syntax +import Sjit.Run + +import Text.GenPrint +derive gPrint Instr + +Start w +# (io,w) = stdio w +# io = Foldl (\io b -> io <<< " " <<< printToString b <<< "\n") (io <<< "Program blocks:\n") comp_state.blocks +# io = io <<< "Interpreted result: " <<< interpreted_result <<< "\n" +# io = io <<< "JIT-compiled result: " <<< jit_compiled_result <<< "\n" +# (_,w) = fclose io w += setReturnCode (if (interpreted_result==jit_compiled_result) 0 1) w +where + interpreted_result = interpret comp_state + jit_compiled_result = exec comp_state + +comp_state =: compile_all Nothing + [ {fun_name="id", fun_args=["x"], fun_expr=Var "x"} + , {fun_name="const", fun_args=["x","y"], fun_expr=Var "x"} + , {fun_name="seven", fun_args=[], fun_expr=App "const" [Int 7, Int 10]} + , {fun_name="main", fun_args=[], fun_expr=App "+" [App "seven" [], App "const" [Int 5, Int 10]]} + ] |