module Gdbmi.Commands
(
break_after,
break_commands,
break_condition,
break_delete,
break_disable,
break_enable,
break_info,
break_insert,
break_list,
break_passcount,
break_watch,
exec_arguments,
environment_cd,
environment_directory,
environment_path,
environment_pwd,
thread_info,
thread_list_ids,
thread_select,
ada_task_info,
exec_continue,
exec_finish,
exec_interrupt,
exec_jump,
exec_next,
exec_next_instruction,
exec_return,
exec_run,
exec_step,
exec_step_instruction,
exec_until,
stack_info_frame,
stack_info_depth,
stack_list_arguments,
stack_list_arguments',
stack_list_frames,
stack_list_locals,
stack_list_locals',
stack_list_variables,
stack_list_variables',
stack_select_frame,
enable_pretty_printing,
var_create,
var_delete,
var_set_format,
var_gdbShow_format,
var_info_num_children,
var_list_children,
var_list_children',
var_info_type,
var_info_expression,
var_info_path_expressoin,
var_gdbShow_attributes,
var_evaluate_expression,
var_assign,
var_update,
var_set_frozen,
var_set_update_range,
var_set_visualizer,
data_disassemble,
data_evaluate_expression,
data_list_changed_registers,
data_list_register_names,
data_list_register_values,
data_read_memory,
data_read_memory_bytes,
data_write_memory_bytes,
trace_find,
trace_define_variable,
trace_list_variables,
trace_save,
trace_start,
trace_status,
trace_stop,
symbol_list_lines,
file_exec_and_symbols,
file_exec_file,
file_list_exec_source_file,
file_list_exec_source_files,
file_symbol_file,
target_attach,
target_detach,
target_disconnect,
target_download,
target_select,
target_file_put,
target_file_get,
target_file_delete,
gdb_exit,
gdb_set,
gdb_gdbShow,
gdb_version,
list_features,
list_target_features,
list_thread_groups,
info_os,
add_inferior,
interpreter_exec,
inferior_tty_set,
inferior_tty_gdbShow,
enable_timings,
Location,
positive_offset_location,
negative_offset_location,
file_line_location,
function_location,
function_label_location,
file_function_location,
label_location,
plain_address_location,
expr_address_location,
func_address_location,
file_func_address_location,
PrintValues(..),
FrameSelect(..),
FormatSpec(..),
FrozenFlag(..),
DisassemblyMode(..),
DataFormat(..),
OutputFormat(..),
TraceMode(..),
Target(..),
Medium(..),
Interpreter(..),
cli_command,
set_token
) where
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import Prelude hiding (reverse, all, lines)
import Gdbmi.Representation (Command(..), Option(..), Token, Parameter(..), render_command)
class GdbShow a where
gdbShow :: a -> String
instance GdbShow Char where
gdbShow = (:[])
instance GdbShow a => GdbShow [a] where
gdbShow = concatMap gdbShow
instance GdbShow Int where
gdbShow = show
newtype Location = Location String
instance GdbShow Location where
gdbShow (Location location) = location
positive_offset_location :: Int -> Location
positive_offset_location offset = Location $ "+" ++ gdbShow offset
negative_offset_location :: Int -> Location
negative_offset_location offset = Location $ "-" ++ gdbShow offset
file_line_location :: String -> Int -> Location
file_line_location filename linenum = Location $ filename ++ ":" ++ gdbShow linenum
function_location :: String -> Location
function_location = Location
function_label_location :: String -> String -> Location
function_label_location function label = Location $ function ++ ":" ++ label
file_function_location :: String -> String -> Location
file_function_location filename function = Location $ filename ++ ":" ++ function
label_location :: String -> Location
label_location = Location
plain_address_location :: String -> Location
plain_address_location addr = Location $ "*" ++ addr
expr_address_location :: String -> Location
expr_address_location = plain_address_location
func_address_location :: String -> Location
func_address_location = plain_address_location
file_func_address_location :: String -> String -> Location
file_func_address_location filename funcaddr = Location $ "'" ++ filename ++ "'::" ++ funcaddr
data PrintValues
= NoValues
| AllValues
| SimpleValues
instance GdbShow PrintValues where
gdbShow NoValues = "--no-values"
gdbShow AllValues = "--all-values"
gdbShow SimpleValues = "--simple-values"
mapPrintValues :: (PrintValues -> a) -> Int -> a
mapPrintValues f 0 = f NoValues
mapPrintValues f 1 = f AllValues
mapPrintValues f 2 = f SimpleValues
mapPrintValues _ _ = error "valid integers for the print-value parameter range from 0 to 2 only"
data FrameSelect
= FrameAddr String
| CurrentFrame
| Floating
instance GdbShow FrameSelect where
gdbShow (FrameAddr addr) = addr
gdbShow CurrentFrame = "*"
gdbShow Floating = "@"
data FormatSpec
= Binary
| Decimal
| Hexadecimal
| Octal
| Natural
instance GdbShow FormatSpec where
gdbShow Binary = "binary"
gdbShow Decimal = "decimal"
gdbShow Hexadecimal = "hexadecimal"
gdbShow Octal = "octal"
gdbShow Natural = "natural"
data FrozenFlag
= Frozen
| Unfrozen
instance GdbShow FrozenFlag where
gdbShow Frozen = "1"
gdbShow Unfrozen = "0"
data DisassemblyMode
= DisassemblyMode Bool Bool
instance GdbShow DisassemblyMode where
gdbShow (DisassemblyMode False False) = "0"
gdbShow (DisassemblyMode True False) = "1"
gdbShow (DisassemblyMode False True) = "2"
gdbShow (DisassemblyMode True True) = "3"
data DataFormat
= DHexadecimal
| DOctal
| DBinary
| DDecimal
| DRaw
| DNatural
instance GdbShow DataFormat where
gdbShow DHexadecimal = "x"
gdbShow DOctal = "o"
gdbShow DBinary = "t"
gdbShow DDecimal = "d"
gdbShow DRaw = "r"
gdbShow DNatural = "N"
data OutputFormat
= HexadecimalInteger
| SignedDecimalInteger
| UnsignedDecimalInteger
| OctalInteger
| BinaryInteger
| Address
| CharacterConstantInteger
| FloatingPointNumber
| OString
| Raw
instance GdbShow OutputFormat where
gdbShow HexadecimalInteger = "x"
gdbShow SignedDecimalInteger = "d"
gdbShow UnsignedDecimalInteger = "u"
gdbShow OctalInteger = "o"
gdbShow BinaryInteger = "t"
gdbShow Address = "a"
gdbShow CharacterConstantInteger = "c"
gdbShow FloatingPointNumber = "f"
gdbShow OString = "s"
gdbShow Raw = "r"
data TraceMode
= None
| FrameNumber Int
| TracepointNumber Int
| PC String
| PCInsideRange String String
| PCOutsideRange String String
| Line Location
instance GdbShow TraceMode where
gdbShow None = "none"
gdbShow (FrameNumber _) = "frame-number"
gdbShow (TracepointNumber _) = "tracepoint-number"
gdbShow (PC _) = "pc"
gdbShow (PCInsideRange _ _) = "pc-inside-range"
gdbShow (PCOutsideRange _ _) = "pc-outside-range"
gdbShow (Line _) = "line"
traceModeOptions :: TraceMode -> [Option]
traceModeOptions None = []
traceModeOptions (FrameNumber x) = [opt x]
traceModeOptions (TracepointNumber x) = [opt x]
traceModeOptions (PC x) = [opt x]
traceModeOptions (PCInsideRange x y) = [opt x, opt y]
traceModeOptions (PCOutsideRange x y) = [opt x, opt y]
traceModeOptions (Line x) = [opt x]
data Target
= Exec FilePath
| Core FilePath
| Remote Medium
| Sim [String]
| Nrom
instance GdbShow Target where
gdbShow (Exec _) = "exec"
gdbShow (Core _) = "core"
gdbShow (Remote _) = "remote"
gdbShow (Sim _) = "sim"
gdbShow Nrom = "nrom"
targetOptions :: Target -> [Option]
targetOptions (Exec x) = [opt x]
targetOptions (Core x) = [opt x]
targetOptions (Remote x) = [opt x]
targetOptions (Sim xs) = map opt xs
targetOptions Nrom = []
data Medium
= SerialDevice String
| TcpHost String Int
| UdpHost String Int
| Pipe String
instance GdbShow Medium where
gdbShow (SerialDevice device) = device
gdbShow (TcpHost host port) = "tcp:" ++ host ++ ":" ++ gdbShow port
gdbShow (UdpHost host port) = "udp:" ++ host ++ ":" ++ gdbShow port
gdbShow (Pipe command) = "| " ++ command
data Interpreter
= Console
| MI
| MI2
| MI1
instance GdbShow Interpreter where
gdbShow Console = "console"
gdbShow MI = "mi"
gdbShow MI2 = "mi2"
gdbShow MI1 = "mi1"
set_token :: Token -> Command -> Command
set_token token (MICommand _ x y z) = MICommand (Just token) x y z
set_token token (CLICommand _ x) = CLICommand (Just token) x
cli_command :: String -> Command
cli_command = CLICommand Nothing
break_after :: Int -> Int -> Command
break_after number count = cmd "break-after" $ map opt [number, count]
break_commands :: Int -> [String] -> Command
break_commands number commands = cmd "break-commands" $ opt number : map opt commands
break_condition :: Int -> String -> Command
break_condition number expr = cmd "break-condition" $ opt number : opt expr : []
break_delete :: [Int] -> Command
break_delete numbers = cmd "break-delete" $ map optr numbers
break_disable :: [Int] -> Command
break_disable numbers = cmd "break-disable" $ map opt numbers
break_enable :: [Int] -> Command
break_enable numbers = cmd "break-enable" $ map opt numbers
break_info :: Int -> Command
break_info number = cmd "break-info" [opt number]
break_insert :: Bool -> Bool -> Bool -> Bool -> Bool -> Maybe String -> Maybe Int -> Maybe Int -> Location -> Command
break_insert temporary hardware pending disabled tracepoint condition ignoreCount threadId location =
cmd "break-insert" $ temporary' ?: hardware' ?: pending' ?: disabled' ?: tracepoint' ?: condition' ?: ignoreCount' ?: threadId' ?: opt location : []
where
temporary' = flagOpt "-t" temporary
hardware' = flagOpt "-h" hardware
pending' = flagOpt "-p" pending
disabled' = flagOpt "-d" disabled
tracepoint' = flagOpt "-a" tracepoint
condition' = valueOpt "-c" condition
ignoreCount' = valueOpt "-i" ignoreCount
threadId' = valueOpt "-p" threadId
break_list :: Command
break_list = cmd "break-list" []
break_passcount :: Int -> Int -> Command
break_passcount tracepointNumber passcount = cmd "break-passcount" $ map opt [tracepointNumber, passcount]
break_watch :: Bool -> Command
break_watch access = cmd "break-watch" [opt (if access then "-a" else "-r")]
exec_arguments :: [String] -> Command
exec_arguments args = cmd "exec-arguments" $ map opt args
environment_cd :: String -> Command
environment_cd pathdir = cmd "environment-cd" [opt pathdir]
environment_directory :: Bool -> [String] -> Command
environment_directory reset pathdirs = cmd "environment-directory" $ flagOpt "-r" reset ?: map opt pathdirs
environment_path :: Bool -> [String] -> Command
environment_path reset pathdirs = cmd "environment-path" $ flagOpt "-r" reset ?: map opt pathdirs
environment_pwd :: Command
environment_pwd = cmd "environment-pwd" []
thread_info :: Maybe Int -> Command
thread_info threadId = cmd "thread-info" $ fmap opt threadId ?: []
thread_list_ids :: Command
thread_list_ids = cmd "thread-list-ids" []
thread_select :: Int -> Command
thread_select threadnum = cmd "thread-select" [opt threadnum]
ada_task_info :: Maybe Int -> Command
ada_task_info taskId = cmd "ada-task-info" $ fmap opt taskId ?: []
exec_continue :: Bool -> Either Bool Int -> Command
exec_continue reverse x = cmd "exec-continue" $ reverse' ?: x' ?: []
where
reverse' = flagOpt "--reverse" reverse
x' = case x of
Left all -> flagOpt "--all" all
Right threadGroup -> Just $ opt' "--threadGroup" threadGroup
exec_finish :: Bool -> Command
exec_finish reverse = cmd "exec-finish" $ flagOpt "--reverse" reverse ?: []
exec_interrupt :: Either Bool Int -> Command
exec_interrupt x = cmd "exec-interrupt" $ x' ?: []
where
x' = case x of
Left all -> flagOpt "-all" all
Right threadGroup -> Just $ opt' "--threadGroup" threadGroup
exec_jump :: Location -> Command
exec_jump location = cmd "exec-jump" [opt location]
exec_next :: Command
exec_next = cmd "exec-next" []
exec_next_instruction :: Bool -> Command
exec_next_instruction reverse = cmd "exec-next-instruction" $ flagOpt "--reverse" reverse ?: []
exec_return :: Command
exec_return = cmd "exec-return" []
exec_run :: Either Bool Int -> Command
exec_run x = cmd "exec-run" $ x' ?: []
where
x' = case x of
Left all -> flagOpt "-all" all
Right threadGroup -> Just $ opt' "--threadGroup" threadGroup
exec_step :: Command
exec_step = cmd "exec-step" []
exec_step_instruction :: Bool -> Command
exec_step_instruction reverse = cmd "exec-step-instruction" $ flagOpt "--reverse" reverse ?: []
exec_until :: Location -> Command
exec_until location = cmd "exec-until" [opt location]
stack_info_frame :: Command
stack_info_frame = cmd "stack-info-frame" []
stack_info_depth :: Maybe Int -> Command
stack_info_depth maxDepth = cmd "stack-info-depth" $ fmap opt maxDepth ?: []
stack_list_arguments :: PrintValues -> Maybe (Int, Int) -> Command
stack_list_arguments printValues frames = cmd "stack-list-arguments" $ opt printValues : maybTupleOpt frames
stack_list_arguments' :: Int -> Maybe (Int, Int) -> Command
stack_list_arguments' = mapPrintValues stack_list_arguments
stack_list_frames :: Maybe (Int, Int) -> Command
stack_list_frames frames = cmd "stack-list-frames" $ maybTupleOpt frames
stack_list_locals :: PrintValues -> Command
stack_list_locals printValues = cmd "stack-list-locals" [opt printValues]
stack_list_locals' :: Int -> Command
stack_list_locals' = mapPrintValues stack_list_locals
stack_list_variables :: PrintValues -> Command
stack_list_variables printValues = cmd "stack-list-variable" [opt printValues]
stack_list_variables' :: Int -> Command
stack_list_variables' = mapPrintValues stack_list_variables
stack_select_frame :: Int -> Command
stack_select_frame framenum = cmd "stack-select-frame" [opt framenum]
enable_pretty_printing :: Command
enable_pretty_printing = cmd "enable-pretty-printing" []
var_create :: Maybe String -> FrameSelect -> String -> Command
var_create name frameSelect expression = cmd "var-create" $ [name', opt frameSelect, opt expression]
where
name' = opt (fromMaybe "-" name)
var_delete :: Bool -> String -> Command
var_delete children name = cmd "var-delete" $ flagOpt "-c" children ?: opt name : []
var_set_format :: String -> FormatSpec -> Command
var_set_format name formatSpec = cmd "var-set-format" [opt name, opt formatSpec]
var_gdbShow_format :: String -> Command
var_gdbShow_format name = cmd "var-gdbShow-format" [opt name]
var_info_num_children :: String -> Command
var_info_num_children name = cmd "var-info-num-children" [opt name]
var_list_children :: Maybe PrintValues -> String -> Maybe (Int, Int) -> Command
var_list_children Nothing name range = var_list_children (Just NoValues) name range
var_list_children (Just printValues) name range = cmd "var-list-children" $ opt printValues : opt name : maybTupleOpt range
var_list_children' :: Int -> String -> Maybe (Int, Int) -> Command
var_list_children' = mapPrintValues (var_list_children . Just)
var_info_type :: Command
var_info_type = cmd "var-info-type" []
var_info_expression :: String -> Command
var_info_expression name = cmd "var-info-expression" [opt name]
var_info_path_expressoin :: String -> Command
var_info_path_expressoin name = cmd "var-info-path-expression" [opt name]
var_gdbShow_attributes :: String -> Command
var_gdbShow_attributes name = cmd "var-gdbShow-attributes" [opt name]
var_evaluate_expression :: Maybe FormatSpec -> String -> Command
var_evaluate_expression formatSpec name = cmd "var-evaluate-expression" $ valueOpt "-f" formatSpec ?: opt name : []
var_assign :: String -> String -> Command
var_assign name expression = cmd "var-assign" [opt name, opt expression]
var_update :: Maybe PrintValues -> Maybe String -> Command
var_update Nothing name = var_update (Just NoValues) name
var_update (Just printValues) name = cmd "var-update" $ opt printValues : fmap opt name ?: []
var_set_frozen :: String -> FrozenFlag -> Command
var_set_frozen name flag = cmd "var-set-frozen" [opt name, opt flag]
var_set_update_range :: String -> Int -> Int -> Command
var_set_update_range name from to = cmd "var-set-update-range" [opt name, opt from, opt to]
var_set_visualizer :: String -> String -> Command
var_set_visualizer name visualizer = cmd "ver-set-visualizer" [opt name, opt visualizer]
data_disassemble :: Either (String, String) (String, Int, Maybe Int) -> DisassemblyMode -> Command
data_disassemble x mode = MICommand Nothing "data-disassemble" options [QuotedString . gdbShow $ mode]
where
options = case x of
Left (start, end) -> opt' "-s" start : opt' "-e" end : []
Right (filename, linenum, lines) -> opt' "-f" filename : opt' "-l" linenum : valueOpt "-n" lines ?: []
data_evaluate_expression :: String -> Command
data_evaluate_expression expr = cmd "data-evaluate-expression" [opt expr]
data_list_changed_registers :: Command
data_list_changed_registers = cmd "data-list-changed-registers" []
data_list_register_names :: [Int] -> Command
data_list_register_names regnos = cmd "data-list-register-names" $ map opt regnos
data_list_register_values :: DataFormat -> [Int] -> Command
data_list_register_values fmt regnos = cmd "data-list-register-values" $ opt fmt : map opt regnos
data_read_memory :: Maybe Int -> String -> OutputFormat -> Int -> Int -> Int -> Maybe Char -> Command
data_read_memory byteOffset address wordFormat wordSize nrRows nrCols asChar =
cmd "data-read-memory" $ valueOpt "-o" byteOffset ?: opt address : opt wordFormat : opt wordSize : opt nrRows : opt nrCols : fmap opt asChar ?: []
data_read_memory_bytes :: Maybe Int -> String -> Int -> Command
data_read_memory_bytes byteOffset address count = cmd "data-read-memory-bytes" $ valueOpt "-o" byteOffset ?: opt address : opt count : []
data_write_memory_bytes :: String -> String -> Command
data_write_memory_bytes address contents = cmd "data-write-memory-bytes" [opt address, opt contents]
trace_find :: TraceMode -> Command
trace_find traceMode = cmd "trace-find" $ opt traceMode : traceModeOptions traceMode
trace_define_variable :: String -> Maybe String -> Command
trace_define_variable name value = cmd "trace-define-variable" $ opt name : fmap opt value ?: []
trace_list_variables :: Command
trace_list_variables = cmd "trace-list-variables" []
trace_save :: Bool -> String -> Command
trace_save remote filename = cmd "trace-save" $ flagOpt "-r" remote ?: opt filename : []
trace_start :: Command
trace_start = cmd "trace-start" []
trace_status :: Command
trace_status = cmd "trace-status" []
trace_stop :: Command
trace_stop = cmd "trace-stop" []
symbol_list_lines :: String -> Command
symbol_list_lines filename = cmd "symbol-list-lines" [opt filename]
file_exec_and_symbols :: Maybe FilePath -> Command
file_exec_and_symbols file = cmd "file-exec-and-symbols" $ fmap opt file ?: []
file_exec_file :: Maybe FilePath -> Command
file_exec_file file = cmd "file-exec-file" $ fmap opt file ?: []
file_list_exec_source_file :: Command
file_list_exec_source_file = cmd "file-list-exec-source-file" []
file_list_exec_source_files :: Command
file_list_exec_source_files = cmd "file-list-exec-source-files" []
file_symbol_file :: Maybe FilePath -> Command
file_symbol_file file = cmd "file-symbol-file" $ fmap opt file ?: []
target_attach :: Either Int FilePath -> Command
target_attach x = cmd "target-attach" $ x' : []
where
x' = case x of
Left pidOrGid -> opt pidOrGid
Right file -> opt file
target_detach :: Maybe Int -> Command
target_detach pidOrGid = cmd "target-detach" $ fmap opt pidOrGid ?: []
target_disconnect :: Command
target_disconnect = cmd "target-disconnect" []
target_download :: Command
target_download = cmd "target-download" []
target_select :: Target -> Command
target_select target = cmd "target-select" $ opt target : targetOptions target
target_file_put :: FilePath -> FilePath -> Command
target_file_put hostfile targetfile = cmd "target-file-put" $ opt hostfile : opt targetfile : []
target_file_get :: FilePath -> FilePath -> Command
target_file_get targetfile hostfile = cmd "target-file-get" $ opt targetfile : opt hostfile : []
target_file_delete :: FilePath -> Command
target_file_delete targetfile = cmd "target-file-delete" $ opt targetfile : []
gdb_exit :: Command
gdb_exit = cmd "gdb-exit" []
gdb_set :: String -> Command
gdb_set expr = cmd "gdb-set" $ opt expr : []
gdb_gdbShow :: String -> Command
gdb_gdbShow name = cmd "gdb-gdbShow" $ opt name : []
gdb_version :: Command
gdb_version = cmd "gdb-version" []
list_features :: Command
list_features = cmd "list-features" []
list_target_features :: Command
list_target_features = cmd "list-target-features" []
list_thread_groups :: Bool -> Maybe Int -> [Int] -> Command
list_thread_groups available recurse groups = cmd "list-thread-groups" $ flagOpt "--available" available ?: valueOpt "--recurse" recurse ?: map opt groups
info_os :: Maybe String -> Command
info_os type_ = cmd "info-os" $ fmap opt type_ ?: []
add_inferior :: Command
add_inferior = cmd "add-inferior" []
interpreter_exec :: Interpreter -> Command -> Command
interpreter_exec interpreter command = cmd "interpreter-exec" $ opt interpreter : opt ((escapeQuotes . render_command) command) : []
inferior_tty_set :: String -> Command
inferior_tty_set tty = cmd "inferior-tty-set" $ opt tty : []
inferior_tty_gdbShow :: Command
inferior_tty_gdbShow = cmd "inferior-tty-gdbShow" []
enable_timings :: Bool -> Command
enable_timings flag = cmd "enable-timings" $ opt (if flag then "yes" else "no") : []
cmd :: String -> [Option] -> Command
cmd operation options = MICommand Nothing operation options []
opt :: GdbShow a => a -> Option
opt parameter = Option (QuotedString . gdbShow $ parameter) Nothing
optr :: Show a => a -> Option
optr parameter = Option (RawString . show $ parameter) Nothing
opt' :: (GdbShow a, GdbShow b) => a -> b -> Option
opt' name value = Option (QuotedString . gdbShow $ name) (Just (QuotedString . gdbShow $ value))
flagOpt :: String -> Bool -> Maybe Option
flagOpt _ False = Nothing
flagOpt flag True = Just (opt flag)
valueOpt :: GdbShow a => String -> Maybe a -> Maybe Option
valueOpt _ Nothing = Nothing
valueOpt flag param = Just (Option (QuotedString flag) (fmap (QuotedString . gdbShow) param))
maybTupleOpt :: GdbShow a => Maybe (a, a) -> [Option]
maybTupleOpt Nothing = []
maybTupleOpt (Just (lowFrame, highFrame)) = map opt [lowFrame, highFrame]
(?:) :: Maybe a -> [a] -> [a]
(Just x) ?: xs = x : xs
Nothing ?: xs = xs
infixr 5 ?:
escapeQuotes :: String -> String
escapeQuotes = replace '"' "\\\""
replace :: Char -> String -> String -> String
replace old new = join new . split old
where
join delim l = concat (intersperse delim l)
split _ [] = []
split c str =
let (str', rest) = break (==c) str in
if null rest
then [str']
else str' : split c (tail rest)