Iterative development

2 files changed, 151 insertions, 58 deletions

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]])}
diff --git a/sjit_c.c b/sjit_c.c
index 50e8f57..879ec18 100644
--- a/sjit_c.c
+++ b/sjit_c.c
@@ -106,7 +106,7 @@ static inline void gen_instr(char *full_code, char **code_p, uint64_t **pgm_p, u
 		case Call:
 			arg=pgm[1];
 #ifdef DEBUG_JIT_INSTRUCTIONS
-			fprintf(stderr,"Call %lu -> %d\n",arg,mapping[arg]-(&code[5]-full_code));
+			fprintf(stderr,"Call %lu -> %d\n",arg,mapping[arg]-(uint32_t)(&code[5]-full_code));
 #endif
 			code[0]='\xe8'; /* callq ARG */
 			*(uint32_t*)&code[1]=mapping[arg]-(&code[5]-full_code);
@@ -181,15 +181,20 @@ static inline void gen_instr(char *full_code, char **code_p, uint64_t **pgm_p, u
 	*pgm_p=pgm;
 }
 
-unsigned int jit(uint64_t *pgm) {
+void init_jit(uint64_t max_instrs, uint64_t max_code_len,
+		char **code_block, uint32_t **mapping) {
+	*code_block=mmap (NULL,max_code_len,PROT_READ | PROT_EXEC,MAP_ANONYMOUS | MAP_PRIVATE,0,0);
+	*mapping=malloc (max_instrs*sizeof(uint32_t));
+}
+
+char *jit_append(char *code_block, uint32_t code_len, char *code_ptr,
+		uint32_t *mapping, uint32_t n_instr, uint64_t *pgm, int is_main) {
 	uint32_t len=*pgm++;
 	uint32_t i;
-
-	uint32_t *mapping=malloc(len*sizeof(uint32_t));
-	uint32_t code_i=0;
+	uint32_t code_i=code_ptr-code_block;
 
 	uint64_t *pgm_p=pgm;
-	for (i=0; i<len; i++) {
+	for (i=n_instr; i<n_instr+len; i++) {
 		enum instr instr=(enum instr)*pgm_p;
 
 		mapping[i]=code_i;
@@ -209,14 +214,20 @@ unsigned int jit(uint64_t *pgm) {
 		}
 	}
 
-	char *code=mmap(NULL, code_i, PROT_WRITE, MAP_ANONYMOUS | MAP_PRIVATE, 0, 0);
-	char *code_wr=code;
+	mprotect (code_block,code_len,PROT_WRITE);
+
+	if (is_main)
+		*(uint32_t*)&code_block[9]=code_ptr-code_block-13;
+
 	pgm_p=pgm;
 	for (i=0; i<len; i++)
-		gen_instr(code, &code_wr, &pgm_p, mapping);
+		gen_instr (code_block,&code_ptr,&pgm_p,mapping);
+
+	mprotect (code_block,code_len,PROT_READ | PROT_EXEC);
 
-	mprotect(code, code_i, PROT_READ | PROT_EXEC);
-	int (*fun)(void) = (int(*)(void)) code;
+	return code_ptr;
+}
 
-	return fun();
+uint64_t jit_exec(char *code_block) {
+	return ((uint64_t(*)(void))code_block)();
 }