Here's another update to the ffcall POC that I posted a week or two
ago. It's now got a Configure test to work out which backend to use
(and an --ask option to override).
It still needs more work (which is fine as there's a feature freeze),
and some work on memory allocation and stuff. I also need to clarify a
few things; such a when I allocate some PMCs in C whether I need to
mark them so that they aren't swept away by a DOD (I suspect so).
Some known issues:
* Can't clone the NCI object
* compilers/pge/mklib.pir might die during the build; I can't do
debugging on the system that I'm on at the moment, so expect a fix
soon
* The callback tests are skipped as I need to do some work to unify
new_callback between backends
An opinion on the build would be appreciated. Should I have
build_nativecall.pl write out nci.c for each backend (as it is now),
or should there be a nci_native.c, nci_ffcall.c etc. and have the
makefile build the right one?
Cheers,
Nick
p.s. I may have difficultly getting online over the next few days
Index: build_tools/build_nativecall.pl
===================================================================
--- build_tools/build_nativecall.pl (revision 9774)
+++ build_tools/build_nativecall.pl (working copy)
@@ -28,10 +28,29 @@
=cut
use strict;
+use Parrot::Config;
# This file will eventually be compiled
open NCI, ">src/nci.c" or die "Can't open nci.c!";
+
+my $nci_implementation = $PConfig{nci_impl};
+
+print "NCI Implementation: $nci_implementation\n";
+
+if ($nci_implementation eq 'ffcall')
+{
+ # Generate
+ open NCI_FFCALL, "build_tools/build_nativecall_ffcall.in" or die;
+
+ my @nci_ffcall = <NCI_FFCALL>;
+
+ print NCI @nci_ffcall;
+ close;
+ exit;
+}
+
+
print_head();
my %ret_type =
@@ -649,6 +668,14 @@
return NULL;
}
+void *clone_call_func(Interp *interpreter, PMC *pmc_nci, void *args)
+{
+}
+
+void release_call_func(void *nci_args)
+{
+}
+
TAIL
}
Index: build_tools/build_nativecall_ffcall.in
===================================================================
--- build_tools/build_nativecall_ffcall.in (revision 0)
+++ build_tools/build_nativecall_ffcall.in (revision 0)
@@ -0,0 +1,815 @@
+/* NCI Implementation which uses ffcall */
+
+#include "nci.str"
+
+#include <avcall.h>
+#include <callback.h>
+
+#include "parrot/parrot.h"
+#include "parrot/method_util.h"
+#include "parrot/oplib/ops.h"
+
+#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 for fetching values */
+
+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)
+
+
+/* Convenience routines for setting values */
+
+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 signatures to parrot ones */
+
+static char *convert_signature (const 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;
+ }
+
+
+#if 0
+ printf ("Map '%s' to '%s'\n",
+ signature,
+ signature_parrot);
+#endif
+
+ return signature_parrot;
+}
+
+
+/* =========== Main NCI call code =========== */
+
+
+extern void nci_invoke (Interp * interpreter, PMC *function);
+
+
+void *
+build_call_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);
+
+ PMC_pmc_val (pmc_nci) = nci_args;
+
+ return nci_invoke;
+}
+
+void *
+clone_call_func(Interp *interpreter, PMC *pmc_nci, void *args)
+{
+ NCIArgs* nci_args = args;
+
+ if (!nci_args) return NULL;
+
+ // XXX Can't clone yet
+ return NULL;
+
+ return build_call_func (interpreter, pmc_nci, nci_args->signature);
+}
+
+
+void release_call_func(void *args)
+{
+ NCIArgs* nci_args = args;
+
+ if (nci_args)
+ {
+ free (nci_args->signature);
+ free (nci_args->signature_parrot);
+
+ free (nci_args);
+ }
+}
+
+
+void nci_invoke (Interp * interpreter, PMC *function)
+{
+ PMC *pmc;
+ unsigned int i, length;
+ struct call_state st;
+ char *signature;
+ __VA_function pointer;
+
+ av_alist alist;
+
+ NCIArgs* nci_args = (NCIArgs *) PMC_pmc_val(function);
+
+ signature = nci_args->signature;
+ pointer = PMC_struct_val(function);
+
+ /* Set up return type for function */
+ switch (signature[0])
+ {
+
+ case 'p':
+ 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 'J':
+ pmc = GET_NCI_P (i);
+ av_ptr (alist, void *, interpreter);
+ break;
+
+ 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':
+ 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 =========== */
+
+/* TODO: Synchronous/Assynchronous */
+
+
+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;
+ unsigned int length, i;
+
+ char signature_parrot[10];
+
+ 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;
+ }
+ }
+
+ /* Prepare parrot signature */
+
+ for (i = 0 ; i < length ; i++)
+ {
+ signature_parrot[i] = (p[i] == 'v') ? 'v' : '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]);
+
+ /* Retrieve returned value */
+
+ switch (p[0])
+ {
+ case 'p':
+ va_return_ptr (alist, void *, PMC_data (pmc));
+ break;
+
+ case 'c':
+ va_return_char (alist, VTABLE_get_integer (interpreter, pmc));
+ break;
+
+ case 's':
+ va_return_short (alist, VTABLE_get_integer (interpreter, pmc));
+ break;
+
+ case 'i':
+ va_return_int (alist, VTABLE_get_integer (interpreter, pmc));
+ break;
+
+ case 'l':
+ va_return_long (alist, VTABLE_get_integer (interpreter, pmc));
+ break;
+
+ case 'f':
+ va_return_float (alist, VTABLE_get_number (interpreter, pmc));
+ break;
+
+ case 'd':
+ va_return_double (alist, VTABLE_get_number (interpreter, pmc));
+ break;
+
+ case 't':
+ /* This will leak memory */
+ va_return_ptr (alist,
+ char *,
+ string_to_cstring(interpreter,
+ VTABLE_get_string (interpreter,
+ pmc)));
+ break;
+
+ case 'v':
+ case '\0':
+ va_return_void (alist);
+ break;
+ }
+}
+
+
+
+PMC*
+Parrot_make_cb (Parrot_Interp interpreter, PMC* sub, PMC* user_data,
+ STRING *cb_signature)
+{
+
+ PMC* interp_pmc, *cb, *cb_sig;
+ __TR_function callback;
+ 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);
+
+ callback = alloc_callback (Parrot_callback_trampoline,
+ user_data);
+
+ PMC_data(cb) = callback;
+
+ return cb;
+}
+
+
+
+
+void
+Parrot_run_callback(Parrot_Interp interpreter,
+ PMC* user_data, void* external_data)
+{
+ internal_exception(1, "Parrot_run_callback needs implementing for ffcall");
+}
+
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: nil
+ * End:
+ *
+ * vim: expandtab shiftwidth=4:
+ */
Index: lib/Parrot/Configure/RunSteps.pm
===================================================================
--- lib/Parrot/Configure/RunSteps.pm (revision 9774)
+++ lib/Parrot/Configure/RunSteps.pm (working copy)
@@ -42,6 +42,7 @@
inter/ops.pl
inter/exp.pl
inter/pmc.pl
+ inter/nci.pl
auto/alignptrs.pl
auto/headers.pl
auto/sizes.pl
Index: MANIFEST
===================================================================
--- MANIFEST (revision 9774)
+++ MANIFEST (working copy)
@@ -31,6 +31,7 @@
ast/hello.past []
ast/node.c []
build_tools/build_nativecall.pl []
+build_tools/build_nativecall_ffcall.in []
build_tools/c2str.pl []
build_tools/fingerprint_c.pl []
build_tools/jit2h.pl []
@@ -318,6 +319,8 @@
config/inter/progs.pl []
config/inter/types.pl []
config/inter/yacc.pl []
+config/inter/nci.pl []
+config/inter/nci/nci_ffcall.in []
docs/BROKEN [devel]doc
docs/ROADMAP [devel]doc
docs/compiler_faq.pod [devel]doc
Index: include/parrot/nci.h
===================================================================
--- include/parrot/nci.h (revision 9774)
+++ include/parrot/nci.h (working copy)
@@ -16,7 +16,10 @@
#include "parrot/parrot.h"
void *build_call_func(Interp *, PMC *, String *);
+void *clone_call_func(Interp *interpreter, PMC *pmc_nci, void *args);
+void release_call_func(void *nci_args);
+
#endif /* PARROT_NCI_H_GUARD */
/*
Index: classes/nci.pmc
===================================================================
--- classes/nci.pmc (revision 9774)
+++ classes/nci.pmc (working copy)
@@ -71,6 +71,9 @@
void destroy() {
if (PMC_data(SELF))
mem_free_executable(PMC_data(SELF));
+
+ if (PMC_pmc_val (SELF))
+ release_call_func(PMC_pmc_val(SELF));
}
/*
@@ -86,7 +89,8 @@
PMC* clone () {
PMC* ret = pmc_new_noinit(INTERP, SELF->vtable->base_type);
PMC_struct_val(ret) = PMC_struct_val(SELF);
- PMC_pmc_val(ret) = NULL;
+ PMC_pmc_val(ret) = clone_call_func (INTERP, SELF,
+ PMC_pmc_val(SELF));
/* FIXME if data is malloced (JIT/i386!) then we need
* the length of data here, to memcpy it
* ManagedStruct or Buffer?
Index: t/pmc/nci.t
===================================================================
--- t/pmc/nci.t (revision 9774)
+++ t/pmc/nci.t (working copy)
@@ -1312,6 +1312,11 @@
# Tests with callback functions
+SKIP: {
+
+ skip 'callback tests incompatible with ffcall' => 9
+ if $PConfig{nci_impl} eq 'ffcall';
+
pasm_output_is(<<'CODE', <<'OUTPUT', "nci_cb_C1 - PASM");
# we need a flag if the call_back is already done
@@ -1976,6 +1981,8 @@
external data: 111111111
OUTPUT
+}
+
pasm_output_is(<<'CODE', <<'OUTPUT', 'nci_pip - array of structs');
.include "datatypes.pasm"
Index: config/inter/nci.pl
===================================================================
--- config/inter/nci.pl (revision 0)
+++ config/inter/nci.pl (revision 0)
@@ -0,0 +1,81 @@
+# Copyright: 2001-2005 The Perl Foundation. All Rights Reserved.
+# $Id$
+
+=head1 NAME
+
+config/inter/nci.pl - Determine which NCI implementation to use
+
+=head1 DESCRIPTION
+
+Determines whether to use the internal NCI implementation, or one provided
+by ffcall.
+
+=cut
+
+package Configure::Step;
+
+use strict;
+use vars qw($description @args);
+use Parrot::Configure::Step ':inter';
+
+$description = "Determining which NCI implementation to use...";
+
[EMAIL PROTECTED] = qw(ask verbose);
+
+sub runstep {
+ my ($ask, $verbose) = @_;
+
+ my @nci_implementations = ('internal');
+
+ cc_gen('config/inter/nci/nci_ffcall.in');
+
+ eval { cc_build('', '-lavcall -lcallback'); };
+
+ if (! $@) {
+ my $test = cc_run ();
+
+ unshift @nci_implementations, 'ffcall'
+ if $test eq 'Received: It worked!';
+ }
+
+ my $nci_implementation = $nci_implementations[0];
+
+ if ($ask)
+ {
+ print <<'END';
+
+
+ You can choose between a number of diffferent backend implementations
+ for making calls to external libraries:
+
+ * internal: The original implementation which doesn't require
+ additional libraries
+
+ * ffcall: Requires the ffcall library
+
+END
+ $nci_implementation =
+ prompt ("\nWhich NCI implementation shall I use? (" .
+ join (',', @nci_implementations) . ")",
+ $nci_implementation);
+
+ $nci_implementation = $nci_implementations[0]
+ unless grep { $_ eq $nci_implementation } @nci_implementations;
+
+ }
+
+ $Configure::Step::result = $nci_implementation;
+
+ # This makes conditionals in the root makefile possible
+ $nci_implementation = "" if $nci_implementation eq 'internal';
+
+ Configure::Data->set( nci_impl => $nci_implementation );
+
+ Configure::Data->add(' ', 'libs', '-lavcall -lcallback')
+ if $nci_implementation eq 'ffcall';
+
+
+
+}
+
+1;
Index: config/inter/nci/nci_ffcall.in
===================================================================
--- config/inter/nci/nci_ffcall.in (revision 0)
+++ config/inter/nci/nci_ffcall.in (revision 0)
@@ -0,0 +1,20 @@
+#include <avcall.h>
+
+void function (char * str)
+{
+ printf ("Received: %s", str);
+
+}
+
+int main ()
+{
+ av_alist alist;
+
+ char* message = "It worked!";
+
+ av_start_void (alist, &function);
+ av_ptr (alist, char *, message);
+
+ av_call (alist);
+
+}
Index: config/gen/makefiles/root.in
===================================================================
--- config/gen/makefiles/root.in (revision 9774)
+++ config/gen/makefiles/root.in (working copy)
@@ -375,7 +375,7 @@
$(SRC_DIR)/global_setup$(O) \
$(SRC_DIR)/interpreter$(O) \
$(SRC_DIR)/inter_call$(O) \
- $(SRC_DIR)/inter_cb$(O) \
+#INVERSE_CONDITIONED_LINE(nci_impl): $(SRC_DIR)/inter_cb$(O) \
$(SRC_DIR)/inter_create$(O) \
$(SRC_DIR)/inter_misc$(O) \
$(SRC_DIR)/inter_run$(O) \
@@ -546,6 +546,7 @@
$(SRC_DIR)/library.str \
$(SRC_DIR)/mmd.str \
$(SRC_DIR)/pmc.str \
+ $(SRC_DIR)/nci.str \
$(SRC_DIR)/objects.str \
$(SRC_DIR)/spf_render.str \
$(SRC_DIR)/spf_vtable.str \
@@ -1031,14 +1032,14 @@
$(SRC_DIR)/exit$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/exit.c
-$(SRC_DIR)/nci$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/nci.c
+$(SRC_DIR)/nci$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/nci.c $(SRC_DIR)/nci.str
$(SRC_DIR)/vtables$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/vtables.c
$(SRC_DIR)/cpu_dep$(O) : $(GENERAL_H_FILES)
-$(SRC_DIR)/nci.c : $(SRC_DIR)/call_list.txt
$(BUILD_TOOLS_DIR)/build_nativecall.pl
- $(PERL) $(BUILD_TOOLS_DIR)/build_nativecall.pl $(SRC_DIR)/call_list.txt
+$(SRC_DIR)/nci.c : $(SRC_DIR)/call_list.txt
$(BUILD_TOOLS_DIR)/build_nativecall.pl
$(BUILD_TOOLS_DIR)/build_nativecall_ffcall.in
+ $(PERL) -Ilib $(BUILD_TOOLS_DIR)/build_nativecall.pl
$(SRC_DIR)/call_list.txt
$(SRC_DIR)/warnings$(O) : $(GENERAL_H_FILES)
