module Arm.Debugger
where
import Data.IORef
import Data.Array
import Data.Array.IO
import Data.List
import Arm.ParseLib
import Data.Word
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
data DebugState
= Debug
{ bkpts :: [Address]
, radix :: Radix
}
deriving (Show)
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)
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 (n1)
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
showDebugState dbgs
= putStrLn (show dbgs)
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"
showMem
:: Radix
-> CPU
-> IO ()
showMem radix cpu
= do let mem = memory cpu
(lo, hi) <- getBounds mem
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
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 ")" }
showSurroundingInstructions radix cpu
= do let regs = registers cpu
r15 <- getReg regs R15
let pc = fromIntegral r15
let mem = memory cpu
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
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')