cvsuser 04/02/05 08:42:51
Modified: classes unmanagedstruct.pmc
include/parrot datatypes.h
src nci_test.c
t/pmc nci.t
Log:
callback function in struct
Revision Changes Path
1.30 +29 -3 parrot/classes/unmanagedstruct.pmc
Index: unmanagedstruct.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/unmanagedstruct.pmc,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- unmanagedstruct.pmc 5 Feb 2004 15:41:17 -0000 1.29
+++ unmanagedstruct.pmc 5 Feb 2004 16:42:25 -0000 1.30
@@ -1,7 +1,7 @@
/*
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: unmanagedstruct.pmc,v 1.29 2004/02/05 15:41:17 leo Exp $
+ * $Id: unmanagedstruct.pmc,v 1.30 2004/02/05 16:42:25 leo Exp $
* Overview:
* PMC class to hold structs that parrot's not responsible for
* disposing of.
@@ -85,8 +85,7 @@
count = (size_t) key_integer(interpreter, next);
init = PMC_pmc_val(pmc);
max = (size_t) VTABLE_get_integer_keyed_int(interpreter, init, ix + 1);
- /* TODO make that _struct_ptr */
- if (*type == enum_type_ptr) {
+ if (*type == enum_type_struct_ptr) {
PMC *ptr;
/* for now ignore count */
assert((int)max <= 1);
@@ -169,6 +168,21 @@
return NULL;
}
+static PMC*
+ret_pmc(Parrot_Interp interpreter, char *p, int type)
+{
+ char *cstr;
+ size_t len;
+
+ switch (type) {
+ case enum_type_func_ptr:
+ return *(PMC**) p;
+ default:
+ internal_exception(1, "returning unhandled pmc type in struct");
+ }
+ return NULL;
+}
+
static void
set_int(char *p, int type, INTVAL value)
{
@@ -405,6 +419,18 @@
int type;
char *p = char_offset_key(interpreter, pmc, key, &type);
return ret_string(interpreter, p, type);
+ }
+
+ PMC* get_pmc_keyed_int (INTVAL key) {
+ int type;
+ char *p = char_offset_int(interpreter, pmc, key, &type);
+ return ret_pmc(interpreter, p, type);
+ }
+
+ PMC* get_pmc_keyed (PMC* key) {
+ int type;
+ char *p = char_offset_key(interpreter, pmc, key, &type);
+ return ret_pmc(interpreter, p, type);
}
INTVAL get_integer() {
1.7 +7 -1 parrot/include/parrot/datatypes.h
Index: datatypes.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/datatypes.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- datatypes.h 3 Oct 2003 15:17:31 -0000 1.6
+++ datatypes.h 5 Feb 2004 16:42:35 -0000 1.7
@@ -3,7 +3,7 @@
* Copyright: (c) 2002 Leopold Toetsch <[EMAIL PROTECTED]>
* License: Artistic/GPL, see README and LICENSES for details
* CVS Info
- * $Id: datatypes.h,v 1.6 2003/10/03 15:17:31 leo Exp $
+ * $Id: datatypes.h,v 1.7 2004/02/05 16:42:35 leo Exp $
* Overview:
* Parrot and native data types enums and type names.
*
@@ -59,6 +59,9 @@
enum_type_ptr, /* native pointer */
enum_type_cstr, /* c string */
+ enum_type_struct_ptr, /* pointer to another struct */
+ enum_type_struct, /* a nested struct */
+ enum_type_func_ptr, /* a function pointer */
enum_type_sized, /* arbitrary size type for list_new */
enum_last_type /* + one */
@@ -111,6 +114,9 @@
{ "ptr", sizeof(void*) },
{ "cstr", sizeof(char *) },
+ { "struct_ptr", sizeof(void*) },
+ { "struct", 0 },
+ { "func_ptr", sizeof(void (*)(void)) },
{ "sized", 0 },
1.18 +15 -0 parrot/src/nci_test.c
Index: nci_test.c
===================================================================
RCS file: /cvs/public/parrot/src/nci_test.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- nci_test.c 5 Feb 2004 15:41:21 -0000 1.17
+++ nci_test.c 5 Feb 2004 16:42:42 -0000 1.18
@@ -99,6 +99,12 @@
return r;
}
+static int call_back(char *str) {
+ puts(str);
+ fflush(stdout);
+ return 4711;
+}
+
void * nci_pi(int test) {
switch (test) {
case 0:
@@ -158,6 +164,15 @@
} t = {
10,
&xx
+ };
+ return &t;
+ }
+ case 5:
+ {
+ static struct {
+ int (*f)(char *);
+ } t = {
+ call_back
};
return &t;
}
1.24 +31 -2 parrot/t/pmc/nci.t
Index: nci.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/nci.t,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -w -r1.23 -r1.24
--- nci.t 5 Feb 2004 15:41:24 -0000 1.23
+++ nci.t 5 Feb 2004 16:42:50 -0000 1.24
@@ -1,4 +1,4 @@
-use Parrot::Test tests => 21;
+use Parrot::Test tests => 22;
use Parrot::Config;
print STDERR $PConfig{jitcpuarch}, " JIT CPU\n";
@@ -515,7 +515,7 @@
push P2, .DATATYPE_CHAR
push P2, 0
push P2, 0
- push P2, .DATATYPE_PTR
+ push P2, .DATATYPE_STRUCT_PTR
# attach the unmanged struct as property
set P1, P2[-1]
setprop P1, "_struct", P4
@@ -543,6 +543,35 @@
100
77
200.000000
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "nci_p_i - func_ptr*");
+ 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
+ push P2, 0
+ push P2, 0
+ assign P5, P2
+ # 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
+ 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_i_p");
