cvsuser 04/09/16 13:59:07
Modified: src inter_cb.c nci_test.c
t/pmc nci.t
Log:
[perl #31606]
Hi,
so far external libraries can pass integers and strings to Parrot callback
subs.
This patch adds support for passing 'void *' pointers. Within a callback
sub, the external data is available as a UnManagedStruct PMC.
In t/pmc/nci.t there are 4 new tests. The tests 'nci_cb_C3 - PIR' and
'nci_cb_C3 - PIR'
receive a static int in libnci.so as external data.
Courtesy of Bernhard Schmalhofer <[EMAIL PROTECTED]>
Revision Changes Path
1.2 +26 -17 parrot/src/inter_cb.c
Index: inter_cb.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_cb.c,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -w -r1.1 -r1.2
--- inter_cb.c 5 May 2004 13:10:35 -0000 1.1
+++ inter_cb.c 16 Sep 2004 20:59:06 -0000 1.2
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_cb.c,v 1.1 2004/05/05 13:10:35 leo Exp $
+$Id: inter_cb.c,v 1.2 2004/09/16 20:59:06 jrieks Exp $
=head1 NAME
@@ -220,33 +220,35 @@
/*
=item C<void
-Parrot_run_callback(Parrot_Interp interpreter, PMC* cbi, void* ext)>
-Run a callback function. The PMC* cbi (callback_info) holds all
-necessary items in its props.
+Parrot_run_callback(Parrot_Interp interpreter, PMC* user_data, void* ext)>
+
+Run a callback function. The PMC* user_data holds all
+necessary items in its properties.
=cut
*/
void
-Parrot_run_callback(Parrot_Interp interpreter, PMC* cbi, void* ext)
+Parrot_run_callback(Parrot_Interp interpreter, PMC* user_data, void* ext)
{
- PMC* user_data, *sig, *sub;
+ PMC * signature;
+ PMC * sub;
STRING* sig_str;
char *p;
char pasm_sig[4];
INTVAL i_param;
+ PMC * p_param;
void* param = NULL; /* avoid -Ox warning */
STRING *sc;
sc = CONST_STRING(interpreter, "_sub");
- sub = VTABLE_getprop(interpreter, cbi, sc);
+ sub = VTABLE_getprop(interpreter, user_data, sc);
sc = CONST_STRING(interpreter, "_signature");
- sig = VTABLE_getprop(interpreter, cbi, sc);
- user_data = cbi;
+ signature = VTABLE_getprop(interpreter, user_data, sc);
- sig_str = VTABLE_get_string(interpreter, sig);
+ sig_str = VTABLE_get_string(interpreter, signature);
p = sig_str->strstart;
pasm_sig[0] = 'v'; /* no return value supported yet */
@@ -284,8 +286,15 @@
* work
*/
break;
+#endif
case 'p':
- /* TODO created UnManagedStruct */
+ /* created a UnManagedStruct */
+ p_param = pmc_new(interpreter, enum_class_UnManagedStruct);
+ PMC_data(p_param) = ext;
+ pasm_sig[2] = 'P';
+ param = (void*) p_param;
+ break;
+#if 0
case 'P':
pasm_sig[2] = 'P';
break;
@@ -295,7 +304,7 @@
param = string_from_cstring(interpreter, ext, 0);
break;
default:
- internal_exception(1, "unhandled sig char '%c' in run_cb");
+ internal_exception(1, "unhandled signature char '%c' in run_cb", *p);
}
pasm_sig[3] = '\0';
Parrot_runops_fromc_args_save(interpreter, sub, pasm_sig,
1.31 +33 -1 parrot/src/nci_test.c
Index: nci_test.c
===================================================================
RCS file: /cvs/public/parrot/src/nci_test.c,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- nci_test.c 16 Sep 2004 12:22:34 -0000 1.30
+++ nci_test.c 16 Sep 2004 20:59:06 -0000 1.31
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2004 The Perl Foundation. All Rights Reserved.
-$Id: nci_test.c,v 1.30 2004/09/16 12:22:34 jrieks Exp $
+$Id: nci_test.c,v 1.31 2004/09/16 20:59:06 jrieks Exp $
=head1 NAME
@@ -56,15 +56,27 @@
void * nci_pi(int test);
void nci_vP(void *pmc);
+
+/* Declarations for callback tests */
+
typedef void (*cb_C1_func)(const char*, void*);
void nci_cb_C1(cb_C1_func, void*);
typedef void (*cb_C2_func)(int, void*);
void nci_cb_C2(cb_C2_func, void*);
+typedef void (*cb_C3_func)(void*, void*);
+void nci_cb_C3(cb_C3_func, void*);
+
typedef void (*cb_D1_func)(void*, const char*);
void nci_cb_D1(cb_D1_func, void*);
+typedef void (*cb_D2_func)(void*, int);
+void nci_cb_D2(cb_D2_func, void*);
+
+typedef void (*cb_D3_func)(void*, void*);
+void nci_cb_D3(cb_D3_func, void*);
+
typedef struct {
int y;
} Nested;
@@ -366,6 +378,12 @@
(cb)(77, user_data);
}
+static int int_cb_C3 = 99;
+void
+nci_cb_C3(cb_C3_func cb, void* user_data) {
+ /* call the cb synchronously */
+ (cb)(&int_cb_C3, user_data);
+}
void
nci_cb_D1(cb_D1_func cb, void* user_data) {
@@ -375,6 +393,20 @@
}
void
+nci_cb_D2(cb_D2_func cb, void* user_data) {
+ /* call the cb synchronously */
+ (cb)(user_data, 88);
+}
+
+static int int_cb_D3 = 111;
+void
+nci_cb_D3(cb_D3_func cb, void* user_data) {
+ /* call the cb synchronously */
+ (cb)(user_data, &int_cb_D3);
+}
+
+
+void
nci_pip (int count, Rect_Like *rects) {
int i;
printf( "Count: %d\n", count);
1.50 +352 -7 parrot/t/pmc/nci.t
Index: nci.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/nci.t,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -w -r1.49 -r1.50
--- nci.t 16 Sep 2004 12:22:35 -0000 1.49
+++ nci.t 16 Sep 2004 20:59:07 -0000 1.50
@@ -1,6 +1,7 @@
#! perl -w
+
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: nci.t,v 1.49 2004/09/16 12:22:35 jrieks Exp $
+# $Id: nci.t,v 1.50 2004/09/16 20:59:07 jrieks Exp $
=head1 NAME
@@ -23,7 +24,7 @@
=cut
-use Parrot::Test tests => 39;
+use Parrot::Test tests => 43;
use Parrot::Config;
SKIP: {
@@ -62,6 +63,7 @@
ok 2
OUTPUT
+
output_is( << 'CODE', << 'OUTPUT', "nci_dd - PIR" );
##PIR##
.sub _test @MAIN
@@ -85,6 +87,7 @@
-8.256000
OUTPUT
+
output_is( << 'CODE', << "OUTPUT", "get_string()" );
##PIR##
.sub _test @MAIN
@@ -110,6 +113,7 @@
libnci$PConfig{so} was successfully loaded
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_fff");
loadlib P1, "libnci"
print "loaded\n"
@@ -141,6 +145,7 @@
ok 2
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_isc");
loadlib P1, "libnci"
print "loaded\n"
@@ -204,6 +209,7 @@
ok 2
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_csc");
loadlib P1, "libnci"
print "loaded\n"
@@ -275,6 +281,7 @@
ok 2
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_tt");
loadlib P1, "libnci"
print "loaded\n"
@@ -304,6 +311,7 @@
ok 2
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_dd - stress test");
loadlib P1, "libnci"
print "loaded\n"
@@ -338,6 +346,7 @@
ok 2
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_dd - clone");
loadlib P1, "libnci"
print "loaded\n"
@@ -379,6 +388,7 @@
ok 4
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_iiii");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_iiii", "iiii"
@@ -395,6 +405,7 @@
2
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_i4i");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_i4i", "i4i"
@@ -409,6 +420,7 @@
42
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_ii3");
.include "datatypes.pasm"
loadlib P1, "libnci"
@@ -433,6 +445,7 @@
4711
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_tb");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_tb", "tb"
@@ -444,6 +457,7 @@
ok worked
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_tB");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_tB", "tB"
@@ -455,6 +469,7 @@
ok done
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_pi - struct with ints");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_pi", "pi"
@@ -486,6 +501,7 @@
66
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_pi - struct with floats");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_pi", "pi"
@@ -517,6 +533,7 @@
47.110000
OUTPUT
+
output_like(<<'CODE', <<'OUTPUT', "nci_pi - align");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_pi", "pi"
@@ -550,6 +567,7 @@
/
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_pi - char*");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_pi", "pi"
@@ -577,6 +595,7 @@
20
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_pi - nested struct *");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_pi", "pi"
@@ -631,6 +650,7 @@
200.000000
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_pi - nested struct * w named access");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_pi", "pi"
@@ -700,6 +720,7 @@
77
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_pi - func_ptr* with signature");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_pi", "pi"
@@ -729,6 +750,7 @@
4711
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_pi - nested struct aligned");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_pi", "pi"
@@ -783,6 +805,7 @@
33
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_pi - nested struct unaligned");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_pi", "pi"
@@ -837,6 +860,7 @@
33
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_pi - nested, unaligned, named");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_pi", "pi"
@@ -891,6 +915,7 @@
33
OUTPUT
+
output_is( << 'CODE', << "OUTPUT", "nci_pi - int");
##PIR##
.include "datatypes.pasm"
@@ -929,6 +954,7 @@
55555
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_ip");
loadlib P1, "libnci"
dlfunc P0, P1, "nci_ip", "ip"
@@ -989,6 +1015,9 @@
got null
OUTPUT
+
+# Tests with callback functions
+
output_is(<<'CODE', <<'OUTPUT', "nci_cb_C1 - PASM");
# we need a flag if the call_back is already done
@@ -1047,6 +1076,7 @@
done.
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', "nci_cb_C1 - PIR");
##PIR##
.sub _test @MAIN
@@ -1120,7 +1150,154 @@
the callback has run
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "nci_cb_D1");
+
+output_is(<<'CODE', <<'OUTPUT', "nci_cb_C2 - PASM");
+ # we need a flag if the call_back is already done
+ new P10, .PerlInt
+ store_global "cb_done", P10
+ # first attempt - create cb manually (this step will be hidden later)
+ newsub P6, .Sub, _call_back
+ # prepare user data
+ new P7, .PerlInt
+ set P7, 42
+ new_callback P5, P6, P7, "iU" # Z in pdd16
+ print "ok 1\n"
+ # now call the external sub, that takes a call_back and user_data
+ loadlib P1, "libnci"
+ dlfunc P0, P1, "nci_cb_C2", "vpP"
+ print "ok 2\n"
+ # P5 is the cb
+ # P6 is user_data
+ set P6, P7
+ invoke
+ # call_back will be called at any time
+ # so spin a bit
+ set I20, 0
+loop:
+ inc I20
+ sleep 0.01
+ find_global P11, "cb_done"
+ if P11, fin
+ gt I20, 10, err
+ branch loop
+fin:
+ print "done.\n"
+ end
+err:
+ print "cb didnt run\n"
+ end
+
+_call_back:
+ print "in callback\n"
+ print "user data: "
+ print P5
+ print "\n"
+ print "external data: "
+ print I5
+ print "\n"
+ find_global P12, "cb_done"
+ inc P12
+ invoke P1
+
+
+CODE
+ok 1
+ok 2
+in callback
+user data: 42
+external data: 77
+done.
+OUTPUT
+
+
+output_is(<<'CODE', <<'OUTPUT', "nci_cb_C3 - PIR");
+##PIR##
+
+.include "datatypes.pasm"
+
+.sub _test @MAIN
+
+ # this flag will be set by the callback function
+ .local pmc cb_done
+ cb_done = new Integer
+ cb_done = 0
+ store_global "cb_done", cb_done
+
+ # prepare user data
+ .local pmc user_data
+ user_data = new Integer
+ user_data = 42
+
+ # A Sub that can be given to the library
+ # this callback function will eventually by called by the library
+ .local pmc cb
+ cb = newsub _call_back
+ .local pmc cb_wrapped
+ cb_wrapped = new_callback cb, user_data, "pU" # Z in pdd16
+ print "created a callback sub\n"
+
+ # now call the external sub, that takes a callback and user data
+ .local pmc libnci
+ libnci = loadlib "libnci"
+ .local pmc nci_cb_C3
+ nci_cb_C3 = dlfunc libnci, "nci_cb_C3", "vpP"
+ print "loaded a function that takes a callback\n"
+ nci_cb_C3( cb_wrapped, user_data )
+
+ # callback will be called at any time
+ # so spin a bit
+ .local int sleep_cnt
+ sleep_cnt = 0
+LOOP:
+ sleep_cnt += 1
+ sleep 0.01
+ .local pmc callback_has_run
+ callback_has_run = find_global "cb_done"
+ if callback_has_run goto FINISHED
+ if sleep_cnt > 10 goto ERROR
+ goto LOOP
+FINISHED:
+ print "the callback has run\n"
+ end
+ERROR:
+ print "the callback didnt run\n"
+ end
+.end
+
+.sub _call_back
+ print "in callback\n"
+ print "user data: "
+ print P5
+ print "\n"
+
+ # P6 is a UnManagedStruct PMC containing a pointer to an integer
+ new P2, .PerlArray
+ push P2, .DATATYPE_INT
+ push P2, 0
+ push P2, 0
+ assign P6, P2
+
+ # print referenced integer in libnci.so
+ I17 = P6[0]
+ print "external data: "
+ print I17
+ print "\n"
+
+ find_global P12, "cb_done"
+ inc P12
+ invoke P1
+.end
+
+CODE
+created a callback sub
+loaded a function that takes a callback
+in callback
+user data: 42
+external data: 99
+the callback has run
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "nci_cb_D1 - PASM");
# we need a flag if the call_back is already done
new P10, .PerlInt
@@ -1178,7 +1355,8 @@
done.
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "nci_cb_C2");
+
+output_is(<<'CODE', <<'OUTPUT', "nci_cb_D2 - PASM");
# we need a flag if the call_back is already done
new P10, .PerlInt
store_global "cb_done", P10
@@ -1187,11 +1365,11 @@
# prepare user data
new P7, .PerlInt
set P7, 42
- new_callback P5, P6, P7, "iU" # Z in pdd16
+ new_callback P5, P6, P7, "Ui" # Z in pdd16
print "ok 1\n"
# now call the external sub, that takes a call_back and user_data
loadlib P1, "libnci"
- dlfunc P0, P1, "nci_cb_C2", "vpP"
+ dlfunc P0, P1, "nci_cb_D2", "vpP"
print "ok 2\n"
# P5 is the cb
# P6 is user_data
@@ -1232,10 +1410,172 @@
ok 2
in callback
user data: 42
-external data: 77
+external data: 88
done.
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "nci_cb_D2 - PIR");
+##PIR##
+.sub _test @MAIN
+
+ # this flag will be set by the callback function
+ .local pmc cb_done
+ cb_done = new Integer
+ cb_done = 0
+ store_global "cb_done", cb_done
+
+ # prepare user data
+ .local pmc user_data
+ user_data = new Integer
+ user_data = 42
+
+ # A Sub that can be given to the library
+ # this callback function will eventually by called by the library
+ .local pmc cb
+ cb = newsub _call_back
+ .local pmc cb_wrapped
+ cb_wrapped = new_callback cb, user_data, "Ui" # Z in pdd16
+ print "created a callback sub\n"
+
+ # now call the external sub, that takes a callback and user data
+ .local pmc libnci
+ libnci = loadlib "libnci"
+ .local pmc nci_cb_D2
+ nci_cb_D2 = dlfunc libnci, "nci_cb_D2", "vpP"
+ print "loaded a function that takes a callback\n"
+ nci_cb_D2( cb_wrapped, user_data )
+
+ # callback will be called at any time
+ # so spin a bit
+ .local int sleep_cnt
+ sleep_cnt = 0
+LOOP:
+ sleep_cnt += 1
+ sleep 0.01
+ .local pmc callback_has_run
+ callback_has_run = find_global "cb_done"
+ if callback_has_run goto FINISHED
+ if sleep_cnt > 10 goto ERROR
+ goto LOOP
+FINISHED:
+ print "the callback has run\n"
+ end
+ERROR:
+ print "the callback didnt run\n"
+ end
+.end
+
+.sub _call_back
+ print "in callback\n"
+ print "user data: "
+ print P5
+ print "\n"
+ print "external data: "
+ print I5
+ print "\n"
+ find_global P12, "cb_done"
+ inc P12
+ invoke P1
+.end
+
+CODE
+created a callback sub
+loaded a function that takes a callback
+in callback
+user data: 42
+external data: 88
+the callback has run
+OUTPUT
+
+
+output_is(<<'CODE', <<'OUTPUT', "nci_cb_D3 - PIR");
+##PIR##
+
+.include "datatypes.pasm"
+
+.sub _test @MAIN
+
+ # this flag will be set by the callback function
+ .local pmc cb_done
+ cb_done = new Integer
+ cb_done = 0
+ store_global "cb_done", cb_done
+
+ # prepare user data
+ .local pmc user_data
+ user_data = new Integer
+ user_data = 42
+
+ # A Sub that can be given to the library
+ # this callback function will eventually by called by the library
+ .local pmc cb
+ cb = newsub _call_back
+ .local pmc cb_wrapped
+ cb_wrapped = new_callback cb, user_data, "Up" # Z in pdd16
+ print "created a callback sub\n"
+
+ # now call the external sub, that takes a callback and user data
+ .local pmc libnci
+ libnci = loadlib "libnci"
+ .local pmc nci_cb_D3
+ nci_cb_D3 = dlfunc libnci, "nci_cb_D3", "vpP"
+ print "loaded a function that takes a callback\n"
+ nci_cb_D3( cb_wrapped, user_data )
+
+ # callback will be called at any time
+ # so spin a bit
+ .local int sleep_cnt
+ sleep_cnt = 0
+LOOP:
+ sleep_cnt += 1
+ sleep 0.01
+ .local pmc callback_has_run
+ callback_has_run = find_global "cb_done"
+ if callback_has_run goto FINISHED
+ if sleep_cnt > 10 goto ERROR
+ goto LOOP
+FINISHED:
+ print "the callback has run\n"
+ end
+ERROR:
+ print "the callback didnt run\n"
+ end
+.end
+
+.sub _call_back
+ print "in callback\n"
+ print "user data: "
+ print P5
+ print "\n"
+
+ # P6 is a UnManagedStruct PMC containing a pointer to an integer
+ new P2, .PerlArray
+ push P2, .DATATYPE_INT
+ push P2, 0
+ push P2, 0
+ assign P6, P2
+
+ # print referenced integer in libnci.so
+ I17 = P6[0]
+ print "external data: "
+ print I17
+ print "\n"
+
+ find_global P12, "cb_done"
+ inc P12
+ invoke P1
+.end
+
+CODE
+created a callback sub
+loaded a function that takes a callback
+in callback
+user data: 42
+external data: 111
+the callback has run
+OUTPUT
+
+
output_is(<<'CODE', <<'OUTPUT', 'nci_pip - array of structs');
.include "datatypes.pasm"
@@ -1313,6 +1653,7 @@
H: 430
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', 'nci_i33 - out parameters and return values');
.include "datatypes.pasm"
@@ -1347,6 +1688,7 @@
Sum: 12
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', 'nci_vpii - nested structs');
.include "datatypes.pasm"
@@ -1415,6 +1757,7 @@
2
OUTPUT
+
output_is(<<'CODE', <<'OUTPUT', 'nci_piiii - nested array in a struct');
.include "datatypes.pasm"
set I0, 1
@@ -1483,6 +1826,7 @@
3: 800
OUTPUT
+
output_is( << 'CODE', << "OUTPUT", "nci_pii - writing back to libnci.so" );
##PIR##
.include "datatypes.pasm"
@@ -1536,6 +1880,7 @@
333
OUTPUT
+
} # SKIP
output_is(<< 'CODE', << 'OUTPUT', "opcode 'does'");
