*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Thu, 14 Jun 2007 11:41:53 +0200
changeset 10613 12d012eeb755
parent 10612 53e2ead58227
child 10614 1950ab5c9214
*** empty log message ***
ExternalFunctionCallback.st
--- a/ExternalFunctionCallback.st	Thu Jun 14 11:28:44 2007 +0200
+++ b/ExternalFunctionCallback.st	Thu Jun 14 11:41:53 2007 +0200
@@ -11,7 +11,7 @@
 "
 "{ Package: 'stx:libbasic' }"
 
-ExternalBytes subclass:#ExternalFunctionCallback
+ExternalFunction subclass:#ExternalFunctionCallback
 	instanceVariableNames:'returnType argumentTypes action'
 	classVariableNames:'CallBackRegistry Verbose'
 	poolDictionaries:''
@@ -143,7 +143,7 @@
 	if (@global(ExternalFunctionCallback:Verbose) == true) {
 	    fprintf(stderr, "ExternalFunctionCallback(wrapper): sending value: to %x..\n", st_callBack);
 	}
-	st_result = _SEND1(st_callBack, @symbol(value:), nil, &value_snd, st_argVector);
+	st_result = _SEND1(st_callBack, @symbol(callFromCWith:), nil, &value_snd, st_argVector);
 	if (@global(ExternalFunctionCallback:Verbose) == true) {
 	    fprintf(stderr, "ExternalFunctionCallback(wrapper): result is %x\n", st_result);
 	}
@@ -245,7 +245,7 @@
 
     A callback is created with:
        cb := ExternalFunctionCallback new.
-    the arguments (as passed from the C-caller into ST) 
+    the arguments (as passed from the C-caller into ST)
     and the returnValue (from ST to the C-caller) are specified with:
        cb returnType:#bool argumentTypes:#(uint).
     Then, the code is generated with:
@@ -256,13 +256,13 @@
     and handed out to C. (you can also hand out the callBack directly - as it is a subclass of
     ExternalBytes.
     The actual action of the callback can be changed (at any time later) with:
-        cb action:[:args | Transcript showCR:args. true].
+	cb action:[:args | Transcript showCR:args. true].
 
     Eventually, the callback should be released:
-        cb release.
+	cb release.
 
     [author:]
-        Claus Gittinger
+	Claus Gittinger
 "
 !
 
@@ -274,7 +274,7 @@
     cb returnType:#bool argumentTypes:#(uint).
     cb generateClosure.
     cb action:[:args | Transcript showCR:args. true].
-    cb address.  'can be passed to C'.
+    cb code.  'can be passed to C'.
 
     ExternalFunctionCallback testCall:cb withArgument:123.
 
@@ -298,73 +298,62 @@
 !
 
 testCall:aCallback withArgument:arg
+    "a simple test, if I can be called"
 %{
     INTFUNC f = __externalAddressVal(aCallback);
     INT result;
+    void *c_arg = 0;
 
-    fprintf(stderr, "ExternalFunctionCallback: calling callBack %x(%d)\n", f, __intVal(arg));
-    result = (*f)(__intVal(arg));
+    if (__isSmallInteger(arg)) {
+	c_arg = (void *)(__intVal(arg));
+    } else {
+	if (arg == true) {
+	    c_arg = (void *)1;
+	} else {
+	   if (__isString(arg)) {
+		c_arg = (void *)__stringVal(arg);
+	   }
+	}
+    }
+    fprintf(stderr, "ExternalFunctionCallback: calling callBack %x(%x)\n", f, c_arg);
+    result = (*f)(c_arg);
     fprintf(stderr, "ExternalFunctionCallback: result from callBack is %x\n", result);
 %}
 ! !
 
 !ExternalFunctionCallback methodsFor:'accessing'!
 
-action:aOneArgBlock
-    action := aOneArgBlock.
+action:aBlock
+    "set the action-block, to be evaluated when C calls me.
+     The C-arguments will be passed as arguments to the block.
+     The value returned by the block will be returned to the C-caller."
+
+    action := aBlock.
 ! !
 
 !ExternalFunctionCallback methodsFor:'callback'!
 
-value:argList
-    "because this is evaluated from C, we probably should not block or abort or do
+callFromCWith:argList
+    "invoked by the C-code, to which we have given out the code-ptr.
+     Because this is evaluated from C, we probably should not block or abort or do
      any other things which confuse C
      (its probably a good idea to write something into a queue here)"
 
     action notNil ifTrue:[
-        ^ action valueWithArguments:argList
+	^ action valueWithArguments:argList
     ].
     ^ nil
 ! !
 
 !ExternalFunctionCallback methodsFor:'generation'!
 
-address
-    self isValid ifFalse:[
+code
+    self hasCode ifFalse:[
 	self generate
     ].
-    ^ super address
+    ^ super code
 
     "Created: / 11-06-2007 / 15:53:00 / cg"
-!
-
-generate
-    |code|
-
-    code := nil
-
-    "Created: / 11-06-2007 / 14:50:57 / cg"
-!
-
-generate0
-    |code|
-
-    code := #[
-		"/ mov ecx, closureIndex
-		16rB9
-		    16r00  16r00  16r00  16r01
-		"/ mov eax, doClosureC
-		16rB8
-		    16r00  16r00  16r00  16r02
-		"/ call *eax
-		16rFF  16rD0
-		"/ ret
-		16rC3
-	    ].
-
-    self allocateBytes:(code size).
-
-    "Created: / 11-06-2007 / 15:29:33 / cg"
 ! !
 
 !ExternalFunctionCallback methodsFor:'private-accessing'!
@@ -376,13 +365,6 @@
     "Created: / 11-06-2007 / 15:52:01 / cg"
 ! !
 
-!ExternalFunctionCallback methodsFor:'private-debugging'!
-
-debugCall:args
-    self halt.
-    ^ nil
-! !
-
 !ExternalFunctionCallback methodsFor:'private-generation'!
 
 generateClosure
@@ -658,7 +640,7 @@
 	printf("  %02x %02x %02x %02x\n", ((unsigned char *)pcl)[8],((unsigned char *)pcl)[9],((unsigned char *)pcl)[10],((unsigned char *)pcl)[11]);
 	printf("  %02x %02x %02x %02x\n", ((unsigned char *)pcl)[12],((unsigned char *)pcl)[13],((unsigned char *)pcl)[14],((unsigned char *)pcl)[15]);
     }
-    __INST(address_) = pcl;
+    __INST(code_) = pcl;
 
 #if 0
     ExternalFunctionCallback__test_call_closure((INTFUNC)pcl);
@@ -685,9 +667,9 @@
     idx := CallBackRegistry identityIndexOf:self.
     CallBackRegistry at:idx put:nil.
 %{
-    ffi_closure *pcl = (ffi_closure *)__INST(address_);
+    void *pcl = (void *)__INST(code_);
 
-    __INST(address_) = 0;
+    __INST(code_) = 0;
     if (pcl) {
 	free(pcl);
     }
@@ -699,5 +681,5 @@
 !ExternalFunctionCallback class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunctionCallback.st,v 1.4 2007-06-14 09:28:16 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunctionCallback.st,v 1.5 2007-06-14 09:41:53 cg Exp $'
 ! !