"{ Package: 'jv:libgdbs' }"

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

!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:[ ^ self ]. "/ gdb process terninated
        eventQueueNotifier wait.
    ] loop.

    "Created: / 02-06-2014 / 22:51:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 20-06-2014 / 21:38:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

eventDispatchSingle: aGDBEvent
    TraceEvents ifTrue:[ 
        Logger log: ('event loop: broadcasting %1 (%2)' bindWith: aGDBEvent class name with: aGDBEvent token) severity: #trace facility: 'GDB'
    ].
    eventAnnouncerInternal announce: aGDBEvent.
    eventAnnouncer announce: aGDBEvent

    "Created: / 02-06-2014 / 22:58:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 19-06-2014 / 22:18:27 / 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 := GDBParser 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>"
!

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 addAll: aGDBEventSet.
        eventQueueNotifier signalForAll.
    ].

    "Created: / 02-06-2014 / 22:42:54 / 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.
    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: / 23-06-2014 / 09:22:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

release
    process pid notNil ifTrue:[
        OperatingSystem sendSignal:(OperatingSystem sigKILL) to:process pid.       
    ]

    "Created: / 26-05-2014 / 21:30:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 20-06-2014 / 21:41:02 / 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> $'
! !