src/GDB.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

module GDB (
    gdbCmd, gdbInit,
    addInferior,
    gdbSession,
) where

import Control.Monad.IO.Class

import Data.Text qualified as T
import Data.Text.IO qualified as T

import System.IO.Error
import System.Process

import Output
import Process

gdbCmd :: String
gdbCmd = "gdb --quiet --interpreter=mi3"

gdbInit :: MonadIO m => Process -> m ()
gdbInit gdb = do
    send gdb $ T.pack "-gdb-set schedule-multiple on"
    send gdb $ T.pack "-gdb-set mi-async on"
    send gdb $ T.pack "-gdb-set print symbol-loading off"

addInferior :: MonadIO m => Process -> Int -> Pid -> m ()
addInferior gdb i pid = do
    send gdb $ T.pack $ "-add-inferior"
    send gdb $ T.pack $ "-target-attach --thread-group i" ++ show i ++ " " ++ show pid
    send gdb $ T.pack $ "-exec-continue --thread-group i" ++ show i

gdbSession :: MonadOutput m => Process -> m ()
gdbSession gdb = do
    outPrompt $ T.pack "gdb> "
    liftIO loop
    outClearPrompt
  where
    loop = catchIOError (Just <$> T.getLine) (\e -> if isEOFError e then return Nothing else ioError e) >>= \case
        Just line -> do
            send gdb (T.pack "-interpreter-exec console \"" `T.append` line `T.append` T.pack "\"")
            loop
        Nothing -> return ()