From f31b200b58e994b7505707931d4278e3f61cc2d6 Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Mon, 24 Dec 2018 14:15:16 +0100 Subject: Iterative development --- sjit.icl | 174 ++++++++++++++++++++++++++++++++++++++++++++++----------------- 1 file changed, 128 insertions(+), 46 deletions(-) (limited to 'sjit.icl') diff --git a/sjit.icl b/sjit.icl index 8c86fc1..c24ea97 100644 --- a/sjit.icl +++ b/sjit.icl @@ -3,6 +3,7 @@ module sjit import StdEnv import StdGeneric import StdMaybe +import StdOverloadedList from Data.Func import mapSt, $ from Data.Map import :: Map(..), get, put, newMap, fromList @@ -39,28 +40,104 @@ import code from "sjit_c." :: Program :== {!Instr} :: CompileState = - { vars :: !Map String Int - , funs :: !Map String Int - , sp :: !Int - , pc :: !Int + { vars :: !Map String Int + , funs :: !Map String Int + , sp :: !Int + , pc :: !Int + , blocks :: ![!Program!] + , jitst :: !JITState } -compile :: ![Function] -> Program -compile funs +:: 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,cs) = mapSt fun funs {vars=newMap, funs=fromList bs_funs, sp=0, pc=len_bs} -= case get "main" cs.funs of - Nothing -> abort "no main function\n" - Just m - # bs = bootstrap m - -> {i \\ i <- flatten [is \\ (_,is) <- bs] ++ flatten is} +# 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 - fun :: !Function !CompileState -> (![Instr], !CompileState) - fun f cs - # cs & funs = put f.fun_name cs.pc cs.funs - # (is,cs) = expr f.fun_expr cs - = (reverse [Ret:is], {cs & pc=cs.pc+1}) + 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 +# (is,cs) = expr f.fun_expr {cs & vars=newMap} +# is = {i \\ i <- reverse [Ret:is]} += + { cs + & vars = vars + , pc = cs.pc+1 + , 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 @@ -76,28 +153,17 @@ where # (is,cs) = expr e cs = ([Put (max 1 (length vs)+1):is], {cs & sp=cs.sp-1, pc=cs.pc+1}) - bootstrap_funs :: (!Int, ![(String, Int)]) - bootstrap_funs = iter 0 (bootstrap 0) - 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]) - - bootstrap :: !Int -> [(String, [Instr])] - bootstrap main = - [ ("_", [PushI 0,Call main,Halt]) - , ("+", [IAddRet]) - , ("*", [IMulRet]) - , ("-", [ISubRet]) - , ("/", [IDivRet]) - ] +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 -exec :: !Program -> Int -exec prog = exec 0 [] +interpret :: !CompileState -> Int +interpret cs = exec 0 [] where + prog = get_program cs sz = size prog exec :: !Int ![Int] -> Int @@ -125,6 +191,22 @@ where 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] @@ -163,12 +245,12 @@ encode x # (_,arr) = gEncode{|*|} x 0 (createArray (gEncodedSize{|*|} x) -1) = arr -jit :: !Program -> Int -jit prog = jit (encode prog) +exec :: !CompileState -> Int +exec {jitst} = exec jitst.code_start where - jit :: !*{#Int} -> Int - jit _ = code { - ccall jit "A:I" + exec :: !Int -> Int + exec _ = code { + ccall jit_exec "p:I" } import Text.GenPrint @@ -176,16 +258,16 @@ derive gPrint Instr Start w # (io,w) = stdio w -# io = io <<< "Program: " <<< printToString prog <<< "\n" +# 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 = exec prog - jit_compiled_result = jit prog + interpreted_result = interpret comp_state + jit_compiled_result = exec comp_state -prog =: compile +comp_state =: compile_all Nothing [ {fun_name="id", fun_expr=Abstr ["x"] (Var "x")} , {fun_name="const", fun_expr=Abstr ["x","y"] (Var "x")} , {fun_name="main", fun_expr=Abstr [] (App "+" [App "const" [Int 37, Int 10], App "const" [Int 5, Int 10]])} -- cgit v1.2.3