--- a/GDBDebugger.st Sun Mar 08 07:37:59 2015 +0000
+++ b/GDBDebugger.st Sun Mar 08 07:38:42 2015 +0000
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"{ Package: 'jv:libgdbs' }"
"{ NameSpace: Smalltalk }"
@@ -39,7 +41,11 @@
(gdb) exec-file <aStringOrFilename>
"
- self send: (GDBMI_file_exec_and_symbols arguments: { aStringOrFilename asString }) wait: false.
+ self
+ send:(GDBMI_file_exec_and_symbols arguments:{
+ aStringOrFilename asString
+ })
+ andWait:false.
"Created: / 28-02-2015 / 00:19:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -119,56 +125,221 @@
!GDBDebugger methodsFor:'commands'!
send: command
- "Execute given `command` and wait until it finishes.
- Command can be either an instance of GDBCommand or
- a String. If String, it is assumed to be a CLI command
- string.
- "
- ^ self send: command wait: true.
+ "Execute given `command` and wait until it finishes and return its result.
+ `command` may be either a GDBCommand or string, in which case it will
+ be parsed into a GDBCommand.
+ "
+ ^ self send:command andWait:true.
"Created: / 03-06-2014 / 00:10:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (comment): / 28-02-2015 / 00:40:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified (comment): / 08-03-2015 / 05:50:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-send: command wait: wait
- "Sends given `command` to GDB. If `aBoolean` is true, wait for
- command to finish. Otherwise, return immediately."
+send:command andWait:wait
+ "Sends given `command` to GDB. If `wait` is true, wait for
+ command to finish and return the command result.
+ Otherwise, return nil immediately.
- | cmd token blocker handler1 handler2 result |
+ `command` may be either a GDBCommand or string, in which case it will
+ be parsed into a GDBCommand.
+ "
+
+ | cmd token blocker handler1 handler2 result |
cmd := command.
- cmd isString ifTrue:[
- cmd := GDBCLICommand new value: cmd.
+ cmd isString ifTrue:[
+ cmd := GDBCLICommand new value:cmd.
].
- (wait and:[Processor activeProcess == connection eventDispatchProcess]) ifTrue:[
- self error: 'Cannot send commands from within event dispatching process. Would deadlock'.
- ].
-
token := self nextCommandSequnceNumber.
- cmd token: token.
- ^ wait ifTrue:[
- handler1 := [ :ev |
- ev token == token ifTrue:[
- connection eventAnnouncer unsubscribe: handler1.
- result := ev result.
- connection eventAnnouncerInternal when: GDBEventSetProcessingFinished do: handler2.
- ]].
- handler2 := [ :ev |
- connection eventAnnouncerInternal unsubscribe: handler2.
- blocker signal.
- ].
+ cmd token:token.
+ ^ wait ifTrue:[
+ self assert:Processor activeProcess ~~ connection eventDispatchProcess
+ message:'Cannot send commands from within event dispatching process. Would deadlock'.
+ handler1 := [:ev |
+ ev token == token ifTrue:[
+ connection eventAnnouncer unsubscribe:handler1.
+ result := ev result.
+ connection eventAnnouncerInternal when:GDBEventSetProcessingFinished
+ do:handler2.
+ ]
+ ].
+ handler2 := [:ev |
+ connection eventAnnouncerInternal unsubscribe:handler2.
+ blocker signal.
+ ].
blocker := Semaphore new.
- connection eventAnnouncer when: GDBCommandResultEvent do: handler1.
- connection pushEvent: (GDBCommandEvent new command: cmd).
+ connection eventAnnouncer when:GDBCommandResultEvent do:handler1.
+ connection pushEvent:(GDBCommandEvent new command:cmd).
blocker wait.
result.
- ] ifFalse:[
- connection pushEvent: (GDBCommandEvent new command: cmd).
+ ]
+ ifFalse:[
+ connection pushEvent:(GDBCommandEvent new command:cmd).
nil.
]
"Created: / 02-06-2014 / 23:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 28-02-2015 / 00:42:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-03-2015 / 05:51:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+send:command andWaitFor:eventHandlers
+ "Sends given `command` to GDB and then wait for events mathing
+ `eventHandlers`.
+
+ Params:
+ `command` may be either a GDBCommand or string, in which case it will
+ be parsed into a GDBCommand.
+ `eventHandler` may be either nil or event class or one arg block or collection
+ of event classes or blocks.
+ - If nil then do not wait for anything (use nil for async send)
+ - If event class, then wait for an event of that class. Note, that
+ subclasses are handled too.
+ - If block, then wait for an event for which the block returns true.
+ - If collectio, then wait for a sequence of events, each matched as above.
+
+ Returns: a matching event or events (in case a collection of handlers has been passes)"
+
+ ^ self send: command andWaitFor: eventHandlers withTimeoutMs: nil
+
+ "Created: / 08-03-2015 / 06:03:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+send:command andWaitFor:eventHandlers withTimeoutMs:timeout
+ "Sends given `command` to GDB and then wait for events mathing
+ `eventHandlers`. Raise a TimeoutError if expected events don't arrive
+ in specified time.
+
+ Params:
+ `command` may be either a GDBCommand or string, in which case it will
+ be parsed into a GDBCommand.
+ `eventHandler` may be either nil or event class or one arg block or collection
+ of event classes or blocks.
+ - If nil then do not wait for anything (use nil for async send)
+ - If event class, then wait for an event of that class. Note, that
+ subclasses are handled too.
+ - If block, then wait for an event for which the block returns true.
+ - If collectio, then wait for a sequence of events, each matched as above.
+ `timeout` wait at most that much milliseconds, throw TimeoutError otherwise. If `timeout` == mil
+ then wait for indefinitly
+
+ Returns: a matching event or events (in case a collection of handlers has been passes)"
+
+ | commandObject |
+
+ command isString ifTrue:[
+ commandObject := (GDBMIParser on:command) parseCommand.
+ commandObject token:self nextCommandSequnceNumber.
+ ] ifFalse:[
+ commandObject := command.
+ commandObject token isNil ifTrue:[
+ commandObject token:self nextCommandSequnceNumber.
+ ].
+ ].
+ ^ self
+ do:[ connection pushEvent:(GDBCommandEvent new command: commandObject) ]
+ andWaitFor: eventHandlers
+ withTimeoutMs: timeout
+
+ "Created: / 07-03-2015 / 11:38:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-03-2015 / 07:31:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!GDBDebugger methodsFor:'commands-convenience'!
+
+do: block andWaitFor:eventHandlers
+ "Evaluates a given block and then wait for events.
+ `eventHandlers`.
+ Params:
+ `block` block to evaluate
+ `eventHandler` may be either nil or event class or one arg block or collection
+ of event classes or blocks.
+ - If nil then do not wait for anything (use nil for async send)
+ - If event class, then wait for an event of that class. Note, that
+ subclasses are handled too.
+ - If block, then wait for an event for which the block returns true.
+ - If collectio, then wait for a sequence of events, each matched as above.
+ Returns: a matching event or events (in case a collection of handlers has been passed)"
+
+ ^ self do: block andWaitFor: eventHandlers withTimeoutMs: nil
+
+ "Created: / 08-03-2015 / 07:30:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+do: block andWaitFor:eventHandlers withTimeoutMs:timeout
+ "Evaluates a given block and then wait for events.
+ `eventHandlers`. Raise a TimeoutError if expected events don't arrive
+ in specified time.
+
+ Params:
+ `block` block to evaluate
+ `eventHandler` may be either nil or event class or one arg block or collection
+ of event classes or blocks.
+ - If nil then do not wait for anything (use nil for async send)
+ - If event class, then wait for an event of that class. Note, that
+ subclasses are handled too.
+ - If block, then wait for an event for which the block returns true.
+ - If collectio, then wait for a sequence of events, each matched as above.
+ `timeout` wait at most that much milliseconds, throw TimeoutError otherwise. If `timeout` == mil
+ then wait for indefinitly
+
+ Returns: a matching event or events (in case a collection of handlers has been passes)"
+
+ | handlersArray handlerFinal eventsArray blocker |
+
+ eventHandlers isNil ifTrue:[
+ "/ Asynchronous send...
+ self assert:timeout isNil.
+ block value.
+ ^ nil
+ ].
+ "/ Synchronous send...
+ self assert:Processor activeProcess ~~ connection eventDispatchProcess
+ message:'Cannot send commands from within event dispatching process. Would deadlock'.
+ eventHandlers isCollection
+ ifTrue:[ handlersArray := eventHandlers ]
+ ifFalse:[ handlersArray := Array with:eventHandlers ].
+ eventsArray := Array new:handlersArray size.
+ 1 to:handlersArray size do:[:i |
+ | handler |
+
+ handler := handlersArray at:i.
+ handlersArray at:i
+ put:[:event |
+ | matches |
+
+ matches := handler isBlock ifTrue:[ handler value:event ] ifFalse:[ event isKindOf:handler ].
+ (matches and:[ i == 1 or:[ (eventsArray at:i - 1) notNil ] ]) ifTrue:[
+ eventsArray at:i put:event.
+ self announcer unsubscribe:(handlersArray at:i).
+ i == handlersArray size ifTrue:[
+ connection eventAnnouncerInternal when: GDBEventSetProcessingFinished do: handlerFinal.
+ ].
+ ].
+ ].
+ self announcer when:GDBEvent do:(handlersArray at:i).
+ ].
+ handlerFinal := [ :event | connection eventAnnouncerInternal unsubscribe: handlerFinal. blocker signal ].
+ blocker := Semaphore new.
+ block value.
+ [
+ (blocker waitWithTimeoutMs:timeout) isNil ifTrue:[
+ eventsArray := nil.
+ ].
+ ] ensure:[
+ handlersArray do:[:handler |
+ handler notNil ifTrue:[
+ self announcer unsubscribe:handler
+ ]
+ ].
+ ].
+ eventsArray isNil ifTrue:[
+ (TimeoutError newException)
+ parameter:timeout;
+ raise.
+ ].
+ ^ eventHandlers isCollection ifTrue:[ eventsArray ] ifFalse:[ eventsArray first ]
+
+ "Created: / 08-03-2015 / 07:28:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!GDBDebugger methodsFor:'event handling'!