"{ Encoding: utf8 }"

"{ Package: 'jv:libgdbs' }"

	instanceVariableNames:'source lookahead token token2CommandMappingBlock recorder'

	classVariableNames:''

	poolDictionaries:'GDBCommandStatus'

	category:'GDB-Private'

!

on: aStringOrStream

    ^ self new on: aStringOrStream

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

! !

recorder

    ^ recorder

!

recorder:something

    recorder := something.

!

token2CommandMappingBlock: aBlock

    token2CommandMappingBlock := aBlock.

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

! !

on: aStringOrStream

    source := aStringOrStream readStream

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

! !

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 or:[ c == Character cr ]) 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>"

!

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

            events add: self parseAsyncRecord.

        ] ifFalse:[

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

                events add: self parseStreamRecord.

            ] ifFalse:[

                peek == $^ ifTrue:[

                    events add: self parseResultRecord.

                ] 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: / 06-09-2014 / 00:44:40 / 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

    "

    | command result descriptor propertyName propertyDescriptor propertyValue |

    self expect: $^.

    result := GDBCommandResult new.

    result status: self parseResultClass.

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

        command := token2CommandMappingBlock value: token. 

        command notNil ifTrue:[

            result command: command.

        ].

    ].

    [ self peek == $, ] whileTrue:[

        self next. "/ eat $,

        propertyName := self parseVariable.

        propertyDescriptor := descriptor propertyDescriptorAt: propertyName.

        self expect: $=.

        propertyDescriptor isNil ifTrue:[ 

            propertyValue := self parseValue.

        ] ifFalse:[ 

        ]. 

        result propertyAt: propertyName put: propertyValue.

     ].             

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

! !

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

!

parseAsyncRecord: eventClassBase

    "

    async-output → async-class ( ',' result )* nl

    "

    | type eventClass event propertyName propertyDescriptor descriptor propertyValue |

    type := self parseString.

    eventClass := eventClassBase eventClassForType: type.

    event := eventClass new.

    event type: type.

    [ self peek == $, ] whileTrue:[

        self next. "/ eat $,

        propertyName := self parseVariable.

        propertyDescriptor := descriptor propertyDescriptorAt: propertyName.

        self expect: $=.

        propertyDescriptor isNil ifTrue:[ 

            propertyValue := self parseValue.

        ] ifFalse:[ 

        ]. 

        event propertyAt: propertyName put: propertyValue.

    ].

    self parseNl.

    ^ event

    "Created: / 01-06-2014 / 23:43:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"

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

! !

parseCommand

    self peek isDigit ifTrue:[ 

        self parseToken

    ].

    ^ self peek == $- ifTrue:[ 

        self parseCommandMI

    ] ifFalse:[ 

        self parseCommandCLI

    ].

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

!

parseCommandCLI

    "raise an error: this method should be implemented (TODO)"

    ^ GDBCLICommand new

        token: token;

        value: self nextLine;

        yourself

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

!

parseCommandMI

    "raise an error: this method should be implemented (TODO)"

    | operation className class args |

    self next. "/ eat $-.

    operation := self parseVariable.

    className := ('GDBMI_' , (operation copyReplaceAll: $- with: $_)) asSymbol.

    class := Smalltalk at: className.

    args := OrderedCollection new.

    [ self peek isNil or:[ self peek == Character cr ] ] whileFalse:[  

        self skipSeparators.

        self peek == $" ifTrue:[ 

            args add: self parseCString

        ] ifFalse:[ 

            args add: self parseNonBlankSequence

        ].

    ].

    self next. "/ eat CR.

    ^ (class arguments: args asArray) token: token.

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

    "Modified: / 26-08-2014 / 08:02:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

parseResult

    "

    result → variable = value

    "

    | name value |

    name := self parseVariable.

    self expect: $=.

    value := self parseValue.

    ^ name -> value

    "Created: / 30-05-2014 / 10:15:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

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

!

parseString

    ^ String streamContents:[:s|

        [ self peek notNil and:[self peek isLetterOrDigit or:['-_' includes: self peek ] ] ] whileTrue:[

            s nextPut: self next.

        ]

    ].

    "Created: / 30-05-2014 / 10:32:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 24-06-2014 / 23:30:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

parseVariable

    "

    variable → string

    "

    ^ self parseString

    "Created: / 30-05-2014 / 10:31:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

parseStreamRecord

    "

    stream-record → console-stream-output | target-stream-output | log-stream-output

    "

    self peek == $~ ifTrue:[

        self next.

        ^ self parseStreamRecord: GDBConsoleOutputEvent.

    ].