Ticket #1105: pre_merge.patch

File pre_merge.patch, 29.6 KB (added by plobsing, 12 years ago)

patches from TT#1147 applied to trunk

  • DEPRECATED.pod 

    diff --git a/DEPRECATED.pod b/DEPRECATED.pod
index 76a372a..92eedb5 100644
    a b  
    7474 
    7575L<https://trac.parrot.org/parrot/ticket/918> 
    7676 
     77=item Use of 'v' in NCI parameter lists [eligible in 2.1] 
     78 
     79An empty parameter list suffices to indicate no parameters to an NCI call. 
     80This has been marked as deprecated in PDD16 for 2 years. 
     81 
     82F<pdds/draft/pdd16_native_call.pod> 
     83 
    7784=back 
    7885 
    7986=head1 Opcodes 

  • config/gen/parrot_include.pm 

    diff --git a/config/gen/parrot_include.pm b/config/gen/parrot_include.pm
index 58dcb5d..b89d14b 100644
    a b  
    3939        include/parrot/library.h 
    4040        include/parrot/longopt.h 
    4141        include/parrot/multidispatch.h 
     42        include/parrot/nci.h 
    4243        include/parrot/packfile.h 
    4344        include/parrot/stat.h 
    4445        include/parrot/string.h 
    4546        include/parrot/pmc.h 
    4647        include/parrot/warnings.h 
    4748        include/parrot/gc_api.h 
    48         src/pmc/timer.pmc 
    4949        src/utils.c 
    5050    ) ]; 
    5151    $data{generated_files} = [ qw( 

  • include/parrot/nci.h 

    diff --git a/include/parrot/nci.h b/include/parrot/nci.h
index 1ff85c4..86ad460 100644
    a b  
    1515 
    1616#include "parrot/parrot.h" 
    1717 
     18/* NCI PMC interface constants */ 
     19/* &gen_from_enum(nci.pasm) */ 
     20typedef enum { 
     21    PARROT_NCI_ARITY, 
     22    PARROT_NCI_PCC_SIGNATURE_PARAMS, 
     23    PARROT_NCI_PCC_SIGNATURE_RET, 
     24    PARROT_NCI_LONG_SIGNATURE, 
     25    PARROT_NCI_MULTI_SIG, 
     26} parrot_nci_enum_t; 
     27/* &end_gen */ 
     28 
    1829void *build_call_func(PARROT_INTERP, SHIM(PMC *pmc_nci), NOTNULL(STRING *signature), NOTNULL(int *jitted)); 
    1930 
    2031#endif /* PARROT_NCI_H_GUARD */ 

  • (a) /dev/null vs. (b) b/lib/Parrot/NativeCall.pm 

    diff --git a/lib/Parrot/NativeCall.pm b/lib/Parrot/NativeCall.pm
new file mode 100644
index 0000000..d0145f8
    a b  
     1# Copyright (C) 2009, Parrot Foundation. 
     2# $Id$ 
     3 
     4package Parrot::NativeCall; 
     5 
     6use strict; 
     7use warnings; 
     8 
     9use base 'Exporter'; 
     10our @EXPORT_OK = qw{ signature_nci_to_pcc }; 
     11 
     12=head1 NAME 
     13 
     14Parrot::NativeCall - Tools for building native call routines 
     15 
     16=head1 SYNOPSIS 
     17 
     18  use Parrot::NativeCall 'signature_nci_to_pcc'; 
     19 
     20  my $pcc_sig = signature_nci_to_pcc("v  VVV"); 
     21 
     22=head1 DESCRIPTION 
     23 
     24C<Parrot::NativeCall> knows how to map NCI signatures to nci frame 
     25functions. 
     26 
     27=head1 GLOBAL VARIABLES 
     28 
     29=over 
     30 
     31=item C<%signature_table> 
     32 
     33Maps NCI signature items to elements of a native call routine. 
     34 
     35For use by F<tools/build/nativecall.pl>. New code should probably write 
     36a wrapper in this module to encapsulate the access. 
     37 
     38=cut 
     39 
     40our %signature_table = ( 
     41    p => { 
     42        as_proto => "void *", 
     43        other_decl => "PMC * const final_destination = pmc_new(interp, enum_class_UnManagedStruct);", 
     44        sig_char => "P", 
     45        ret_assign => "VTABLE_set_pointer(interp, final_destination, return_data);\n    Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"P\", final_destination);", 
     46    }, 
     47    i => { as_proto => "int",    sig_char => "I" }, 
     48    l => { as_proto => "long",   sig_char => "I" }, 
     49    c => { as_proto => "char",   sig_char => "I" }, 
     50    s => { as_proto => "short",  sig_char => "I" }, 
     51    f => { as_proto => "float",  sig_char => "N" }, 
     52    d => { as_proto => "double", sig_char => "N" }, 
     53    t => { as_proto => "char *", 
     54           other_decl => "STRING *final_destination;", 
     55           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);", 
     56           sig_char => "S" }, 
     57    v => { as_proto => "void", 
     58           return_type => "void *", 
     59           sig_char => "v", 
     60           ret_assign => "", 
     61           func_call_assign => "" 
     62         }, 
     63    P => { as_proto => "PMC *", sig_char => "P" }, 
     64    O => { as_proto => "PMC *", returns => "", sig_char => "Pi" }, 
     65    J => { as_proto => "PARROT_INTERP", returns => "", sig_char => "" }, 
     66    S => { as_proto => "STRING *", sig_char => "S" }, 
     67    I => { as_proto => "INTVAL", sig_char => "I" }, 
     68    N => { as_proto => "FLOATVAL", sig_char => "N" }, 
     69    b => { as_proto => "void *", as_return => "", sig_char => "S" }, 
     70    B => { as_proto => "char **", as_return => "", sig_char => "S" }, 
     71    # These should be replaced by modifiers in the future 
     72    2 => { as_proto => "short *",  sig_char => "P", return_type => "short", 
     73           ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, 
     74    3 => { as_proto => "int *",  sig_char => "P", return_type => "int", 
     75           ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, 
     76    4 => { as_proto => "long *",  sig_char => "P", return_type => "long", 
     77           ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, 
     78    L => { as_proto => "long *", as_return => "" }, 
     79    T => { as_proto => "char **", as_return => "" }, 
     80    V => { as_proto => "void **", as_return => "", sig_char => "P" }, 
     81    '@' => { as_proto => "PMC *", as_return => "", cname => "xAT_", sig_char => 'Ps' }, 
     82); 
     83 
     84for (values %signature_table) { 
     85    if (not exists $_->{as_return}) { $_->{as_return} = $_->{as_proto} } 
     86    if (not exists $_->{return_type}) { $_->{return_type} = $_->{as_proto} } 
     87    if (not exists $_->{return_type_decl}) { $_->{return_type_decl} = $_->{return_type} } 
     88    if (not exists $_->{ret_assign} and exists $_->{sig_char}) { 
     89        $_->{ret_assign} = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "' 
     90                           . $_->{sig_char} . '", return_data);'; 
     91    } 
     92    if (not exists $_->{func_call_assign}) { 
     93        $_->{func_call_assign} = "return_data = " 
     94    } 
     95} 
     96 
     97=back 
     98 
     99=head1 FUNCTIONS 
     100 
     101=over 
     102 
     103=item C<signature_nci_to_pcc> 
     104 
     105Converts an NCI signature to a PCC signature. 
     106 
     107=cut 
     108 
     109sub signature_nci_to_pcc { 
     110    my $nci_sig = shift; 
     111    my ($nci_ret, $nci_params) = $nci_sig =~ /^(.)\s*(\S*)/; 
     112    my $pcc_ret =  $signature_table{$nci_ret}{sig_char}; 
     113    my $pcc_params = join '', map $signature_table{$_}{sig_char}, split //, $nci_params; 
     114    return "${pcc_params}->${pcc_ret}"; 
     115} 
     116 
     1171; 
     118 
     119=back 
     120 
     121=cut 
     122 
     123# Local Variables: 
     124#   mode: cperl 
     125#   cperl-indent-level: 4 
     126#   fill-column: 100 
     127# End: 
     128# vim: expandtab shiftwidth=4: 

  • src/extend.c 

    diff --git a/src/extend.c b/src/extend.c
index 7d13cc7..5d247bd 100644
    a b  
    17471747        (char *) NULL, 0); 
    17481748    Parrot_PMC sub = pmc_new(interp, enum_class_NCI); 
    17491749    VTABLE_set_pointer_keyed_str(interp, sub, sig, F2DPTR(func)); 
    1750     PObj_get_FLAGS(sub) |= PObj_private1_FLAG; 
    17511750    return sub; 
    17521751} 
    17531752 

  • src/ops/core.ops 

    diff --git a/src/ops/core.ops b/src/ops/core.ops
index 0b78166..eae4b8d 100644
    a b  
    13221322    else { 
    13231323        $1 = pmc_new(interp, enum_class_NCI); 
    13241324        VTABLE_set_pointer_keyed_str(interp, $1, $4, F2DPTR(p)); 
    1325         PObj_get_FLAGS($1) |= PObj_private1_FLAG; 
    13261325    } 
    13271326    Parrot_str_free_cstring(name); 
    13281327} 

  • src/pmc/nci.pmc 

    diff --git a/src/pmc/nci.pmc b/src/pmc/nci.pmc
index ef5c5e4..9da11e8 100644
    a b  
    1818 
    1919*/ 
    2020 
     21#include "parrot/nci.h" 
     22 
    2123typedef INTVAL (*nci_sub_t)(PARROT_INTERP, PMC *); 
    22 typedef INTVAL (*nci_jit_sub_t)(PARROT_INTERP, PMC *, char *); 
    23  
    24 void pcc_params(PARROT_INTERP, STRING *sig, Parrot_NCI_attributes * const nci_info, 
    25                 size_t sig_length); 
    26 void pcc_params(PARROT_INTERP, STRING *sig, Parrot_NCI_attributes * const nci_info, 
    27                 size_t sig_length) { 
    28     char    param_buf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }; 
    29     char   *param_sig    = sig_length <= 7 
    30                          ? param_buf 
    31                          : mem_allocate_n_typed(sig_length, char); 
    32     size_t  j            = 0; 
    33     size_t  i; 
    34  
    35     for (i = 1; i < sig_length; i++) { 
    36         INTVAL c = Parrot_str_indexed(interp, sig, i); 
     24typedef nci_sub_t nci_jit_sub_t; 
    3725 
    38         switch (c) { 
    39             case (INTVAL)'0':    /* null ptr or such - doesn't consume a reg */ 
    40                 break; 
    41             case (INTVAL)'f': 
    42             case (INTVAL)'N': 
    43             case (INTVAL)'d': 
    44                 param_sig[j++] = 'N'; 
    45                 break; 
    46             case (INTVAL)'I':   /* INTVAL */ 
    47             case (INTVAL)'l':   /* long */ 
    48             case (INTVAL)'i':   /* int */ 
    49             case (INTVAL)'s':   /* short */ 
    50             case (INTVAL)'c':   /* char */ 
    51                 param_sig[j++] = 'I'; 
    52                 break; 
    53             case (INTVAL)'S': 
    54             case (INTVAL)'t':   /* string, pass a cstring */ 
    55                 param_sig[j++] = 'S'; 
    56                 break; 
    57             case (INTVAL)'J':   /* interpreter */ 
    58                 break; 
    59             case (INTVAL)'p':   /* push pmc->data */ 
    60             case (INTVAL)'O':   /* push PMC * object in P2 */ 
    61             case (INTVAL)'P':   /* push PMC * */ 
    62             case (INTVAL)'V':   /* push PMC * */ 
    63                 param_sig[j++] = 'P'; 
    64             case (INTVAL)'v': 
    65                 break; 
    66                 /* I have no idea how to handle these */ 
    67             case (INTVAL)'2': 
    68             case (INTVAL)'3': 
    69             case (INTVAL)'4': 
    70                 param_sig[j++] = 'I'; 
    71                 break; 
    72             case (INTVAL)'@': 
    73                 param_sig[j++] = '@'; 
    74                 break; 
    75             case (INTVAL)'b': /* buffer (void*) pass Buffer_bufstart(SReg) */ 
    76             case (INTVAL)'B': /* buffer (void**) pass &Buffer_bufstart(SReg) */ 
    77                 param_sig[j++] = 'S'; 
    78                 break; 
    79             default: 
    80                 if (sig_length > 7) 
    81                     mem_sys_free(param_sig); 
    82                 Parrot_ex_throw_from_c_args(interp, NULL, 
     26#define NCI_raw_FLAG    PObj_private0_FLAG 
     27 
     28STRING *pcc_sig_params(PARROT_INTERP, STRING *sig); 
     29STRING *pcc_sig_params(PARROT_INTERP, STRING *sig) { 
     30    size_t sig_len = Parrot_str_byte_length(interp, sig); 
     31    char param_buf[sig_len*2]; 
     32 
     33    size_t i, j; 
     34 
     35    for (i = 1, j = 0; i < sig_len; i++) { 
     36        INTVAL c = Parrot_str_indexed(interp, sig, i); 
     37        if (c > 127) { 
     38            Parrot_ex_throw_from_c_args(interp, NULL, 
    8339                    EXCEPTION_JIT_ERROR, 
    84                     "Unknown param Signature %c\n", (char)c); 
    85                 break; 
     40                    "Unknown param type at %d in signature '%S' (way too big)\n", i, sig); 
     41        } 
     42        else { 
     43            switch ((char)c) { 
     44                case 'v': 
     45                case '0': 
     46                case 'J': 
     47                    break; 
     48                case 'N': 
     49                case 'd': 
     50                case 'f': 
     51                    param_buf[j++] = 'N'; 
     52                    break; 
     53                case 'I': 
     54                case 'l': 
     55                case 'i': 
     56                case 's': 
     57                case 'c': 
     58                    param_buf[j++] = 'I'; 
     59                    break; 
     60                case 'S': 
     61                case 't': 
     62                case 'b': 
     63                case 'B': 
     64                    param_buf[j++] = 'S'; 
     65                    break; 
     66                case 'P': 
     67                case 'p': 
     68                case 'V': 
     69                case '2': 
     70                case '3': 
     71                case '4': 
     72                    param_buf[j++] = 'P'; 
     73                    break; 
     74                case 'O': 
     75                    param_buf[j++] = 'P'; 
     76                    param_buf[j++] = 'i'; 
     77                    break; 
     78                case '@': 
     79                    param_buf[j++] = 'P'; 
     80                    param_buf[j++] = 's'; 
     81                    break; 
     82                default: 
     83                    Parrot_ex_throw_from_c_args(interp, NULL, 
     84                            EXCEPTION_JIT_ERROR, 
     85                            "Unknown param type at %d in signature '%S'\n", i, sig); 
     86            } 
    8687        } 
    8788    } 
    8889 
    89     PARROT_ASSERT(j <= sig_length); 
     90    return string_make(interp, param_buf, j, NULL, PObj_constant_FLAG); 
     91} 
    9092 
    91     /* use only the signature-significant part of the string buffer */ 
    92     if (j) { 
    93         nci_info->pcc_params_signature = string_make(interp, param_sig, j, 
    94             NULL, PObj_constant_FLAG); 
     93STRING *pcc_sig_ret(PARROT_INTERP, STRING *sig); 
     94STRING *pcc_sig_ret(PARROT_INTERP, STRING *sig) { 
     95    INTVAL c = Parrot_str_indexed(interp, sig, 0); 
     96    if (c > 127) { 
     97        Parrot_ex_throw_from_c_args(interp, NULL, 
     98                EXCEPTION_JIT_ERROR, 
     99                "Unknown return type at %d in signature '%S' (way too big)\n", 0, sig); 
     100    } 
     101    else { 
     102        switch ((char)c) { 
     103            case 'v': 
     104                return CONST_STRING(interp, "v"); 
     105            case 'N': 
     106            case 'f': 
     107            case 'd': 
     108                return CONST_STRING(interp, "N"); 
     109            case 'I': 
     110            case 'l': 
     111            case 'i': 
     112            case 's': 
     113            case 'c': 
     114                return CONST_STRING(interp, "I"); 
     115            case 'S': 
     116            case 't': 
     117                return CONST_STRING(interp, "S"); 
     118            case 'p': 
     119            case 'P': 
     120                return CONST_STRING(interp, "P"); 
     121            case '2': 
     122            case '3': 
     123            case '4': 
     124                return CONST_STRING(interp, "P"); 
     125            default: 
     126                Parrot_ex_throw_from_c_args(interp, NULL, 
     127                        EXCEPTION_JIT_ERROR, 
     128                        "Unknown return type at %d in signature '%S'\n", 0, sig); 
     129        } 
    95130    } 
    96     else 
    97         nci_info->pcc_params_signature = CONST_STRING(interp, ""); 
    98  
    99     if (sig_length > 7) 
    100         mem_sys_free(param_sig); 
    101131} 
    102132 
    103133/* actually build the NCI thunk */ 
    … …  
    106136static 
    107137nci_sub_t build_func(PARROT_INTERP, PMC *pmc, Parrot_NCI_attributes *nci_info) 
    108138{ 
    109     STRING    *key        = nci_info->signature; 
    110     size_t     key_length = Parrot_str_byte_length(interp, key); 
     139    STRING    *key        = nci_info->nci_signature; 
    111140    int       jitted      = 0; 
    112141 
    113     pcc_params(interp, key, nci_info, key_length); 
    114  
    115     /* Arity is length of that string minus one (the return type). */ 
    116     nci_info->arity       = key_length - 1; 
    117  
    118142    /* Build call function. */ 
    119143    nci_info->func        = (PMC *)(build_call_func(interp, pmc, key, &jitted)); 
    120     nci_info->jitted      = jitted; 
    121144 
    122145    return (nci_sub_t)nci_info->func; 
    123146} 
    124147 
    125148 
    126149pmclass NCI auto_attrs { 
    127     ATTR STRING    *signature;              /* The signature. */ 
    128     ATTR void      *func;                   /* Function pointer to call. */ 
    129     ATTR void      *orig_func;              /* Function pointer 
    130                                              * used to create func */ 
    131     ATTR STRING    *pcc_params_signature;   /* The signature. */ 
    132     ATTR STRING    *long_signature;         /* The full signature. */ 
    133     ATTR PMC       *multi_sig;              /* type tuple array (?) */ 
    134     ATTR INTVAL     arity;                  /* Cached arity of the NCI. */ 
    135     ATTR INTVAL     jitted;                 /* Is this a jitted NCI stub. */ 
     150    /* Signature Attributes */ 
     151    ATTR STRING    *nci_signature;          /* The NCI signature */ 
     152    ATTR STRING    *pcc_signature_ret;      /* The PCC return signature */ 
     153    ATTR STRING    *pcc_signature_param;    /* The PCC param signature */ 
     154 
     155    /* Function Pointers */ 
     156    ATTR void      *func;                   /* Function pointer to call */ 
     157    ATTR void      *orig_func;              /* Function pointer being wrapped */ 
     158 
     159    /* Sub PMC Attributes */ 
     160    ATTR INTVAL     arity;                  /* Number of params taken */ 
     161    /* MMD Attributes */ 
     162    ATTR PMC       *multi_sig; 
     163    ATTR STRING    *long_signature; 
    136164 
    137165/* 
    138166 
    … …  
    147175    METHOD get_multisig() { 
    148176        PMC *sig; 
    149177        GET_ATTR_multi_sig(INTERP, SELF, sig); 
    150         if (PMC_IS_NULL(sig)) 
     178        if (sig == NULL) { 
    151179            sig = PMCNULL; 
     180        } 
    152181        RETURN(PMC *sig); 
    153182    } 
    154183 
    … …  
    178207 
    179208    VTABLE void init() { 
    180209        /* Mark that we're not a raw NCI. */ 
    181         PObj_flag_CLEAR(private2, SELF); 
     210        PObj_get_FLAGS(SELF) &= ~NCI_raw_FLAG; 
     211        /* Mark that we have a custom gc marker */ 
    182212        PObj_custom_mark_SET(SELF); 
    183213    } 
    184214 
    185215/* 
    186216 
    187 =item C<void set_pointer_keyed_str(STRING *key, void *func)> 
     217=item C<void *get_pointer()> 
    188218 
    189 Sets the specified function pointer and signature (C<*key>). 
     219=item C<void set_pointer(void *ptr)> 
     220 
     221Get/Set the pointer being wrapped. Setting through this interface sets 
     222the raw flag. 
    190223 
    191224=cut 
    192225 
    … …  
    194227 
    195228    VTABLE void set_pointer(void *ptr) { 
    196229        SET_ATTR_orig_func(INTERP, SELF, ptr); 
    197         PObj_flag_SET(private2, SELF); 
     230        PObj_get_FLAGS(SELF) |= NCI_raw_FLAG; 
    198231    } 
    199232 
    200233    VTABLE void *get_pointer() { 
    201234        return PARROT_NCI(SELF)->orig_func; 
    202235    } 
    203236 
     237/* 
     238 
     239=item C<void set_pointer_keyed_str(STRING *key, void *func)> 
     240 
     241Roughly equivalent to C<set_string(key)> and C<set_pointer(func)>. 
     242Setting through this interface clears the raw flag. 
     243 
     244=cut 
     245 
     246*/ 
     247 
    204248    VTABLE void set_pointer_keyed_str(STRING *key, void *func) { 
    205         Parrot_NCI_attributes * const nci_info   = PARROT_NCI(SELF); 
    206  
    207         /* Store the original function and signature. */ 
    208         SET_ATTR_orig_func(INTERP, SELF, func); 
    209  
    210         /* ensure that the STRING signature is constant */ 
    211         if (!PObj_constant_TEST(key)) { 
    212             char * const key_c      = Parrot_str_to_cstring(INTERP, key); 
    213             size_t       key_length = Parrot_str_byte_length(interp, key); 
    214             key                     = string_make(interp, key_c, key_length, 
    215                                         NULL, PObj_constant_FLAG); 
    216             Parrot_str_free_cstring(key_c); 
     249        SELF.set_string_native(key); 
     250        SELF.set_pointer(func); 
     251        PObj_get_FLAGS(SELF) &= ~NCI_raw_FLAG; 
     252    } 
     253 
     254/* 
     255 
     256=item C<STRING *get_string()> 
     257 
     258=item C<void set_string(STRING *str)> 
     259 
     260Get/Set the NCI signature. 
     261 
     262=cut 
     263 
     264*/ 
     265 
     266    VTABLE STRING *get_string() { 
     267        return PARROT_NCI(SELF)->nci_signature; 
     268    } 
     269 
     270    VTABLE void set_string_native(STRING *str) { 
     271        if (!PObj_constant_TEST(str)) { 
     272            str = Parrot_str_copy(INTERP, str); 
    217273        } 
     274        SET_ATTR_nci_signature(INTERP, SELF, str); 
    218275 
    219         nci_info->signature = key; 
     276        /* set up derivative attributes */ 
     277        SET_ATTR_pcc_signature_param(INTERP, SELF, pcc_sig_params(INTERP, str)); 
     278        SET_ATTR_pcc_signature_ret(INTERP, SELF, pcc_sig_ret(INTERP, str)); 
     279        /* Arity is length of the NCI signature minus one (the return type). */ 
     280        SET_ATTR_arity(INTERP, SELF, Parrot_str_byte_length(INTERP, str) - 1); 
    220281    } 
    221282 
    222283/* 
    … …  
    232293        if (PARROT_NCI(SELF)) { 
    233294            Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); 
    234295 
    235             Parrot_gc_mark_STRING_alive(interp, nci_info->signature); 
    236             Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_params_signature); 
     296            Parrot_gc_mark_STRING_alive(interp, nci_info->nci_signature); 
     297            Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_signature_param); 
     298            Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_signature_ret); 
    237299            Parrot_gc_mark_STRING_alive(interp, nci_info->long_signature); 
    238300            Parrot_gc_mark_PMC_alive(interp, nci_info->multi_sig); 
    239301        } 
    … …  
    262324         * ManagedStruct or Buffer? 
    263325         */ 
    264326        nci_info_ret->func                  = nci_info_self->func; 
    265         nci_info_ret->orig_func             = nci_info_self->orig_func; 
    266         nci_info_ret->signature             = nci_info_self->signature; 
    267         nci_info_ret->pcc_params_signature  = nci_info_self->pcc_params_signature; 
     327        nci_info_ret->orig_func              = nci_info_self->orig_func; 
     328        nci_info_ret->nci_signature         = nci_info_self->nci_signature; 
     329        nci_info_ret->pcc_signature_param   = nci_info_self->pcc_signature_param; 
     330        nci_info_ret->pcc_signature_ret     = nci_info_self->pcc_signature_ret; 
     331        nci_info_ret->long_signature        = nci_info_self->long_signature; 
     332        nci_info_ret->multi_sig             = nci_info_self->multi_sig; 
    268333        nci_info_ret->arity                 = nci_info_self->arity; 
    269         nci_info_ret->jitted                = nci_info_self->jitted; 
    270334        PObj_get_FLAGS(ret)                |= (PObj_get_FLAGS(SELF) & 0x7); 
    271335 
    272336        return ret; 
    … …  
    306370        PMC                          *cont; 
    307371 
    308372        GET_ATTR_orig_func(INTERP, SELF, orig_func); 
    309         func = PObj_flag_TEST(private2, SELF) 
     373        func = PObj_get_FLAGS(SELF) & NCI_raw_FLAG 
    310374            ? (nci_sub_t) D2FPTR(orig_func) 
    311375            : (nci_sub_t) D2FPTR(nci_info->func); 
    312376 
    … …  
    320384                    "attempt to call NULL function"); 
    321385        } 
    322386 
    323         if (nci_info->jitted) { 
    324             nci_jit_sub_t jit_func = (nci_jit_sub_t) D2FPTR(nci_info->func); 
     387        func(INTERP, SELF); 
    325388 
    326             /* Parrot_eprintf(interp, "JITTED %S\n", nci_info->signature); */ 
    327             sig_str = Parrot_str_to_cstring(interp, nci_info->pcc_params_signature); 
    328             jit_func(INTERP, SELF, sig_str); 
    329             Parrot_str_free_cstring(sig_str); 
    330         } 
    331         else { 
    332             if (PObj_flag_TEST(private2, SELF)) { 
    333                 /* Parrot_eprintf(interp, "RAW NCI CALL\n"); */ 
    334             } 
    335             else { 
    336                 /* Parrot_eprintf(interp, "HACKED %S\n", nci_info->signature); */ 
    337             } 
    338             func(INTERP, SELF); 
    339         } 
    340389        cont = INTERP->current_cont; 
    341390 
    342391        /* 
    … …  
    397446 
    398447*/ 
    399448    METHOD arity() { 
    400         Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); 
    401         INTVAL arity = 0; 
    402  
    403         if (nci_info) { 
    404             if (!nci_info->func) 
    405                 build_func(INTERP, SELF, nci_info); 
    406             if (nci_info->func) { 
    407                 arity = nci_info->arity; 
    408                 RETURN(INTVAL arity); 
    409             } 
     449        INTVAL arity; 
     450        GET_ATTR_arity(INTERP, SELF, arity); 
     451        RETURN(INTVAL arity); 
     452    } 
     453 
     454/* 
     455 
     456=item C<INTVAL get_integer_keyed_int(INTVAL key)> 
     457 
     458=item C<STRING *get_string_keyed_int(INTVAL key)> 
     459 
     460=item C<PMC *get_pmc_keyed_int(INTVAL key)> 
     461 
     462Accessors for all attributes of this class not otherwise accessible through VTABLES. 
     463Integers are used for keys to make access easier for JIT. These are also available to 
     464PIR from F<runtime/parrot/include/nci.pasm> 
     465 
     466=over 
     467 
     468=item INTVAL keys 
     469 
     470C<PARROT_NCI_ARITY> 
     471 
     472=item STRING keys 
     473 
     474C<PARROT_NCI_PCC_SIGNATURE_PARAMS>, C<PARROT_NCI_PCC_SIGNATURE_RET>, 
     475C<PARROT_LONG_SIGNATURE> 
     476 
     477=item PMC keys 
     478 
     479C<PARROT_NCI_MULTI_SIG> 
     480 
     481=back 
     482 
     483=cut 
     484 
     485*/ 
     486 
     487    VTABLE INTVAL get_integer_keyed_int(INTVAL key) { 
     488        switch (key) { 
     489            case PARROT_NCI_ARITY: 
     490                return PARROT_NCI(SELF)->arity; 
     491            default: 
     492                Parrot_ex_throw_from_c_args(INTERP, NULL, 
     493                    EXCEPTION_INVALID_OPERATION, 
     494                    "Bad index for NCI.get_integer_keyed_int()"); 
     495        } 
     496    } 
     497 
     498    VTABLE STRING *get_string_keyed_int(INTVAL key) { 
     499        switch (key) { 
     500            case PARROT_NCI_PCC_SIGNATURE_PARAMS: 
     501                return PARROT_NCI(SELF)->pcc_signature_param; 
     502            case PARROT_NCI_PCC_SIGNATURE_RET: 
     503                return PARROT_NCI(SELF)->pcc_signature_ret; 
     504            case PARROT_NCI_LONG_SIGNATURE: 
     505                return PARROT_NCI(SELF)->long_signature; 
     506            default: 
     507                Parrot_ex_throw_from_c_args(INTERP, NULL, 
     508                    EXCEPTION_INVALID_OPERATION, 
     509                    "Bad index for NCI.get_string_keyed_int()"); 
    410510        } 
     511    } 
    411512 
    412         Parrot_ex_throw_from_c_args(INTERP, NULL, 
    413             EXCEPTION_INVALID_OPERATION, 
    414             "You cannot get the arity of an undefined NCI."); 
     513    VTABLE PMC *get_pmc_keyed_int(INTVAL key) { 
     514        PMC *retval; 
     515        switch (key) { 
     516            case PARROT_NCI_MULTI_SIG: 
     517                GET_ATTR_multi_sig(INTERP, SELF, retval); 
     518            default: 
     519                Parrot_ex_throw_from_c_args(INTERP, NULL, 
     520                    EXCEPTION_INVALID_OPERATION, 
     521                    "Bad index for NCI.get_pmc_keyed_int()"); 
     522        } 
     523        if (retval == NULL) { 
     524            retval = PMCNULL; 
     525        } 
     526        return retval; 
    415527    } 
    416528} 
    417529 

  • t/pmc/nci.t 

    diff --git a/t/pmc/nci.t b/t/pmc/nci.t
index 735f152..fbfca27 100644
    a b  
    55use strict; 
    66use warnings; 
    77use lib qw( . lib ../lib ../../lib ); 
     8use Parrot::BuildUtil; 
     9use Parrot::NativeCall 'signature_nci_to_pcc'; 
     10 
     11my @nci_sigs; 
     12BEGIN { 
     13    @nci_sigs = 
     14        grep {$_} 
     15        map {chomp; s/^\s*//; s/\s*$//; s/#.*$//; $_} 
     16        split /\n/, Parrot::BuildUtil::slurp_file('src/call_list.txt'); 
     17} 
     18 
    819use Test::More; 
    9 use Parrot::Test tests => 70; 
     20use Parrot::Test tests => (70 + @nci_sigs); 
    1021use Parrot::Config qw(%PConfig); 
    1122 
    1223=head1 NAME 
    … …  
    3243 
    3344$ENV{TEST_PROG_ARGS} ||= ''; 
    3445 
     46foreach my $nci_sig (@nci_sigs) { 
     47    my ($nci_ret, $nci_params) = $nci_sig =~ /\S+/g; 
     48    $nci_params ||= ''; 
     49    my $pcc_sig = signature_nci_to_pcc($nci_sig); 
     50    pir_output_is( << "CODE", "$pcc_sig\n", "NCI PMC signatures equivalent to nativecall.pl ('$nci_sig')" ); 
     51.include "nci.pasm" 
     52.sub test :main 
     53    .local pmc nci 
     54    nci = new ['NCI'] 
     55    nci = "${nci_ret}${nci_params}" 
     56    .local string s 
     57    s = nci[ .PARROT_NCI_PCC_SIGNATURE_PARAMS ] 
     58    print s 
     59    print "->" 
     60    s = nci[ .PARROT_NCI_PCC_SIGNATURE_RET ] 
     61    print s 
     62    print "\\n" 
     63.end 
     64CODE 
     65} 
     66 
    3567SKIP: { 
    3668    unless ( -e "runtime/parrot/dynext/libnci_test$PConfig{load_ext}" ) { 
    3769        skip( "Please make libnci_test$PConfig{load_ext}", Test::Builder->expected_tests() ); 

  • tools/build/nativecall.pl 

    diff --git a/tools/build/nativecall.pl b/tools/build/nativecall.pl
index 9edd1a0..06341a6 100644
    a b  
    3030use strict; 
    3131use warnings; 
    3232 
     33use lib 'lib'; 
     34use Parrot::NativeCall; 
     35 
    3336my $opt_warndups = 0; 
    3437 
    3538# This file will eventually be compiled 
    … …  
    3740 
    3841print_head( \@ARGV ); 
    3942 
    40  
    41 my %sig_table = ( 
    42     p => { 
    43         as_proto => "void *", 
    44         other_decl => "PMC * const final_destination = pmc_new(interp, enum_class_UnManagedStruct);", 
    45         sig_char => "P", 
    46         ret_assign => "VTABLE_set_pointer(interp, final_destination, return_data);\n    Parrot_pcc_fill_returns_from_c_args(interp, call_object, \"P\", final_destination);", 
    47     }, 
    48     i => { as_proto => "int",    sig_char => "I" }, 
    49     l => { as_proto => "long",   sig_char => "I" }, 
    50     c => { as_proto => "char",   sig_char => "I" }, 
    51     s => { as_proto => "short",  sig_char => "I" }, 
    52     f => { as_proto => "float",  sig_char => "N" }, 
    53     d => { as_proto => "double", sig_char => "N" }, 
    54     t => { as_proto => "char *", 
    55            other_decl => "STRING *final_destination;", 
    56            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);", 
    57            sig_char => "S" }, 
    58     v => { as_proto => "void", 
    59            return_type => "void *", 
    60            sig_char => "v", 
    61            ret_assign => "", 
    62            func_call_assign => "" 
    63          }, 
    64     P => { as_proto => "PMC *", sig_char => "P" }, 
    65     O => { as_proto => "PMC *", returns => "", sig_char => "Pi" }, 
    66     J => { as_proto => "PARROT_INTERP", returns => "", sig_char => "" }, 
    67     S => { as_proto => "STRING *", sig_char => "S" }, 
    68     I => { as_proto => "INTVAL", sig_char => "I" }, 
    69     N => { as_proto => "FLOATVAL", sig_char => "N" }, 
    70     b => { as_proto => "void *", as_return => "", sig_char => "S" }, 
    71     B => { as_proto => "char **", as_return => "", sig_char => "S" }, 
    72     # These should be replaced by modifiers in the future 
    73     2 => { as_proto => "short *",  sig_char => "P", return_type => "short", 
    74            ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, 
    75     3 => { as_proto => "int *",  sig_char => "P", return_type => "int", 
    76            ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, 
    77     4 => { as_proto => "long *",  sig_char => "P", return_type => "long", 
    78            ret_assign => 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "I", return_data);' }, 
    79     L => { as_proto => "long *", as_return => "" }, 
    80     T => { as_proto => "char **", as_return => "" }, 
    81     V => { as_proto => "void **", as_return => "", sig_char => "P" }, 
    82     '@' => { as_proto => "PMC *", as_return => "", cname => "xAT_", sig_char => 'Ps' }, 
    83 ); 
    84  
    85 for (values %sig_table) { 
    86     if (not exists $_->{as_return}) { $_->{as_return} = $_->{as_proto} } 
    87     if (not exists $_->{return_type}) { $_->{return_type} = $_->{as_proto} } 
    88     if (not exists $_->{return_type_decl}) { $_->{return_type_decl} = $_->{return_type} } 
    89     if (not exists $_->{ret_assign} and exists $_->{sig_char}) { 
    90         $_->{ret_assign} = 'Parrot_pcc_fill_returns_from_c_args(interp, call_object, "' 
    91                            . $_->{sig_char} . '", return_data);'; 
    92     } 
    93     if (not exists $_->{func_call_assign}) { 
    94         $_->{func_call_assign} = "return_data = " 
    95     } 
    96 } 
    97  
     43my %sig_table = %Parrot::NativeCall::signature_table; 
    9844 
    9945my $temp_cnt = 0; 
    10046my (@put_pointer, @put_pointer_nci_too, @nci_defs);