---------------------------------------------------------------------- -- 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 -- MAINTAINER: Alex Mason -- EMAIL: axman6@gmail.com ---------------------------------------------------------------------- module Arm.Debugger where ---------------------------------------------------------------------- -- Standard libraries. ---------------------------------------------------------------------- import Data.IORef import Data.Array import Data.Array.IO import Data.List import Arm.ParseLib import Data.Word ---------------------------------------------------------------------- -- Local libraries. ---------------------------------------------------------------------- import Arm.CPU import Arm.Decoder import Arm.ExecutionUnit import Arm.Format import Arm.Loader import Arm.Memory import Arm.Parser import Arm.Program import Arm.Register import Arm.RegisterName ---------------------------------------------------------------------- -- Debugger state data structure. ---------------------------------------------------------------------- data DebugState = Debug { bkpts :: [Address] , radix :: Radix } 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 <- getLine putStrLn "" case head 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 '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 } 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 <- emptyCPU memSize writeIORef (debug cpu) True loadProgram cpu program showSurroundingInstructions Hex cpu loop cpu (Debug [] Hex) ---------------------------------------------------------------------- -- 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 pc <- getReg regs R15 case (elemIndex pc bps) of Nothing -> do singleStep cpu 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 mem = memory cpu (lo, hi) <- getBounds mem -- :: IO (Int, Int) let hiByte = hi * 4 let loop addr = do val <- readMem mem 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 = fromIntegral r15 let mem = memory cpu -- let bounds = range mem bounds <- getBounds mem let hiBound = fromIntegral (snd bounds) * 4 let addrsLo = dropWhile (< 0) [pc - 20, pc - 16 .. pc - 4] let shLo = map (showInstruction radix mem False) (map fromIntegral addrsLo) let addrsHi = takeWhile (< hiBound) [pc + 4, pc + 8 .. pc + 20] let shHi = map (showInstruction radix mem False) (map fromIntegral addrsHi) sequence shLo showInstruction radix mem True (fromIntegral pc) sequence shHi ---------------------------------------------------------------------- -- Show current instruction (highlighted). ---------------------------------------------------------------------- showInstruction :: Radix -> Memory -> Bool -> Address -> IO () showInstruction radix mem highlight addr = do opcode <- readMem mem 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 ----------------------------------------------------------------------