--- a/GDBInternalPipeStream.st Tue Jun 24 09:23:18 2014 +0100
+++ b/GDBInternalPipeStream.st Tue Jun 24 23:42:44 2014 +0100
@@ -103,6 +103,7 @@
"Created: / 07-06-2014 / 00:48:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+
!GDBInternalPipeStream methodsFor:'accessing'!
atEnd
--- a/GDBMI_exec_return.st Tue Jun 24 09:23:18 2014 +0100
+++ b/GDBMI_exec_return.st Tue Jun 24 23:42:44 2014 +0100
@@ -64,3 +64,10 @@
^ 'exec-return'
! !
+!GDBMI_exec_return class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/GDBParser.st Tue Jun 24 09:23:18 2014 +0100
+++ b/GDBParser.st Tue Jun 24 23:42:44 2014 +0100
@@ -184,6 +184,16 @@
"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
@@ -375,6 +385,58 @@
"Modified: / 19-06-2014 / 21:43:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!GDBParser methodsFor:'parsing-commands'!
+
+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.
+
+ "Created: / 24-06-2014 / 23:10:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!GDBParser methodsFor:'parsing-misc'!
parseResult
@@ -395,13 +457,13 @@
parseString
^ String streamContents:[:s|
- [ self peek isLetterOrDigit or:['-_' includes: self peek ] ] whileTrue:[
+ [ 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: / 20-06-2014 / 09:20:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-06-2014 / 23:30:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseVariable
@@ -734,15 +796,18 @@
nextLine
| line |
+
+ line := lookahead notNil
+ ifTrue:[ lookahead asString , source nextLine ]
+ ifFalse:[ source nextLine ].
lookahead := nil.
- line := source nextLine.
recorder notNil ifTrue:[
recorder recordResponse: line.
].
^ line
"Created: / 23-10-2012 / 11:05:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 22-06-2014 / 21:56:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-06-2014 / 23:28:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
peek
@@ -770,10 +835,9 @@
!
skipSeparators
- lookahead := nil.
- source skipSeparators
+ [ self peek notNil and:[ self peek isSeparator ] ] whileTrue:[ self next ]
"Created: / 19-11-2012 / 20:05:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 28-05-2014 / 00:21:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-06-2014 / 23:31:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
--- a/GDBSimulatorProcess.st Tue Jun 24 09:23:18 2014 +0100
+++ b/GDBSimulatorProcess.st Tue Jun 24 23:42:44 2014 +0100
@@ -1,12 +1,47 @@
"{ Package: 'jv:libgdbs' }"
GDBProcess subclass:#GDBSimulatorProcess
- instanceVariableNames:'record thread'
+ instanceVariableNames:'record thread steppingSemaphore'
classVariableNames:''
poolDictionaries:''
- category:'GDB-Private'
+ category:'GDB-Private-Simulator'
+!
+
+!GDBSimulatorProcess methodsFor:'execution'!
+
+pause
+ steppingSemaphore isNil ifTrue:[
+ steppingSemaphore := Semaphore new.
+ ] ifFalse:[
+ steppingSemaphore clear.
+ ].
+
+ "Created: / 24-06-2014 / 13:05:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+resume
+ | sema |
+
+ steppingSemaphore notNil ifTrue:[
+ sema := steppingSemaphore.
+ steppingSemaphore := nil.
+ sema signalForAll.
+ ].
+ thread isNil ifTrue:[ self start ].
+
+ "Created: / 24-06-2014 / 13:05:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+step
+ steppingSemaphore isNil ifTrue:[
+ steppingSemaphore := Semaphore new.
+ ].
+ thread isNil ifTrue:[ self start ].
+ steppingSemaphore signal.
+
+ "Created: / 24-06-2014 / 13:02:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
!GDBSimulatorProcess methodsFor:'initialization'!
initialize
@@ -19,42 +54,43 @@
!GDBSimulatorProcess methodsFor:'processing'!
-process: commandOrResponse
- | commandLine |
+processCommand: actual expecting: expected
- "Process response..."
- commandOrResponse isResponse ifTrue:[
- debuggerOutput nextPutAll: commandOrResponse string.
+ actual class == GDBMI_gdb_exit ifTrue:[
+ actual token notNil ifTrue:[
+ debuggerOutput nextPutAll: actual token printString.
+ ].
+ debuggerOutput nextPutLine: '^exit'.
+ ^ true.
+ ].
+ (actual class == GDBMI_inferior_tty_set and:[expected class == GDBMI_inferior_tty_set]) ifTrue:[
^ false.
].
- "Process command"
- commandLine := debuggerInput nextLine.
- commandLine ~= commandOrResponse string ifTrue:[
- | commandLineStream token command |
+
+ actual token notNil ifTrue:[
+ debuggerOutput nextPutAll: actual token printString.
+ ].
+ debuggerOutput nextPutLine: '^error,msg="Unexpected command"'.
+ ^ false
+
+ "Created: / 24-06-2014 / 23:37:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
- commandLineStream := commandLine readStream.
- commandLineStream peek isDigit ifTrue:[
- token := 0.
- [ commandLineStream peek isDigit ] whileTrue:[
- token := (token * 10) + (commandLineStream next codePoint - $0 codePoint)
- ]
- ].
- command := commandLineStream upToEnd.
- token notNil ifTrue:[
- debuggerOutput nextPutAll: token printString.
- ].
+processCommandLineExpecting: lineExpected
+ | lineActual |
- command = '-gdb-exit' ifTrue:[
- debuggerOutput nextPutLine: '^exit'.
- ^ true "/ We're done
- ] ifFalse:[
- debuggerOutput nextPutLine:'^error,msg="Unexpected command for this simulation"'
- ].
-
+ lineActual := debuggerInput nextLine.
+ lineActual ~= lineExpected ifTrue:[
+ | cmdActual cmdExpected |
+
+ cmdActual := (GDBParser on: lineActual ) parseCommand.
+ cmdExpected := (GDBParser on: lineExpected ) parseCommand.
+
+ ^ self processCommand: cmdActual expecting: cmdExpected.
].
^ false
- "Created: / 24-06-2014 / 08:50:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 24-06-2014 / 23:37:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
processLoop
@@ -62,12 +98,26 @@
done := false.
events := record readStream.
- [ done or:[ events atEnd ] ] whileFalse:[
- done := self process: events next.
+ [ done or:[ events atEnd ] ] whileFalse:[
+ | event |
+
+ event := events next.
+ event isCommand ifTrue:[
+ done := self processCommandLineExpecting: event string.
+ ] ifFalse:[
+ self processResponse: event.
+ ]
].
"Created: / 24-06-2014 / 08:48:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-06-2014 / 23:37:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+processResponse: response
+ debuggerOutput nextPutAll: response string
+
+ "Created: / 24-06-2014 / 22:57:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GDBSimulatorProcess methodsFor:'start & stop'!
@@ -78,9 +128,8 @@
record:aGDBSessionRecord
record := aGDBSessionRecord.
- self start.
- "Modified: / 24-06-2014 / 00:58:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-06-2014 / 13:06:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
start
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/GDBSimulatorProcessTests.st Tue Jun 24 23:42:44 2014 +0100
@@ -0,0 +1,33 @@
+"{ Package: 'jv:libgdbs' }"
+
+TestCase subclass:#GDBSimulatorProcessTests
+ instanceVariableNames:'events simulator debugger'
+ classVariableNames:''
+ poolDictionaries:'GDBCommandStatus'
+ category:'GDB-Private-Tests'
+!
+
+!GDBSimulatorProcessTests methodsFor:'running'!
+
+tearDown
+ simulator notNil ifTrue:[ simulator stop ].
+ debugger notNil ifTrue:[ debugger release ].
+ events := nil.
+
+ "Created: / 24-06-2014 / 13:10:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!GDBSimulatorProcessTests methodsFor:'tests'!
+
+test_01
+ events := OrderedCollection new.
+ simulator := GDBSimulatorProcess new record: GDBSimulatorResource session_factorial_01.
+ simulator start.
+ debugger := GDBDebugger newWithProcess: simulator.
+ debugger announcer on: GDBEvent do:[:ev | events add: ev ].
+
+ self assert: events isEmpty.
+
+ "Created: / 24-06-2014 / 13:08:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
--- a/abbrev.stc Tue Jun 24 09:23:18 2014 +0100
+++ b/abbrev.stc Tue Jun 24 23:42:44 2014 +0100
@@ -11,7 +11,6 @@
GDBPTY GDBPTY jv:libgdbs 'GDB-Private' 0
GDBProcess GDBProcess jv:libgdbs 'GDB-Private' 0
GDBSessionRecord GDBSessionRecord jv:libgdbs 'GDB-Private-Simulator' 0
-GDBSimulatorResource GDBSimulatorResource jv:libgdbs 'GDB-Resources' 1
GDBValueDescriptor GDBValueDescriptor jv:libgdbs 'GDB-Private-Descriptors' 0
GDBValueDescriptorError GDBValueDescriptorError jv:libgdbs 'GDB-Private-Descriptors' 1
jv_libgdbs jv_libgdbs jv:libgdbs '* Projects & Packages *' 3
@@ -29,7 +28,8 @@
GDBParser GDBParser jv:libgdbs 'GDB-Private' 0
GDBPrimitiveValueDescriptor GDBPrimitiveValueDescriptor jv:libgdbs 'GDB-Private-Descriptors' 0
GDBSessionRecorder GDBSessionRecorder jv:libgdbs 'GDB-Private-Simulator' 0
-GDBSimulatorProcess GDBSimulatorProcess jv:libgdbs 'GDB-Private' 0
+GDBSimulatorProcess GDBSimulatorProcess jv:libgdbs 'GDB-Private-Simulator' 0
+GDBSimulatorProcessTests GDBSimulatorProcessTests jv:libgdbs 'GDB-Private-Tests' 1
GDBStreamOutputEvent GDBStreamOutputEvent jv:libgdbs 'GDB-Core-Events' 0
GDBUnixProcess GDBUnixProcess jv:libgdbs 'GDB-Private' 0
GDBAddresValueDescriptor GDBAddresValueDescriptor jv:libgdbs 'GDB-Private-Descriptors' 0
@@ -166,3 +166,4 @@
GDBThreadGroupAddedEvent GDBThreadGroupAddedEvent jv:libgdbs 'GDB-Core-Events' 0
GDBThreadGroupExitedEvent GDBThreadGroupExitedEvent jv:libgdbs 'GDB-Core-Events' 0
GDBThreadGroupStartedEvent GDBThreadGroupStartedEvent jv:libgdbs 'GDB-Core-Events' 0
+GDBSimulatorResource GDBSimulatorResource jv:libgdbs 'GDB-Resources' 1
--- a/jv_libgdbs.st Tue Jun 24 09:23:18 2014 +0100
+++ b/jv_libgdbs.st Tue Jun 24 23:42:44 2014 +0100
@@ -29,7 +29,7 @@
^ #(
#'stx:goodies/announcements' "Announcement - superclass of GDBAsyncEvent "
- #'stx:goodies/sunit' "TestAsserter - superclass of GDBSimulatorResource "
+ #'stx:goodies/sunit' "TestAsserter - superclass of GDBSimulatorProcessTests "
#'stx:libbasic' "ArithmeticValue - extended "
)
!
@@ -75,7 +75,6 @@
GDBPTY
GDBProcess
GDBSessionRecord
- (GDBSimulatorResource autoload)
GDBValueDescriptor
GDBValueDescriptorError
#'jv_libgdbs'
@@ -94,6 +93,7 @@
GDBPrimitiveValueDescriptor
GDBSessionRecorder
GDBSimulatorProcess
+ (GDBSimulatorProcessTests autoload)
GDBStreamOutputEvent
GDBUnixProcess
GDBAddresValueDescriptor
@@ -230,6 +230,7 @@
GDBThreadGroupAddedEvent
GDBThreadGroupExitedEvent
GDBThreadGroupStartedEvent
+ (GDBSimulatorResource autoload)
)
!
--- a/libgdbs.rc Tue Jun 24 09:23:18 2014 +0100
+++ b/libgdbs.rc Tue Jun 24 23:42:44 2014 +0100
@@ -25,7 +25,7 @@
VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
VALUE "ProductName", "LibraryName\0"
VALUE "ProductVersion", "6.2.4.0\0"
- VALUE "ProductDate", "Tue, 24 Jun 2014 08:22:06 GMT\0"
+ VALUE "ProductDate", "Tue, 24 Jun 2014 22:42:06 GMT\0"
END
END
--- a/tests/GDBParserTests.st Tue Jun 24 09:23:18 2014 +0100
+++ b/tests/GDBParserTests.st Tue Jun 24 23:42:44 2014 +0100
@@ -73,6 +73,32 @@
!GDBParserTests methodsFor:'tests - commands'!
+test_command_01
+ | command |
+
+ command := (GDBParser on: 'b factorial') parseCommand.
+
+ self assert: command isCLICommand.
+ self assert: command token isNil.
+ self assert: command value = 'b factorial'.
+
+ "Created: / 24-06-2014 / 23:21:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+test_command_02
+ | command |
+
+ command := (GDBParser on: '-gdb-exit') parseCommand.
+
+ self assert: command isMICommand.
+ self assert: command class == GDBMI_gdb_exit.
+ self assert: command arguments isEmpty
+
+ "Created: / 24-06-2014 / 23:29:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!GDBParserTests methodsFor:'tests - commands reponses'!
+
test_command_break_list_01
| parser events |
--- a/tests/tests.rc Tue Jun 24 09:23:18 2014 +0100
+++ b/tests/tests.rc Tue Jun 24 23:42:44 2014 +0100
@@ -25,7 +25,7 @@
VALUE "LegalCopyright", "My CopyRight or CopyLeft\0"
VALUE "ProductName", "LibraryName\0"
VALUE "ProductVersion", "6.2.4.0\0"
- VALUE "ProductDate", "Tue, 24 Jun 2014 08:22:08 GMT\0"
+ VALUE "ProductDate", "Tue, 24 Jun 2014 22:42:09 GMT\0"
END
END