Hi, I've added Process>>#isSuspendedInCCall useful when you try to make the difference between a suspended process and a process to make a c-call which is reentrant.
Cheers, Gwen
>From dbd749b21895b1d2875937c5a2e54728c73079dd Mon Sep 17 00:00:00 2001 From: Gwenael Casaccio <[email protected]> Date: Sat, 12 Apr 2014 11:09:21 +0200 Subject: [PATCH 2/2] Add Process>>#isSuspendedInCCall It's not possible to make the difference between a suspended process and a process suspended by a C-Call. It's usefull to make the difference when the C-Call is reentrant (with GTK callbacks for instance). 2014-04-11 Gwenael Casaccio <[email protected]> * kernel/CCallable.st: Annotate c-call methods with suspendedCall attribute, indirect call to the primitive used by Process>>#isSuspendedInCCall. * kernel/Process.st: Add isSuspendedInCCall. * package/kernel-tests/kernel/ProcessTests.st: Add new file. --- ChangeLog | 6 ++++++ kernel/CCallable.st | 22 ++++++++++++++++++++-- kernel/Process.st | 11 +++++++++++ packages/kernel-tests/ChangeLog | 4 ++++ packages/kernel-tests/kernel/ProcessTests.st | 23 +++++++++++++++++++++++ 5 files changed, 64 insertions(+), 2 deletions(-) create mode 100644 packages/kernel-tests/kernel/ProcessTests.st diff --git a/ChangeLog b/ChangeLog index 4aa2f2c..9a8f5eb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2014-04-12 Gwenael Casaccio <[email protected]> + + * kernel/CCallable.st: Annotate c-call methods with suspendedCall attribute, + indirect call to the primitive used by Process>>#isSuspendedInCCall. + * kernel/Process.st: Add isSuspendedInCCall. + 2014-04-11 Gwenael Casaccio <[email protected]> * kernel/Process.st: Change the process creation it set on the right diff --git a/kernel/CCallable.st b/kernel/CCallable.st index a937b61..d043c7f 100644 --- a/kernel/CCallable.st +++ b/kernel/CCallable.st @@ -128,6 +128,13 @@ to perform the actual call-out to C routines.'> ] asyncCall [ + <category: 'calling'> + <suspendedCCall> + + ^ self primAsyncCall: thisContext parentContext + ] + + primAsyncCall: aContext [ "Perform the call-out for the function represented by the receiver. The arguments (and the receiver if one of the arguments has type #self or #selfSmalltalk) are taken from the parent context. @@ -136,11 +143,12 @@ to perform the actual call-out to C routines.'> call-out is not suspended." <category: 'calling'> + <suspendedCCall> <primitive: VMpr_CFuncDescriptor_asyncCall> ^self isValid ifFalse: [SystemExceptions.CInterfaceError signal: 'Invalid C call-out ' , self name] - ifTrue: [self asyncCallNoRetryFrom: thisContext parentContext] + ifTrue: [self asyncCallNoRetryFrom: aContext ] ] asyncCallNoRetryFrom: aContext [ @@ -153,22 +161,31 @@ to perform the actual call-out to C routines.'> does not attempt to find functions in shared objects." <category: 'calling'> + <suspendedCCall> <primitive: VMpr_CFuncDescriptor_asyncCall> self primitiveFailed ] callInto: aValueHolder [ + <category: 'calling'> + <suspendedCCall> + + ^ self primCallFrom: thisContext parentContext into: aValueHolder + ] + + primCallFrom: aContext into: aValueHolder [ "Perform the call-out for the function represented by the receiver. The arguments (and the receiver if one of the arguments has type #self or #selfSmalltalk) are taken from the parent context, and the the result is stored into aValueHolder. aValueHolder is also returned." <category: 'calling'> + <suspendedCCall> <primitive: VMpr_CFuncDescriptor_call> ^self isValid ifFalse: [SystemExceptions.CInterfaceError signal: 'Invalid C call-out ' , self name] - ifTrue: [self callNoRetryFrom: thisContext parentContext into: aValueHolder] + ifTrue: [self callNoRetryFrom: aContext into: aValueHolder] ] callNoRetryFrom: aContext into: aValueHolder [ @@ -180,6 +197,7 @@ to perform the actual call-out to C routines.'> attempt to find functions in shared objects." <category: 'calling'> + <suspendedCCall> <primitive: VMpr_CFuncDescriptor_call> self primitiveFailed ] diff --git a/kernel/Process.st b/kernel/Process.st index 76d0742..c379e1f 100644 --- a/kernel/Process.st +++ b/kernel/Process.st @@ -422,6 +422,17 @@ can suspend themselves and resume themselves however they wish.'> ^suspendedContext isNil ] + isSuspendedInCCall [ + <category: 'private'> + + | ctx | + self isSuspended ifFalse: [ ^ false ]. + ctx := self suspendedContext. + ctx isBlock ifTrue: [ ^ false ]. + ctx method attributeAt: #suspendedCCall ifAbsent: [ ^ false ]. + ^ true. + ] + isWaiting [ "Answer whether the receiver is wating on a semaphore" diff --git a/packages/kernel-tests/ChangeLog b/packages/kernel-tests/ChangeLog index d0557f3..5a8b821 100644 --- a/packages/kernel-tests/ChangeLog +++ b/packages/kernel-tests/ChangeLog @@ -1,3 +1,7 @@ +2014-04-11 Gwenael Casaccio <[email protected]> + + * kernel/ProcessTests.st: Add new file. + 2014-02-06 Holger Hans Peter Freyther <[email protected]> * kernel/CCallableTest.st: Add new file. diff --git a/packages/kernel-tests/kernel/ProcessTests.st b/packages/kernel-tests/kernel/ProcessTests.st new file mode 100644 index 0000000..65298fc --- /dev/null +++ b/packages/kernel-tests/kernel/ProcessTests.st @@ -0,0 +1,23 @@ +True extend [ + testCallin: aCallback [ + <cCall: 'testCallin' returning: #void args: #(#selfSmalltalk #cObject)> + ] +] + +TestCase subclass: TestProcess [ + + testCCallState [ + <category: 'testing'> + + | p | + p := Processor activeProcess. + self assert: p isSuspendedInCCall not. + true + testCallin: (CCallbackDescriptor + for: [ :x | self assert: p isSuspendedInCCall. + 3 + ] + returning: #int + withArgs: #(#string)) + ] +] -- 1.8.3.2
_______________________________________________ help-smalltalk mailing list [email protected] https://lists.gnu.org/mailman/listinfo/help-smalltalk
