Mercurial Mercurial > hg > jv-libgdbs / file revision
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
GDBDebugger.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Sat, 28 Feb 2015 08:34:19 +0100
changeset 56 20989de12cfb
parent 53 63669c2c0f9e
child 64 ed6b45e838b7
permissions -rw-r--r--
More work on variables + tests

"{ Package: 'jv:libgdbs' }"

"{ NameSpace: Smalltalk }"

Object subclass:#GDBDebugger
	instanceVariableNames:'connection commandSequenceNumber inferiorStateSequenceNumber
		inferiors selectedInferior selectedThread selectedFrame'
	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>"
!

executable: aStringOrFilename
    "Sets the executable to debug. 
     API equivalent to CLI command:

         (gdb) exec-file <aStringOrFilename>
    "
    self send: (GDBMI_file_exec_and_symbols arguments: { aStringOrFilename asString }) wait: false.

    "Created: / 28-02-2015 / 00:19:48 / 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
!

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. 
     Command can be either an instance of GDBCommand or
     a String. If String, it is assumed to be a CLI command
     string.
     "
    ^ self send: command wait: true.

    "Created: / 03-06-2014 / 00:10:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (comment): / 28-02-2015 / 00:40:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

send: command wait: wait
    "Sends given `command` to GDB. If `aBoolean` is true, wait for
     command to finish. Otherwise, return immediately."

    | cmd token blocker handler1 handler2 result |

    cmd := command.
    cmd isString ifTrue:[ 
        cmd := GDBCLICommand new value: cmd.
    ].
    (wait and:[Processor activeProcess == connection eventDispatchProcess]) ifTrue:[ 
        self error: 'Cannot send commands from within event dispatching process. Would deadlock'.
    ].

    token := self nextCommandSequnceNumber.
    cmd token: token.
    ^ wait ifTrue:[ 
        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.
    ] ifFalse:[
        connection pushEvent: (GDBCommandEvent new command: cmd).
        nil.
    ]

    "Created: / 02-06-2014 / 23:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 28-02-2015 / 00:42:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBDebugger methodsFor:'event handling'!

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

onCommandResultEvent:aGDBCommandResultEvent 
    aGDBCommandResultEvent result status == CommandStatusExit ifTrue:[
        connection pushEvent:GDBExitEvent new.
    ].

    "Created: / 07-09-2014 / 23:37:07 / 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 |

    threadId := aGDBRunningEvent threadId.
    threadId = 'all' ifFalse:[ 
        threadId := threadId asInteger.
    ].
    self nextInferiorStateSequnceNumber.
    threads := Set new.
    inferiors do:[:inferior | 
        inferior threads do:[:thread | 
            (threadId isString or:[thread id = threadId]) ifTrue:[ 
                thread setStatus: GDBThreadStatusRunning theOneAndOnlyInstance.
                threads add: thread.
            ].
        ].
    ].
    aGDBRunningEvent setThreads: threads

    "Created: / 07-09-2014 / 23:34:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 08-09-2014 / 23:51:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

onStoppedEvent: aGDBStoppedEvent
    | threads threadIds |

    threadIds := aGDBStoppedEvent stoppedThreadIds.
    threadIds = 'all' ifFalse:[ 
        threadIds := threadIds collect:[:e | e asInteger ].
    ].
    threads := Set new.
    inferiors do:[:inferior | 
        inferior threads do:[:thread | 
            (threadIds isString or:[threadIds includes: thread id]) ifTrue:[ 
                thread setStatus: GDBThreadStateStopped theOneAndOnlyInstance.
                threads add: thread.
            ].
        ].
    ].
    aGDBStoppedEvent setThreads: threads

    "Created: / 07-09-2014 / 23:34:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 27-02-2015 / 09:54:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

onThreadCreatedEvent:aGDBThreadCreatedEvent 
    | inferior |

    inferior := self inferiorForId:aGDBThreadCreatedEvent threadGroupId.
    inferior onThreadCreatedEvent:aGDBThreadCreatedEvent.

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

onThreadExitedEvent:aGDBThreadExitedEvent 
    | inferior |

    inferior := self inferiorForId:aGDBThreadExitedEvent threadGroupId.
    inferior onThreadExitedEvent:aGDBThreadExitedEvent.

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

onThreadGroupAddedEvent:aGDBThreadGroupAddedEvent 
    | inferior |

    inferiors isNil ifTrue:[
        inferiors := List new.
    ].
    inferior := GDBThreadGroup newWithDebugger:self
            id:aGDBThreadGroupAddedEvent threadGroupId.
    inferiors add:inferior.
    aGDBThreadGroupAddedEvent setThreadGroup:inferior

    "Modified: / 07-09-2014 / 21:18:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

onThreadGroupExitedEvent:aGDBThreadGroupExitedEvent 
    | inferior |

    inferior := self inferiorForId:aGDBThreadGroupExitedEvent threadGroupId.
    inferior setExitCode:aGDBThreadGroupExitedEvent exitCode.
    aGDBThreadGroupExitedEvent setThreadGroup:inferior

    "Created: / 06-09-2014 / 02:37:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 07-09-2014 / 21:23:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

onThreadGroupStartedEvent:aGDBThreadGroupStartedEvent 
    | inferior |

    inferior := self inferiorForId:aGDBThreadGroupStartedEvent threadGroupId.
    inferior setPid:aGDBThreadGroupStartedEvent pid.
    aGDBThreadGroupStartedEvent setThreadGroup:inferior

    "Created: / 06-09-2014 / 02:37:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 07-09-2014 / 21:23:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBDebugger methodsFor:'finalization'!

finalize
    self release.

    "Created: / 26-05-2014 / 21:23:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBDebugger methodsFor:'initialize & release'!

initializeWithProcess: aGDBProcess
    self registerForFinalization.
    connection := GDBConnection newWithProcess: aGDBProcess.

    commandSequenceNumber := 0.
    inferiorStateSequenceNumber := 0.

    self subscribe.        

    connection eventPumpStart.
    connection eventDispatchStart.
    Delay waitForMilliseconds:100.  

"/    self send: (GDBMICommand inferiorTtySet: driver inferiorPTY name).
    self send: (GDBMI_inferior_tty_set arguments: { connection inferiorPTY name }).
    self send: (GDBMI_gdb_set arguments: #('target-async' 'on')).

    "Created: / 20-06-2014 / 21:45:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 29-09-2014 / 23:30:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

release
    connection notNil ifTrue:[ 
        self unsubscribe.
        connection release.
        connection := nil.
    ].

    "Created: / 26-05-2014 / 21:24:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 20-06-2014 / 22:08:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

subscribe
    connection eventAnnouncerInternal
        when: GDBCommandEvent               send: #onCommandEvent:           to: self;
        when: GDBCommandResultEvent         send: #onCommandResultEvent:     to: self;
        when: GDBExitEvent                  send: #onExitEvent:              to: self;

        when: GDBThreadGroupAddedEvent      send: #onThreadGroupAddedEvent:  to: self;
        when: GDBThreadGroupStartedEvent    send: #onThreadGroupStartedEvent: to: self;
        when: GDBThreadGroupExitedEvent     send: #onThreadGroupExitedEvent: to: self;

        when: GDBThreadCreatedEvent         send: #onThreadCreatedEvent:      to: self;
        when: GDBThreadExitedEvent          send: #onThreadExitedEvent:       to: self;

        when: GDBRunningEvent               send: #onRunningEvent:            to: self;
        when: GDBStoppedEvent               send: #onStoppedEvent:            to: self.

    "Created: / 20-06-2014 / 22:07:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 07-09-2014 / 23:32:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

unsubscribe
    connection eventAnnouncerInternal unsubscribe: self

    "Created: / 20-06-2014 / 22:07:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBDebugger methodsFor:'testing'!

isConnected
    ^ connection notNil

    "Created: / 20-06-2014 / 22:12:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!GDBDebugger class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'
! !
hg/jv-libgdbs