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

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

    ].

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

! !

!GDBConnection class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !