"{ Package: 'jv:libgdbs' }"
"{ NameSpace: Smalltalk }"
Object subclass:#GDBConnection
instanceVariableNames:'process inferiorPTY eventAnnouncer eventAnnouncerInternal
eventQueue eventQueueLock eventQueueNotifier eventDispatchProcess
eventPumpProcess outstandingCommands recorder'
classVariableNames:''
poolDictionaries:'GDBDebugFlags'
category:'GDB-Private'
!
!GDBConnection class methodsFor:'instance creation'!
new
^ self shouldNotImplement.
"Created: / 20-06-2014 / 21:45:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
newWithProcess: aGDBProcess
^ self basicNew initializeWithProcess: aGDBProcess
"Created: / 20-06-2014 / 21:45:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GDBConnection methodsFor:'accessing'!
eventAnnouncer
^ eventAnnouncer
!
eventAnnouncerInternal
^ eventAnnouncerInternal
"Created: / 19-06-2014 / 22:18:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
inferiorPTY
^ inferiorPTY
!
recorder
^ recorder
!
recorder:aGDBSessionRecorder
recorder := aGDBSessionRecorder.
! !
!GDBConnection methodsFor:'commands'!
send: command
| commandString |
commandString := command token notNil
ifTrue:[ command token printString , command asString ]
ifFalse:[ commandString := command asString ].
outstandingCommands add: command.
recorder notNil ifTrue:[
recorder recordCommand: commandString
].
process debuggerInput nextPutLine: commandString.
"Created: / 20-06-2014 / 22:09:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-06-2014 / 23:31:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GDBConnection methodsFor:'event dispatching'!
eventDispatchLoop
"raise an error: this method should be implemented (TODO)"
[
| eventQueueEmpty |
eventQueueEmpty := false.
[ eventQueueEmpty ] whileFalse:[
| event |
event := nil.
eventQueueLock critical:[
eventQueueEmpty := eventQueue isEmpty.
eventQueueEmpty ifFalse:[
event := eventQueue removeFirst.
]
].
eventQueueEmpty ifFalse:[
[
self eventDispatchSingle: event.
] on: Error do:[:ex |
"/ Pass
].
].
].
process pid isNil ifTrue:[
"/ gdb process terninated
(process debuggerOutput isNil or:[ process debuggerOutput atEnd ]) ifTrue:[
"/ No unprocessed output in stream...
^ self
]
].
eventQueueNotifier wait.
] loop.
"Created: / 02-06-2014 / 22:51:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-09-2014 / 22:38:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
eventDispatchProcess
^ eventDispatchProcess
!
eventDispatchSingle: aGDBEvent
TraceEvents ifTrue:[
Logger log: ('event loop: broadcasting %1 (%2)' bindWith: aGDBEvent class name with: aGDBEvent token) severity: #trace facility: 'GDB' originator: self attachment: aGDBEvent
].
eventAnnouncerInternal announce: aGDBEvent.
eventAnnouncer announce: aGDBEvent
"Created: / 02-06-2014 / 22:58:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 27-02-2015 / 09:49:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
eventDispatchStart
eventDispatchProcess isNil ifTrue:[
eventDispatchProcess := [
TraceEvents ifTrue:[
Logger log: 'event loop: starting' severity: #trace facility: 'GDB'
].
self eventDispatchLoop.
] newProcess.
eventDispatchProcess name:('GDB Event dispatcher (%1)' bindWith:process pid).
eventDispatchProcess priority:Processor userBackgroundPriority.
eventDispatchProcess addExitAction:[
eventDispatchProcess := nil.
TraceEvents ifTrue:[
Logger log: 'event loop: terminated' severity: #trace facility: 'GDB'
].
].
eventDispatchProcess resume.
].
"Created: / 02-06-2014 / 22:51:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 20-06-2014 / 21:38:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
eventDispatchStop
| t |
t := eventDispatchProcess.
(t notNil and:[ t isDead not]) ifTrue:[
eventDispatchProcess := nil.
t terminate.
"/ raise its prio to make it terminate quickly
t priority:(Processor userSchedulingPriority + 1)
].
"Created: / 02-06-2014 / 22:52:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GDBConnection methodsFor:'event pump'!
eventPumpLoop
| parser |
parser := GDBMIParser on:process debuggerOutput.
parser
token2CommandMappingBlock:[:token |
| command |
command := outstandingCommands
detect:[:cmd | cmd token == token ]
ifNone:[ nil ].
command notNil ifTrue:[
outstandingCommands remove:command
].
command
].
parser recorder:recorder.
[
process debuggerOutput atEnd
] whileFalse:[
| eventset |
[
[
eventset := parser parseOutput.
] on:StreamNotOpenError do:[ ^ self. ].
self pushEventSet:eventset.
] on:AbortOperationRequest do:[
| terminator i c |
terminator := '(gdb)'.
i := 1.
process debuggerOutput notNil ifTrue:[
[
process debuggerOutput atEnd not and:[ i <= terminator size ]
] whileTrue:[
c := process debuggerOutput next.
c == (terminator at:i) ifTrue:[
i := i + 1.
] ifFalse:[ i := 1. ].
].
process debuggerOutput next.
"/ read nl.
] ifFalse:[ ^ self. ].
]
]
"Created: / 02-06-2014 / 22:38:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 23-06-2014 / 09:20:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 27-02-2015 / 15:08:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
eventPumpStart
eventPumpProcess isNil ifTrue:[
eventPumpProcess := [
TraceEvents ifTrue:[
Logger log: 'event pump: starting' severity: #trace facility: 'GDB'
].
self eventPumpLoop
] newProcess.
eventPumpProcess name:('GDB Event pump (%1)' bindWith:process pid).
eventPumpProcess priority:Processor userBackgroundPriority.
eventPumpProcess addExitAction:[
TraceEvents ifTrue:[
Logger log: 'event pump: terminated' severity: #trace facility: 'GDB'
].
eventPumpProcess := nil.
].
eventPumpProcess resume.
].
"Created: / 02-06-2014 / 22:38:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 20-06-2014 / 21:37:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
eventPumpStop
| t |
t := eventPumpProcess.
(t notNil and:[ t isDead not]) ifTrue:[
eventPumpProcess := nil.
t terminate.
"/ raise its prio to make it terminate quickly
t priority:(Processor userSchedulingPriority + 1)
].
"Created: / 02-06-2014 / 22:40:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GDBConnection methodsFor:'events'!
pushEvent: aGDBEvent
eventQueueLock critical:[
eventQueue add: aGDBEvent.
eventQueueNotifier signalForAll.
].
"Created: / 02-06-2014 / 22:49:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
pushEventSet: aGDBEventSet
eventQueueLock critical:[
eventQueue add: (GDBEventSetProcessingStarted new setEventSet: aGDBEventSet).
eventQueue addAll: aGDBEventSet.
eventQueue add: (GDBEventSetProcessingFinished new setEventSet: aGDBEventSet).
eventQueueNotifier signalForAll.
].
"Created: / 02-06-2014 / 22:42:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-09-2014 / 22:50:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GDBConnection methodsFor:'initialize & release'!
initializeWithProcess: aGDBProcess
process := aGDBProcess.
inferiorPTY := GDBPTY new.
eventQueue := OrderedCollection new.
eventQueueLock := RecursionLock new.
eventQueueNotifier := Semaphore new.
eventAnnouncer := Announcer new.
eventAnnouncer subscriptionRegistry subscriptionClass: GDBEventSubscription.
eventAnnouncerInternal := Announcer new.
outstandingCommands := Set new.
recorder := GDBSessionRecorder new.
aGDBProcess connection: self.
"Created: / 20-06-2014 / 21:40:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 18-09-2014 / 00:11:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
release
| pid |
pid := process pid.
(pid notNil and:[pid > 1]) ifTrue:[
OperatingSystem sendSignal:(OperatingSystem sigKILL) to:process pid.
]
"Created: / 26-05-2014 / 21:30:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 05-07-2014 / 22:20:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
released: status
TraceProcesses ifTrue:[
Logger log: ('gdb process: exited with status %1' bindWith: status code) severity: #trace facility: 'GDB'.
].
TraceProcesses ifTrue:[
Logger log: ('gdb process: waiting for event pump to finish' bindWith: status code) severity: #trace facility: 'GDB'.
].
[ eventPumpProcess notNil ] whileTrue:[
Delay waitForMilliseconds: 200.
].
TraceProcesses ifTrue:[
Logger log: ('gdb process: event pump finished' bindWith: status code) severity: #trace facility: 'GDB'.
].
eventQueueNotifier signalForAll.
process release.
inferiorPTY release.
"Created: / 26-05-2014 / 21:31:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 20-06-2014 / 21:37:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GDBConnection class methodsFor:'documentation'!
version_HG
^ '$Changeset: <not expanded> $'
! !