"

jv:libgdbs - GNU Debugger Interface Library

Copyright (C) 2015-now Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

"{ Package: 'jv:libgdbs' }"

"{ NameSpace: Smalltalk }"

GDBLocalProcess subclass:#GDBStXSimpleProcess

	instanceVariableNames:'debuggerError errorPumpProcess'

	classVariableNames:''

	poolDictionaries:'GDBDebugFlags'

	category:'GDB-Private'

!

!GDBStXSimpleProcess class methodsFor:'documentation'!

copyright

"

jv:libgdbs - GNU Debugger Interface Library

Copyright (C) 2015-now Jan Vrany

This library is free software; you can redistribute it and/or

modify it under the terms of the GNU Lesser General Public

License as published by the Free Software Foundation; either

version 2.1 of the License. 

This library is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU

Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public

License along with this library; if not, write to the Free Software

Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

"

!

documentation

"

    GDBStXSimpleProcess is Smalltalk/X specific GDB process implementation

    that uses (two) pipes for communicating with GDB itself. 

    This implementation should work on all platforms, but does not support

    access to GDB's built-in CLI - this means that clients wanting to provide

    a CLI interface to the GDB must emulate it on their own.

    [author:]

        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

        GDBRemoteProcess

        GDBStXUnixProcess

"

! !

!GDBStXSimpleProcess methodsFor:'error pump'!

errorPumpLoop

    [ debuggerError atEnd ] whileFalse:[

        debuggerError readWait.

        debuggerError atEnd ifFalse:[

            | line |

            line := debuggerError nextLine.

            line notNil ifTrue:[ 

                Logger log: line severity: #error facility: 'GDB'

            ].

        ].

    ]

    "Created: / 15-01-2018 / 09:31:39 / jv"

!

errorPumpStart

    errorPumpProcess isNil ifTrue:[

        errorPumpProcess := [

                TraceEvents ifTrue:[

                    Logger log: 'error pump: starting' severity: #trace facility: 'GDB'

                ].

                self errorPumpLoop

            ] newProcess.

        errorPumpProcess name:('GDB Error pump (%1)' bindWith: self id).

        errorPumpProcess priority:Processor userBackgroundPriority.

        errorPumpProcess addExitAction:[ 

            TraceEvents ifTrue:[

                Logger log: 'error pump: terminated' severity: #trace facility: 'GDB'

            ].

            errorPumpProcess := nil. 

        ].

        errorPumpProcess resume.

    ].

    "Created: / 15-01-2018 / 09:28:06 / jv"

    "Modified: / 20-10-2018 / 06:53:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

errortPumpStop

    | t |

    t := errorPumpProcess.

    (t notNil and:[ t isDead not]) ifTrue:[ 

        errorPumpProcess := nil.

        t terminate.

         "/ raise its prio to make it terminate quickly

        t priority:(Processor userSchedulingPriority + 1)                       

    ].

    "Created: / 15-01-2018 / 09:29:49 / jv"

! !

!GDBStXSimpleProcess methodsFor:'initialization & release'!

initialize

    | exe inputPipe  input  outputPipe  output errorPipe error args |

    exe := self class gdbExecutable.

    (exe isNil or:[ exe asFilename isExecutable not ]) ifTrue:[ 

        GDBError signal: 'Could not find gdb, please set path to gdb using GDBProcess class >> gdbExecutable:'.

        ^ self.

    ].

    inputPipe := NonPositionableExternalStream makePipe.

    input := inputPipe second.

    outputPipe := NonPositionableExternalStream makePipe.

    output := outputPipe first.

    errorPipe := NonPositionableExternalStream makePipe.

    error := outputPipe first.

    args := (Array new: 7)

             at: 1 put: exe;

             at: 2 put: '-q';

             at: 3 put: '-nx';

             at: 4 put: '--interpreter';

             at: 5 put: 'mi2';

             at: 6 put: '-ex';

             at: 7 put: 'set new-console on';

             yourself.

    Processor 

        monitor:[

            pid := OperatingSystem 

                    exec:args first

                    withArguments:args

                    environment:OperatingSystem getEnvironment

                    fileDescriptors: (Array

                            with: inputPipe first fileDescriptor

                            with: outputPipe second fileDescriptor

                            with: errorPipe second fileDescriptor

                        )

                    fork:true

                    newPgrp:false

                    inDirectory:Filename currentDirectory

                    showWindow: false.      

            debuggerInput := input.

            debuggerOutput := output.

            debuggerError := error.

            pid.

        ]

        action:[:stat | self exited:stat. ].

    inputPipe first close.

    outputPipe second close.

    errorPipe second close.

    pid isNil ifTrue:[

        input close.

        output close.

        error close.

        self error:'Failed to launch gdb'.

    ].

    "Created: / 12-12-2017 / 21:04:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 15-01-2018 / 09:35:03 / jv"

    "Modified: / 21-10-2018 / 08:06:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

initializeWithCommand: aString

    | inputPipe  input  outputPipe  output errorPipe error argv |

    command := aString.

    argv := (self command2argv: command) ,

            ((Array new: 5)

             at: 1 put: '-q';

             at: 2 put: '--interpreter';

             at: 3 put: 'mi';

             at: 4 put: '-ex';

             at: 5 put: 'set new-console on';

             yourself).

    inputPipe := NonPositionableExternalStream makePipe.

    input := inputPipe second.

    outputPipe := NonPositionableExternalStream makePipe.

    output := outputPipe first.

    errorPipe := NonPositionableExternalStream makePipe.

    error := outputPipe first.

    "/

    OperatingSystem isMSWINDOWSlike ifTrue:[ 

        (OperatingSystem getEnvironment:'HOME') isNil ifTrue:[ 

            OperatingSystem setEnvironment:'HOME' to: Filename homeDirectory pathName

        ].

    ].

    Processor 

        monitor:[

            pid := OperatingSystem 

                    exec:argv first

                    withArguments:argv

                    environment:OperatingSystem getEnvironment

                    fileDescriptors: (Array

                            with: inputPipe first fileDescriptor

                            with: outputPipe second fileDescriptor

                            with: errorPipe second fileDescriptor

                        )

                    fork:true

                    newPgrp:false

                    inDirectory:Filename currentDirectory

                    showWindow: false.      

            debuggerInput := input.

            debuggerOutput := output.

            debuggerError := error.

            pid.

        ]

        action:[:stat | self exited:stat. ].

    inputPipe first close.

    outputPipe second close.

    errorPipe second close.

    pid isNil ifTrue:[

        input close.

        output close.

        error close.

        self error:'Failed to launch gdb'.

    ].

    "Created: / 12-12-2018 / 20:13:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 11-06-2019 / 11:45:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 25-06-2019 / 21:10:02 / jv"

!

release

    pid := connection := nil.

    debuggerInput notNil ifTrue:[ debuggerInput close ].

    debuggerOutput notNil ifTrue:[ debuggerOutput close ].

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

    "Modified: / 15-12-2017 / 23:59:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBStXSimpleProcess class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !