diff options
Diffstat (limited to 'VM.hs')
| -rw-r--r-- | VM.hs | 20 |
1 files changed, 11 insertions, 9 deletions
@@ -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)) |