summaryrefslogtreecommitdiff
path: root/VM.hs
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2019-12-13 13:39:35 +0100
committertomsmeding <tom.smeding@gmail.com>2019-12-13 13:39:35 +0100
commit3595d3c75503158e4eedaedbac8e81cbbe5ae54b (patch)
treed5de3449acabdf0af4d7e361d1063d3934bb0064 /VM.hs
parent80fee1089b659a7c7ee3a96d4cf999d369c0eb48 (diff)
Follow caller-save convention using stack, not full state restore
Diffstat (limited to 'VM.hs')
-rw-r--r--VM.hs20
1 files changed, 11 insertions, 9 deletions
diff --git a/VM.hs b/VM.hs
index 08e7c63..bd7cbef 100644
--- a/VM.hs
+++ b/VM.hs
@@ -25,6 +25,7 @@ data State = State
{ sTempMap :: TempMap
, sArgs :: [RunValue] {- current arguments -}
, sCloVals :: [RunValue] {- current closure -}
+ , sStack :: [RunValue] {- IPush/IPop stack -}
, sHandles :: IMap.IntMap Handle
, sUniq :: Int
}
@@ -46,7 +47,7 @@ vmRun :: IRProgram -> IO ()
vmRun (IRProgram bbs gfds datas) =
let bbmap = Map.fromList [(bidOf bb, bb) | bb <- bbs]
info = Info bbmap gfds datas
- state = State IMap.empty [] [] (IMap.fromList [(-1, stdin), (-2, stdout), (-3, stderr)]) 0
+ state = State IMap.empty [] [] [] (IMap.fromList [(-1, stdin), (-2, stdout), (-3, stderr)]) 0
in IO.catchIOError (void $ vmRunBB info state (head bbs)) vmErrorHandler
vmErrorHandler :: IOError -> IO ()
@@ -82,6 +83,14 @@ vmRunInstr info@(Info _ _ datas) state (dest, instr) = case instr of
in return (assignRef state dest (RVClosure name cloVals))
IDiscard _ ->
return state -- TODO: erase temporary from state for IDiscard (RTemp i)
+ IPush refs ->
+ return (state { sStack = map (findRef (sTempMap state)) refs ++ sStack state })
+ IPop refs ->
+ if length (sStack state) >= length refs
+ then let (values, newStack) = splitAt (length refs) (sStack state)
+ state' = state { sStack = newStack }
+ in return (foldl (uncurry . assignRef) state' (zip refs values))
+ else error "VM: IPop on too-small stack"
vmRunTerm :: Info -> State -> Terminator -> IO (RunValue, State)
vmRunTerm info@(Info bbmap _ _) state@(State { sTempMap = tmap }) term = case term of
@@ -111,14 +120,7 @@ callClosure info@(Info bbmap gfds _) state@(State { sTempMap = tmap }) cl as =
Just (GlobFuncDef b _ _) -> do
(rv, state') <- vmRunBB info (state { sArgs = map (findRef tmap) as, sCloVals = clvals })
(bbmap Map.! b)
- -- TODO: we restore tempmap here after the call, and that's
- -- _really_ dodgy. I think it works because we never mutate
- -- a reference after first assigning it, and without it
- -- recursion fails, but it feels ugly. A proper solution
- -- would be to further compile the IR down to something
- -- that stores its values on a stack, so that recursion is
- -- handled automatically.
- return (rv, state' { sArgs = sArgs state, sCloVals = sCloVals state, sTempMap = sTempMap state })
+ return (rv, state' { sArgs = sArgs state, sCloVals = sCloVals state })
Nothing ->
-- Take 'tail as' to skip the first self-link argument
vmRunBuiltin state clname (map (findRef tmap) (tail as))