"{ Encoding: utf8 }"

"

jv:libgdbs - GNU Debugger Interface Library

Copyright (C) 2015-now Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

"{ Package: 'jv:libgdbs' }"

"{ NameSpace: Smalltalk }"

Object subclass:#GDBDebugger

	instanceVariableNames:'connection commandSequenceNumber inferiorStateSequenceNumber

		inferiors breakpoints selectedInferior selectedThread

		selectedFrame prettyPrintingEnabled frameFiltersEnabled

		finalizationRegistry debuggerFeatures targetFeatures

		supportedCommands directories'

	classVariableNames:''

	poolDictionaries:'GDBCommandStatus GDBFeatures'

	category:'GDB-Core'

!

!GDBDebugger class methodsFor:'documentation'!

copyright

"

jv:libgdbs - GNU Debugger Interface Library

Copyright (C) 2015-now Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

! !

!GDBDebugger class methodsFor:'instance creation'!

new    

    ^ self newWithProcess: GDBProcess new

    "Modified: / 12-12-2017 / 21:15:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

newWithProcess: aGDBProcess

    ^ self basicNew initializeWithProcess: aGDBProcess

    "Created: / 20-06-2014 / 21:44:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBDebugger methodsFor:'accessing'!

announcer

    ^ connection eventAnnouncer.

    "Created: / 02-06-2014 / 23:06:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

breakpointForId: id

    ^ self breakpointForId: id ifAbsent:[self error: ('No breakpoint with id ''%1'' found!!' bindWith: id)]

    "Created: / 18-05-2018 / 13:39:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-02-2019 / 15:04:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

breakpointForId: id ifAbsent: block

    self breakpoints do:[:bp |

        bp number = id ifTrue:[ ^ bp ].

        bp locations do: [ :loc |

            loc number = id ifTrue:[ ^ loc ].

        ].

    ].

    ^ block value.

    "Created: / 07-02-2019 / 15:04:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

breakpoints

    breakpoints isNil ifTrue:[ 

        breakpoints := List new.

    ].

    ^ breakpoints

    "Created: / 06-07-2017 / 16:06:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

consoleInput

    ^ connection consoleInput

    "Created: / 31-05-2017 / 23:20:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 02-06-2017 / 23:13:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

consoleOutput

    ^ connection consoleOutput

    "Created: / 31-05-2017 / 23:20:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 02-06-2017 / 23:13:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

directories

    "Return a list of directories where GDB looks for source code and an Array.

     Variables such as $cdir and $cwd are NOT expanded.

    "

    | result |

    directories isNil ifTrue:[

        result := self send: (GDBMI_gdb_show arguments: #('directories')).

        OperatingSystem isMSWINDOWSlike ifTrue:[ 

            "/ On Windows, GDB uses cygwin paths (i.e., slashed, unix-like paths). 

            "/ Convert them to Windows paths as used in Smalltalk/X:

            directories := ((result propertyAt: #value) tokensBasedOn: $;) 

                                collect: [ :d | (Filename cygNamed:d) pathName ]

                                as: Array.

        ] ifFalse:[ 

            directories := ((result propertyAt: #value) tokensBasedOn: $:) asArray

        ].

    ].

    ^ directories

    "Created: / 09-03-2018 / 12:05:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 03-04-2018 / 21:14:45 / jv"

!

features

    "Return a list of features supported ty this version og GDB.

     See 

            * GDBFeatures` pool

            * https://sourceware.org/gdb/onlinedocs/gdb/GDB_002fMI-Support-Commands.html,

              command `-list-features`

    "

    ^ debuggerFeatures , (targetFeatures ? connection nativeTargetFeatures)

    "Created: / 07-02-2018 / 10:50:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 26-03-2018 / 21:35:22 / jv"

    "Modified: / 09-04-2018 / 15:39:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

inferiorForId: id

    ^ inferiors ? #() detect:[:e | e id = id ] ifNone:[ 

        self error: ('No inferior (thread group) with id ''%1'' found!!' bindWith: id)

    ].

    "Created: / 07-09-2014 / 21:22:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

inferiorStderr

    ^ connection inferiorPTY master

    "Created: / 09-06-2014 / 10:01:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 09-06-2014 / 18:26:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

inferiorStdin

    ^ connection inferiorPTY master

    "Created: / 09-06-2014 / 10:00:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 09-06-2014 / 18:27:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

inferiorStdout

    ^ connection inferiorPTY master

    "Created: / 09-06-2014 / 10:01:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 09-06-2014 / 18:27:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

inferiors

    ^ inferiors ? #()

    "Modified: / 06-07-2017 / 16:06:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

selectedInferior

    selectedInferior isNil ifTrue:[ 

        inferiors size == 1 ifTrue:[ 

            ^ inferiors anElement.

        ].

    ].

    ^ selectedInferior

    "Created: / 07-09-2014 / 23:02:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

threadForId: id

    inferiors ? #() do:[:tg |

        tg threads do:[:t | 

            t id = id ifTrue:[ ^ t ]

        ].

    ].

    self error: ('No thread with id ''%1'' found!!' bindWith: id)

    "Created: / 04-02-2018 / 21:37:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBDebugger methodsFor:'accessing-private'!

connectionTrace

    ^ connection trace

    "Created: / 09-03-2018 / 10:04:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

currentInferiorStateSequnceNumber

    ^ inferiorStateSequenceNumber

    "Created: / 19-06-2014 / 22:22:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

finalizationRegistry

    ^ finalizationRegistry

!

nextCommandSequnceNumber

    commandSequenceNumber := commandSequenceNumber + 1.

    commandSequenceNumber == SmallInteger maxVal ifTrue:[ 

        commandSequenceNumber := 0.

    ].

    ^ commandSequenceNumber

    "Created: / 02-06-2014 / 23:48:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

nextInferiorStateSequnceNumber

    inferiorStateSequenceNumber := inferiorStateSequenceNumber + 1.

    inferiorStateSequenceNumber == SmallInteger maxVal ifTrue:[

        inferiorStateSequenceNumber := 0.

    ].

    ^ inferiorStateSequenceNumber

    "Created: / 02-06-2014 / 23:48:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBDebugger methodsFor:'commands'!

send: command

    "Execute given `command` and wait until it finishes and return its result.

     `command` may be either a GDBCommand or string, in which case it will

     be parsed into a GDBCommand. 

   "

    ^ self send:command andWait:true.

    "Created: / 03-06-2014 / 00:10:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 08-03-2015 / 05:50:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

send:command andWait:wait 

    "Sends given `command` to GDB. If `wait` is true, wait for

     command to finish and return the command result.  

     Otherwise, return nil immediately.

     If `wait` is true and if command results in an error GDBError

     is thrown.

     `command` may be either a GDBCommand or string, in which case it will

     be parsed into a GDBCommand.           

    "

    | blocker result |

    self assert: self isConnected.

    ^ wait ifTrue:[

        self 

            assert:Processor activeProcess ~~ connection eventDispatchProcess

            message:'Cannot send commands from within event dispatching process. Would deadlock'.

        blocker := Semaphore new.

        self send: command andWithResultDo: [ :r | 

            result := r.

            blocker signal

        ].

        blocker wait.

        result isError ifTrue:[

            GDBCommandFailedError raiseForResult: result.

        ].

        result.

    ]

    ifFalse:[

        | cmd |

        cmd := command.

        cmd isString ifTrue:[

            cmd := GDBCommand parse:cmd.

        ].    

        cmd token: self nextCommandSequnceNumber.

        connection pushEvent:(GDBCommandEvent new command:cmd).

        nil.

    ]

    "Created: / 02-06-2014 / 23:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 26-03-2018 / 21:19:59 / jv"

    "Modified: / 28-01-2019 / 21:26:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

send:command andWaitFor:eventHandlers

    "Sends given `command` to GDB and then wait for events mathing 

     `eventHandlers`. 

     Params:

     `command`      may be either a GDBCommand or string, in which case it will

                    be parsed into a GDBCommand.

     `eventHandler` may be either nil or event class or one arg block or collection

                    of event classes or blocks.

                    - If nil then do not wait for anything (use nil for async send)

                    - If event class, then wait for an event of that class. Note, that

                      subclasses are handled too.

                    - If block, then wait for an event for which the block returns true.

                    - If collectio, then wait for a sequence of events, each matched as above.

     Returns:       a matching event or events (in case a collection of handlers has been passes)"

    ^ self send: command andWaitFor: eventHandlers withTimeoutMs: nil

    "Created: / 08-03-2015 / 06:03:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

send:command andWaitFor:eventHandlers withTimeoutMs:timeout 

    "Sends given `command` to GDB and then wait for events mathing 

     `eventHandlers`. Raise a TimeoutError if expected events don't arrive

     in specified time.

     Params:

     `command`      may be either a GDBCommand or string, in which case it will

                    be parsed into a GDBCommand.

     `eventHandler` may be either nil or event class or one arg block or collection

                    of event classes or blocks.

                    - If nil then do not wait for anything (use nil for async send)

                    - If event class, then wait for an event of that class. Note, that

                      subclasses are handled too.

                    - If block, then wait for an event for which the block returns true.

                    - If collectio, then wait for a sequence of events, each matched as above.

     `timeout`       wait at most that much milliseconds, throw TimeoutError otherwise. If `timeout` == mil

                    then wait for indefinitly

     Returns:       a matching event or events (in case a collection of handlers has been passes)"

    | commandObject |

    self assert: self isConnected.

    command isString ifTrue:[

        commandObject := GDBCommand parse: command.

        commandObject token:self nextCommandSequnceNumber.

    ] ifFalse:[

        commandObject := command.

        commandObject token isNil ifTrue:[

            commandObject token:self nextCommandSequnceNumber.

        ].

    ].

    ^ self 

        do:[ connection pushEvent:(GDBCommandEvent new command: commandObject) ] 

        andWaitFor: eventHandlers 

        withTimeoutMs: timeout

    "Created: / 07-03-2015 / 11:38:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 19-01-2019 / 23:05:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

send:command andWithResultDo: block

    "Sends given `command` to GDB and return nil immediately. Once the command

     is processed and result returned, evaluate `block` passing the

     result (as instance of GDBCommandResult)

     The `command` may be either a GDBCommand or string, in which case it will

     be parsed into a GDBCommand.

     When calling this method from a UI code, i.e., from an UI even loop, keep

     in mind that the block will be evaluated from within GDB's internal event

     dispatch loop.

     It's is a good practice not to do anything real within the block but just

     grab the result and let it be processed within UI event loop, e.g.

         doSomeAction

             debugger send: (GDBMI_data_read_memory arguments:...) 

                      andWithResultDo:[ :result | self sensor pushUserEvent: #updateWithResult: with: result ].

    "

    | cmd  token handler1  handler2  result |

    self assert: self isConnected.

    cmd := command.

    cmd isString ifTrue:[

        cmd := GDBCommand parse:cmd.

    ].

    token := self nextCommandSequnceNumber.

    cmd token:token.

    handler1 := [:ev | 

        ev token == token ifTrue:[

            connection eventAnnouncer unsubscribe:handler1.

            result := ev result.

            connection eventAnnouncerInternal when:GDBEventSetProcessingFinished

                do:handler2.

        ]

    ].

    handler2 := [:ev | 

        connection eventAnnouncerInternal unsubscribe:handler2.

        block value: result.

    ].

    connection eventAnnouncer when:GDBCommandResultEvent do:handler1.

    connection pushEvent:(GDBCommandEvent new command:cmd).

    ^ nil

    "Created: / 26-01-2018 / 21:47:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 26-03-2018 / 21:48:02 / jv"

    "Modified: / 19-01-2019 / 23:06:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBDebugger methodsFor:'commands - API'!

attach: aStringOrInteger

    "Attach to a running process.

     API equivalent to CLI command:

        (gdb) attach <aStringOrInteger>

    "

    self send:(GDBMI_target_attach arguments:(Array with: aStringOrInteger asString)).

    "Created: / 05-06-2017 / 17:08:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 25-01-2018 / 23:28:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

disassembleFile: file line: line count: count

    "

    Disassemble `count` source lines from `file` starting at line `line`.

    Returns a list of GDBInstructionsAndSourceLine objects.

    If `count` is nil, then disassemble entire function at given

    source `file` and `line`.

    "

    | cmd result disassembly |

    self assert: file isString.

    self assert: line isInteger.

    self assert:(count isNil or:[ count isInteger ]).

    count notNil ifTrue:[ 

        cmd := GDBMI_data_disassemble arguments: (Array with: '-f' with: file with: '-l' with: line with: '-n' with: count with: '--' with: 5)

    ] ifFalse:[ 

        cmd := GDBMI_data_disassemble arguments: (Array with: '-f' with: file with: '-l' with: line                        with: '--' with: 5)

    ].

    result := self send: cmd.

    disassembly := result propertyAt: 'asm_insns'

.   disassembly do:[:each | each setDebugger: self ].

    ^ disassembly

    "Created: / 22-06-2018 / 11:42:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

disassembleFunction: address

    "

    Disassemble function at given `address` (given as String). Address

    might be any expression evaluable by GDB or function name (as it 

    appears in debug info)

    WARNING: This requires feature 'data-disassemble-a-option'.

    This feature is not present in GDB as of 8.1 and likely won't be in

    8.2.

    "

    | result disassembly |

    self assert: address isString.