"{ Package: 'jv:libgdbs' }"

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

!

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: aGDBCommand

    ^ self send: aGDBCommand wait: true.

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

!

send: aGDBCommand wait: aBoolean

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

     command to finish. Otherwise, return immediately."

    | token blocker releaser result |

    token := self nextCommandSequnceNumber.

    aGDBCommand token: token.

    ^ aBoolean ifTrue:[ 

        releaser := [ :ev |

                    ev token == token ifTrue:[ 

                        self announcer unsubscribe: releaser.

                        result := ev result.

                        blocker signal.

                    ]].

        blocker := Semaphore new.

        self announcer when: GDBCommandResultEvent do: releaser.

        connection pushEvent: (GDBCommandEvent new command: aGDBCommand).

        blocker wait.

        result.

    ] ifFalse:[

        connection pushEvent: (GDBCommandEvent new command: aGDBCommand).

        nil.

    ]

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

                threads add: thread.

            ].

        ].

    ].

    aGDBStoppedEvent setThreads: threads

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

    "Modified: / 08-09-2014 / 23:50:54 / 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 })

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

    "Modified: / 23-06-2014 / 23:44:49 / 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> $'

! !