Index: src/ops/core.ops =================================================================== --- src/ops/core.ops (revision 42085) +++ src/ops/core.ops (working copy) @@ -1322,7 +1322,6 @@ else { $1 = pmc_new(interp, enum_class_NCI); VTABLE_set_pointer_keyed_str(interp, $1, $4, F2DPTR(p)); - PObj_get_FLAGS($1) |= PObj_private1_FLAG; } Parrot_str_free_cstring(name); } Index: src/pmc/nci.pmc =================================================================== --- src/pmc/nci.pmc (revision 42085) +++ src/pmc/nci.pmc (working copy) @@ -18,86 +18,115 @@ */ +#include "parrot/nci.h" + typedef INTVAL (*nci_sub_t)(PARROT_INTERP, PMC *); -typedef INTVAL (*nci_jit_sub_t)(PARROT_INTERP, PMC *, char *); +typedef nci_sub_t nci_jit_sub_t; -void pcc_params(PARROT_INTERP, STRING *sig, Parrot_NCI_attributes * const nci_info, - size_t sig_length); -void pcc_params(PARROT_INTERP, STRING *sig, Parrot_NCI_attributes * const nci_info, - size_t sig_length) { - char param_buf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }; - char *param_sig = sig_length <= 7 - ? param_buf - : mem_allocate_n_typed(sig_length, char); - size_t j = 0; - size_t i; +#define NCI_raw_FLAG PObj_private0_FLAG - for (i = 1; i < sig_length; i++) { - INTVAL c = Parrot_str_indexed(interp, sig, i); - - switch (c) { - case (INTVAL)'0': /* null ptr or such - doesn't consume a reg */ - break; - case (INTVAL)'f': - case (INTVAL)'N': - case (INTVAL)'d': - param_sig[j++] = 'N'; - break; - case (INTVAL)'I': /* INTVAL */ - case (INTVAL)'l': /* long */ - case (INTVAL)'i': /* int */ - case (INTVAL)'s': /* short */ - case (INTVAL)'c': /* char */ - param_sig[j++] = 'I'; - break; - case (INTVAL)'S': - case (INTVAL)'t': /* string, pass a cstring */ - param_sig[j++] = 'S'; - break; - case (INTVAL)'J': /* interpreter */ - break; - case (INTVAL)'p': /* push pmc->data */ - case (INTVAL)'O': /* push PMC * object in P2 */ - case (INTVAL)'P': /* push PMC * */ - case (INTVAL)'V': /* push PMC * */ - param_sig[j++] = 'P'; - case (INTVAL)'v': - break; - /* I have no idea how to handle these */ - case (INTVAL)'2': - case (INTVAL)'3': - case (INTVAL)'4': - param_sig[j++] = 'I'; - break; - case (INTVAL)'@': - param_sig[j++] = '@'; - break; - case (INTVAL)'b': /* buffer (void*) pass Buffer_bufstart(SReg) */ - case (INTVAL)'B': /* buffer (void**) pass &Buffer_bufstart(SReg) */ - param_sig[j++] = 'S'; - break; +STRING *pcc_sig_ret(PARROT_INTERP, STRING *sig); +STRING *pcc_sig_ret(PARROT_INTERP, STRING *sig) { + INTVAL c = Parrot_str_indexed(interp, sig, 0); + if (c > 127) { + Parrot_ex_throw_from_c_args(interp, NULL, + EXCEPTION_JIT_ERROR, + "Unknown return type at %d in signature '%S' (way too big)\n", 0, sig); + } + else { + switch ((char)c) { + case 'v': + return CONST_STRING(interp, "v"); + case 'N': + case 'f': + case 'd': + return CONST_STRING(interp, "N"); + case 'I': + case 'l': + case 'i': + case 's': + case 'c': + return CONST_STRING(interp, "I"); + case 'S': + case 't': + return CONST_STRING(interp, "S"); + case 'p': + case 'P': + return CONST_STRING(interp, "P"); + case '2': + case '3': + case '4': + return CONST_STRING(interp, "P"); default: - if (sig_length > 7) - mem_sys_free(param_sig); Parrot_ex_throw_from_c_args(interp, NULL, - EXCEPTION_JIT_ERROR, - "Unknown param Signature %c\n", (char)c); - break; + EXCEPTION_JIT_ERROR, + "Unknown return type at %d in signature '%S'\n", 0, sig); } } +} - PARROT_ASSERT(j <= sig_length); +STRING *pcc_sig_params(PARROT_INTERP, STRING *sig); +STRING *pcc_sig_params(PARROT_INTERP, STRING *sig) { + size_t sig_len = Parrot_str_byte_length(interp, sig); + char param_buf[sig_len*2]; - /* use only the signature-significant part of the string buffer */ - if (j) { - nci_info->pcc_params_signature = string_make(interp, param_sig, j, - NULL, PObj_constant_FLAG); + size_t i, j; + + for (i = 1, j = 0; i < sig_len; i++) { + INTVAL c = Parrot_str_indexed(interp, sig, i); + if (c > 127) { + Parrot_ex_throw_from_c_args(interp, NULL, + EXCEPTION_JIT_ERROR, + "Unknown param type at %d in signature '%S' (way too big)\n", i, sig); + } + else { + switch ((char)c) { + case '0': + case 'J': + break; + case 'N': + case 'd': + case 'f': + param_buf[j++] = 'N'; + break; + case 'I': + case 'l': + case 'i': + case 's': + case 'c': + param_buf[j++] = 'I'; + break; + case 'S': + case 't': + case 'b': + case 'B': + param_buf[j++] = 'S'; + break; + case 'P': + case 'p': + case 'V': + case '2': + case '3': + case '4': + param_buf[j++] = 'P'; + break; + case 'O': + param_buf[j++] = 'P'; + param_buf[j++] = 'i'; + break; + case '@': + param_buf[j++] = 'P'; + param_buf[j++] = 's'; + break; + default: + Parrot_ex_throw_from_c_args(interp, NULL, + EXCEPTION_JIT_ERROR, + "Unknown param type at %d in signature '%S'\n", i, sig); + } + } } - else - nci_info->pcc_params_signature = CONST_STRING(interp, ""); - if (sig_length > 7) - mem_sys_free(param_sig); + return string_make(interp, param_buf, j, NULL, PObj_constant_FLAG); } /* actually build the NCI thunk */ @@ -106,117 +135,115 @@ static nci_sub_t build_func(PARROT_INTERP, PMC *pmc, Parrot_NCI_attributes *nci_info) { - STRING *key = nci_info->signature; - size_t key_length = Parrot_str_byte_length(interp, key); + STRING *key = nci_info->nci_signature; int jitted = 0; - pcc_params(interp, key, nci_info, key_length); - - /* Arity is length of that string minus one (the return type). */ - nci_info->arity = key_length - 1; - /* Build call function. */ nci_info->func = (PMC *)(build_call_func(interp, pmc, key, &jitted)); - nci_info->jitted = jitted; return (nci_sub_t)nci_info->func; } pmclass NCI auto_attrs { - ATTR STRING *signature; /* The signature. */ - ATTR void *func; /* Function pointer to call. */ - ATTR void *orig_func; /* Function pointer - * used to create func */ - ATTR STRING *pcc_params_signature; /* The signature. */ - ATTR STRING *long_signature; /* The full signature. */ - ATTR PMC *multi_sig; /* type tuple array (?) */ - ATTR INTVAL arity; /* Cached arity of the NCI. */ - ATTR INTVAL jitted; /* Is this a jitted NCI stub. */ + /* Signature Attributes */ + ATTR STRING *nci_signature; /* The NCI signature */ + ATTR STRING *pcc_signature_ret; /* The PCC return signature */ + ATTR STRING *pcc_signature_param; /* The PCC param signature */ + /* Function Pointers */ + ATTR void *func; /* Function pointer to call */ + ATTR void *raw_func; /* Function pointer being wrapped */ + + /* Sub PMC Attributes */ + ATTR INTVAL arity; /* Number of params taken */ + /* MMD Attributes */ + ATTR PMC *multi_sig; + ATTR STRING *long_signature; + /* -=item C +=item C -Return the MMD signature PMC, if any or a Null PMC. +Initializes the NCI with a C function pointer. =cut */ - METHOD get_multisig() { - PMC *sig; - GET_ATTR_multi_sig(INTERP, SELF, sig); - if (PMC_IS_NULL(sig)) - sig = PMCNULL; - RETURN(PMC *sig); + VTABLE void init() { + /* Mark that we're not a raw NCI */ + PObj_get_FLAGS(SELF) &= ~NCI_raw_FLAG; + /* Mark that we have a custom gc marker */ + PObj_custom_mark_SET(SELF); } /* -=item C +=item C -Sets the specified function pointer and raw flag. +=item C +Get/Set the pointer being wrapped. Setting through this interface sets +the raw flag. + =cut */ - METHOD make_raw_nci(PMC *func) { - VTABLE_set_pointer(interp, SELF, (void *)func); + VTABLE void *get_pointer() { + return PARROT_NCI(SELF)->raw_func; } + VTABLE void set_pointer(void *ptr) { + SET_ATTR_raw_func(INTERP, SELF, ptr); + PObj_get_FLAGS(SELF) |= NCI_raw_FLAG; + } + /* -=item C +=item C -Initializes the NCI with a C function pointer. +=item C +Get/Set the NCI signature. + =cut */ - VTABLE void init() { - /* Mark that we're not a raw NCI. */ - PObj_flag_CLEAR(private2, SELF); - PObj_custom_mark_SET(SELF); + VTABLE STRING *get_string() { + return PARROT_NCI(SELF)->nci_signature; } + VTABLE void set_string_native(STRING *str) { + if (!PObj_constant_TEST(str)) { + str = Parrot_str_copy(INTERP, str); + } + SET_ATTR_nci_signature(INTERP, SELF, str); + + /* set up derivative attributes */ + SET_ATTR_pcc_signature_param(INTERP, SELF, pcc_sig_params(INTERP, str)); + SET_ATTR_pcc_signature_ret(INTERP, SELF, pcc_sig_ret(INTERP, str)); + /* Arity is length of the NCI signature minus one (the return type). */ + SET_ATTR_arity(INTERP, SELF, Parrot_str_byte_length(INTERP, str) - 1); + } + /* =item C -Sets the specified function pointer and signature (C<*key>). +Roughly equivalent to C and C. +Setting through this interface clears the raw flag. =cut */ - VTABLE void set_pointer(void *ptr) { - SET_ATTR_orig_func(INTERP, SELF, ptr); - PObj_flag_SET(private2, SELF); - } - - VTABLE void *get_pointer() { - return PARROT_NCI(SELF)->orig_func; - } - VTABLE void set_pointer_keyed_str(STRING *key, void *func) { - Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); - - /* Store the original function and signature. */ - SET_ATTR_orig_func(INTERP, SELF, func); - - /* ensure that the STRING signature is constant */ - if (!PObj_constant_TEST(key)) { - char * const key_c = Parrot_str_to_cstring(INTERP, key); - size_t key_length = Parrot_str_byte_length(interp, key); - key = string_make(interp, key_c, key_length, - NULL, PObj_constant_FLAG); - Parrot_str_free_cstring(key_c); - } - - nci_info->signature = key; + SELF.set_string_native(key); + SELF.set_pointer(func); + PObj_get_FLAGS(SELF) &= ~NCI_raw_FLAG; } /* @@ -232,8 +259,9 @@ if (PARROT_NCI(SELF)) { Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); - Parrot_gc_mark_STRING_alive(interp, nci_info->signature); - Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_params_signature); + Parrot_gc_mark_STRING_alive(interp, nci_info->nci_signature); + Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_signature_param); + Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_signature_ret); Parrot_gc_mark_STRING_alive(interp, nci_info->long_signature); Parrot_gc_mark_PMC_alive(interp, nci_info->multi_sig); } @@ -252,7 +280,7 @@ VTABLE PMC *clone() { Parrot_NCI_attributes * const nci_info_self = PARROT_NCI(SELF); Parrot_NCI_attributes *nci_info_ret; - void *orig_func; + void *raw_func; PMC * const ret = pmc_new(INTERP, SELF->vtable->base_type); nci_info_ret = PARROT_NCI(ret); @@ -262,11 +290,13 @@ * ManagedStruct or Buffer? */ nci_info_ret->func = nci_info_self->func; - nci_info_ret->orig_func = nci_info_self->orig_func; - nci_info_ret->signature = nci_info_self->signature; - nci_info_ret->pcc_params_signature = nci_info_self->pcc_params_signature; + nci_info_ret->raw_func = nci_info_self->raw_func; + nci_info_ret->nci_signature = nci_info_self->nci_signature; + nci_info_ret->pcc_signature_param = nci_info_self->pcc_signature_param; + nci_info_ret->pcc_signature_ret = nci_info_self->pcc_signature_ret; + nci_info_ret->long_signature = nci_info_self->long_signature; + nci_info_ret->multi_sig = nci_info_self->multi_sig; nci_info_ret->arity = nci_info_self->arity; - nci_info_ret->jitted = nci_info_self->jitted; PObj_get_FLAGS(ret) |= (PObj_get_FLAGS(SELF) & 0x7); return ret; @@ -284,7 +314,7 @@ VTABLE INTVAL defined() { Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); - return nci_info->orig_func != NULL; + return nci_info->raw_func != NULL; } /* @@ -302,12 +332,12 @@ Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); nci_sub_t func; char *sig_str; - void *orig_func; + void *raw_func; PMC *cont; - GET_ATTR_orig_func(INTERP, SELF, orig_func); - func = PObj_flag_TEST(private2, SELF) - ? (nci_sub_t) D2FPTR(orig_func) + GET_ATTR_raw_func(INTERP, SELF, raw_func); + func = PObj_get_FLAGS(SELF) & NCI_raw_FLAG + ? (nci_sub_t) D2FPTR(raw_func) : (nci_sub_t) D2FPTR(nci_info->func); if (!func) { @@ -320,23 +350,8 @@ "attempt to call NULL function"); } - if (nci_info->jitted) { - nci_jit_sub_t jit_func = (nci_jit_sub_t) D2FPTR(nci_info->func); + func(INTERP, SELF); - /* Parrot_eprintf(interp, "JITTED %S\n", nci_info->signature); */ - sig_str = Parrot_str_to_cstring(interp, nci_info->pcc_params_signature); - jit_func(INTERP, SELF, sig_str); - Parrot_str_free_cstring(sig_str); - } - else { - if (PObj_flag_TEST(private2, SELF)) { - /* Parrot_eprintf(interp, "RAW NCI CALL\n"); */ - } - else { - /* Parrot_eprintf(interp, "HACKED %S\n", nci_info->signature); */ - } - func(INTERP, SELF); - } cont = INTERP->current_cont; /* @@ -384,11 +399,30 @@ VTABLE INTVAL get_bool() { Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); - return (0 != (INTVAL)nci_info->orig_func); + return (0 != (INTVAL)nci_info->raw_func); } /* +=item C + +Return the MMD signature PMC, if any or a Null PMC. + +=cut + +*/ + + METHOD get_multisig() { + PMC *sig; + GET_ATTR_multi_sig(INTERP, SELF, sig); + if (sig == NULL) { + sig = PMCNULL; + } + RETURN(PMC *sig); + } + +/* + =item C Return the arity of the NCI (the number of arguments). @@ -397,22 +431,85 @@ */ METHOD arity() { - Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); - INTVAL arity = 0; + INTVAL arity; + GET_ATTR_arity(INTERP, SELF, arity); + RETURN(INTVAL arity); + } - if (nci_info) { - if (!nci_info->func) - build_func(INTERP, SELF, nci_info); - if (nci_info->func) { - arity = nci_info->arity; - RETURN(INTVAL arity); - } +/* + +=item C + +=item C + +=item C + +Accessors for all attributes of this class not otherwise accessible through VTABLES. +Integers are used for keys to make access easier for JIT. These are also available to +PIR from F + +=over + +=item INTVAL keys + +C + +=item STRING keys + +C, C, +C + +=item PMC keys + +C + +=back + +=cut + +*/ + + VTABLE INTVAL get_integer_keyed_int(INTVAL key) { + switch (key) { + case PARROT_NCI_ARITY: + return PARROT_NCI(SELF)->arity; + default: + Parrot_ex_throw_from_c_args(INTERP, NULL, + EXCEPTION_INVALID_OPERATION, + "Bad index for NCI.get_integer_keyed_int()"); } + } - Parrot_ex_throw_from_c_args(INTERP, NULL, - EXCEPTION_INVALID_OPERATION, - "You cannot get the arity of an undefined NCI."); + VTABLE STRING *get_string_keyed_int(INTVAL key) { + switch (key) { + case PARROT_NCI_PCC_SIGNATURE_PARAMS: + return PARROT_NCI(SELF)->pcc_signature_param; + case PARROT_NCI_PCC_SIGNATURE_RET: + return PARROT_NCI(SELF)->pcc_signature_ret; + case PARROT_NCI_LONG_SIGNATURE: + return PARROT_NCI(SELF)->long_signature; + default: + Parrot_ex_throw_from_c_args(INTERP, NULL, + EXCEPTION_INVALID_OPERATION, + "Bad index for NCI.get_string_keyed_int()"); + } } + + VTABLE PMC *get_pmc_keyed_int(INTVAL key) { + PMC *retval; + switch (key) { + case PARROT_NCI_MULTI_SIG: + GET_ATTR_multi_sig(INTERP, SELF, retval); + default: + Parrot_ex_throw_from_c_args(INTERP, NULL, + EXCEPTION_INVALID_OPERATION, + "Bad index for NCI.get_pmc_keyed_int()"); + } + if (retval == NULL) { + retval = PMCNULL; + } + return retval; + } } /* Index: src/nci_test.c =================================================================== --- src/nci_test.c (revision 42085) +++ src/nci_test.c (working copy) @@ -102,7 +102,7 @@ PARROT_EXPORT void nci_v(void); PARROT_EXPORT void nci_vP(void *); PARROT_EXPORT void nci_vpii(Outer *, int, int); -PARROT_EXPORT void nci_vv(void); +PARROT_EXPORT void nci_v_2(void); PARROT_EXPORT void nci_vVi(Opaque**, int); PARROT_EXPORT void nci_vp(Opaque*); PARROT_EXPORT char * nci_ttt(char *, char *); @@ -1051,7 +1051,7 @@ /* =item C +nci_v_2(void)> Multiplies the global variable C by 3. @@ -1060,7 +1060,7 @@ */ PARROT_EXPORT void -nci_vv(void) +nci_v_2(void) { nci_dlvar_int *= 3; } Index: src/extend.c =================================================================== --- src/extend.c (revision 42085) +++ src/extend.c (working copy) @@ -1729,7 +1729,6 @@ (char *) NULL, 0); Parrot_PMC sub = pmc_new(interp, enum_class_NCI); VTABLE_set_pointer_keyed_str(interp, sub, sig, F2DPTR(func)); - PObj_get_FLAGS(sub) |= PObj_private1_FLAG; return sub; } Index: tools/build/nativecall.pl =================================================================== --- tools/build/nativecall.pl (revision 42085) +++ tools/build/nativecall.pl (working copy) @@ -30,6 +30,9 @@ use strict; use warnings; +use lib 'lib'; +use Parrot::NativeCall; + my $opt_warndups = 0; # This file will eventually be compiled @@ -37,65 +40,8 @@ print_head( \@ARGV ); +my %sig_table = %Parrot::NativeCall::signature_table; -my %sig_table = ( - p => { - as_proto => "void *", - other_decl => "PMC * const final_destination = pmc_new(interp, enum_class_UnManagedStruct);", - sig_char => "P", - ret_assign => "VTABLE_set_pointer(interp, final_destination, return_data);\n Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"P\", final_destination);", - }, - i => { as_proto => "int", sig_char => "I" }, - l => { as_proto => "long", sig_char => "I" }, - c => { as_proto => "char", sig_char => "I" }, - s => { as_proto => "short", sig_char => "I" }, - f => { as_proto => "float", sig_char => "N" }, - d => { as_proto => "double", sig_char => "N" }, - t => { as_proto => "char *", - other_decl => "STRING *final_destination;", - ret_assign => "final_destination = Parrot_str_new(interp, return_data, 0);\n Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"S\", final_destination);", - sig_char => "S" }, - v => { as_proto => "void", - return_type => "void *", - sig_char => "v", - ret_assign => "", - func_call_assign => "" - }, - P => { as_proto => "PMC *", sig_char => "P" }, - O => { as_proto => "PMC *", returns => "", sig_char => "Pi" }, - J => { as_proto => "PARROT_INTERP", returns => "", sig_char => "" }, - S => { as_proto => "STRING *", sig_char => "S" }, - I => { as_proto => "INTVAL", sig_char => "I" }, - N => { as_proto => "FLOATVAL", sig_char => "N" }, - b => { as_proto => "void *", as_return => "", sig_char => "S" }, - B => { as_proto => "char **", as_return => "", sig_char => "S" }, - # These should be replaced by modifiers in the future - 2 => { as_proto => "short *", sig_char => "P", return_type => "short", - ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, - 3 => { as_proto => "int *", sig_char => "P", return_type => "int", - ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, - 4 => { as_proto => "long *", sig_char => "P", return_type => "long", - ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, - L => { as_proto => "long *", as_return => "" }, - T => { as_proto => "char **", as_return => "" }, - V => { as_proto => "void **", as_return => "", sig_char => "P" }, - '@' => { as_proto => "PMC *", as_return => "", cname => "xAT_", sig_char => 'Ps' }, -); - -for (values %sig_table) { - if (not exists $_->{as_return}) { $_->{as_return} = $_->{as_proto} } - if (not exists $_->{return_type}) { $_->{return_type} = $_->{as_proto} } - if (not exists $_->{return_type_decl}) { $_->{return_type_decl} = $_->{return_type} } - if (not exists $_->{ret_assign} and exists $_->{sig_char}) { - $_->{ret_assign} = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "' - . $_->{sig_char} . '", return_data);'; - } - if (not exists $_->{func_call_assign}) { - $_->{func_call_assign} = "return_data = " - } -} - - my $temp_cnt = 0; my (@put_pointer, @put_pointer_nci_too, @nci_defs); my %seen; @@ -370,15 +316,15 @@ { typedef $ret_type (*func_t)($proto); func_t pointer; - void *orig_func; + void *raw_func; $call_object_decl $return_data_decl $other_decl Parrot_pcc_fill_params_from_c_args(interp, call_object, \"$sig\"$fill_params); $extra_preamble - GETATTR_NCI_orig_func(interp, self, orig_func); - pointer = (func_t)D2FPTR(orig_func); + GETATTR_NCI_raw_func(interp, self, raw_func); + pointer = (func_t)D2FPTR(raw_func); $return_assign ($ret_type)(*pointer)($call_params); $final_assign $extra_postamble @@ -393,14 +339,14 @@ pcf_${return}_(PARROT_INTERP, PMC *self) { $ret_type (*pointer)(void); - void *orig_func; + void *raw_func; $return_data_decl $other_decl $call_object_decl $extra_preamble - GETATTR_NCI_orig_func(interp, self, orig_func); - pointer = ($ret_type (*)(void))D2FPTR(orig_func); + GETATTR_NCI_raw_func(interp, self, raw_func); + pointer = ($ret_type (*)(void))D2FPTR(raw_func); $return_assign ($ret_type)(*pointer)(); $final_assign $extra_postamble Index: lib/Parrot/NativeCall.pm =================================================================== --- lib/Parrot/NativeCall.pm (revision 0) +++ lib/Parrot/NativeCall.pm (revision 0) @@ -0,0 +1,128 @@ +# Copyright (C) 2009, Parrot Foundation. +# $Id$ + +package Parrot::NativeCall; + +use strict; +use warnings; + +use base 'Exporter'; +our @EXPORT_OK = qw{ signature_nci_to_pcc }; + +=head1 NAME + +Parrot::NativeCall - Tools for building native call routines + +=head1 SYNOPSIS + + use Parrot::NativeCall 'signature_nci_to_pcc'; + + my $pcc_sig = signature_nci_to_pcc("v VVV"); + +=head1 DESCRIPTION + +C knows how to map NCI signatures to nci frame +functions. + +=head1 GLOBAL VARIABLES + +=over + +=item C<%signature_table> + +Maps NCI signature items to elements of a native call routine. + +For use by F. New code should probably write +a wrapper in this module to encapsulate the access. + +=cut + +our %signature_table = ( + p => { + as_proto => "void *", + other_decl => "PMC * const final_destination = pmc_new(interp, enum_class_UnManagedStruct);", + sig_char => "P", + ret_assign => "VTABLE_set_pointer(interp, final_destination, return_data);\n Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"P\", final_destination);", + }, + i => { as_proto => "int", sig_char => "I" }, + l => { as_proto => "long", sig_char => "I" }, + c => { as_proto => "char", sig_char => "I" }, + s => { as_proto => "short", sig_char => "I" }, + f => { as_proto => "float", sig_char => "N" }, + d => { as_proto => "double", sig_char => "N" }, + t => { as_proto => "char *", + other_decl => "STRING *final_destination;", + ret_assign => "final_destination = Parrot_str_new(interp, return_data, 0);\n Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"S\", final_destination);", + sig_char => "S" }, + v => { as_proto => "void", + return_type => "void *", + sig_char => "v", + ret_assign => "", + func_call_assign => "" + }, + P => { as_proto => "PMC *", sig_char => "P" }, + O => { as_proto => "PMC *", returns => "", sig_char => "Pi" }, + J => { as_proto => "PARROT_INTERP", returns => "", sig_char => "" }, + S => { as_proto => "STRING *", sig_char => "S" }, + I => { as_proto => "INTVAL", sig_char => "I" }, + N => { as_proto => "FLOATVAL", sig_char => "N" }, + b => { as_proto => "void *", as_return => "", sig_char => "S" }, + B => { as_proto => "char **", as_return => "", sig_char => "S" }, + # These should be replaced by modifiers in the future + 2 => { as_proto => "short *", sig_char => "P", return_type => "short", + ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, + 3 => { as_proto => "int *", sig_char => "P", return_type => "int", + ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, + 4 => { as_proto => "long *", sig_char => "P", return_type => "long", + ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, + L => { as_proto => "long *", as_return => "" }, + T => { as_proto => "char **", as_return => "" }, + V => { as_proto => "void **", as_return => "", sig_char => "P" }, + '@' => { as_proto => "PMC *", as_return => "", cname => "xAT_", sig_char => 'Ps' }, +); + +for (values %signature_table) { + if (not exists $_->{as_return}) { $_->{as_return} = $_->{as_proto} } + if (not exists $_->{return_type}) { $_->{return_type} = $_->{as_proto} } + if (not exists $_->{return_type_decl}) { $_->{return_type_decl} = $_->{return_type} } + if (not exists $_->{ret_assign} and exists $_->{sig_char}) { + $_->{ret_assign} = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "' + . $_->{sig_char} . '", return_data);'; + } + if (not exists $_->{func_call_assign}) { + $_->{func_call_assign} = "return_data = " + } +} + +=back + +=head1 FUNCTIONS + +=over + +=item C + +Converts an NCI signature to a PCC signature. + +=cut + +sub signature_nci_to_pcc { + my $nci_sig = shift; + my ($nci_ret, $nci_params) = $nci_sig =~ /^(.)\s*(\S*)/; + my $pcc_ret = $signature_table{$nci_ret}{sig_char}; + my $pcc_params = join '', map $signature_table{$_}{sig_char}, split //, $nci_params; + return "${pcc_params}->${pcc_ret}"; +} + +1; + +=back + +=cut + +# Local Variables: +# mode: cperl +# cperl-indent-level: 4 +# fill-column: 100 +# End: +# vim: expandtab shiftwidth=4: Index: include/parrot/nci.h =================================================================== --- include/parrot/nci.h (revision 42085) +++ include/parrot/nci.h (working copy) @@ -15,6 +15,17 @@ #include "parrot/parrot.h" +/* NCI PMC interface constants */ +/* &gen_from_enum(nci.pasm) */ +typedef enum { + PARROT_NCI_ARITY, + PARROT_NCI_PCC_SIGNATURE_PARAMS, + PARROT_NCI_PCC_SIGNATURE_RET, + PARROT_NCI_LONG_SIGNATURE, + PARROT_NCI_MULTI_SIG, +} parrot_nci_enum_t; +/* &end_gen */ + void *build_call_func(PARROT_INTERP, SHIM(PMC *pmc_nci), NOTNULL(STRING *signature), NOTNULL(int *jitted)); #endif /* PARROT_NCI_H_GUARD */ Index: t/pmc/nci.t =================================================================== --- t/pmc/nci.t (revision 42085) +++ t/pmc/nci.t (working copy) @@ -5,8 +5,19 @@ use strict; use warnings; use lib qw( . lib ../lib ../../lib ); +use Parrot::BuildUtil; +use Parrot::NativeCall 'signature_nci_to_pcc'; + +my @nci_sigs; +BEGIN { + @nci_sigs = + grep {$_} + map {chomp; s/^\s*//; s/\s*$//; s/#.*$//; $_} + split /\n/, Parrot::BuildUtil::slurp_file('src/call_list.txt'); +} + use Test::More; -use Parrot::Test tests => 70; +use Parrot::Test tests => (70 + @nci_sigs); use Parrot::Config qw(%PConfig); =head1 NAME @@ -32,6 +43,27 @@ $ENV{TEST_PROG_ARGS} ||= ''; +foreach my $nci_sig (@nci_sigs) { + my ($nci_ret, $nci_params) = $nci_sig =~ /\S+/g; + $nci_params ||= ''; + my $pcc_sig = signature_nci_to_pcc($nci_sig); + pir_output_is( << "CODE", "$pcc_sig\n", "NCI PMC signatures equivalent to nativecall.pl ('$nci_sig')" ); +.include "nci.pasm" +.sub test :main + .local pmc nci + nci = new ['NCI'] + nci = "${nci_ret}${nci_params}" + .local string s + s = nci[ .PARROT_NCI_PCC_SIGNATURE_PARAMS ] + print s + print "->" + s = nci[ .PARROT_NCI_PCC_SIGNATURE_RET ] + print s + print "\\n" +.end +CODE +} + SKIP: { unless ( -e "runtime/parrot/dynext/libnci_test$PConfig{load_ext}" ) { skip( "Please make libnci_test$PConfig{load_ext}", Test::Builder->expected_tests() ); @@ -2310,7 +2342,7 @@ skip( "nci_dlvar_int hangs on HP-UX", 1 ) if $^O eq 'hpux'; - pir_output_is( << 'CODE', << 'OUTPUT', "nci_vv and nci_dlvar_int" ); + pir_output_is( << 'CODE', << 'OUTPUT', "nci_v_2 and nci_dlvar_int" ); .include "datatypes.pasm" @@ -2341,21 +2373,21 @@ print $I2 print "\n" - .local pmc nci_vv - nci_vv = dlfunc libnci_test, "nci_vv", "vv" - nci_vv() + .local pmc nci_v_2 + nci_v_2 = dlfunc libnci_test, "nci_v_2", "v" + nci_v_2() $I1 = nci_dlvar_int[0] print $I1 print "\n" - nci_vv() + nci_v_2() $I1 = nci_dlvar_int[0] print $I1 print "\n" - nci_vv() + nci_v_2() $I1 = nci_dlvar_int[0] print $I1 print "\n" - nci_vv() + nci_v_2() $I1 = nci_dlvar_int[0] print $I1 print "\n" Index: config/gen/parrot_include.pm =================================================================== --- config/gen/parrot_include.pm (revision 42085) +++ config/gen/parrot_include.pm (working copy) @@ -39,13 +39,13 @@ include/parrot/library.h include/parrot/longopt.h include/parrot/multidispatch.h + include/parrot/nci.h include/parrot/packfile.h include/parrot/stat.h include/parrot/string.h include/parrot/pmc.h include/parrot/warnings.h include/parrot/gc_api.h - src/pmc/timer.pmc src/utils.c ) ]; $data{generated_files} = [ qw(