Author: nickg
Date: Wed Jan 11 07:53:39 2006
New Revision: 11086
Added:
branches/nci/NCI_NOTES.txt
branches/nci/src/nci_ffcall.c
Modified:
branches/nci/MANIFEST
branches/nci/include/parrot/nci.h
branches/nci/src/classes/nci.pmc
branches/nci/tools/build/nci_builtin_c.pl
Log:
NCI #5. An intermediate step.
Abstract some of the NCI backend functionality so that we can unify their API.
Write up some notes about how things work currently.
Import nci_ffcall.c which was part of a previous POC. Not built yet.
Modified: branches/nci/MANIFEST
==============================================================================
--- branches/nci/MANIFEST (original)
+++ branches/nci/MANIFEST Wed Jan 11 07:53:39 2006
@@ -1778,6 +1778,7 @@ src/method_util.c
src/misc.c []
src/mmd.c []
src/nci_builtin_sigs.txt [devel]doc
+src/nci_ffcall.c []
src/nci_test.c []
src/objects.c []
src/ops/bit.ops []
Added: branches/nci/NCI_NOTES.txt
==============================================================================
--- (empty file)
+++ branches/nci/NCI_NOTES.txt Wed Jan 11 07:53:39 2006
@@ -0,0 +1,53 @@
+These are temporary notes about NCI as they can become confusing when you
+start working on multiple implementations!
+
+Current 'Builtin' NCI:
+
+The bytecode calls
+
+ val = dlfunc LIBRARY, FUNCTION, PROTOTYPE
+
+which returns an NCI PMC which can be called just like a normal function.
+
+dlfunc is implemented in core.op which simple does a pmc_new and then calls
+set_pointer_keyed_str on it with the prototype and the looked up address
+of the function in the library.
+
+All that set_pointer_keyed_str does is remember the function address
+(in struct val) and the looked up address (using build_call_func, in
+the data field) of the nci wrapper code which can handle that
+signature.
+
+When the NCI PMC is invoked, it retrieves the function from the NCI
+layer function and calls it with the PMC itself as the argument.
+
+The NCI layer function will then retrieve the call arguments from the
+interpreter, put them into C types, and call the library function. The
+returned value is converted back to a parrot PMC, and returns.
+
+PMC must store: address of NCI layer function, and library function
+
+
+'Current' 'ffcall' implementation
+
+The set_pointer_keyed_str sets struct_val to the ultimate function,
+and data to malloced data structure which contains the parrot and NCI
+signatures.
+
+
+When the invoke method is called, the main nci ffcall invoke routine
+is called mostly makes ffcall calls based on the two signatures.
+
+
+
+
+Suggested unification:
+
+Implement an NCI abstraction which will use vtables. The entries will be:
+
+ nci_new
+ nci_clone
+ nci_invoke
+ nci_free
+
+
Modified: branches/nci/include/parrot/nci.h
==============================================================================
--- branches/nci/include/parrot/nci.h (original)
+++ branches/nci/include/parrot/nci.h Wed Jan 11 07:53:39 2006
@@ -14,8 +14,29 @@
#define PARROT_NCI_H_GUARD
#include "parrot/parrot.h"
+#include "parrot/method_util.h"
-void *build_call_func(Interp *, PMC *, String *);
+typedef void* (*nci_new_method_t)(Interp* interpreter,
+ PMC* pmc, STRING* signature);
+typedef void* (*nci_clone_method_t)(void *context);
+typedef void (*nci_invoke_method_t)(Interp* interpreter,
+ Parrot_csub_t func,
+ PMC* pmc);
+typedef void (*nci_free_method_t)(void * context);
+
+
+struct nci_vtable {
+
+ // Used to initialise a new NCI PMC
+ nci_new_method_t nci_new;
+ // Used to clone an NCI PMC
+ nci_clone_method_t nci_clone;
+ // Used to invoke the NCI call
+ nci_invoke_method_t nci_invoke;
+ // Cleans up the NCI data structures
+ nci_free_method_t nci_free;
+
+};
#endif /* PARROT_NCI_H_GUARD */
Modified: branches/nci/src/classes/nci.pmc
==============================================================================
--- branches/nci/src/classes/nci.pmc (original)
+++ branches/nci/src/classes/nci.pmc Wed Jan 11 07:53:39 2006
@@ -25,6 +25,10 @@ The caller has to preserve registers if
#include "parrot/parrot.h"
#include "parrot/method_util.h"
+
+extern struct nci_vtable nci_builtin_vtable;
+struct nci_vtable *nci_vtable_ptr = &nci_builtin_vtable;
+
pmclass NCI need_ext {
/*
@@ -55,7 +59,10 @@ Sets the specified function pointer and
void set_pointer_keyed_str(STRING *key, void *func) {
/* key = signature */
PMC_struct_val(SELF) = func;
- PMC_data(SELF) = build_call_func(INTERP, SELF, key);
+
+ nci_vtable_ptr->nci_free (PMC_data(SELF));
+
+ PMC_data(SELF) = nci_vtable_ptr->nci_new (INTERP, SELF, key);
}
/*
@@ -69,8 +76,7 @@ Destroys the NCI, freeing any allocated
*/
void destroy() {
- if (PMC_data(SELF))
- mem_free_executable(PMC_data(SELF));
+ nci_vtable_ptr->nci_free (PMC_data(SELF));
}
/*
@@ -91,7 +97,7 @@ Creates and returns a clone of the NCI.
* the length of data here, to memcpy it
* ManagedStruct or Buffer?
*/
- PMC_data(ret) = PMC_data(SELF);
+ PMC_data(ret) = nci_vtable_ptr->nci_clone (PMC_data(SELF));
PObj_get_FLAGS(ret) |= (PObj_get_FLAGS(SELF) & 0x3);
return ret;
}
@@ -126,6 +132,7 @@ shifted down.
Parrot_csub_t func = (Parrot_csub_t)D2FPTR(PMC_data(SELF));
INTERP->current_cont = NULL;
+
if (!func)
real_exception(INTERP, NULL, INVALID_OPERATION,
"attempt to call NULL function");
@@ -140,7 +147,9 @@ shifted down.
* private1 ... created via dlfunc
*
*/
- func(INTERP, SELF);
+
+ nci_vtable_ptr->nci_invoke (INTERP, func, SELF);
+
return next;
}
Added: branches/nci/src/nci_ffcall.c
==============================================================================
--- (empty file)
+++ branches/nci/src/nci_ffcall.c Wed Jan 11 07:53:39 2006
@@ -0,0 +1,831 @@
+/*
+Copyright: 2006 The Perl Foundation. All Rights Reserved.
+$Id$
+
+=head1 NAME
+
+src/nci_ffcall.c - NCI Implementation using ffcall
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#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:
+ */
Modified: branches/nci/tools/build/nci_builtin_c.pl
==============================================================================
--- branches/nci/tools/build/nci_builtin_c.pl (original)
+++ branches/nci/tools/build/nci_builtin_c.pl Wed Jan 11 07:53:39 2006
@@ -581,9 +581,9 @@ sub print_tail {
/* This function serves a single purpose. It takes the function
signature for a C function we want to call and returns a pointer
to a function that can call it. */
-void *
-build_call_func(Interp *interpreter, PMC *pmc_nci,
- STRING *signature)
+static void *
+nci_builtin_new (Interp *interpreter, PMC *pmc_nci,
+ STRING *signature)
{
char *c;
STRING *ns, *message;
@@ -615,7 +615,7 @@ build_call_func(Interp *interpreter, PMC
iglobals = interpreter->iglobals;
if (PMC_IS_NULL(iglobals))
- PANIC("iglobals isn�t created yet");
+ PANIC("iglobals isn't created yet");
HashPointer = VTABLE_get_pmc_keyed_int(interpreter, iglobals,
IGLOBALS_NCI_FUNCS);
@@ -657,6 +657,40 @@ $put_pointer
return NULL;
}
+
+static void* nci_builtin_clone (void* context)
+{
+ return context;
+}
+
+
+static void nci_builtin_invoke (Interp *interpreter,
+ Parrot_csub_t func,
+ PMC * pmc)
+{
+ func (interpreter, pmc);
+}
+
+
+static void nci_builtin_free (void * context)
+{
+#if 0
+ /* Doesn't actually look like this memory needs to be freed */
+ if (context)
+ mem_free_executable(context);
+#endif
+}
+
+
+struct nci_vtable nci_builtin_vtable =
+{
+ nci_builtin_new,
+ nci_builtin_clone,
+ nci_builtin_invoke,
+ nci_builtin_free
+};
+
+
TAIL
}
