aboutsummaryrefslogtreecommitdiff
path: root/Sjit/Run.icl
blob: ad03e0218215c62767652dd3be79b76f0494cf4b (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
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]
		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
	exec :: !Int -> Int
	exec _ = code {
		ccall jit_exec "p:I"
	}