{-# OPTIONS -Wall #-}
{-# LANGUAGE OverloadedStrings #-}


module Language.Pck.Tool.Debugger (
        -- * Debugger drivers
          runDbg
        , runDbgIO
        , evalProgDbg
        -- * Data type
        -- ** trace
        , TrcLog
        , DbgTrc(..)
        -- ** break
        , DbgBrk(..)
        , DbgOrd(..)
  )where

import Control.Monad.State
import qualified Data.ByteString.Char8 as B
import Text.Printf (printf)
import Data.List (intercalate)

import Language.Pck.Cpu.Instruction
import Language.Pck.Cpu.Memory
import Language.Pck.Cpu.Register
import Language.Pck.Cpu.State
import Language.Pck.Cpu.Execution



----------------------------------------
--  driver
----------------------------------------
-- | debugging run
--
-- Example: run with a break condition. (break at pc == 1)
--
-- >  > runDbg [] [(BrkPc BEQ 1)] [(0,[MOVI R0 7, MOVI R1 8, HALT])] []
-- >  pc : 1
-- >  gr : [7,0,0,0,0,0,0,0]
-- >  fl : [False,False]
--
--
-- Example: run with trace output. (instruction trace)
--
-- >  > runDbg [TrcInst] [] [(0,[MOVI R0 7, MOVI R1 8, HALT])] []
-- >  TrcInst:        pc : 0  MOVI R0 7
-- >  
-- >  TrcInst:        pc : 1  MOVI R1 8
-- >  
-- >  TrcInst:        pc : 2  HALT
--
runDbg :: [DbgTrc] -> [DbgBrk] -> InstImage -> DataImage -> (TrcLog, CpuState)
runDbg dbgtrc dbgbrk insts vals = runState (evalProgDbg dbgtrc dbgbrk)
                                    (initCpuStateMem insts vals)


-- | debugging run for IO output
--
-- Example: run with trace output. (instruction trace)
--
-- >  > runDbgIO [TrcInst] [] [(0,[MOVI R0 7, MOVI R1 8, HALT])] []
-- >  TrcInst:        pc : 0  MOVI R0 7
-- >  
-- >  TrcInst:        pc : 1  MOVI R1 8
-- >  
-- >  TrcInst:        pc : 2  HALT
--
runDbgIO :: [DbgTrc] -> [DbgBrk] -> InstImage -> DataImage -> IO ()
runDbgIO dbgtrc dbgbrk insts vals =
    let (trc, _) = runDbg dbgtrc dbgbrk insts vals
    in  putStr $ B.unpack trc

-- evaluate a program with debuggin
evalProgDbg :: [DbgTrc] -> [DbgBrk] -> EvalCpu TrcLog
evalProgDbg dbgtrc dbgbrk = loop B.empty 0
    where loop trclog cnt = do trclog' <- tracePre dbgtrc trclog
                               res  <- evalProg True
                               res' <- checkBreak dbgbrk res
                               trclog'' <- tracePost dbgtrc trclog'
                               checkRunLimit cnt
                               case res' of
                                 RsNormal -> loop trclog'' (cnt+1)
                                 RsErr e  -> error $ show trclog'' ++ "\n\n"
                                                     ++ e ++ "\n"
                                 _        -> return trclog''

-- run limiter for inf loop
dbgRunLimit :: Int
dbgRunLimit = 1000000

checkRunLimit :: Int -> EvalCpu ()
checkRunLimit n
    | n < dbgRunLimit = return ()
    | otherwise       = do s <- get
                           error $ "RUN COUNT OVER!\n" ++ show s


----------------------------------------
--  debug trace
----------------------------------------
-- | data type for 'runDbg' log
type TrcLog = B.ByteString

-- | trace conditions for 'runDbg' or 'runDbgIO'
data DbgTrc = TrcInst   -- ^ trace instructions
            | TrcReg    -- ^ trace registers
            | TrcPc     -- ^ trace pc
            | TrcCall   -- ^ trace call target address
            | TrcBranch -- ^ trace branch information
            | TrcLoad   -- ^ trace memory load
            | TrcStore  -- ^ trace memory store
            deriving (Show, Eq)

-- pre/post trace
tracePre, tracePost :: [DbgTrc] -> TrcLog -> EvalCpu TrcLog
tracePre  = traceMany [TrcInst, TrcPc, TrcBranch, TrcCall, TrcLoad, TrcStore]
tracePost = traceMany [TrcReg]

traceMany :: [DbgTrc] -> [DbgTrc] -> TrcLog -> EvalCpu TrcLog
traceMany target dbgtrc trclog = do let list = filter (`elem` target) dbgtrc
                                    l <- mapM traceOne list
                                    return $ B.append trclog (B.concat l)

traceOne :: DbgTrc -> EvalCpu TrcLog
traceOne TrcPc     = tracePc
traceOne TrcInst   = traceInst
traceOne TrcReg    = traceReg
traceOne TrcCall   = traceCall
traceOne TrcBranch = traceBranch
traceOne TrcLoad   = traceLoad
traceOne TrcStore  = traceStore


-- each trace
tracePc :: EvalCpu TrcLog
tracePc = do pc <- readPc
             return $ B.pack $ concat ["TrcPc:\tpc : ", (pprHex pc), "\n"]

traceInst :: EvalCpu TrcLog
traceInst = do pc <- readPc
               inst <- fetchInst
               return $ B.pack $ concat [ "TrcInst:\tpc : ",  (pprHex pc), "\t"
                                        , (show inst), "\n\n"]

traceReg :: EvalCpu TrcLog
traceReg = do stat <- get
              return $ B.pack $ concat
                    [ "TrcReg:\n"
                    , "pc : ",  pprHex (pcFromCpuState stat)
                    , "\ngr : ", pprHexList (grFromCpuState stat)
                    , "\nfl : ", show (flFromCpuState stat), "\n\n"]


traceLoad :: EvalCpu TrcLog
traceLoad = traceAddress isLoadInst "TrcLoad:\tload-ad : "

traceStore :: EvalCpu TrcLog
traceStore = traceAddress isStoreInst "TrcStore:\tstore-ad : "

traceCall :: EvalCpu TrcLog
traceCall = traceAddress isCallInst "TrcCall:\ttarget : "

traceAddress :: (Inst -> Maybe GReg) -> String -> EvalCpu TrcLog
traceAddress prd str =  do pc <- readPc
                           inst <- fetchInst
                           case (prd inst) of
                             Just reg -> do ad <- readGReg reg
                                            return $ pprSIIInst str ad pc inst
                             _        -> return ""

isLoadInst :: Inst -> Maybe GReg
isLoadInst (LD _ reg) = Just reg
isLoadInst _          = Nothing

isStoreInst :: Inst -> Maybe GReg
isStoreInst (ST reg _) = Just reg
isStoreInst _          = Nothing

isCallInst :: Inst -> Maybe GReg
isCallInst (CALL reg) = Just reg
isCallInst _          = Nothing


traceBranch :: EvalCpu TrcLog
traceBranch = do pc <- readPc
                 inst <- fetchInst
                 case inst of
                   BRI cond imm -> do flag <- readFlags
                                      let strTaken = if (judgeFCond flag cond)
                                                       then "Taken" else "Not"
                                      return $ pprTrcBranch
                                                 (pc+imm) strTaken pc inst

                   JRI      imm -> return $ pprTrcBranch
                                              (pc+imm) "Taken" pc inst

                   J        reg -> do ad <- readGReg reg
                                      return $ pprTrcBranch ad "Taken" pc inst

                   CALL     reg -> do ad <- readGReg reg
                                      return $ pprTrcBranch ad "Taken" pc inst

                   _            -> return ""

-- pretty print utility
pprHex :: Int -> String
pprHex = printf "0x%x"

pprHexList :: [Int] -> String
pprHexList xs = "[" ++ (intercalate "," (map pprHex xs)) ++ "]"

pprSIIInst :: String -> Int -> Int -> Inst -> TrcLog
pprSIIInst str n pc inst = B.pack $ concat
                             [ str, (show n), "\t -- "
                             , "pc : " , (show pc), "\t"
                             , (show inst), "\n\n" ]

pprTrcBranch :: Int -> String -> Int -> Inst -> TrcLog
pprTrcBranch ad str pc inst = B.pack $ concat
                                [ "TrcBranch:\ttarget : ", (show ad), "\t"
                                , str, "\t -- "
                                , "pc : ", (show pc), "\t"
                                , (show inst) , "\n\n" ]


----------------------------------------
--  debug break
----------------------------------------

-- | break conditions
--
-- Example:
--
-- >  BrkPc BEQ 3          -- pc == 3
-- >  BrkPc BGE 0x80       -- pc >= 0x80
-- >  BrkGReg R0 BEQ 7     -- R0 == 7
-- >  BrkDmem 0x20 BLT 4   -- *0x20 < 4
--
data DbgBrk = BrkNon                  -- ^ no break
            | BrkOne                  -- ^ always one step break
            | BrkPc   DbgOrd Int      -- ^ pc break
            | BrkGReg GReg DbgOrd Int -- ^ register break
            | BrkDmem Int DbgOrd Int  -- ^ data memory break
            deriving (Eq)

-- | break operators
data DbgOrd = BEQ  -- ^ equal
            | BNE  -- ^ not equal
            | BLT  -- ^ little than
            | BLE  -- ^ little equal
            | BGT  -- ^ greater than
            | BGE  -- ^ greater equal
            deriving (Eq, Show)



-- user break setting 
checkBreak :: [DbgBrk] -> ResultStat -> EvalCpu ResultStat
checkBreak [] res    = return res
checkBreak dbgbrk res = do b <- mapM breakOne dbgbrk
                           return $ if (RsDbgBrk `elem` b)
                                      then RsDbgBrk else res

breakOne :: DbgBrk -> EvalCpu ResultStat
breakOne (BrkNon)   = return RsNormal
breakOne (BrkOne)   = return RsDbgBrk

breakOne (BrkPc o v) = do pc <- readPc
                          return $ if (ordFunc o) pc v
                                     then RsDbgBrk else RsNormal

breakOne (BrkGReg reg o v) = do reg' <- readGReg reg
                                return $ if (ordFunc o) reg' v
                                           then RsDbgBrk else RsNormal

breakOne (BrkDmem ad o v) = do mem <- readDmem ad
                               return $ if (ordFunc o) mem v
                                          then RsDbgBrk else RsNormal

ordFunc :: DbgOrd -> (Int -> Int -> Bool)
ordFunc BEQ = (==)
ordFunc BNE = (/=)
ordFunc BLT = (<)
ordFunc BLE = (<=)
ordFunc BGT = (>)
ordFunc BGE = (>=)