>From dbd749b21895b1d2875937c5a2e54728c73079dd Mon Sep 17 00:00:00 2001
From: Gwenael Casaccio
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
* 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
+
+ * 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
* 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 [
+
+
+
+ ^ 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."
+
^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."
+
self primitiveFailed
]
callInto: aValueHolder [
+
+
+
+ ^ 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."
+
^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."
+
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 [
+
+
+ | 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
+
+ * kernel/ProcessTests.st: Add new file.
+
2014-02-06 Holger Hans Peter Freyther
* 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 [
+
+ ]
+]
+
+TestCase subclass: TestProcess [
+
+ testCCallState [
+
+
+ | 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