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
|
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]
}
:: StackValue
= SVImmediate !Immediate
| SVRegOffset !Register !Offset /* value is reg + offset */
simulate :: !(Simulator a) -> [Instruction]
simulate sim = flatten (reverse (execState sim initial).instrs)
where
// TODO: when finishing:
// - check that the stack is empty
// - update heap pointer
initial =
{ instrs = []
, hp_offset = 0
, 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
]
buildCons :: !Label !Int -> Simulator ()
buildCons cons nargs =
write_heap (SVImmediate (Address 2 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
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"
|
