Nick Glencross wrote:
Guys,
As mentioned on the list yesterday I started evaluating ffcall as a
way of providing NCI functionality.
Ok, here's an updated version with (hopefully) working callbacks -- at
least enough for a POC.
If you tried out my previous version, run 'rm */*ffcall*' before
applying this patch to avoid creating botched files.
I'll show an example of how you might use it...
I started by hacking nci_test.c to include:
typedef int (*cb_C1_func)(int, int, int);
void
nci_cb_C1(cb_C1_func cb, int a, int b, int c) {
int result = (cb)(a, b, c);
printf ("Result is %d\n", result);
}
This routine accepts a callback pointer and three arguments, and then
calls the callback with these arguments and prints the value received back.
The parrot harness might look like this:
.sub test :main
.local pmc libnci_test
libnci_test = loadlib "libnci_test"
.local pmc nci_cb_C1
nci_cb_C1 = dlfunc libnci_test, "nci_cb_C1", "ipiii"
.local pmc user_data
user_data = new .Integer
.local pmc cb
cb = newsub _call_back
.local pmc cb_wrapped
cb_wrapped = new_callback cb, user_data, "iiii"
nci_cb_C1 (cb_wrapped, 1,2,3)
print "Finish!\n"
.end
.sub _call_back
.param int a
.param int b
.param int c
print "Hello world!\n"
print a
print " "
print b
print " "
print c
print " "
print_newline
.return (b)
.end
The script looks similar to before, but certain limitations have been
lifted. A PMC must still be supplied to new_callback (although this
requirement could be lifted), but this does not need to be seen by the
callback (unless you want it to -- just pass it with a normal 'p'
signature) Moreover, the callback signature can be anything, and would
now include the return type which will be returned to C.
To clarify, 'ipiii' refers to the C nci_cb_C1 routine, and the 'iiii'
refers to the prototype for _call_back.
Running it gives
Hello world!
1 2 3
Result is 2
Finish!
'1 2 3' were passed from parrot into C and then back out into parrot to
be printed. parrot then returned the middle one which was printed back
in C-land.
Have fun!
Nick
Index: src/nci_ffcall.c
===================================================================
--- src/nci_ffcall.c (revision 0)
+++ src/nci_ffcall.c (revision 0)
@@ -0,0 +1,777 @@
+/* *Proof Of Concept* - show how ffcall can provide NCI functionality */
+
+#include <avcall.h>
+#include <callback.h>
+
+#include "parrot/parrot.h"
+#include "parrot/method_util.h"
+#include "parrot/oplib/ops.h"
+
+#include "nci_ffcall.str"
+
+#if defined(HAS_JIT) && defined(I386)
+# include "parrot/exec.h"
+# include "parrot/jit.h"
+/*# define CAN_BUILD_CALL_FRAMES*/
+#endif
+
+/* Structure used for storing arguments and return values */
+
+typedef union UnionArg
+{
+ char _char;
+ int _int;
+ short _short;
+ long _long;
+
+ float _float;
+ double _double;
+
+ int *_int_p;
+ long *_long_p;
+ short *_short_p;
+
+ float *_float_p;
+ double *_double_p;
+
+ char *_string;
+
+ void *_pointer;
+} UnionArg;
+
+
+/* The NCI data structure which stores the NCI and parrot signatures
+ as well as arguments and return value */
+
+typedef struct NCIArgs
+{
+ char *signature;
+ char *signature_parrot;
+
+ UnionArg result;
+ UnionArg args[10];
+
+} NCIArgs;
+
+
+/* Convenience routines */
+
+static INTVAL
+get_nci_I(Interp *interpreter, struct call_state *st, int n)
+{
+ assert(n < st->src.n);
+ Parrot_fetch_arg_nci(interpreter, st);
+
+ return UVal_int(st->val);
+}
+
+static FLOATVAL
+get_nci_N(Interp *interpreter, struct call_state *st, int n)
+{
+ assert(n < st->src.n);
+ Parrot_fetch_arg_nci(interpreter, st);
+
+ return UVal_num(st->val);
+}
+
+static STRING*
+get_nci_S(Interp *interpreter, struct call_state *st, int n)
+{
+ assert(n < st->src.n);
+ Parrot_fetch_arg_nci(interpreter, st);
+
+ return UVal_str(st->val);
+}
+
+static PMC*
+get_nci_P(Interp *interpreter, struct call_state *st, int n)
+{
+ /*
+ * exessive args are passed as NULL
+ * used by e.g. MMD infix like __add
+ */
+ if (n < st->src.n)
+ Parrot_fetch_arg_nci(interpreter, st);
+ else
+ UVal_pmc(st->val) = NULL;
+
+ return UVal_pmc(st->val);
+}
+
+#define GET_NCI_I(n) get_nci_I(interpreter, &st, n)
+#define GET_NCI_S(n) get_nci_S(interpreter, &st, n)
+#define GET_NCI_N(n) get_nci_N(interpreter, &st, n)
+#define GET_NCI_P(n) get_nci_P(interpreter, &st, n)
+
+/*
+ * set return value
+ */
+static void
+set_nci_I(Interp *interpreter, struct call_state *st, INTVAL val)
+{
+ Parrot_init_ret_nci(interpreter, st, "I");
+ UVal_int(st->val) = val;
+ Parrot_convert_arg(interpreter, st);
+ Parrot_store_arg(interpreter, st);
+}
+
+static void
+set_nci_N(Interp *interpreter, struct call_state *st, FLOATVAL val)
+{
+ Parrot_init_ret_nci(interpreter, st, "N");
+ UVal_num(st->val) = val;
+ Parrot_convert_arg(interpreter, st);
+ Parrot_store_arg(interpreter, st);
+}
+
+static void
+set_nci_S(Interp *interpreter, struct call_state *st, STRING *val)
+{
+ Parrot_init_ret_nci(interpreter, st, "S");
+ UVal_str(st->val) = val;
+ Parrot_convert_arg(interpreter, st);
+ Parrot_store_arg(interpreter, st);
+}
+
+static void
+set_nci_P(Interp *interpreter, struct call_state *st, PMC* val)
+{
+ Parrot_init_ret_nci(interpreter, st, "P");
+ UVal_pmc(st->val) = val;
+ Parrot_convert_arg(interpreter, st);
+ Parrot_store_arg(interpreter, st);
+}
+
+/* Convert NCI types to their corresponding parrot types */
+
+static char *convert_signature (char *signature)
+{
+ int i, length = strlen (signature);
+
+ char *signature_parrot = (char *) malloc (length);
+
+ for (i = 0 ; i < length+1 ; i++)
+ {
+ char map = '\0';
+
+ switch (signature[i])
+ {
+ case 'p': map = 'P'; break;
+ case 'i': map = 'I'; break;
+ case '3': map = 'P'; break;
+ case '2': map = 'P'; break;
+ case '4': map = 'P'; break;
+ case 'l': map = 'I'; break;
+ case 'c': map = 'I'; break;
+ case 's': map = 'I'; break;
+ case 'f': map = 'N'; break;
+ case 'd': map = 'N'; break;
+ case 'b': map = 'S'; break;
+ case 't': map = 'S'; break;
+ case 'P': map = 'P'; break;
+ case '0': map = 'P'; break;
+ case 'S': map = 'S'; break;
+ case 'I': map = 'I'; break;
+ case 'N': map = 'N'; break;
+ case 'B': map = 'S'; break;
+ case 'v': map = 'v'; break;
+ case 'J': map = ' '; break;
+
+ }
+
+ signature_parrot[i] = map;
+ }
+
+ return signature_parrot;
+}
+
+
+/* =========== Main NCI call code =========== */
+
+void *
+build_call_ffcall_func(Interp *interpreter, PMC *pmc_nci,
+ STRING *signature)
+{
+ NCIArgs* nci_args = (NCIArgs *) malloc (sizeof (NCIArgs));
+
+ nci_args->signature = string_to_cstring (interpreter, signature);
+
+ nci_args->signature_parrot = convert_signature (nci_args->signature);
+
+#if 0
+ printf ("Map '%s' to '%s'\n",
+ nci_args->signature,
+ nci_args->signature_parrot);
+#endif
+
+ return (void *) nci_args;
+}
+
+
+void nci_ffcall_invoke (Interp * interpreter, PMC *function)
+{
+ PMC *pmc;
+ unsigned int i, length;
+ typedef void (*func_t)(void);
+ func_t pointer;
+ struct call_state st;
+ char *signature;
+
+ av_alist alist;
+
+ Parrot_csub_t func = (Parrot_csub_t)D2FPTR(PMC_data(function));
+ NCIArgs* nci_args = (NCIArgs *) PMC_data(function);
+
+ signature = nci_args->signature;
+ pointer = (func_t) D2FPTR(PMC_struct_val(function));
+
+ /* Set up return type for function */
+ switch (signature[0])
+ {
+ case 'p':
+ av_start_ptr (alist, pointer, void *, &nci_args->result._pointer);
+ break;
+
+ case 'c':
+ av_start_char (alist, pointer, &nci_args->result._char);
+ break;
+
+ case 's':
+ av_start_short (alist, pointer, &nci_args->result._short);
+ break;
+
+ case 'i':
+ av_start_int (alist, pointer, &nci_args->result._int);
+ break;
+
+ case 'l':
+ av_start_long (alist, pointer, &nci_args->result._long);
+ break;
+
+ case 'f':
+ av_start_float (alist, pointer, &nci_args->result._float);
+ break;
+
+ case 'd':
+ av_start_double (alist, pointer, &nci_args->result._double);
+ break;
+
+ case 't':
+ av_start_ptr (alist, pointer, char *, &nci_args->result._string);
+ break;
+
+ case '\0':
+ case 'v':
+ av_start_void (alist, pointer);
+ break;
+
+ default:
+ PIO_eprintf(interpreter, "Bad nci return type '%c'\n",
+ signature[0]);
+ break;
+ }
+
+ length = strlen (nci_args->signature);
+
+ Parrot_init_arg_nci(interpreter, &st, nci_args->signature_parrot+1);
+
+ /* Set function input arguments */
+ for (i = 0 ; i < length-1 ; i++)
+ {
+ switch (signature[i+1])
+ {
+ case 'p':
+ pmc = GET_NCI_P (i);
+ nci_args->args[i]._pointer = PMC_data (pmc);
+ av_ptr (alist, void *, nci_args->args[i]._pointer);
+ break;
+
+ case 'P':
+ pmc = GET_NCI_P (i);
+ nci_args->args[i]._pointer =
+ pmc == PMCNULL
+ ? NULL
+ : pmc;
+ av_ptr (alist, void *, nci_args->args[i]._pointer);
+ break;
+
+ case 'b':
+ nci_args->args[i]._pointer = PMC_struct_val(GET_NCI_S(i)) ;
+ av_ptr (alist, void *, nci_args->args[i]._pointer);
+ break;
+
+ case 'B':
+ nci_args->args[i]._pointer = &PObj_bufstart(GET_NCI_S(i)) ;
+ av_ptr (alist, void *, nci_args->args[i]._pointer);
+ break;
+
+ case 'c':
+ nci_args->args[i]._char = GET_NCI_I (i) ;
+ av_char (alist, nci_args->args[i]._char);
+ break;
+
+ case 's':
+ nci_args->args[i]._short = GET_NCI_I (i) ;
+ av_short (alist, nci_args->args[i]._short);
+ break;
+
+ case 'i':
+ nci_args->args[i]._int = GET_NCI_I (i) ;
+ av_int (alist, nci_args->args[i]._int);
+ break;
+
+ case 'l':
+ nci_args->args[i]._long = GET_NCI_I (i) ;
+ av_long (alist, nci_args->args[i]._long);
+ break;
+
+ case 'f':
+ nci_args->args[i]._float = GET_NCI_N (i) ;
+ av_float (alist, nci_args->args[i]._float);
+ break;
+
+ case 'd':
+ nci_args->args[i]._double = GET_NCI_N (i) ;
+ av_double (alist, nci_args->args[i]._double);
+ break;
+
+ case 't':
+ nci_args->args[i]._string =
+ string_to_cstring(interpreter, GET_NCI_S (i));
+ av_ptr (alist, char *, nci_args->args[i]._string);
+ break;
+
+ case '2':
+ pmc = GET_NCI_P (i);
+ nci_args->args[i]._short_p = malloc (sizeof (short));
+ *nci_args->args[i]._long_p = PMC_int_val (pmc);
+ av_ptr (alist, short *, nci_args->args[i]._short_p);
+ break;
+
+ case '4':
+ pmc = GET_NCI_P (i);
+ nci_args->args[i]._long_p = malloc (sizeof (long));
+ *nci_args->args[i]._long_p = PMC_int_val (pmc);
+ av_ptr (alist, long *, nci_args->args[i]._long_p);
+ break;
+
+ case '3':
+ pmc = GET_NCI_P (i);
+ nci_args->args[i]._int_p = malloc (sizeof (int));
+ *nci_args->args[i]._long_p = PMC_int_val (pmc);
+ av_ptr (alist, int *, nci_args->args[i]._int_p);
+ break;
+
+ case 'v':
+ /* 'v' arguments will be rare, and only one allowed */
+ break;
+
+ default:
+ pmc = GET_NCI_P (i);
+ PIO_eprintf(interpreter, "Bad nci argument type '%c'\n",
+ signature[i+1]);
+ break;
+ }
+
+
+ }
+
+ // Make the actual call to C function
+ av_call (alist);
+
+ // Reinitialise interating arguments
+ Parrot_init_arg_nci(interpreter, &st, nci_args->signature_parrot+1);
+
+ /* Write backs to variables and cleanup */
+ for (i = 0 ; i < length-1 ; i++)
+ {
+ switch (signature[i+1])
+ {
+ case '2':
+ pmc = GET_NCI_P (i);
+ PMC_int_val (pmc) = *nci_args->args[i]._short_p;
+ free (nci_args->args[i]._short_p);
+ break;
+
+
+ case '3':
+ pmc = GET_NCI_P (i);
+ PMC_int_val (pmc) = *nci_args->args[i]._int_p;
+ free (nci_args->args[i]._int_p);
+ break;
+
+ case '4':
+ pmc = GET_NCI_P (i);
+ PMC_int_val (pmc) = *nci_args->args[i]._long_p;
+ free (nci_args->args[i]._long_p);
+ break;
+
+ case 't':
+ free (nci_args->args[i]._string);
+ break;
+
+ default:
+ // This is required to synchronise the arguments
+ pmc = GET_NCI_P (i);
+ break;
+ }
+ }
+
+
+
+ /* Retrieve return value from function */
+ switch (signature[0])
+ {
+ case 'p':
+ pmc = pmc_new(interpreter, enum_class_UnManagedStruct);
+ PMC_data (pmc) = nci_args->result._pointer;
+ set_nci_P (interpreter, &st, pmc);
+ break;
+
+ case 'c':
+ set_nci_I(interpreter, &st, nci_args->result._char);
+ break;
+
+ case 's':
+ set_nci_I(interpreter, &st, nci_args->result._short);
+ break;
+
+ case 'i':
+ set_nci_I(interpreter, &st, nci_args->result._int);
+ break;
+
+ case 'l':
+ set_nci_I(interpreter, &st, nci_args->result._long);
+ break;
+
+ case 'f':
+ set_nci_N(interpreter, &st, nci_args->result._float);
+ break;
+
+ case 'd':
+ set_nci_N(interpreter, &st, nci_args->result._double);
+ break;
+
+ case 't':
+ {
+ STRING *string =
+ string_from_cstring(interpreter,
+ nci_args->result._string, 0);
+ set_nci_S (interpreter, &st, string);
+ }
+ break;
+ }
+}
+
+
+
+/* =========== Callback code =========== */
+
+/* XXX Synchronous & Interpreter check */
+
+
+static void Parrot_callback_trampoline (void *data,
+ va_alist alist)
+{
+ PMC * passed_interp;
+ PMC * signature;
+ PMC * pmc_args[10];
+ PMC * sub;
+ PMC * pmc;
+ STRING * sig_str;
+ char * p;
+ STRING* sc;
+ void* param = NULL;
+ unsigned int length, i;
+
+ char *signature_parrot;
+
+ UnionArg arg, return_value;
+
+ Parrot_Interp interpreter = NULL;
+
+ PMC *user_data = (PMC *) data;
+
+ /* Find the correct interpreter */
+
+ LOCK(interpreter_array_mutex);
+ for (i = 0; i < n_interpreters; i++) {
+ if (interpreter_array[i] == NULL)
+ continue;
+ interpreter = interpreter_array[i];
+ if (interpreter)
+ if (contained_in_pool(interpreter,
+ interpreter->arena_base->pmc_pool, user_data))
+ break;
+ }
+ UNLOCK(interpreter_array_mutex);
+
+ if (!interpreter)
+ PANIC("interpreter not found for callback");
+
+ sc = CONST_STRING(interpreter, "_interpreter");
+ passed_interp = VTABLE_getprop(interpreter, user_data, sc);
+ if (PMC_data(passed_interp) != interpreter)
+ PANIC("callback gone to wrong interpreter");
+
+ /* Retrieve the values which hangs off the userdata PMC */
+
+ sc = CONST_STRING(interpreter, "_sub");
+ sub = VTABLE_getprop(interpreter, user_data, sc);
+
+ sc = CONST_STRING(interpreter, "_signature");
+ signature = VTABLE_getprop(interpreter, user_data, sc);
+
+ sig_str = VTABLE_get_string(interpreter, signature);
+ p = sig_str->strstart;
+
+ length = strlen (p);
+
+
+ /* Specify return type */
+
+ switch (p[0])
+ {
+ case 'p':
+ va_start_ptr (alist, void *);
+ break;
+
+ case 'c':
+ va_start_char (alist);
+ break;
+
+ case 's':
+ va_start_short (alist);
+ break;
+
+ case 'i':
+ va_start_int (alist);
+ break;
+
+ case 'l':
+ va_start_long (alist);
+ break;
+
+ case 'f':
+ va_start_float (alist);
+ break;
+
+ case 'd':
+ va_start_double (alist);
+ break;
+
+ case 't':
+ va_start_ptr (alist, char *);
+ break;
+
+ case '\0':
+ case 'v':
+ va_start_void (alist);
+ break;
+
+ default:
+ PIO_eprintf(interpreter, "Bad nci callback return type '%c'\n",
+ signature[0]);
+ break;
+ }
+
+
+ /* Iterate arguments */
+
+ for (i = 0 ; i < length-1 ; i++)
+ {
+ switch (p[i+1])
+ {
+ case 'p':
+ pmc_args[i] =
+ pmc_new(interpreter, enum_class_UnManagedStruct);
+ PMC_data (pmc_args[i]) = va_arg_ptr (alist, void *);
+ break;
+
+ case 'c':
+ pmc_args[i] = pmc_new(interpreter, enum_class_Integer);
+ VTABLE_set_integer_native (interpreter, pmc_args[i],
+ va_arg_char (alist));
+ break;
+
+ case 's':
+ pmc_args[i] = pmc_new(interpreter, enum_class_Integer);
+ VTABLE_set_integer_native (interpreter, pmc_args[i],
+ va_arg_short (alist));
+ break;
+ break;
+
+ case 'i':
+ pmc_args[i] = pmc_new(interpreter, enum_class_Integer);
+ VTABLE_set_integer_native (interpreter, pmc_args[i],
+ va_arg_int (alist));
+ break;
+
+ case 'l':
+ pmc_args[i] = pmc_new(interpreter, enum_class_Integer);
+ VTABLE_set_integer_native (interpreter, pmc_args[i],
+ va_arg_long (alist));
+ break;
+
+ case 'f':
+ pmc_args[i] = pmc_new(interpreter, enum_class_Float);
+ VTABLE_set_number_native (interpreter, pmc_args[i],
+ va_arg_float (alist));
+ break;
+
+ case 'd':
+ pmc_args[i] = pmc_new(interpreter, enum_class_Float);
+ VTABLE_set_number_native (interpreter, pmc_args[i],
+ va_arg_double (alist));
+ break;
+
+ case 't':
+ arg._string = va_arg_ptr (alist, char *);
+ pmc_args[i] = pmc_new(interpreter, enum_class_String);
+ VTABLE_set_string_native (interpreter, pmc_args[i],
+ string_from_cstring (interpreter,
+ va_arg_ptr
(alist,
+
char *),
+ 0));
+
+ break;
+
+
+ default:
+ PIO_eprintf(interpreter,
+ "Bad nci callback argument type '%c'\n",
+ p[i+1]);
+ break;
+ }
+ }
+
+ /** This is overly complicated */
+
+ signature_parrot = convert_signature (p);
+
+ for (i = 0 ; i < length ; i++)
+ {
+ if (signature_parrot[i] != 'v')
+ signature_parrot[i] = 'P';
+ }
+
+ /* Make actual call to parrot callback */
+ pmc = Parrot_runops_fromc_args (interpreter, sub,
+ signature_parrot,
+ pmc_args[0],
+ pmc_args[1],
+ pmc_args[2],
+ pmc_args[3],
+ pmc_args[4],
+ pmc_args[5],
+ pmc_args[6],
+ pmc_args[7],
+ pmc_args[8],
+ pmc_args[9]);
+
+ free (signature_parrot);
+
+ /* Retrieve returned value */
+
+ switch (p[0])
+ {
+ case 'p':
+ return_value._pointer = PMC_data (pmc);
+ va_return_ptr (alist, void *, return_value._pointer);
+ break;
+
+ case 'c':
+ return_value._char = VTABLE_get_integer (interpreter, pmc);
+ va_return_char (alist, return_value._char);
+ break;
+
+ case 's':
+ return_value._short = VTABLE_get_integer (interpreter, pmc);
+ va_return_short (alist, return_value._short);
+
+ break;
+
+ case 'i':
+ return_value._int = VTABLE_get_integer (interpreter, pmc);
+ va_return_int (alist, return_value._int);
+ break;
+
+ case 'l':
+ return_value._long = VTABLE_get_integer (interpreter, pmc);
+ va_return_long (alist, return_value._long);
+
+ break;
+
+ case 'f':
+ return_value._float = VTABLE_get_number (interpreter, pmc);
+ va_return_float (alist, return_value._float);
+
+ break;
+
+ case 'd':
+ return_value._double = VTABLE_get_number (interpreter, pmc);
+ va_return_double (alist, return_value._double);
+
+ break;
+
+ case 't':
+ /* XXX */
+ break;
+
+ case '\0':
+ case 'v':
+ va_return_void (alist);
+ break;
+ }
+}
+
+
+
+PMC*
+Parrot_make_cb_ffcall (Parrot_Interp interpreter, PMC* sub, PMC* user_data,
+ STRING *cb_signature)
+{
+ typedef void (*func_t)(void *data, va_alist alist);
+
+ PMC* interp_pmc, *cb, *cb_sig;
+ STRING *sc;
+
+ interp_pmc = VTABLE_get_pmc_keyed_int(interpreter, interpreter->iglobals,
+ (INTVAL) IGLOBALS_INTERPRETER);
+
+ sc = CONST_STRING(interpreter, "_interpreter");
+ VTABLE_setprop(interpreter, user_data, sc, interp_pmc);
+
+ sc = CONST_STRING(interpreter, "_sub");
+ VTABLE_setprop(interpreter, user_data, sc, sub);
+
+ cb_sig = pmc_new(interpreter, enum_class_String);
+ VTABLE_set_string_native(interpreter, cb_sig, cb_signature);
+
+ sc = CONST_STRING(interpreter, "_signature");
+ VTABLE_setprop(interpreter, user_data, sc, cb_sig);
+
+ dod_register_pmc(interpreter, user_data);
+
+ cb = pmc_new(interpreter, enum_class_UnManagedStruct);
+
+ dod_register_pmc(interpreter, cb);
+
+ func_t callback = alloc_callback (F2DPTR (Parrot_callback_trampoline),
+ user_data);
+
+ PMC_data(cb) = callback;
+
+ return cb;
+}
+
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */
Index: ops/core.ops
===================================================================
--- ops/core.ops (revision 9645)
+++ ops/core.ops (working copy)
@@ -1201,7 +1201,7 @@
$1 = pmc_new(interpreter, enum_class_Undef);
}
else {
- $1 = pmc_new(interpreter, enum_class_NCI);
+ $1 = pmc_new(interpreter, enum_class_NCI_FFCALL);
$1->vtable->set_pointer_keyed_str(interpreter, $1, $4, F2DPTR(p));
PObj_get_FLAGS($1) |= PObj_private1_FLAG;
}
@@ -1248,7 +1248,7 @@
}
op new_callback(out PMC, in PMC, in PMC, in STR) {
- $1 = Parrot_make_cb(interpreter, $2, $3, $4);
+ $1 = Parrot_make_cb_ffcall(interpreter, $2, $3, $4);
goto NEXT();
}
Index: include/parrot/interpreter.h
===================================================================
--- include/parrot/interpreter.h (revision 9645)
+++ include/parrot/interpreter.h (working copy)
@@ -456,6 +456,8 @@
void Parrot_callback_D(PMC *callback_info, void *external_data);
PMC* Parrot_make_cb(Interp * interpreter, PMC* sub, PMC* user_data,
STRING* cb_signature);
+PMC* Parrot_make_cb_ffcall(Interp * interpreter, PMC* sub, PMC* user_data,
+ STRING* cb_signature);
typedef opcode_t *(*native_func_t)(Interp * interpreter,
opcode_t * cur_opcode,
Index: include/parrot/nci.h
===================================================================
--- include/parrot/nci.h (revision 9645)
+++ include/parrot/nci.h (working copy)
@@ -16,7 +16,10 @@
#include "parrot/parrot.h"
void *build_call_func(Interp *, PMC *, String *);
+void *build_call_ffcall_func(Interp *, PMC *, String *);
+void nci_ffcall_invoke (Interp *, PMC *);
+
#endif /* PARROT_NCI_H_GUARD */
/*
Index: classes/nci_ffcall.pmc
===================================================================
--- classes/nci_ffcall.pmc (revision 0)
+++ classes/nci_ffcall.pmc (revision 0)
@@ -0,0 +1,197 @@
+/*
+Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
+$Id: /ffcall/classes/nci.pmc 9268 2005-09-28T16:00:42.088421Z robert $
+
+=head1 NAME
+
+classes/nci_ffcall.pmc - Native Call Interface
+
+=head1 DESCRIPTION
+
+The vtable functions for the native C call functions.
+
+Invoking an NCI function changes some registers according to PDD 3.
+
+The caller has to preserve registers if needed.
+
+=head2 Methods
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "parrot/method_util.h"
+
+pmclass NCI_FFCALL need_ext {
+
+/*
+
+=item C<void init()>
+
+Initializes the NCI with a C<NULL> function pointer.
+
+=cut
+
+*/
+
+ void init() {
+ PMC_struct_val(SELF) = NULL;
+ PMC_pmc_val(SELF) = NULL;
+ }
+
+/*
+
+=item C<void set_pointer_keyed_str(STRING *key, void *func)>
+
+Sets the specified function pointer and signature (C<*key>).
+
+=cut
+
+*/
+
+ void set_pointer_keyed_str(STRING *key, void *func) {
+ /* key = signature */
+ PMC_struct_val(SELF) = func;
+ PMC_data(SELF) = build_call_ffcall_func (INTERP, SELF, key);
+ }
+
+/*
+
+=item C<void destroy()>
+
+Destroys the NCI, freeing any allocated memory.
+
+=cut
+
+*/
+
+
+ void destroy() {
+#if 0
+ if (PMC_data(SELF))
+ mem_free_executable(PMC_data(SELF));
+#endif
+ }
+
+/*
+
+=item C<PMC *clone()>
+
+Creates and returns a clone of the NCI.
+
+=cut
+
+*/
+
+ PMC* clone () {
+#if 0
+ PMC* ret = pmc_new_noinit(INTERP, SELF->vtable->base_type);
+ PMC_struct_val(ret) = PMC_struct_val(SELF);
+ PMC_pmc_val(ret) = NULL;
+ /* FIXME if data is malloced (JIT/i386!) then we need
+ * the length of data here, to memcpy it
+ * ManagedStruct or Buffer?
+ */
+ PMC_data(ret) = PMC_data(SELF);
+ PObj_get_FLAGS(ret) |= (PObj_get_FLAGS(SELF) & 0x3);
+ return ret;
+#endif
+ }
+
+/*
+
+=item C<INTVAL defined()>
+
+Returns whether the NCI is defined.
+
+=cut
+
+*/
+
+ INTVAL defined () {
+ return PMC_data(SELF) != NULL;
+ }
+
+/*
+
+=item C<void *invoke(void *next)>
+
+Calls the associated C function, returning C<*next>. If
+the invocant is a class, the PMC arguments are
+shifted down.
+
+=cut
+
+*/
+
+ void* invoke (void * next) {
+ Parrot_csub_t func = (Parrot_csub_t)D2FPTR(PMC_data(SELF));
+ UINTVAL flags;
+
+ INTERP->current_cont = NULL;
+ if (!func)
+ real_exception(INTERP, NULL, INVALID_OPERATION,
+ "attempt to call NULL function");
+
+ nci_ffcall_invoke (INTERP, SELF);
+ return next;
+ }
+
+/*
+
+=item C<INTVAL get_integer()>
+
+Returns the function pointer as an integer.
+
+=cut
+
+*/
+
+ INTVAL get_integer () {
+ return((INTVAL)PMC_data(SELF));
+ }
+
+/*
+
+=item C<INTVAL get_bool()>
+
+Returns the boolean value of the pointer.
+
+=cut
+
+*/
+
+ INTVAL get_bool () {
+ return(0 != (INTVAL)PMC_data(SELF));
+ }
+
+}
+
+/*
+
+=back
+
+=head1 SEE ALSO
+
+F<docs/pdds/pdd03_calling_conventions.pod>.
+
+=head1 HISTORY
+
+Initial revision by sean 2002/08/04.
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+*/
Index: config/gen/makefiles/root.in
===================================================================
--- config/gen/makefiles/root.in (revision 9645)
+++ config/gen/makefiles/root.in (working copy)
@@ -428,6 +428,7 @@
$(SRC_DIR)/mmd$(O) \
$(SRC_DIR)/builtin$(O) \
$(SRC_DIR)/extend$(O) \
+ $(SRC_DIR)/nci_ffcall$(O) \
$(SRC_DIR)/extend_vtable$(O) \
$(SRC_DIR)/revision$(O) \
$(PF_DIR)/pf_items$(O) \
@@ -468,7 +469,7 @@
# libs
LIBPARROT = ${blib_lib_libparrot_a}
#CONDITIONED_LINE(has_icu):ICU_SHARED = ${icu_shared}
-ALL_PARROT_LIBS = $(LIBPARROT) $(ICU_SHARED) $(C_LIBS)
+ALL_PARROT_LIBS = $(LIBPARROT) $(ICU_SHARED) -lavcall -lcallback $(C_LIBS)
# dynamic extensions
DYNEXT_DIR = runtime/parrot/dynext
@@ -534,6 +535,7 @@
STR_FILES = \
$(SRC_DIR)/builtin.str \
$(SRC_DIR)/inter_call.str \
+ $(SRC_DIR)/nci_ffcall.str \
$(SRC_DIR)/inter_cb.str \
$(SRC_DIR)/inter_misc.str \
$(SRC_DIR)/global.str \
@@ -1025,6 +1027,8 @@
$(SRC_DIR)/nci$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/nci.c
+$(SRC_DIR)/nci_ffcall$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/nci_ffcall.c
+
$(SRC_DIR)/vtables$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/vtables.c
$(SRC_DIR)/cpu_dep$(O) : $(GENERAL_H_FILES)
