"{ Package: 'jv:libgdbs' }"

"{ NameSpace: Smalltalk }"

Object subclass:#GDBDebugger

	instanceVariableNames:'connection commandSequenceNumber inferiorStateSequenceNumber

		inferiors breakpoints selectedInferior selectedThread

		selectedFrame prettyPrintingEnabled frameFiltersEnabled'

	classVariableNames:''

	poolDictionaries:'GDBCommandStatus'

	category:'GDB-Core'

!

!GDBDebugger class methodsFor:'instance creation'!

new

    ^ self newWithProcess: GDBUnixProcess new

    "Modified: / 20-06-2014 / 21:44:53 / 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>"

!

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>"

!

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>"

! !

!GDBDebugger methodsFor:'accessing-private'!

currentInferiorStateSequnceNumber

    ^ inferiorStateSequenceNumber

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

!

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.           

    "

    | cmd  token  blocker  handler1  handler2  result |

    cmd := command.

    cmd isString ifTrue:[

        cmd := GDBCLICommand new value:cmd.

    ].

    token := self nextCommandSequnceNumber.

    cmd token:token.

    ^ wait ifTrue:[

        self assert:Processor activeProcess ~~ connection eventDispatchProcess

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

        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.

            blocker signal.

        ].

        blocker := Semaphore new.

        connection eventAnnouncer when:GDBCommandResultEvent do:handler1.

        connection pushEvent:(GDBCommandEvent new command:cmd).

        blocker wait.

        result isError ifTrue:[

        ].

        result.

    ]

    ifFalse:[

        connection pushEvent:(GDBCommandEvent new command:cmd).

        nil.

    ]

    "Created: / 02-06-2014 / 23:45:43 / 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 |

    command isString ifTrue:[

        commandObject := (GDBMIParser on:command) parseCommand.

        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: / 08-03-2015 / 07:31:15 / 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:{ aStringOrInteger asString }) andWait: true.

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

!

enableFrameFilters

    "Enables frame filters & frame decorators for MI interface. Once enabled,

     cannot be turned off.

     @see GDBMI_enable_frame_filters"

    | result |

    result := self send: GDBMI_enable_frame_filters new.

    result isDone ifTrue:[ 

        frameFiltersEnabled := true.

    ] ifFalse:[ 

        GDBError raiseErrorString: 'failed to enable frame filters'

    ].

    "Created: / 12-06-2017 / 09:29:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

enablePrettyPrinting

    "Enables pretty printing for MI interface. Once enabled,

     cannot be turned off.

     @see GDBMI_enable_pretty_printing"

    | result |

    result := self send: GDBMI_enable_pretty_printing new.

    result isDone ifTrue:[ 

        prettyPrintingEnabled := true.

    ] ifFalse:[ 

        GDBError raiseErrorString: 'failed to enable pretty printing'

    ].

    "Created: / 12-06-2017 / 09:29:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

executable: aStringOrFilename

    "Sets the executable to debug. 

     API equivalent to CLI command:

        (gdb) exec-file <aStringOrFilename>

    "

    self executable: aStringOrFilename arguments: nil

    "Created: / 28-02-2015 / 00:19:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 05-06-2017 / 17:06:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

executable: aStringOrFilename arguments: anArray"of String"

    "Sets the executable to debug and argument to pass to it.

     API equivalent to CLI command:

        (gdb) exec-file <aStringOrFilename>   

        (gdb) set args <anArray>

    "

    self send:(GDBMI_file_exec_and_symbols arguments:{ aStringOrFilename asString }) andWait: true.

    anArray notEmptyOrNil ifTrue:[ 

        self send: (GDBMI_exec_arguments arguments: anArray) andWait: true.

    ].

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

! !

!GDBDebugger methodsFor:'evaluating'!

do: block andWaitFor:eventHandlers

    "Evaluates a given block and then wait for events.

     `eventHandlers`. 

     Params:

     `block`        block to evaluate

     `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 collection, 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 passed)"

    ^ self do: block andWaitFor: eventHandlers withTimeoutMs: nil

    "Created: / 08-03-2015 / 07:30:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 12-06-2017 / 09:31:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

do: block andWaitFor:eventHandlers withTimeoutMs:timeout 

    "Evaluates a given block and then wait for events.

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

     in specified time.

     Params:

     `block`        block to evaluate

     `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)"

    | handlersArray handlerFinal eventsArray blocker |

    eventHandlers isNil ifTrue:[

        "/ Asynchronous send...

        self assert:timeout isNil.

        block value.

        ^ nil

    ].

    "/ Synchronous send...

    self assert:Processor activeProcess ~~ connection eventDispatchProcess

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

    eventHandlers isCollection 

        ifTrue:[ handlersArray := eventHandlers ]

        ifFalse:[ handlersArray := Array with:eventHandlers ].

    eventsArray := Array new:handlersArray size.

    1 to:handlersArray size do:[:i | 

        | handler |

        handler := handlersArray at:i.

        handlersArray at:i

            put:[:event | 

                | matches |

                matches := handler isBlock ifTrue:[ handler value:event ] ifFalse:[ event isKindOf:handler ].

                (matches and:[ i == 1 or:[ (eventsArray at:i - 1) notNil ] ]) ifTrue:[

                    eventsArray at:i put:event.

                    self announcer unsubscribe:(handlersArray at:i).

                    i == handlersArray size ifTrue:[

                        connection eventAnnouncerInternal when: GDBEventSetProcessingFinished do: handlerFinal.

                    ].

                ].

            ].

        self announcer when:GDBEvent do:(handlersArray at:i).

    ].

    handlerFinal := [ :event | connection eventAnnouncerInternal unsubscribe: handlerFinal. blocker signal ].  

    blocker := Semaphore new.

    block value.

    [

        (blocker waitWithTimeoutMs:timeout) isNil ifTrue:[

            eventsArray := nil.

        ].

    ] ensure:[

        handlersArray do:[:handler | 

            handler notNil ifTrue:[

                self announcer unsubscribe:handler

            ]

        ].

    ].

    eventsArray isNil ifTrue:[

        (TimeoutError newException)

            parameter:timeout;

            raise.

    ].

    ^ eventHandlers isCollection ifTrue:[ eventsArray ] ifFalse:[ eventsArray first ]

    "Created: / 08-03-2015 / 07:28:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBDebugger methodsFor:'event handling'!

onBreakpointCreatedEvent: aGDBBreakpointCreatedEvent

    | breakpoint |

    breakpoints isNil ifTrue:[ 

        breakpoints := List new.

    ].

    breakpoint := aGDBBreakpointCreatedEvent breakpoint.

    breakpoint setDebugger: self.

    breakpoints add: breakpoint.

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

    "Modified: / 07-07-2017 / 12:39:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

onBreakpointDeletedEvent: aGDBBreakpointDeletedEvent

    | breakpoint |

    breakpoint := breakpoints detect:[:e | e number == aGDBBreakpointDeletedEvent id ].

    breakpoint setDebugger: nil.

    breakpoints remove: breakpoint.

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

    "Modified: / 07-07-2017 / 12:39:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

onBreakpointModifiedEvent: aGDBBreakpointModifiedEvent

    | old new |

    new := aGDBBreakpointModifiedEvent breakpoint.

    old := breakpoints detect:[:e | e number == new number ].

    old updateFrom: new.

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

    "Modified: / 07-07-2017 / 12:30:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

onCommandEvent:aGDBCommandEvent 

    connection send:aGDBCommandEvent command.

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

    "Modified: / 20-06-2014 / 22:09:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

onExitEvent:aGDBExitEvent 

    self release.

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

    "Modified: / 04-06-2014 / 09:28:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

onRunningEvent: aGDBRunningEvent

    | threads threadId |