cvsuser 04/02/05 09:16:15
Modified: classes unmanagedstruct.pmc
t/pmc nci.t
Log:
function pointer with signature in properties
Revision Changes Path
1.31 +22 -5 parrot/classes/unmanagedstruct.pmc
Index: unmanagedstruct.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/unmanagedstruct.pmc,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -w -r1.30 -r1.31
--- unmanagedstruct.pmc 5 Feb 2004 16:42:25 -0000 1.30
+++ unmanagedstruct.pmc 5 Feb 2004 17:16:04 -0000 1.31
@@ -1,7 +1,7 @@
/*
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: unmanagedstruct.pmc,v 1.30 2004/02/05 16:42:25 leo Exp $
+ * $Id: unmanagedstruct.pmc,v 1.31 2004/02/05 17:16:04 leo Exp $
* Overview:
* PMC class to hold structs that parrot's not responsible for
* disposing of.
@@ -169,14 +169,30 @@
}
static PMC*
-ret_pmc(Parrot_Interp interpreter, char *p, int type)
+ret_pmc(Parrot_Interp interpreter, PMC* pmc, char *p, int type, INTVAL idx)
{
char *cstr;
size_t len;
+ PMC *ret, *init, *ptr;
switch (type) {
case enum_type_func_ptr:
- return *(PMC**) p;
+ /* this is a raw function pointer - not a PMC */
+ ret = *(PMC**) p;
+ /* now check if initializer has a signature attached */
+ init = PMC_pmc_val(pmc);
+ ptr = VTABLE_get_pmc_keyed_int(interpreter, init, idx*3);
+ if (ptr->pmc_ext && ptr->metadata) {
+ PMC *sig = VTABLE_getprop(interpreter, ptr,
+ string_from_cstring(interpreter, "_signature", 0));
+ if (VTABLE_defined(interpreter, sig)) {
+ STRING *sig_str = VTABLE_get_string(interpreter, sig);
+ ret = pmc_new(interpreter, enum_class_NCI);
+ VTABLE_set_string_keyed(interpreter, ret,
+ *(PMC**)p, sig_str);
+ }
+ }
+ return ret;
default:
internal_exception(1, "returning unhandled pmc type in struct");
}
@@ -424,13 +440,14 @@
PMC* get_pmc_keyed_int (INTVAL key) {
int type;
char *p = char_offset_int(interpreter, pmc, key, &type);
- return ret_pmc(interpreter, p, type);
+ return ret_pmc(interpreter, pmc, p, type, key);
}
PMC* get_pmc_keyed (PMC* key) {
int type;
char *p = char_offset_key(interpreter, pmc, key, &type);
- return ret_pmc(interpreter, p, type);
+ return ret_pmc(interpreter, pmc, p, type,
+ key_2_idx(interpreter, pmc, key));
}
INTVAL get_integer() {
1.25 +32 -3 parrot/t/pmc/nci.t
Index: nci.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/nci.t,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -w -r1.24 -r1.25
--- nci.t 5 Feb 2004 16:42:50 -0000 1.24
+++ nci.t 5 Feb 2004 17:16:15 -0000 1.25
@@ -1,4 +1,4 @@
-use Parrot::Test tests => 22;
+use Parrot::Test tests => 23;
use Parrot::Config;
print STDERR $PConfig{jitcpuarch}, " JIT CPU\n";
@@ -560,10 +560,39 @@
# P1 isnt a real PMC, its only suited for passing on to
# the NCI PMC as a Key
set P1, P5[0]
- # TODO handled that inside the struct PMC
- # e.g. attach a function signature property to the initializer
+ # if no signatur was given, do it manually
+ # s. below for another method
new P0, .NCI
set P0[P1], "it"
+ set S5, "hello call_back"
+ invoke
+ print I5
+ print "\n"
+ end
+CODE
+hello call_back
+4711
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "nci_p_i - func_ptr* with signature");
+ loadlib P1, "libnci"
+ dlfunc P0, P1, "nci_pi", "pi"
+ # this test function returns a struct { int (*f)(char *) }
+ set I5, 5
+ invoke
+ new P2, .PerlArray
+.include "datatypes.pasm"
+ push P2, .DATATYPE_FUNC_PTR
+ # attach function signature property to this type
+ set P1, P2[-1]
+ new P3, .PerlString
+ set P3, "it"
+ setprop P1, "_signature", P3
+ push P2, 0
+ push P2, 0
+ assign P5, P2
+ # now we get a callable NCI PMC
+ set P0, P5[0]
set S5, "hello call_back"
invoke
print I5
