+Memory dubugging to SAMi

Ignore-this: e6acb95f1212a682d8a1fc2543478e48

darcs-hash:20100209061637-09b00-c774ed613f0f4ce7d46e329e78b4b35c299349f4

GMachine.hs

@@ -179,7 +179,18 @@ eval=SProc "%eval" ["sc"]
             ,SAM.Alloc "stag"
             ,Move (Register "temp") [Memory "H0" 2,Register "stag"]
             ,Dispatch "stag"
-                [(2,[Clear (Register "sc")])] -- 0 :input 1:output 2:halt
+                [(0, -- input f
+                    [])
+                ,(1, -- output x k
+                    [])
+                ,(2, -- halt
+                    [Clear (Register "sc")
+                    ,Inline "#origin" []
+                    ,Locate 1
+                    ,Inline "#stackNew" []
+                    ,Clear (Memory "S0" (-1))
+                    ])
+                ]
             ,Delete "stag"
             ])
         ]

SAM.hs

@@ -38,6 +38,8 @@ import Data.Ord
 import Data.Word
 import qualified Data.Map as M
 import qualified Data.Set as S
+import Numeric
+import Text.Printf
 
 import Util
 import SCGR
@@ -425,6 +427,9 @@ type SAMST=StateT SAMInternal
 
 enterProc :: ProcName -> [(ProcName,RegName)] -> SAMST IO ()
 enterProc name args=do
+    liftIO $ putStrLn $ "entering:"++name
+    dumpMemory
+
     ptb<-liftM procTable get
     rtb<-liftM regTable get
     let SProc _ rs ss=M.findWithDefault (error $ "SAMi: procedure not found: "++name) name ptb
@@ -435,6 +440,26 @@ enterProc name args=do
     modify (\x->x{regTable=rtb'})
     mapM_ (execStmt name) ss
     modify (\x->x{regTable=M.delete name $ regTable x})
+
+dumpMemory :: SAMST IO ()
+dumpMemory=do
+    t<-liftM memTable get
+    p<-liftM pointer get
+    let maxAddr=max 0 $ maximum (map msize $ M.elems t)-1
+        ss=map (\x->dumpMemoryBetween p t (x*w,(x+1)*w-1)) [0..maxAddr `div` w]
+    liftIO $ mapM_ putStrLn ss
+    where w=16
+
+dumpMemoryBetween :: Int -> MemTable -> (Int,Int) -> String
+dumpMemoryBetween p t (a0,a1)=unlines $ map dumpKey ks
+    where
+        ks=M.keys t
+        head=maximum $ map length ks
+        dumpKey k=printf ("%"++show head++"s|") k++dump (t M.! k)
+        dump fm=unwords $ map (\x->showAddr x $ mread fm x) [a0..a1]
+        showAddr a v=(if a==p then ">" else " ")++(showHex v "")
+
+
 
 
 execStmt p (Alloc r)=modifyRT $ M.adjust (first $ M.insert r 0) p
@@ -502,14 +527,3 @@ modifyPointer f=modify $ \x->x{pointer=g $ pointer x}
     where g x=let y=f x in if x<0 then error $ "modifyPointer: invalid pos: "++show y else y
 
 
-
-
-
-
-
-
-
-
-
-
-

Util.hs

@@ -111,7 +111,10 @@ mwrite (FlatMemory m) i v=FlatMemory $ IM.insert i v m
 mmodify :: FlatMemory -> Int -> (Word8 -> Word8) -> FlatMemory
 mmodify fm i f=mwrite fm i (f $ mread fm i)
 
-
+msize :: FlatMemory -> Int
+msize (FlatMemory m)=case IM.maxViewWithKey m of
+    Nothing -> 0
+    Just ((k,v),m') -> if v/=0 then k+1 else msize $ FlatMemory m'
 
 
 -- | a b c ... z aa ab ac ... az ba ...