"{ Encoding: utf8 }"

"

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

Object subclass:#GDBMIParser

	instanceVariableNames:'source lookahead token token2CommandMappingBlock recorder'

	classVariableNames:''

	poolDictionaries:'GDBCommandStatus'

	category:'GDB-Private'

!

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

"

    A parser that reads GDB MI output records from a stream

    and converts them to objects.

    See [1] for description of GDB MI output syntax.

    [author:]

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

    [instance variables:]

    [class variables:]

    [see also:]

        [1]: https://sourceware.org/gdb/onlinedocs/gdb/GDB_002fMI-Output-Syntax.html#GDB_002fMI-Output-Syntax

"

! !

!GDBMIParser class methodsFor:'instance creation'!

on: aStringOrStream

    ^ self new on: aStringOrStream

    "Created: / 27-05-2014 / 23:50:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBMIParser methodsFor:'accessing'!

recorder

    ^ recorder

!

recorder:something

    recorder := something.

!

token2CommandMappingBlock: aBlock

    token2CommandMappingBlock := aBlock.

    "Created: / 19-06-2014 / 21:34:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBMIParser methodsFor:'initialization'!

on: aStringOrStream

    source := aStringOrStream readStream

    "Created: / 27-05-2014 / 23:50:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBMIParser methodsFor:'parsing'!

parseCString

    self expect: $".

    ^ self parseCStringRest: ''.

    "Created: / 27-05-2014 / 23:51:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 18-06-2014 / 07:19:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseCStringEscape: char

    |ascii c |

    char == $" ifTrue:[

	^ $".

    ].

    char == $b ifTrue:[

	^ Character backspace

    ].

    char == $t ifTrue:[

	^ Character tab

    ].

    char == $n ifTrue:[

	^ Character cr

    ].

    char == $r ifTrue:[

	^ Character return

    ].

    char == $f ifTrue:[

	^ Character newPage

    ].

"/    char == $u ifTrue:[

"/        ascii := 0.

"/        c := source peekOrNil.

"/        4 timesRepeat:[

"/            (c isDigitRadix:16) ifFalse:[

"/                self syntaxError:'invalid hex character constant'

"/                        position:source position-2 to:(source position - 1).

"/                ^ Character value:ascii

"/            ].

"/            ascii := (ascii bitShift:4).

"/            ascii := ascii + c digitValue.

"/            source next. c := source peekOrNil.

"/        ].

"/        ^ Character value:ascii

"/    ].

    char == $x ifTrue:[

	ascii := 0.

	c := self peekOrNil.

	2 timesRepeat:[

	    (c isDigitRadix:16) ifFalse:[

		self error:'Invalid hex character escape'.

		^ Character value:ascii

	    ].

	    ascii := (ascii bitShift:4).

	    ascii := ascii + c digitValue.

	    self next. c := self peekOrNil.

	].

	^ Character value:ascii

    ].

    "OctalEscape ::= \ OctalDigit |

		     \ OctalDigit OctalDigit

		     \ ZeroToThree OctalDigit OctalDigit"

    (char between:$0 and:$3) ifTrue:[

	ascii := char digitValue.

	c := self peekOrNil.

	(c between: $0 and: $7) ifTrue:[

	    self next.

	    ascii := (ascii bitShift:3).

	    ascii := ascii + c digitValue.

	].

	c := self peekOrNil.

	(c between: $0 and: $7) ifTrue:[

	    self next.

	    ascii := (ascii bitShift:3).

	    ascii := ascii + c digitValue.

	].

	^ Character value:ascii

    ].

    (char between:$4 and: $7) ifTrue:[

	ascii := char digitValue.

	c := self peekOrNil.

	(c between: $0 and: $7) ifTrue:[

	    self next.

	    ascii := (ascii bitShift:3).

	    ascii := ascii + c digitValue.

	].

	^ Character value:ascii

    ].

    ^ char

    "Created: / 28-05-2014 / 00:02:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseCStringRest: alreadyRead

    | buffer inString nextChar |

    buffer := (String new: 50) writeStream.

    buffer nextPutAll: alreadyRead.

    nextChar := self next.

    inString := true.

    [inString] whileTrue:[

        nextChar isNil ifTrue:[

            self error: 'Unexpected end of input'.

        ].

        nextChar == $\ ifTrue:[

            nextChar := self next.

            nextChar := self parseCStringEscape:nextChar.

        ] ifFalse:[

            (nextChar == $") ifTrue:[

                (self peekOrNil == $") ifTrue:[

                    self next

                ] ifFalse:[

                    inString := false

                ]

            ].

        ].

        inString ifTrue:[

            buffer nextPut:nextChar.

            nextChar := self next

        ]

    ].

    ^ buffer contents

    "Created: / 18-06-2014 / 07:17:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseNl

    | c |

    c := self peek.

    c == Character return"CR" ifTrue:[ 

        self next.

        c := self peek.

    ].

    c == Character lf"LF" ifTrue:[

        self next

    ].

    "Created: / 30-05-2014 / 09:52:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 31-05-2014 / 00:38:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 12-01-2018 / 08:56:40 / jv"

!

parseNonBlankSequence

    ^ String streamContents:[ :buffer | 

        [ self peek isNil or: [ self peek isSeparator ] ] whileFalse:[

            buffer nextPut: self next.

        ]

    ]

    "Created: / 24-06-2014 / 23:19:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseOutput

    "

    output → ( out-of-band-record )* [ result-record ] '(gdb)' nl

    out-of-band-record → async-record | stream-record

    "

    | peek events |

    events := GDBEventSet new.

    peek := self peek.

    peek == Character space ifTrue:[ self next ].

    peek := self peek.

    peek == Character cr ifTrue:[ self next ].

    [

        token := nil.

        peek := self peek.

        peek isNil ifTrue:[ 

            source atEnd ifTrue:[ ^ events ].

        ].

        peek isDigit ifTrue:[ self parseToken. peek := self peek ].

        peek ~~ $(

    ] whileTrue:[

        ('*+=' includes: self peek) ifTrue:[

            | event |

            event := self parseAsyncRecord.

            events add: event.

            "Sigh, GDB 7.7.1 does not write '(gdb)' terminator after an

             async events (even though specification says it should). 

             Thus, report any execution record immediately"

            event isAsyncEvent ifTrue:[

                events last token: token.

                recorder notNil ifTrue:[ 

                    recorder recordResponseEnd.

                ].

                ^ events

            ].

        ] ifFalse:[

            ('~@&' includes: self peek) ifTrue:[

                events add: self parseStreamRecord.

            ] ifFalse:[

                peek == $^ ifTrue:[

                    events add: self parseResultRecord.

                    "/ Sigh, when using MI over PTY (as suggested by Pedro Alves),

                    "/ the PTY is kept open if GDB exits so peek block for ever.

                    "/ So, if ^exit status is reported, exit immediately. 

                    (events last isCommandResultEvent and:[ events last status == #exit ]) ifTrue:[ 

                        events last token: token. 

                        recorder notNil ifTrue:[ 

                            recorder recordResponseEnd.

                        ].

                        ^ events

                    ].

                ] ifFalse:[

                    self error:'Invalid MI record'.

                ].

            ].

        ].

        events last token: token.

    ].

    self expect: '(gdb)'.

    [ self peek == Character space ] whileTrue:[ self next ].

    self parseNl.

    recorder notNil ifTrue:[ 

        recorder recordResponseEnd.

    ].

    ^ events

    "Created: / 30-05-2014 / 09:52:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 11-07-2017 / 11:04:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parsePostStartHeader

    "

Python Exception <type 'exceptions.ImportError'> No module named gdb: 

./gdb: warning: 

Could not load the Python gdb module from `/usr/local/share/gdb/python'.

Limited Python support is available from the _gdb module.

Suggest passing --data-directory=/path/to/gdb/data-directory.

=thread-group-added,id='i1'

(gdb) 

    "

    | atBeginingOfLine c |

    atBeginingOfLine := true.

    [ 

        c := source peek.

        atBeginingOfLine and:[ c == $= ]

    ] whileFalse:[ 

        c := source next.

        atBeginingOfLine := c == Character lf

    ].

    "Created: / 01-03-2015 / 08:25:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseResultClass

    "

    result-class → 'done' | 'running' | 'connected' | 'error' | 'exit'

    "

    | c1 c2 |

    c1 := self peek.

    c1 == $d ifTrue:[

	self expect: 'done'.

	^ CommandStatusDone.

    ].

    c1 == $r ifTrue:[

	self expect: 'running'.

	^ CommandStatusDone.

    ].

    c1 == $c ifTrue:[

	self expect: 'connected'.

	^ CommandStatusConnected.

    ].

    c1 == $e ifTrue:[

	self next.

	c2 := self peek.

	c2 == $x ifTrue:[

	    self expect: 'xit'.

	    ^ CommandStatusExit.

	].

	c2 == $r ifTrue:[

	    self expect: 'rror'.

	    ^ CommandStatusError.

	].

    ].

    ^ self error:'Unsupported result class'

    "Created: / 31-05-2014 / 00:16:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 01-06-2014 / 23:21:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseResultRecord

    "

    result-record → '^' result-class ( ',' result )* nl

    "

    self expect: $^.

    result := GDBCommandResult new.

    descriptor := GDBMAContainer new.

    (token notNil and:[ token2CommandMappingBlock notNil ]) ifTrue:[ 

        command := token2CommandMappingBlock value: token. 

        command notNil ifTrue:[

            result command: command.

        ].

    ].

    descriptor klass isNil ifTrue:[ 

        "/ Command result is not an object but list of properties...

        [ self peek == $, ] whileTrue:[

            self next. "/ eat $,

            propertyName := self parseVariable.

            propertyDescriptor := descriptor propertyDescriptorAt: propertyName.

            self expect: $=.

            propertyDescriptor isNil ifTrue:[ 

                propertyValue := self parseValue.

            ] ifFalse:[ 

                propertyValue := propertyDescriptor parseUsingGDBMIParser:self. 

            ]. 

            result propertyAt: propertyName put: propertyValue.

         ].             

    ] ifFalse:[ 

        "/ Command result forms an object.

        "/ Create an object and parse property list as its properties.

        | object |

        object := descriptor klass new.

        self peek == $, ifTrue:[

            self next. "/ eat first , following command status...

            self parsePropertiesFor: object describedBy: descriptor.

        ].

        result propertyAt: #value put: object.

    ].

    self parseNl.

    ^ GDBCommandResultEvent new result: result.

    "Created: / 30-05-2014 / 09:52:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseToken

    token := 0.

    [ self peek isDigit ] whileTrue:[ 

        token := (token * 10) + (self next codePoint - $0 codePoint).

    ].

    "Created: / 28-05-2014 / 00:14:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 03-06-2014 / 00:49:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!GDBMIParser methodsFor:'parsing-async events'!

parseAsyncRecord

    "

    async-record → exec-async-output | status-async-output | notify-async-output

    "

    self peek == $* ifTrue:[

        self next.

        ^ self parseAsyncRecord: GDBExecutionEvent.

    ].

    self peek == $+ ifTrue:[

        self next.

        ^ self parseAsyncRecord: GDBStatusEvent .

    ].

    self peek == $= ifTrue:[

        self next.

        ^ self parseAsyncRecord: GDBNotificationEvent.

    ].

    ^ self error: 'Invalid async-record'

    "Created: / 30-05-2014 / 09:57:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 02-06-2014 / 22:19:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!