{-# OPTIONS -Wall #-} {-# OPTIONS -fno-warn-unused-do-bind #-} {-# LANGUAGE OverloadedStrings #-} module Language.Pck.Tool.InteractiveDebugger ( -- * Interactive Debugger driver runIdbIO -- * Interactive Debugger usage -- $idbnote ) where import System.IO import Control.Monad.State import qualified Data.ByteString.Char8 as B import Data.List (intercalate, elemIndex, sortBy) import Data.Char (toLower) import Text.Printf (printf) import Data.Attoparsec.ByteString as P import qualified Data.Attoparsec.ByteString.Char8 as P8 import Control.Applicative ((<$>), (<*>), (<|>), (<$), (*>)) import Language.Pck.Cpu.Instruction import Language.Pck.Cpu.Memory import Language.Pck.Cpu.State import Language.Pck.Tool.Debugger ---------------------------------------- -- driver ---------------------------------------- -- | interactive debugger driver. -- -- Example: -- -- > > runIdbIO [TrcInst] [] [(0,insts)] [] -- > For help, type "help". -- > (idb) info reg -- > pc : 0 -- > gr : [0,0,0,0,0,0,0,0] -- > fl : [False,False] -- > -- > (idb) s -- > TrcInst: pc : 0 MOVI R0 0 -- > -- > (idb) s -- > TrcInst: pc : 1 MOVI R1 1 -- > -- > (idb) b 4 -- > Num Enb What -- > 1 y pc == 4 -- > -- > (idb) c -- > TrcInst: pc : 2 MOVI R2 2 -- > -- > TrcInst: pc : 3 MOVI R3 3 -- > -- > (idb) x/10 0 -- > 0x00000000: 0x00000000 0x00000000 0x00000000 0x00000000 -- > 0x00000004: 0x00000000 0x00000000 0x00000000 0x00000000 -- > 0x00000008: 0x00000000 0x00000000 -- > -- > (idb) q -- -- please see "help" command -- runIdbIO :: [DbgTrc] -> [DbgBrk] -> InstImage -> DataImage -> IO () runIdbIO dbgtrc dbgbrk insts vals = do putStrLn "For help, type \"help\"." loop initStat "" (setBrkTable dbgbrk) where initStat = initCpuStateMem insts vals loop s prev t = do putStr "(idb) " hFlush stdout a <- getLine let a' = (if a == "" then prev else map toLower a) let dbgbrk' = getEnableBrkTable t case (parseOnly line (B.pack a')) of Left _ -> printUnknown a' >> printUsage >> loop s a' t Right x -> case x of CBlank -> loop s a' t CQuit -> return () CRun -> exeRun initStat a' t dbgtrc dbgbrk' CC -> exeRun s a' t dbgtrc dbgbrk' CS -> exeRun s a' t dbgtrc (BrkOne : dbgbrk') CInfoReg -> printRegs s >> loop s a' t CDisasCr -> printDisasmCr s >> loop s a' t CDisasAd ad -> printDisasmAd ad s >> loop s a' t CX n ad -> printDmem n ad s >> loop s a' t CPw ad v -> loop (setDmem ad v s) a' t CInfoB -> printBrkTable t >> loop s a' t CDelete n -> exeBrkUtil s a' deleteBrkTable n CEnable n -> exeBrkUtil s a' enableBrkTable n CDisable n -> exeBrkUtil s a' disableBrkTable n CB n -> exeBW s a' t (BrkPc BEQ n) CWatchPc o v -> exeBW s a' t (BrkPc o v) CWatchGReg d o v -> exeBW s a' t (BrkGReg d o v) CWatchDmem d o v -> exeBW s a' t (BrkDmem d o v) CHelp -> printUsage >> loop s a' t where exeRun st cmd tbl trc brk = let (l',st') = runState (evalProgDbg trc brk) st in B.putStr l' >> loop st' cmd tbl exeBrkUtil st cmd f n = let t' = f (n - 1) t in printBrkTable t' >> loop st cmd t' exeBW st cmd tbl b = let tbl' = addBrkTable (True, b) tbl in printBrkTable tbl' >> loop st cmd tbl' ---------------------------------------- -- sub commands ---------------------------------------- -- usage printUsage :: IO () printUsage = putStr "List of commands:\n\ \\n\ \q\t-- Exit debugger\n\ \help\t-- Print list of commands\n\ \run\t-- Start debugged program\n\ \s\t-- Step program\n\ \c\t-- Continue program being debugged\n\ \x\t-- Examin memory: x(/COUNT) ADDRESS\n\ \info reg\t-- List of registers\n\ \disas\t-- Disassemble: disassemble (ADDRESS)\n\ \info b\t-- Status of breakpoints\n\ \disable\t-- Disable breakpoint: disable NUMBER\n\ \enable\t-- Enable breakpoint: enable NUMBER\n\ \delete\t-- Delete breakpoint: delete NUMBER\n\ \b\t-- Set breakpoint: b ADDRESS\n\ \watch\t-- Set a watchpoint. example:\n\ \ \t data memory -- watch *0x80 != 10\n\ \ \t pc -- watch pc > 3\n\ \ \t register -- watch r7 == 3\n\ \p\t-- Print memory value: p *ADDRESS\n\ \p\t-- Set memory value: p *ADDRESS = VALUE\n\ \\n" printUnknown :: String -> IO () printUnknown xs = putStr $ "unknown command : " ++ (show xs) ++ "\n\n" -- info register utility printRegs :: CpuState -> IO () printRegs s = putStr $ concat [ "pc : ", (show . pcFromCpuState $ s) , "\ngr : ", (show . grFromCpuState $ s) , "\nfl : ", (show . flFromCpuState $ s), "\n\n" ] -- disassemble utility printDisasmCr :: CpuState -> IO () printDisasmCr s = printDisasm (pcFromCpuState s) 16 s printDisasmAd :: Int -> CpuState -> IO () printDisasmAd ad s = printDisasm ad 16 s printDisasm :: Int -> Int -> CpuState -> IO () printDisasm ad cnt s = putStr $ pprInst ad $ extractImems (imemFromCpuState s) ad cnt pprInst :: Int -> [Inst] -> String pprInst _ [] = [] pprInst ad xs = concat [ ppr0x08x ad, ": " , show y, "\n" , pprInst (ad + 1) zs] where (y:zs) = xs -- memory access utility printDmem :: Int -> Int -> CpuState -> IO () printDmem cnt ad s = putStr $ pprDmem 4 ad $ extractDmems (dmemFromCpuState s) ad cnt pprDmem :: Int -> Int -> [Int] -> String pprDmem _ _ [] = [] pprDmem c ad xs = ppr0x08x ad ++ ": " ++ (unwords $ map ppr0x08x ys) ++ "\n" ++ pprDmem c (ad + c) zs where (ys,zs) = splitAt c xs ppr0x08x :: Int -> String ppr0x08x = printf "0x%08x" -- p set utility setDmem :: Int -> Int -> CpuState -> CpuState setDmem ad val = execState (updateDmem ad val) ---------------------------------------- -- breakpoint and watchpoint ---------------------------------------- type BrkTable = [(Bool, DbgBrk)] -- set, get, print the BrkTable setBrkTable :: [DbgBrk] -> BrkTable setBrkTable = zip (repeat True) getEnableBrkTable :: BrkTable -> [DbgBrk] getEnableBrkTable = map snd . filter ((== True) . fst) printBrkTable :: BrkTable -> IO () printBrkTable xs = putStrLn $ "Num Enb What\n" ++ pprBrkTable xs ++ "\n" pprBrkTable :: BrkTable -> String pprBrkTable xs = intercalate "\n" $ zipWith f ([1..]::[Int]) xs where f n (b, ibrk) = (show n) ++ " " ++ (pprEnb b) ++ " " ++ (pprBrk ibrk) pprEnb True = "y " pprEnb False = "n " pprBrk = showDbgBrk showDbgBrk :: DbgBrk -> String showDbgBrk (BrkNon) = "non breakpoint" showDbgBrk (BrkOne) = "allways breakpoint" showDbgBrk (BrkPc o ad) = printf "PC %s %d (PC %s 0x%x)" o' ad o' ad where o' = showDbgOrd o showDbgBrk (BrkDmem mem o ad) = printf "*%d %s %d (*0x%x %s 0x%x)" mem o' ad mem o' ad where o' = showDbgOrd o showDbgBrk (BrkGReg reg o ad) = printf "%s %s %d (%s %s 0x%x)" reg' o' ad reg' o' ad where reg' = show reg o' = showDbgOrd o showDbgOrd :: DbgOrd -> String showDbgOrd BEQ = "==" showDbgOrd BNE = "!=" showDbgOrd BLT = "<" showDbgOrd BLE = "<=" showDbgOrd BGT = ">" showDbgOrd BGE = ">=" -- add, delete, enable, disable element with the BrkTable addBrkTable :: (Bool, DbgBrk) -> BrkTable -> BrkTable addBrkTable x xs = xs ++ [x] deleteBrkTable :: Int -> BrkTable -> BrkTable deleteBrkTable _ [] = [] deleteBrkTable 0 (_:xs) = xs deleteBrkTable n (x:xs) = x : deleteBrkTable (n-1) xs enableBrkTable, disableBrkTable :: Int -> BrkTable -> BrkTable enableBrkTable = setFstN True disableBrkTable = setFstN False setFstN :: a -> Int -> [(a,b)] -> [(a,b)] setFstN _ _ [] = [] setFstN a 0 ((_,b):xs) = (a,b) : xs setFstN a n (x:xs) = x : (setFstN a (n-1) xs) ---------------------------------------- -- command parser ---------------------------------------- data Cmd = CQuit | CHelp | CRun | CC | CS | CInfoReg | CInfoB | CDisasAd Int | CDisasCr | CX Int Int | CPw Int Int | CDelete Int | CEnable Int | CDisable Int | CB Int | CWatchPc DbgOrd Int | CWatchGReg GReg DbgOrd Int | CWatchDmem Int DbgOrd Int | CBlank deriving (Show, Eq) -- commands type ParseCmd = Parser Cmd line :: ParseCmd line = do skipSpaces a <- command skipSpaces endOfInput return a -- each command command :: ParseCmd command = cmdQuit <|> cmdHelp <|> cmdRun <|> cmdS <|> cmdC <|> cmdInfoReg <|> cmdInfoB <|> cmdDisasAd <|> cmdDisasCr <|> cmdXn <|> cmdX1 <|> cmdPw <|> cmdPr <|> cmdDelete <|> cmdEnable <|> cmdDisable <|> cmdB <|> cmdWatchPc <|> cmdWatchGReg <|> cmdWatchDmem <|> cmdBlank -- blank cmdBlank :: ParseCmd cmdBlank = CBlank <$ skipSpaces -- run cmdQuit, cmdHelp, cmdRun, cmdC, cmdS :: ParseCmd cmdQuit = CQuit <$ string "q" cmdHelp = CHelp <$ string "help" cmdRun = CRun <$ string "run" cmdS = CS <$ string "s" cmdC = CC <$ string "c" cmdInfoReg, cmdInfoB :: ParseCmd cmdInfoReg = CInfoReg <$ (string "info" >> delimSpace >> string "reg") cmdInfoB = CInfoB <$ (string "info" >> delimSpace >> string "b") -- disassemble cmdDisasAd, cmdDisasCr :: ParseCmd cmdDisasAd = CDisasAd <$> (string "disas" >> delimSpace *> num) cmdDisasCr = CDisasCr <$ string "disas" -- memory access cmdXn, cmdX1, cmdPr, cmdPw :: ParseCmd cmdXn = CX <$> (string "x/" >> num) <*> (delimSpace >> num) cmdX1 = CX 1 <$> (string "x" >> delimSpace *> num) cmdPr = CX 1 <$> (string "p" >> delimSpace >> string "*" >> num) cmdPw = CPw <$> (string "p" >> delimSpace >> string "*" >> num) <*> (skipSpaces >> string "=" >> skipSpaces >> num) -- break utility cmdDelete, cmdEnable, cmdDisable :: ParseCmd cmdDelete = CDelete <$> (string "delete" >> delimSpace *> num) cmdEnable = CEnable <$> (string "enable" >> delimSpace *> num) cmdDisable = CDisable <$> (string "disable" >> delimSpace *> num) -- break and watch cmdB :: ParseCmd cmdB = CB <$> (string "b" >> delimSpace *> num) cmdWatchPc :: ParseCmd cmdWatchPc = CWatchPc <$> (string "watch" >> delimSpace >> string "pc" >> skipSpaces >> dbgord) <*> (skipSpaces >> num) cmdWatchGReg :: ParseCmd cmdWatchGReg = CWatchGReg <$> (string "watch" >> delimSpace >> greg) <*> (skipSpaces >> dbgord) <*> (skipSpaces >> num) cmdWatchDmem :: ParseCmd cmdWatchDmem = CWatchDmem <$> (string "watch" >> delimSpace >> string "*" >> num) <*> (skipSpaces >> dbgord) <*> (skipSpaces >> num) -- utility skipSpaces :: Parser () skipSpaces = skipWhile P8.isHorizontalSpace delimSpace :: Parser () delimSpace = satisfy P8.isHorizontalSpace *> skipWhile P8.isHorizontalSpace -- number num :: Parser Int num = numMinus <|> numHex <|> numNoSign numNoSign :: Parser Int numNoSign = do d <- P.takeWhile1 (inClass "0123456789") return $ read (B.unpack d) numMinus :: Parser Int numMinus = do P8.char8 '-' d <- P.takeWhile1 (inClass "0123456789") return $ read ('-' : B.unpack d) numHex :: Parser Int numHex = do string "0x" d <- P.takeWhile1 (inClass "0123456789abcdef") return $ read ("0x" ++ B.unpack d) -- DbgOrd dbgord :: Parser DbgOrd dbgord = do a <- choice $ map string [ "==" , "!=" , "<=" , "<" , ">=" , ">" ] return $ strToDbgOrd a strToDbgOrd :: B.ByteString -> DbgOrd strToDbgOrd "==" = BEQ strToDbgOrd "!=" = BNE strToDbgOrd "<" = BLT strToDbgOrd "<=" = BLE strToDbgOrd ">" = BGT strToDbgOrd ">=" = BGE strToDbgOrd x = error $ "strToDbgOrd" ++ (show x) -- GReg greg :: Parser GReg greg = do let reverseSortedGregNames = sortBy (flip compare) gregNames a <- choice $ map string reverseSortedGregNames return $ strToGReg a gregNames :: [B.ByteString] gregNames = map (B.pack . (map toLower) . show) [(minBound :: GReg) .. (maxBound :: GReg)] strToGReg :: B.ByteString -> GReg strToGReg x = case (elemIndex x gregNames) of Just n -> toEnum n Nothing -> error $ "strToGReg" ++ (show x) -- $idbnote -- -- Usage: -- -- > q -- Exit debugger -- > help -- Print list of commands -- > run -- Start debugged program -- > s -- Step program -- > c -- Continue program being debugged -- > x -- Examin memory: x(/COUNT) ADDRESS -- > info reg -- List of registers -- > disas -- Disassemble: disassemble (ADDRESS) -- > info b -- Status of breakpoints -- > disable -- Disable breakpoint: disable NUMBER -- > enable -- Enable breakpoint: enable NUMBER -- > delete -- Delete breakpoint: delete NUMBER -- > b -- Set breakpoint: b ADDRESS -- > watch -- Set a watchpoint. example: -- > data memory -- watch *0x80 != 10 -- > pc -- watch pc > 3 -- > register -- watch r7 == 3 -- > p -- Print memory value: p *ADDRESS -- > p -- Set memory value: p *ADDRESS = VALUE -- >