"{ Encoding: utf8 }"

"{ Package: 'jv:libgdbs' }"

	instanceVariableNames:'source lookahead token'

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

! !

on: aStringOrStream

    source := aStringOrStream readStream

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

! !

parseCString

    | buffer inString nextChar |

    self expect: $".

    nextChar := self next.

    buffer := (String new: 50) writeStream.

    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: / 27-05-2014 / 23:51:35 / 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>"

!

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

!

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 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'.

                ].

            ].

        ].

    ].

    self expect: '(gdb)'.

    self parseNl.

    ^ events

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

    "Modified: / 02-06-2014 / 22:21:54 / 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

    "

    | result |

    self expect: $^.

    result := GDBCommandResult new.

    result status: self parseResultClass.

    self peek == $, ifTrue:[

        self next.

        result value: self parseResult.

    ].

    self parseNl.

    ^ GDBCommandResultEvent new result: result.

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

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

!

parseToken

    "Created: / 28-05-2014 / 00:14:57 / 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: eventClass

    "

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

    "

    | type data |

    type := self parseString.

    data := Array streamContents:[ :s |

	[ self peek == $, ] whileTrue:[

	    self next.

	    s nextPut: self parseResult.

	]

    ].

    self parseNl.

    ^ eventClass new

	type: type;

	data: data;

	yourself

    "Created: / 01-06-2014 / 23:43:36 / 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 isLetter or:['-' includes: self peek ] ]  whileTrue:[

	    s nextPut: self next.

	]

    ].

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

    "Modified: / 31-05-2014 / 00:33:59 / 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.

    ].

    self peek == $@ ifTrue:[

        self next.

        ^ self parseStreamRecord: GDBTargetOutputEvent.

    ].

    self peek == $& ifTrue:[

        self next.

        ^ self parseStreamRecord: GDBLogOutputEvent.

    ].

    self error:'Invalid stream record'

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

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

!

parseStreamRecord: eventClass

    | value |

    value := self parseCString.

    self parseNl.

    ^ eventClass new value: value; yourself

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

! !

expect: aStringOrChar

    | c |

    aStringOrChar isCharacter ifTrue:[

	(self atEnd or:[(c := self next) ~= aStringOrChar]) ifTrue:[

	    self error:('Expected ''%1'' got ''%2''.' bindWith: aStringOrChar with: c).

	].

	^self.

    ].

    aStringOrChar isString ifTrue:[

	aStringOrChar do:[:expected|

	    (self atEnd or:[(c := self next) ~= expected]) ifTrue:[

		self error:('Expected ''%1''.' bindWith: aStringOrChar).

	    ].

	].

	^self.

    ].

    self error:'Invalid expected value'.

    "Created: / 19-11-2012 / 20:08:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

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

!

expectLineEnd

    self expect: Character cr.

    "Created: / 19-11-2012 / 20:06:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

expectSpace

    self expect: Character space.

    "Created: / 19-11-2012 / 20:06:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

parseConst

    "

    const → c-string

    "

    ^ self parseCString.

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

!

parseList

    "

    list → '[]' | '[' value ( ',' value )* ']' | '[' result ( ',' result )* ']'

    "

    self expect: $[.

    self peek == $] ifTrue:[

	self next.

	^ #()

    ] ifFalse:[

	^ Array streamContents:[ :s|

	    s nextPut: self parseValue.

	    [ self peek == $, ] whileTrue:[

		self next.

		s nextPut: self parseValue.

	    ].

	    self expect: $].

	].

    ].

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

!

parseTuple

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

    | object |

    object := GDBTuple new.

    self expect: ${.

    self peek == $} ifTrue:[

	self next.

    ] ifFalse:[

	| name value |

	name := self parseVariable.

	self expect: $=.

	value := self parseValue.

	object propertyAt: name put: value.

	[ self peek == $, ] whileTrue:[

	    self next.

	    name := self parseVariable.

	    self expect: $=.

	    value := self parseValue.

	    object propertyAt: name put: value.

	].

	self expect: $}.

    ].

    ^ object

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

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

!

parseValue

    "

    value → const | tuple | list

    "

    self peek == $" ifTrue:[