HARM-0.1.3: Arm/Debugger.hs
----------------------------------------------------------------------
-- 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
----------------------------------------------------------------------