compiler/ghci/Debugger.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- GHCi Interactive debugging commands
   4 --
   5 -- Pepe Iborra (supported by Google SoC) 2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module Debugger where
  10
  11 import Linker
  12 import Breakpoints
  13 import RtClosureInspect
  14
  15 import PrelNames
  16 import HscTypes
  17 import IdInfo
  18 --import Id
  19 import Var hiding ( varName )
  20 import VarSet
  21 import VarEnv
  22 import Name
  23 import NameEnv
  24 import RdrName
  25 import Module
  26 import Finder
  27 import UniqSupply
  28 import Type
  29 import TyCon
  30 import DataCon
  31 import TcGadt
  32 import GHC
  33 import GhciMonad
  34 import PackageConfig
  35
  36 import Outputable
  37 import ErrUtils
  38 import FastString
  39 import SrcLoc
  40 import Util
  41
  42 import Control.Exception
  43 import Control.Monad
  44 import qualified Data.Map as Map
  45 import Data.Array.Unboxed
  46 import Data.Traversable ( traverse )
  47 import Data.Typeable             ( Typeable )
  48 import Data.Maybe
  49 import Data.IORef
  50
  51 import System.IO
  52 import GHC.Exts
  53
  54 #include "HsVersions.h"
  55
  56 -----------------------------
  57 -- | The :breakpoint command
  58 -----------------------------
  59 bkptOptions :: String -> GHCi ()
  60 bkptOptions cmd = do
  61   dflags <- getDynFlags
  62   bt     <- getBkptTable
  63   bkptOptions' (words cmd) bt
  64    where
  65     bkptOptions' ["list"] bt = do
  66       let msgs = [ ppr mod <+> colon <+> ppr coords
  67                    | (mod,site) <- btList bt
  68                    , let coords = getSiteCoords bt mod site]
  69           num_msgs = [parens (int n) <+> msg | (n,msg) <- zip [1..] msgs]
  70       msg <- showForUser$ if null num_msgs
  71                             then text "There are no enabled breakpoints"
  72                             else vcat num_msgs
  73       io$ putStrLn msg
  74
  75     bkptOptions' ["stop"] bt = do
  76         inside_break <- liftM not isTopLevel
  77         when inside_break $ throwDyn StopChildSession
  78
  79     bkptOptions' ("add":cmds) bt
  80       | [mod_name,line]<- cmds
  81       , [(lineNum,[])] <- reads line
  82       =  handleAdd mod_name $ (\mod->addBkptByLine mod lineNum)
  83
  84       | [mod_name,line,col] <- cmds
  85       = handleAdd mod_name $ (\mod->addBkptByCoord mod (read line, read col))
  86
  87       | otherwise = throwDyn $ CmdLineError $
  88                        "syntax: :breakpoint add Module line [col]"
  89        where
  90          handleAdd mod_name f = do
  91            sess        <- getSession
  92            dflags      <- getDynFlags
  93            mod         <- io$ GHC.findModule sess (GHC.mkModuleName mod_name) Nothing
  94            ghciHandleDyn (handleBkptEx mod) $
  95             case f mod bt of
  96              (newTable, site)  -> do
  97                setBkptTable newTable
  98                io (putStrLn ("Breakpoint set at " ++
  99                               show (getSiteCoords newTable mod site)))
 100
 101     bkptOptions' ("del":cmds) bt
 102       | [i']     <- cmds
 103       , [(i,[])] <- reads i'
 104       , bkpts    <- btList bt
 105       = if i > length bkpts
 106            then throwDyn $ CmdLineError
 107               "Not a valid breakpoint #. Use :breakpoint list to see the current breakpoints."
 108            else
 109              let (mod, site) = bkpts !! (i-1)
 110              in handleDel mod $ delBkptBySite mod site
 111
 112       | [fn,line]      <- cmds
 113       , [(lineNum,[])] <- reads line
 114       , mod            <- GHC.mkModule mainPackageId (GHC.mkModuleName fn)
 115       = handleDel mod $  delBkptByLine mod lineNum
 116
 117       | [fn,line,col]  <- cmds
 118       , [(lineNum,[])] <- reads line
 119       , [(colNum,[])]  <- reads col
 120       , mod            <- GHC.mkModule mainPackageId (GHC.mkModuleName fn)
 121       = handleDel mod $ delBkptByCoord mod (lineNum, colNum)
 122
 123       | otherwise = throwDyn $ CmdLineError $
 124              "syntax: :breakpoint del (breakpoint # | Module line [col])"
 125
 126        where delMsg = "Breakpoint deleted"
 127              handleDel mod f = ghciHandleDyn (handleBkptEx mod) $ do
 128                modifyBkptTable f
 129                newTable <- getBkptTable
 130                sess <- getSession
 131                dflags <- getDynFlags
 132                io$ putStrLn delMsg
 133
 134     bkptOptions' _ _ = throwDyn $ CmdLineError $
 135                          "syntax: :breakpoint (list|stop|add|del)"
 136
 137     handleBkptEx :: Module -> Debugger.BkptException -> a
 138     handleBkptEx _ NoBkptFound = error "No suitable breakpoint site found"  --TODO Automatically add to the next suitable line
 139     handleBkptEx _ NotNeeded   = error "Nothing to do"
 140     handleBkptEx m NotHandled  = error$ "Module " ++ showSDoc (ppr m) ++  " was not loaded under debugging mode. Enable debugging mode and reload it"
 141
 142 -------------------------
 143 -- Breakpoint Tables
 144 -------------------------
 145
 146 data BkptTable a  = BkptTable {
 147                            -- | An array of breaks, indexed by site number
 148      breakpoints :: Map.Map a (UArray Int Bool)
 149                            -- | A list of lines, each line can have zero or more sites, which are annotated with a column number
 150    , sites       :: Map.Map a [[(SiteNumber, Int)]]
 151    }
 152
 153 sitesOf :: Ord a => BkptTable a -> a -> Maybe [[(SiteNumber, Int)]]
 154 sitesOf bt fn = Map.lookup fn (sites bt)
 155 bkptsOf bt fn = Map.lookup fn (breakpoints bt)
 156
 157
 158 -- The functions for manipulating BkptTables do throw exceptions
 159 data BkptException =
 160                     NotHandled
 161                   | NoBkptFound
 162                   | NotNeeded   -- Used when a breakpoint was already enabled
 163   deriving Typeable
 164
 165 emptyBkptTable :: Ord a => BkptTable a
 166 addModule      :: Ord a => a -> [(SiteNumber,Coord)] -> BkptTable a -> BkptTable a
 167 -- | Lines start at index 1
 168 addBkptByLine  :: Ord a => a -> Int        -> BkptTable a -> (BkptTable a, SiteNumber)
 169 addBkptByCoord :: Ord a => a -> Coord      -> BkptTable a -> (BkptTable a, SiteNumber)
 170 delBkptByLine  :: Ord a => a -> Int        -> BkptTable a -> BkptTable a
 171 delBkptBySite  :: Ord a => a -> SiteNumber -> BkptTable a -> BkptTable a
 172 delBkptByCoord :: Ord a => a -> Coord      -> BkptTable a -> BkptTable a
 173
 174 isBkptEnabled  :: Ord a => BkptTable a -> BkptLocation a -> Bool
 175 btElems        :: Ord a => BkptTable a -> [(a, [SiteNumber])]
 176 btList         :: Ord a => BkptTable a -> [BkptLocation a]
 177 sitesList      :: Ord a => BkptTable a -> [(a, [Coord])]
 178 getSiteCoords  :: Ord a => BkptTable a -> a -> SiteNumber -> Coord
 179
 180 emptyBkptTable = BkptTable Map.empty Map.empty
 181
 182 addBkptByLine a i bt
 183    | Just lines    <- sitesOf bt a
 184    , Just bkptsArr <- bkptsOf bt a
 185    , i < length lines
 186    = case lines!!i of
 187        []    -> throwDyn NoBkptFound
 188        (x:_) -> let (siteNum,col) = x
 189                     wasAlreadyOn  = bkptsArr ! siteNum
 190                     newArr        = bkptsArr // [(siteNum, True)]
 191                     newTable      = Map.insert a newArr (breakpoints bt)
 192         in if wasAlreadyOn
 193            then throwDyn NotNeeded
 194            else (bt{breakpoints=newTable}, siteNum)
 195
 196    | Just sites    <- sitesOf bt a
 197    = throwDyn NoBkptFound
 198    | otherwise     = throwDyn NotHandled
 199
 200 addBkptByCoord a (r,c) bt
 201    | Just lines    <- sitesOf bt a
 202    , Just bkptsArr <- bkptsOf bt a
 203    , r < length lines
 204        = case [ (sn,col) | (sn,col)<-lines!!r, col>=c] of
 205        []    -> throwDyn NoBkptFound
 206        (x:_) -> let (siteNum, col) = x
 207                     wasAlreadyOn  = bkptsArr ! siteNum
 208                     newArr        = bkptsArr // [(siteNum, True)]
 209                     newTable      = Map.insert a newArr (breakpoints bt)
 210         in if wasAlreadyOn
 211            then throwDyn NotNeeded
 212            else (bt{breakpoints=newTable}, siteNum)
 213
 214    | Just sites    <- sitesOf bt a
 215    = throwDyn NoBkptFound
 216    | otherwise     = throwDyn NotHandled
 217
 218 delBkptBySite a i bt
 219    | Just bkptsArr <- bkptsOf bt a
 220    , not (inRange (bounds bkptsArr) i)
 221    = throwDyn NoBkptFound
 222
 223    | Just bkptsArr <- bkptsOf bt a
 224    , bkptsArr ! i     -- Check that there was a enabled bkpt here
 225    , newArr        <- bkptsArr // [(i,False)]
 226    , newTable      <- Map.insert a newArr (breakpoints bt)
 227    = bt {breakpoints=newTable}
 228
 229    | Just sites    <- sitesOf bt a
 230    = throwDyn NotNeeded
 231
 232    | otherwise = throwDyn NotHandled
 233
 234 delBkptByLine a l bt
 235    | Just sites    <- sitesOf bt a
 236    , (site:_)      <- [s | (s,c') <- sites !! l]
 237    = delBkptBySite a site bt
 238
 239    | Just sites    <- sitesOf bt a
 240    = throwDyn NoBkptFound
 241
 242    | otherwise = throwDyn NotHandled
 243
 244 delBkptByCoord a (r,c) bt
 245    | Just sites    <- sitesOf bt a
 246    , (site:_)      <- [s | (s,c') <- sites !! r, c>=c', isBkptEnabled bt (a,s)]
 247    = delBkptBySite a site bt
 248
 249    | Just sites    <- sitesOf bt a
 250    = throwDyn NoBkptFound
 251
 252    | otherwise = throwDyn NotHandled
 253
 254 btElems bt = [ (a, [i | (i,True) <- assocs siteArr])
 255              | (a, siteArr) <- Map.assocs (breakpoints bt) ]
 256
 257 btList bt =  [(a,site) | (a, sites) <- btElems bt, site <- sites]
 258
 259 sitesList bt = [ (a, sitesCoords sitesCols) | (a, sitesCols) <- Map.assocs (sites bt) ]
 260     where sitesCoords sitesCols =
 261               [ (row,col)
 262                 | (row, cols) <- zip [0..] sitesCols, (_,col) <- cols ]
 263
 264 getSiteCoords bt a site
 265    | Just rows <- sitesOf bt a
 266    = head [ (r,c) | (r,row) <- zip [0..] rows
 267                   , (s,c)   <- row
 268                   , s == site ]
 269
 270 -- addModule is dumb and inefficient, but it does the job
 271 --addModule fn siteCoords _ | trace ("addModule: " ++ moduleString (unsafeCoerce# fn) ++ " - " ++ show siteCoords) False = undefined
 272 addModule a [] bt = bt
 273 addModule a siteCoords bt
 274    | nrows        <- maximum$ [i | (_,(i,j)) <- siteCoords ]
 275    , sitesByRow   <- [ [(s,c) | (s,(r,c)) <- siteCoords, r==i]
 276                        | i <- [0..nrows] ]
 277    , nsites       <- length siteCoords
 278    , initialBkpts <- listArray (1, nsites) (repeat False)
 279    = bt{ sites       = Map.insert a sitesByRow (sites bt)
 280        , breakpoints = Map.insert a initialBkpts (breakpoints bt) }
 281
 282 isBkptEnabled bt (a,site)
 283    | Just bkpts <- bkptsOf bt a
 284    , inRange (bounds bkpts) site
 285    = bkpts ! site
 286    | otherwise = throwDyn NotHandled            -- This is an error
 287
 288 -----------------
 289 -- Other stuff
 290 -----------------
 291 refreshBkptTable :: [ModSummary] -> GHCi ()
 292 refreshBkptTable [] = return ()
 293 refreshBkptTable (ms:mod_sums) = do
 294     sess   <- getSession
 295     when (Opt_Debugging `elem` flags (GHC.ms_hspp_opts ms)) $ do
 296       old_table <- getBkptTable
 297       new_table <- addModuleGHC sess old_table (GHC.ms_mod ms)
 298       setBkptTable new_table
 299     refreshBkptTable mod_sums
 300   where addModuleGHC sess bt mod = do
 301           Just mod_info <- io$ GHC.getModuleInfo sess mod
 302           dflags <- getDynFlags
 303           let sites = GHC.modInfoBkptSites mod_info
 304           io$ debugTraceMsg dflags 2
 305                 (ppr mod <> text ": inserted " <> int (length sites) <>
 306                  text " breakpoints")
 307           return$ addModule mod sites bt