From 3595d3c75503158e4eedaedbac8e81cbbe5ae54b Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Fri, 13 Dec 2019 13:39:35 +0100
Subject: Follow caller-save convention using stack, not full state restore

---
 VM.hs | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

(limited to 'VM.hs')

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))
-- 
cgit v1.2.3-54-g00ecf