---------------------------------------------------------------------- -- FILE: Debugger.hs -- DESCRIPTION: -- DATE: 03/27/2001 -- PROJECT: -- LANGUAGE PLATFORM: -- OS PLATFORM: RedHat Linux 6.2 -- AUTHOR: Jeffrey A. Meunier -- EMAIL: jeffm@cse.uconn.edu ---------------------------------------------------------------------- module Debugger where ---------------------------------------------------------------------- -- Standard libraries. ---------------------------------------------------------------------- import IOExts import List import ParseLib import Word ---------------------------------------------------------------------- -- Local libraries. ---------------------------------------------------------------------- import CPU import Decoder import ExecutionUnit import Format import Loader import Memory import MemoryManager import Parser import Program import Register import RegisterName import Swi ---------------------------------------------------------------------- -- Debugger state data structure. ---------------------------------------------------------------------- data DebugState = Debug { bkpts :: [Address] , radix :: Radix , dumpRange :: [(Address, Address)] } deriving (Show) ---------------------------------------------------------------------- -- Debug a program, displaying the instruction at each step. ---------------------------------------------------------------------- dbg :: Program -> IO () dbg program = let loop cpu dbgs = do isRunning <- readIORef (running cpu) if not isRunning then return () else do putStr "dbg: " cmd <- getChar putStrLn "" case cmd of 'm' -> do showMem (radix dbgs) cpu loop cpu dbgs 'r' -> do showRegs (radix dbgs) cpu loop cpu dbgs 'q' -> return () 'n' -> do singleStep cpu showSurroundingInstructions (radix dbgs) cpu loop cpu dbgs '?' -> do showHelp loop cpu dbgs 'b' -> do dbgs <- addBreakpoint dbgs loop cpu dbgs 's' -> do showDebugState dbgs loop cpu dbgs 't' -> do displayString cpu loop cpu dbgs 'g' -> do runToBreakpoint cpu dbgs loop cpu dbgs 'h' -> do putStrLn "hex" loop cpu dbgs { radix = Hex } 'd' -> do putStrLn "decimal" loop cpu dbgs { radix = Dec } 'e' -> do ranges <- getDumpRange (dumpRange dbgs) loop cpu dbgs { dumpRange = ranges } 'u' -> do dumpMem (memman cpu) (dumpRange dbgs) (radix dbgs) loop cpu dbgs x -> if and [x >= '1', x <= '9'] then do stepTimes cpu ((fromEnum x) - (fromEnum '0')) showSurroundingInstructions (radix dbgs) cpu loop cpu dbgs else do showSurroundingInstructions (radix dbgs) cpu loop cpu dbgs memSize = (memorySize program `div` 4) + 1 in do cpu <- mkCPU memSize writeIORef (debug cpu) True loadProgram cpu program showSurroundingInstructions Hex cpu loop cpu (Debug [] Hex []) ---------------------------------------------------------------------- -- Dump a memory range. ---------------------------------------------------------------------- dumpMem :: MemoryManager -> [(Address, Address)] -> Radix -> IO () dumpMem memman ranges rad = do showMemRanges 1 ranges putStr "range to dump: " rangeStr <- getLine case papply pIntegral rangeStr of [(rangeNum, _)] -> if (fromIntegral rangeNum) > length ranges then putStrLn "no such range" else do let [range] = take 1 (drop ((fromIntegral rangeNum) - 1) ranges) dumpMemRange rad memman range return () _ -> do putStrLn "Parse error" return () where showMemRanges _ [] = return () showMemRanges n ((start, end) : ranges) = do --putStrLn (show n ++ ": " ++ show start ++ " - " ++ show end) putStrLn (show n ++ ": " ++ formatNum rad start ++ " - " ++ formatNum rad end) showMemRanges (n+1) ranges dumpMemRange rad memman (lo, hi) | lo > hi = return () | otherwise = do val <- mmRead memman lo putStrLn (" " ++ (formatNum rad lo) ++ ": " ++ (formatNum rad val)) dumpMemRange rad memman (lo+4, hi) ---------------------------------------------------------------------- -- Get memory dump range. ---------------------------------------------------------------------- getDumpRange :: [(Address, Address)] -> IO [(Address, Address)] getDumpRange ranges = do putStrLn "Get dump range" putStr "Start address: " addrStr <- getLine case papply pIntegral addrStr of [(startAddr, _)] -> do putStr "End address: " addrStr' <- getLine case papply pIntegral addrStr' of [(endAddr, _)] -> return (ranges ++ [(startAddr, endAddr)]) _ -> do putStrLn "Parse error" return ranges _ -> do putStrLn "Parse error" return ranges ---------------------------------------------------------------------- -- Show a string in memory. ---------------------------------------------------------------------- displayString cpu = do putStr "string starting address: " addrStr <- getLine case papply pIntegral addrStr of [(addr, _)] -> do s <- fetchString (memman cpu) addr putStrLn s _ -> return () ---------------------------------------------------------------------- -- Run the cpu to a breakpoint, or until finished. ---------------------------------------------------------------------- runToBreakpoint cpu dbgs = let rad = radix dbgs bps = bkpts dbgs regs = registers cpu loop = do isRunning <- readIORef (running cpu) if (not isRunning) then return () else do singleStep cpu pc <- getReg regs R15 case (elemIndex pc bps) of Nothing -> loop Just _ -> do showSurroundingInstructions rad cpu return () in loop ---------------------------------------------------------------------- -- ---------------------------------------------------------------------- stepTimes cpu n = if n == 0 then return () else do isRunning <- readIORef (running cpu) if not isRunning then return () else do singleStep cpu stepTimes cpu (n-1) ---------------------------------------------------------------------- -- Add a breakpoint to the breakpoint list. ---------------------------------------------------------------------- addBreakpoint :: DebugState -> IO DebugState addBreakpoint dbgs = do putStr "break address: " addrStr <- getLine case papply pIntegral addrStr of [(addr, _)] -> return dbgs { bkpts = addr : (bkpts dbgs) } _ -> return dbgs ---------------------------------------------------------------------- -- Show the current debug state. ---------------------------------------------------------------------- showDebugState dbgs = putStrLn (show dbgs) ---------------------------------------------------------------------- -- Show help message. ---------------------------------------------------------------------- showHelp :: IO () showHelp = do putStrLn " b: add breakpoint" putStrLn " d: decimal" putStrLn " g: go (run to next breakpoint)" putStrLn " h: hexadecimal" putStrLn " m: dump memory" putStrLn " q: quit" putStrLn " r: show registers" putStrLn " s: show debug state" putStrLn " 1-9: step program 1-9 times" putStrLn " ?: this help message" ---------------------------------------------------------------------- -- Show memory. ---------------------------------------------------------------------- showMem :: Radix -> CPU -> IO () showMem radix cpu = do let mm = memman cpu let mem = mmMem mm let (lo, hi) = boundsIOArray mem let hiByte = hi * 4 let loop addr = do val <- mmRead mm addr if addr >= hiByte then return () else do putStrLn (" " ++ (formatNum radix addr) ++ ": " ++ (formatNum radix val)) loop (addr + 4) loop lo ---------------------------------------------------------------------- -- Show all registers. ---------------------------------------------------------------------- showRegs :: Radix -> CPU -> IO () showRegs radix cpu = let regs = registers cpu showReg regName = do regVal <- getReg regs regName putStr ((show regName) ++ "=" ++ (formatNum radix regVal)) in do { putStr " "; showReg R0; putStr " "; showReg R4; putStr " "; showReg R8; putStr " "; showReg R12; putStrLn ""; putStr " "; showReg R1; putStr " "; showReg R5; putStr " "; showReg R9; putStr " "; showReg R13; putStrLn ""; putStr " "; showReg R2; putStr " "; showReg R6; putStr " "; showReg R10; putStr " "; showReg R14; putStrLn ""; putStr " "; showReg R3; putStr " "; showReg R7; putStr " "; showReg R11; putStr " "; showReg R15; putStrLn ""; showReg CPSR; putStr " ("; showCPSRFlags regs; putStrLn ")" } ---------------------------------------------------------------------- -- Show instructions before and after current instruction. ---------------------------------------------------------------------- showSurroundingInstructions radix cpu = do let regs = registers cpu r15 <- getReg regs R15 let pc = word32ToInt r15 let mm = memman cpu let mem = mmMem mm let bounds = boundsIOArray mem let hiBound = word32ToInt (snd bounds) * 4 let addrsLo = dropWhile (< 0) [pc - 20, pc - 16 .. pc - 4] let shLo = map (showInstruction radix mm False) (map intToWord32 addrsLo) let addrsHi = takeWhile (< hiBound) [pc + 4, pc + 8 .. pc + 20] let shHi = map (showInstruction radix mm False) (map intToWord32 addrsHi) sequence shLo showInstruction radix mm True (intToWord32 pc) sequence shHi ---------------------------------------------------------------------- -- Show current instruction (highlighted). ---------------------------------------------------------------------- showInstruction :: Radix -> MemoryManager -> Bool -> Address -> IO () showInstruction radix mm highlight addr = do opcode <- mmRead mm addr let instr = decode opcode let hexOp = formatHex 8 '0' "" opcode putStr ((if highlight then ">" else " ") ++ (formatNum radix addr) ++ ": " ++ (formatNum radix opcode) ++ " " ++ (if highlight then ">" else " ")) case instr of Nothing -> putStrLn "" Just instr' -> putStrLn (show instr') ---------------------------------------------------------------------- -- eof ----------------------------------------------------------------------