From 4d24cd1e3c8a35df8ea872dda22f431b46c3c64f Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Mon, 24 Dec 2018 14:40:24 +0100 Subject: Divide in modules --- .gitignore | 2 +- Makefile | 2 +- Sjit/Compile.dcl | 44 +++++++++ Sjit/Compile.icl | 152 +++++++++++++++++++++++++++++++ Sjit/Run.dcl | 6 ++ Sjit/Run.icl | 63 +++++++++++++ Sjit/Syntax.dcl | 12 +++ Sjit/Syntax.icl | 1 + isjit.icl | 32 +++++++ sjit.icl | 273 ------------------------------------------------------- 10 files changed, 312 insertions(+), 275 deletions(-) create mode 100644 Sjit/Compile.dcl create mode 100644 Sjit/Compile.icl create mode 100644 Sjit/Run.dcl create mode 100644 Sjit/Run.icl create mode 100644 Sjit/Syntax.dcl create mode 100644 Sjit/Syntax.icl create mode 100644 isjit.icl delete mode 100644 sjit.icl diff --git a/.gitignore b/.gitignore index 7310f09..b6a6c3b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,4 @@ *.abc *.o -sjit +isjit diff --git a/Makefile b/Makefile index ae85740..ec6b966 100644 --- a/Makefile +++ b/Makefile @@ -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/Compile.icl b/Sjit/Compile.icl new file mode 100644 index 0000000..31b6523 --- /dev/null +++ b/Sjit/Compile.icl @@ -0,0 +1,152 @@ +implementation module Sjit.Compile + +import StdEnv +import StdGeneric +import StdMaybe +import StdOverloadedList + +from Data.Func import mapSt, $ +from Data.Map import :: Map(..), get, put, newMap, fromList + +import Sjit.Syntax + +import code from "sjit_c." + +appendProgram :: !Bool !Program !JITState -> JITState +appendProgram is_main prog jitst +# new_code_ptr = append + jitst.code_start jitst.code_len jitst.code_ptr + jitst.mapping + jitst.n_instr + (encode prog) + is_main += + { jitst + & code_ptr = new_code_ptr + , n_instr = jitst.n_instr + size prog + } +where + append :: !Int !Int !Int !Int !Int !{#Int} !Bool -> Int + append _ _ _ _ _ _ _ = code { + ccall jit_append "pIppIAI:p" + } + +bootstrap :: (!Program, !CompileState) +bootstrap +# (len_bs, bs_funs) = bootstrap_funs +# is = {i \\ i <- flatten [is \\ (_,is) <- header]} += + ( is, + { vars = newMap + , funs = fromList bs_funs + , sp = 0 + , pc = len_bs + , blocks = [!is!] + , jitst = appendProgram False is (initJITState 1000) + }) +where + bootstrap_funs :: (!Int, ![(String, Int)]) + bootstrap_funs = iter 0 header + where + iter :: !Int ![(String, [Instr])] -> (!Int, ![(String, Int)]) + iter pc [] = (pc, []) + iter pc [(name,is):rest] + # fun = (name,pc) + # (pc,funs) = iter (pc+length is) rest + = (pc,[fun:funs]) + + header :: [(!String, ![Instr])] + header = + [ ("_", [PushI 0,Call 0 /* main address */,Halt]) + , ("+", [IAddRet]) + , ("*", [IMulRet]) + , ("-", [ISubRet]) + , ("/", [IDivRet]) + ] + + initJITState :: !Int -> JITState + initJITState maxlen + # (code_start,mapping) = init maxlen (maxlen*10) + = + { n_instr = 0 + , code_start = code_start + , code_len = maxlen*10 + , code_ptr = code_start + , mapping = mapping + } + where + init :: !Int !Int -> (!Int, !Int) + init _ _ = code { + ccall init_jit "II:Vpp" + } + +compile :: !Function !CompileState -> CompileState +compile f cs +# cs & funs = put f.fun_name cs.pc cs.funs +# vars = cs.vars +# cs & vars = foldr (uncurry put) cs.vars [(v,sp) \\ v <- f.fun_args & sp <- [cs.sp+1..]] +# (is,cs) = expr f.fun_expr cs +# is = {i \\ i <- reverse [Ret:Put (max 1 (length f.fun_args)+1):is]} += + { cs + & vars = vars + , pc = cs.pc+2 + , blocks = cs.blocks ++| [!is!] + , jitst = appendProgram (f.fun_name == "main") is cs.jitst + } +where + expr :: !Expr !CompileState -> (![Instr], !CompileState) + expr (Int i) cs = ([PushI i], {cs & sp=cs.sp+1, pc=cs.pc+1}) + expr (Var v) cs = case get v cs.vars of + Just i -> ([PushRef (i-cs.sp)], {cs & sp=cs.sp+1, pc=cs.pc+1}) + Nothing -> abort "undefined variable\n" + expr (App f args) cs + # args = if (args=:[]) [Int 0] args + # (iss,cs) = mapSt expr args {cs & sp=cs.sp+1} + = case get f cs.funs of + Just f -> ([Pop (length args-1):Call f:flatten iss], {cs & sp=cs.sp+2-length args, pc=cs.pc+2}) + Nothing -> abort "undefined function\n" + +compile_all :: !(Maybe CompileState) ![Function] -> CompileState +compile_all mcs funs +# cs = case mcs of + Just cs -> cs + Nothing -> snd bootstrap += foldl (flip compile) cs funs + +generic gEncodedSize a :: !a -> Int +gEncodedSize{|Int|} _ = 1 +gEncodedSize{|{!}|} fx xs = 1 + sum [fx x \\ x <-: xs] +gEncodedSize{|UNIT|} _ = 0 +gEncodedSize{|PAIR|} fx fy (PAIR x y) = fx x + fy y +gEncodedSize{|EITHER|} fl _ (LEFT l) = fl l +gEncodedSize{|EITHER|} _ fr (RIGHT r) = fr r +gEncodedSize{|CONS|} fx (CONS x) = fx x + 1 +gEncodedSize{|OBJECT|} fx (OBJECT x) = fx x + +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} +where + sz = size xs + + walk ai i arr + | ai >= sz = (i,arr) + # (i,arr) = fx xs.[ai] i arr + = walk (ai+1) i arr +gEncode{|UNIT|} _ i arr = (i,arr) +gEncode{|PAIR|} fx fy (PAIR x y) i arr + # (i,arr) = fx x i arr + = fy y i arr +gEncode{|EITHER|} fl _ (LEFT l) i arr = fl l i arr +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 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]]} + ] diff --git a/sjit.icl b/sjit.icl deleted file mode 100644 index 6b94745..0000000 --- a/sjit.icl +++ /dev/null @@ -1,273 +0,0 @@ -module sjit - -import StdEnv -import StdGeneric -import StdMaybe -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 - -:: 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 -appendProgram is_main prog jitst -# new_code_ptr = append - jitst.code_start jitst.code_len jitst.code_ptr - jitst.mapping - jitst.n_instr - (encode prog) - is_main -= - { jitst - & code_ptr = new_code_ptr - , n_instr = jitst.n_instr + size prog - } -where - append :: !Int !Int !Int !Int !Int !{#Int} !Bool -> Int - append _ _ _ _ _ _ _ = code { - ccall jit_append "pIppIAI:p" - } - -bootstrap :: (!Program, !CompileState) -bootstrap -# (len_bs, bs_funs) = bootstrap_funs -# is = {i \\ i <- flatten [is \\ (_,is) <- header]} -= - ( is, - { vars = newMap - , funs = fromList bs_funs - , sp = 0 - , pc = len_bs - , blocks = [!is!] - , jitst = appendProgram False is (initJITState 1000) - }) -where - bootstrap_funs :: (!Int, ![(String, Int)]) - bootstrap_funs = iter 0 header - where - iter :: !Int ![(String, [Instr])] -> (!Int, ![(String, Int)]) - iter pc [] = (pc, []) - iter pc [(name,is):rest] - # fun = (name,pc) - # (pc,funs) = iter (pc+length is) rest - = (pc,[fun:funs]) - - header :: [(!String, ![Instr])] - header = - [ ("_", [PushI 0,Call 0 /* main address */,Halt]) - , ("+", [IAddRet]) - , ("*", [IMulRet]) - , ("-", [ISubRet]) - , ("/", [IDivRet]) - ] - - initJITState :: !Int -> JITState - initJITState maxlen - # (code_start,mapping) = init maxlen (maxlen*10) - = - { n_instr = 0 - , code_start = code_start - , code_len = maxlen*10 - , code_ptr = code_start - , mapping = mapping - } - where - init :: !Int !Int -> (!Int, !Int) - init _ _ = code { - ccall init_jit "II:Vpp" - } - -compile :: !Function !CompileState -> CompileState -compile f cs -# cs & funs = put f.fun_name cs.pc cs.funs -# vars = cs.vars -# cs & vars = foldr (uncurry put) cs.vars [(v,sp) \\ v <- f.fun_args & sp <- [cs.sp+1..]] -# (is,cs) = expr f.fun_expr cs -# is = {i \\ i <- reverse [Ret:Put (max 1 (length f.fun_args)+1):is]} -= - { cs - & vars = vars - , pc = cs.pc+2 - , blocks = cs.blocks ++| [!is!] - , jitst = appendProgram (f.fun_name == "main") is cs.jitst - } -where - expr :: !Expr !CompileState -> (![Instr], !CompileState) - expr (Int i) cs = ([PushI i], {cs & sp=cs.sp+1, pc=cs.pc+1}) - expr (Var v) cs = case get v cs.vars of - Just i -> ([PushRef (i-cs.sp)], {cs & sp=cs.sp+1, pc=cs.pc+1}) - Nothing -> abort "undefined variable\n" - expr (App f args) cs - # args = if (args=:[]) [Int 0] args - # (iss,cs) = mapSt expr args {cs & sp=cs.sp+1} - = case get f cs.funs of - Just f -> ([Pop (length args-1):Call f:flatten iss], {cs & sp=cs.sp+2-length args, pc=cs.pc+2}) - Nothing -> abort "undefined function\n" - -compile_all :: !(Maybe CompileState) ![Function] -> CompileState -compile_all mcs funs -# cs = case mcs of - Just cs -> cs - 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] -gEncodedSize{|UNIT|} _ = 0 -gEncodedSize{|PAIR|} fx fy (PAIR x y) = fx x + fy y -gEncodedSize{|EITHER|} fl _ (LEFT l) = fl l -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} -where - sz = size xs - - walk ai i arr - | ai >= sz = (i,arr) - # (i,arr) = fx xs.[ai] i arr - = walk (ai+1) i arr -gEncode{|UNIT|} _ i arr = (i,arr) -gEncode{|PAIR|} fx fy (PAIR x y) i arr - # (i,arr) = fx x i arr - = fy y i arr -gEncode{|EITHER|} fl _ (LEFT l) i arr = fl l i arr -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 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]]} - ] -- cgit v1.2.3