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)