diff options
| -rw-r--r-- | VM.hs | 13 |
1 files changed, 10 insertions, 3 deletions
@@ -30,6 +30,7 @@ data State = State , sStack :: [RunValue] {- IPush/IPop stack -} , sHandles :: IMap.IntMap Handle , sUniq :: Int + , sHeatmap :: IMap.IntMap Int } -- TODO: are more constructors from Value needed? @@ -52,6 +53,7 @@ vmRun irprogram@(IRProgram bbs gfds datas) = do let bbmap = Map.fromList [(bidOf bb, bb) | bb <- bbs] info = Info bbmap gfds datas state = State tmap [] [] [] (IMap.fromList [(-1, stdin), (-2, stdout), (-3, stderr)]) 0 + IMap.empty IO.catchIOError (void $ vmRunBB info state (head bbs)) vmErrorHandler vmErrorHandler :: IOError -> IO () @@ -59,8 +61,11 @@ vmErrorHandler e = if IO.isUserError e && IO.ioeGetErrorString e == kErrorExit then return () else IO.ioError e vmRunBB :: Info -> State -> BB -> IO (RunValue, State) -vmRunBB info state (BB _ inss term) = do - state' <- foldM (vmRunInstr info) state inss +vmRunBB info state (BB bid inss term) = do + state' <- foldM (vmRunInstr info) + (state { sHeatmap = IMap.insertWith (+) bid 1 (sHeatmap state) }) + -- state + inss vmRunTerm info state' term vmRunInstr :: Info -> State -> Instruction -> IO State @@ -115,7 +120,9 @@ vmRunTerm info@(Info bbmap _ _) state@(State { sTempMap = tmap }) term = case te IJmp b -> vmRunBB info state (bbmap Map.! b) IRet ref -> (,state) <$> findRef tmap ref ITailC cl as -> callClosure info state cl as - IExit -> IO.ioError (IO.userError kErrorExit) + IExit -> do + hPutStrLn stderr (show (sHeatmap state)) + IO.ioError (IO.userError kErrorExit) IUnknown -> undefined findRef :: TempMap -> Ref -> IO RunValue |