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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
|
implementation module Snug.Compile.Simulate
import StdEnv
import Control.Monad
import Control.Monad.Identity
import Control.Monad.State
import Data.Functor
import MIPS.MIPS32
import Snug.Compile.ABI
import Snug.Syntax
:: SimulationState =
{ instrs :: ![[Instruction]]
, hp_offset :: !Int
, stack :: ![StackValue]
}
simulate :: ![StackValue] !(Simulator a) -> [Instruction]
simulate stack sim = flatten (reverse (execState sim initial).instrs)
where
// TODO: when finishing:
// - check that the stack is empty
initial =
{ instrs = []
, hp_offset = 0
, stack = stack
}
stackSize :: Simulator Int
stackSize = gets \s -> length s.stack
add :: ![Instruction] -> Simulator ()
add is = modify \s -> {s & instrs=[is:s.instrs]}
push :: StackValue -> Simulator ()
push sv = modify \s -> {s & stack=[sv:s.stack]}
pop :: Simulator StackValue
pop =
getState >>= \{stack} ->
modify (\s -> {s & stack=tl stack}) $> hd stack
write_heap :: !StackValue -> Simulator StackValue
write_heap sv =
getState >>= \{hp_offset} ->
storeStackValue sv hp_offset HeapPtr >>|
modify (\s -> {s & hp_offset=hp_offset+4}) $>
SVRegOffset HeapPtr hp_offset
storeStackValue :: !StackValue !Offset !Register -> Simulator ()
storeStackValue (SVImmediate (Immediate i)) doffset dreg
| i == 0 = add
[ StoreWord R0 doffset dreg
]
| 0 <= i && i < 0x10000 = add
[ OrImmediate TempImm R0 (Immediate i)
, StoreWord TempImm doffset dreg
]
| 0 > i && i >= -0x8000 = add
[ AddImmediate Signed TempImm R0 (Immediate i)
, StoreWord TempImm doffset dreg
]
| otherwise = add
[ LoadUpperImmediate TempImm (Immediate (i >> 16))
, OrImmediate TempImm TempImm (Immediate (i bitand 0xffff))
, StoreWord TempImm doffset dreg
]
storeStackValue (SVImmediate imm=:(Address _ _)) doffset dreg = add
[ LoadAddress TempImm imm
, StoreWord TempImm doffset dreg
]
storeStackValue (SVRegOffset reg 0) doffset dreg = add
[ StoreWord reg doffset dreg
]
storeStackValue (SVRegOffset reg offset) doffset dreg = add
[ AddImmediate Signed TempImm reg (Immediate offset)
, StoreWord TempImm doffset dreg
]
storeStackValue (SVIndirect offset reg) doffset dreg = add
[ LoadWord TempImm offset reg
, StoreWord TempImm doffset dreg
]
buildCons :: !Label !Int -> Simulator ()
buildCons cons nargs =
write_heap (SVImmediate (Address 0 cons)) >>= \addr ->
mapM_ (\_ -> pop >>= write_heap) [1..nargs] >>|
push addr
buildThunk :: !Label !Int -> Simulator ()
buildThunk cons 0 =
write_heap (SVImmediate (Address 0 cons)) >>= \addr ->
modify (\s -> {s & hp_offset=s.hp_offset+4}) >>| // reserve space to overwrite with indir
push addr
buildThunk cons nargs =
write_heap (SVImmediate (Address 0 cons)) >>= \addr ->
mapM_ (\_ -> pop >>= write_heap) [1..nargs] >>|
push addr
pushBasicValue :: !BasicValue -> Simulator ()
pushBasicValue val = push (SVImmediate (Immediate imm))
where
imm = case val of
BVInt i -> i
BVChar c -> toInt c
pushArg :: !Int !Int -> Simulator ()
pushArg i j =
getState >>= \{stack} ->
case stack !! i of
SVRegOffset reg offset ->
push (SVIndirect (offset + (j+1)*4) reg)
_ ->
abort "unexpected reference in pushArg\n"
indirectAndEval :: Simulator ()
indirectAndEval =
pop >>= \sv ->
case sv of
SVRegOffset HeapPtr offset ->
add
// Build indirection
[ LoadAddress TempImm (Address 0 (functionLabel "" NodeEntry "indir"))
, StoreWord TempImm 0 FrontEvalPtr
] >>|
storeStackValue sv 4 FrontEvalPtr >>|
add
// Evaluate
[ AddImmediate Signed FrontEvalPtr HeapPtr (Immediate offset)
, Jump NoLink (Direct (Address 0 "eval"))
] >>|
getState >>= \{hp_offset} ->
add
[ AddImmediate Signed HeapPtr HeapPtr (Immediate hp_offset)
]
_ ->
abort "unexpected top of stack in indirect\n"
|
