Ticket #1147: nci_pmc_fixup.patch

File nci_pmc_fixup.patch, 33.4 KB (added by plobsing, 5 years ago)
  • src/ops/core.ops

     
    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

     
    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 *); 
     24typedef nci_sub_t nci_jit_sub_t; 
    2325 
    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; 
     26#define NCI_raw_FLAG    PObj_private0_FLAG 
    3427 
    35     for (i = 1; i < sig_length; i++) { 
    36         INTVAL c = Parrot_str_indexed(interp, sig, i); 
    37  
    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; 
     28STRING *pcc_sig_ret(PARROT_INTERP, STRING *sig); 
     29STRING *pcc_sig_ret(PARROT_INTERP, STRING *sig) { 
     30    INTVAL c = Parrot_str_indexed(interp, sig, 0); 
     31    if (c > 127) { 
     32        Parrot_ex_throw_from_c_args(interp, NULL, 
     33                EXCEPTION_JIT_ERROR, 
     34                "Unknown return type at %d in signature '%S' (way too big)\n", 0, sig); 
     35    } 
     36    else { 
     37        switch ((char)c) { 
     38            case 'v': 
     39                return CONST_STRING(interp, "v"); 
     40            case 'N': 
     41            case 'f': 
     42            case 'd': 
     43                return CONST_STRING(interp, "N"); 
     44            case 'I': 
     45            case 'l': 
     46            case 'i': 
     47            case 's': 
     48            case 'c': 
     49                return CONST_STRING(interp, "I"); 
     50            case 'S': 
     51            case 't': 
     52                return CONST_STRING(interp, "S"); 
     53            case 'p': 
     54            case 'P': 
     55                return CONST_STRING(interp, "P"); 
     56            case '2': 
     57            case '3': 
     58            case '4': 
     59                return CONST_STRING(interp, "P"); 
    7960            default: 
    80                 if (sig_length > 7) 
    81                     mem_sys_free(param_sig); 
    8261                Parrot_ex_throw_from_c_args(interp, NULL, 
    83                     EXCEPTION_JIT_ERROR, 
    84                     "Unknown param Signature %c\n", (char)c); 
    85                 break; 
     62                        EXCEPTION_JIT_ERROR, 
     63                        "Unknown return type at %d in signature '%S'\n", 0, sig); 
    8664        } 
    8765    } 
     66} 
    8867 
    89     PARROT_ASSERT(j <= sig_length); 
     68STRING *pcc_sig_params(PARROT_INTERP, STRING *sig); 
     69STRING *pcc_sig_params(PARROT_INTERP, STRING *sig) { 
     70    size_t sig_len = Parrot_str_byte_length(interp, sig); 
     71    char param_buf[sig_len*2]; 
    9072 
    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); 
     73    size_t i, j; 
     74 
     75    for (i = 1, j = 0; i < sig_len; i++) { 
     76        INTVAL c = Parrot_str_indexed(interp, sig, i); 
     77        if (c > 127) { 
     78            Parrot_ex_throw_from_c_args(interp, NULL, 
     79                    EXCEPTION_JIT_ERROR, 
     80                    "Unknown param type at %d in signature '%S' (way too big)\n", i, sig); 
     81        } 
     82        else { 
     83            switch ((char)c) { 
     84                case '0': 
     85                case 'J': 
     86                    break; 
     87                case 'N': 
     88                case 'd': 
     89                case 'f': 
     90                    param_buf[j++] = 'N'; 
     91                    break; 
     92                case 'I': 
     93                case 'l': 
     94                case 'i': 
     95                case 's': 
     96                case 'c': 
     97                    param_buf[j++] = 'I'; 
     98                    break; 
     99                case 'S': 
     100                case 't': 
     101                case 'b': 
     102                case 'B': 
     103                    param_buf[j++] = 'S'; 
     104                    break; 
     105                case 'P': 
     106                case 'p': 
     107                case 'V': 
     108                case '2': 
     109                case '3': 
     110                case '4': 
     111                    param_buf[j++] = 'P'; 
     112                    break; 
     113                case 'O': 
     114                    param_buf[j++] = 'P'; 
     115                    param_buf[j++] = 'i'; 
     116                    break; 
     117                case '@': 
     118                    param_buf[j++] = 'P'; 
     119                    param_buf[j++] = 's'; 
     120                    break; 
     121                default: 
     122                    Parrot_ex_throw_from_c_args(interp, NULL, 
     123                            EXCEPTION_JIT_ERROR, 
     124                            "Unknown param type at %d in signature '%S'\n", i, sig); 
     125            } 
     126        } 
    95127    } 
    96     else 
    97         nci_info->pcc_params_signature = CONST_STRING(interp, ""); 
    98128 
    99     if (sig_length > 7) 
    100         mem_sys_free(param_sig); 
     129    return string_make(interp, param_buf, j, NULL, PObj_constant_FLAG); 
    101130} 
    102131 
    103132/* actually build the NCI thunk */ 
     
    106135static 
    107136nci_sub_t build_func(PARROT_INTERP, PMC *pmc, Parrot_NCI_attributes *nci_info) 
    108137{ 
    109     STRING    *key        = nci_info->signature; 
    110     size_t     key_length = Parrot_str_byte_length(interp, key); 
     138    STRING    *key        = nci_info->nci_signature; 
    111139    int       jitted      = 0; 
    112140 
    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  
    118141    /* Build call function. */ 
    119142    nci_info->func        = (PMC *)(build_call_func(interp, pmc, key, &jitted)); 
    120     nci_info->jitted      = jitted; 
    121143 
    122144    return (nci_sub_t)nci_info->func; 
    123145} 
    124146 
    125147 
    126148pmclass 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. */ 
     149    /* Signature Attributes */ 
     150    ATTR STRING    *nci_signature;          /* The NCI signature */ 
     151    ATTR STRING    *pcc_signature_ret;      /* The PCC return signature */ 
     152    ATTR STRING    *pcc_signature_param;    /* The PCC param signature */ 
    136153 
     154    /* Function Pointers */ 
     155    ATTR void      *func;                   /* Function pointer to call */ 
     156    ATTR void      *raw_func;               /* Function pointer being wrapped */ 
     157 
     158    /* Sub PMC Attributes */ 
     159    ATTR INTVAL     arity;                  /* Number of params taken */ 
     160    /* MMD Attributes */ 
     161    ATTR PMC       *multi_sig; 
     162    ATTR STRING    *long_signature; 
     163 
    137164/* 
    138165 
    139 =item C<METHOD get_multisig()> 
     166=item C<void init()> 
    140167 
    141 Return the MMD signature PMC, if any or a Null PMC. 
     168Initializes the NCI with a C<NULL> function pointer. 
    142169 
    143170=cut 
    144171 
    145172*/ 
    146173 
    147     METHOD get_multisig() { 
    148         PMC *sig; 
    149         GET_ATTR_multi_sig(INTERP, SELF, sig); 
    150         if (PMC_IS_NULL(sig)) 
    151             sig = PMCNULL; 
    152         RETURN(PMC *sig); 
     174    VTABLE void init() { 
     175        /* Mark that we're not a raw NCI */ 
     176        PObj_get_FLAGS(SELF) &= ~NCI_raw_FLAG; 
     177        /* Mark that we have a custom gc marker */ 
     178        PObj_custom_mark_SET(SELF); 
    153179    } 
    154180 
    155181/* 
    156182 
    157 =item C<METHOD set_raw_nci_ptr(void *func)> 
     183=item C<void *get_pointer()> 
    158184 
    159 Sets the specified function pointer and raw flag. 
     185=item C<void set_pointer(void *ptr)> 
    160186 
     187Get/Set the pointer being wrapped. Setting through this interface sets 
     188the raw flag. 
     189 
    161190=cut 
    162191 
    163192*/ 
    164193 
    165     METHOD make_raw_nci(PMC *func) { 
    166         VTABLE_set_pointer(interp, SELF, (void *)func); 
     194    VTABLE void *get_pointer() { 
     195        return PARROT_NCI(SELF)->raw_func; 
    167196    } 
    168197 
     198    VTABLE void set_pointer(void *ptr) { 
     199        SET_ATTR_raw_func(INTERP, SELF, ptr); 
     200        PObj_get_FLAGS(SELF) |= NCI_raw_FLAG; 
     201    } 
     202 
    169203/* 
    170204 
    171 =item C<void init()> 
     205=item C<STRING *get_string()> 
    172206 
    173 Initializes the NCI with a C<NULL> function pointer. 
     207=item C<void set_string(STRING *str)> 
    174208 
     209Get/Set the NCI signature. 
     210 
    175211=cut 
    176212 
    177213*/ 
    178214 
    179     VTABLE void init() { 
    180         /* Mark that we're not a raw NCI. */ 
    181         PObj_flag_CLEAR(private2, SELF); 
    182         PObj_custom_mark_SET(SELF); 
     215    VTABLE STRING *get_string() { 
     216        return PARROT_NCI(SELF)->nci_signature; 
    183217    } 
    184218 
     219    VTABLE void set_string_native(STRING *str) { 
     220        if (!PObj_constant_TEST(str)) { 
     221            str = Parrot_str_copy(INTERP, str); 
     222        } 
     223        SET_ATTR_nci_signature(INTERP, SELF, str); 
     224 
     225        /* set up derivative attributes */ 
     226        SET_ATTR_pcc_signature_param(INTERP, SELF, pcc_sig_params(INTERP, str)); 
     227        SET_ATTR_pcc_signature_ret(INTERP, SELF, pcc_sig_ret(INTERP, str)); 
     228        /* Arity is length of the NCI signature minus one (the return type). */ 
     229        SET_ATTR_arity(INTERP, SELF, Parrot_str_byte_length(INTERP, str) - 1); 
     230    } 
     231 
    185232/* 
    186233 
    187234=item C<void set_pointer_keyed_str(STRING *key, void *func)> 
    188235 
    189 Sets the specified function pointer and signature (C<*key>). 
     236Roughly equivalent to C<set_string(key)> and C<set_pointer(func)>. 
     237Setting through this interface clears the raw flag. 
    190238 
    191239=cut 
    192240 
    193241*/ 
    194242 
    195     VTABLE void set_pointer(void *ptr) { 
    196         SET_ATTR_orig_func(INTERP, SELF, ptr); 
    197         PObj_flag_SET(private2, SELF); 
    198     } 
    199  
    200     VTABLE void *get_pointer() { 
    201         return PARROT_NCI(SELF)->orig_func; 
    202     } 
    203  
    204243    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); 
    217         } 
    218  
    219         nci_info->signature = key; 
     244        SELF.set_string_native(key); 
     245        SELF.set_pointer(func); 
     246        PObj_get_FLAGS(SELF) &= ~NCI_raw_FLAG; 
    220247    } 
    221248 
    222249/* 
     
    232259        if (PARROT_NCI(SELF)) { 
    233260            Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); 
    234261 
    235             Parrot_gc_mark_STRING_alive(interp, nci_info->signature); 
    236             Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_params_signature); 
     262            Parrot_gc_mark_STRING_alive(interp, nci_info->nci_signature); 
     263            Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_signature_param); 
     264            Parrot_gc_mark_STRING_alive(interp, nci_info->pcc_signature_ret); 
    237265            Parrot_gc_mark_STRING_alive(interp, nci_info->long_signature); 
    238266            Parrot_gc_mark_PMC_alive(interp, nci_info->multi_sig); 
    239267        } 
     
    252280    VTABLE PMC *clone() { 
    253281        Parrot_NCI_attributes * const nci_info_self = PARROT_NCI(SELF); 
    254282        Parrot_NCI_attributes *nci_info_ret; 
    255         void                  *orig_func; 
     283        void                  *raw_func; 
    256284 
    257285        PMC * const ret     = pmc_new(INTERP, SELF->vtable->base_type); 
    258286        nci_info_ret        = PARROT_NCI(ret); 
     
    262290         * ManagedStruct or Buffer? 
    263291         */ 
    264292        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; 
     293        nci_info_ret->raw_func              = nci_info_self->raw_func; 
     294        nci_info_ret->nci_signature         = nci_info_self->nci_signature; 
     295        nci_info_ret->pcc_signature_param   = nci_info_self->pcc_signature_param; 
     296        nci_info_ret->pcc_signature_ret     = nci_info_self->pcc_signature_ret; 
     297        nci_info_ret->long_signature        = nci_info_self->long_signature; 
     298        nci_info_ret->multi_sig             = nci_info_self->multi_sig; 
    268299        nci_info_ret->arity                 = nci_info_self->arity; 
    269         nci_info_ret->jitted                = nci_info_self->jitted; 
    270300        PObj_get_FLAGS(ret)                |= (PObj_get_FLAGS(SELF) & 0x7); 
    271301 
    272302        return ret; 
     
    284314 
    285315    VTABLE INTVAL defined() { 
    286316        Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); 
    287         return nci_info->orig_func != NULL; 
     317        return nci_info->raw_func != NULL; 
    288318    } 
    289319 
    290320/* 
     
    302332        Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); 
    303333        nci_sub_t                     func; 
    304334        char                         *sig_str; 
    305         void                         *orig_func; 
     335        void                         *raw_func; 
    306336        PMC                          *cont; 
    307337 
    308         GET_ATTR_orig_func(INTERP, SELF, orig_func); 
    309         func = PObj_flag_TEST(private2, SELF) 
    310             ? (nci_sub_t) D2FPTR(orig_func) 
     338        GET_ATTR_raw_func(INTERP, SELF, raw_func); 
     339        func = PObj_get_FLAGS(SELF) & NCI_raw_FLAG 
     340            ? (nci_sub_t) D2FPTR(raw_func) 
    311341            : (nci_sub_t) D2FPTR(nci_info->func); 
    312342 
    313343        if (!func) { 
     
    320350                    "attempt to call NULL function"); 
    321351        } 
    322352 
    323         if (nci_info->jitted) { 
    324             nci_jit_sub_t jit_func = (nci_jit_sub_t) D2FPTR(nci_info->func); 
     353        func(INTERP, SELF); 
    325354 
    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         } 
    340355        cont = INTERP->current_cont; 
    341356 
    342357        /* 
     
    384399 
    385400    VTABLE INTVAL get_bool() { 
    386401        Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); 
    387         return (0 != (INTVAL)nci_info->orig_func); 
     402        return (0 != (INTVAL)nci_info->raw_func); 
    388403    } 
    389404 
    390405/* 
    391406 
     407=item C<METHOD get_multisig()> 
     408 
     409Return the MMD signature PMC, if any or a Null PMC. 
     410 
     411=cut 
     412 
     413*/ 
     414 
     415    METHOD get_multisig() { 
     416        PMC *sig; 
     417        GET_ATTR_multi_sig(INTERP, SELF, sig); 
     418        if (sig == NULL) { 
     419            sig = PMCNULL; 
     420        } 
     421        RETURN(PMC *sig); 
     422    } 
     423 
     424/* 
     425 
    392426=item C<METHOD arity()> 
    393427 
    394428Return the arity of the NCI (the number of arguments). 
     
    397431 
    398432*/ 
    399433    METHOD arity() { 
    400         Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); 
    401         INTVAL arity = 0; 
     434        INTVAL arity; 
     435        GET_ATTR_arity(INTERP, SELF, arity); 
     436        RETURN(INTVAL arity); 
     437    } 
    402438 
    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             } 
     439/* 
     440 
     441=item C<INTVAL get_integer_keyed_int(INTVAL key)> 
     442 
     443=item C<STRING *get_string_keyed_int(INTVAL key)> 
     444 
     445=item C<PMC *get_pmc_keyed_int(INTVAL key)> 
     446 
     447Accessors for all attributes of this class not otherwise accessible through VTABLES. 
     448Integers are used for keys to make access easier for JIT. These are also available to 
     449PIR from F<runtime/parrot/include/nci.pasm> 
     450 
     451=over 
     452 
     453=item INTVAL keys 
     454 
     455C<PARROT_NCI_ARITY> 
     456 
     457=item STRING keys 
     458 
     459C<PARROT_NCI_PCC_SIGNATURE_PARAMS>, C<PARROT_NCI_PCC_SIGNATURE_RET>, 
     460C<PARROT_LONG_SIGNATURE> 
     461 
     462=item PMC keys 
     463 
     464C<PARROT_NCI_MULTI_SIG> 
     465 
     466=back 
     467 
     468=cut 
     469 
     470*/ 
     471 
     472    VTABLE INTVAL get_integer_keyed_int(INTVAL key) { 
     473        switch (key) { 
     474            case PARROT_NCI_ARITY: 
     475                return PARROT_NCI(SELF)->arity; 
     476            default: 
     477                Parrot_ex_throw_from_c_args(INTERP, NULL, 
     478                    EXCEPTION_INVALID_OPERATION, 
     479                    "Bad index for NCI.get_integer_keyed_int()"); 
    410480        } 
     481    } 
    411482 
    412         Parrot_ex_throw_from_c_args(INTERP, NULL, 
    413             EXCEPTION_INVALID_OPERATION, 
    414             "You cannot get the arity of an undefined NCI."); 
     483    VTABLE STRING *get_string_keyed_int(INTVAL key) { 
     484        switch (key) { 
     485            case PARROT_NCI_PCC_SIGNATURE_PARAMS: 
     486                return PARROT_NCI(SELF)->pcc_signature_param; 
     487            case PARROT_NCI_PCC_SIGNATURE_RET: 
     488                return PARROT_NCI(SELF)->pcc_signature_ret; 
     489            case PARROT_NCI_LONG_SIGNATURE: 
     490                return PARROT_NCI(SELF)->long_signature; 
     491            default: 
     492                Parrot_ex_throw_from_c_args(INTERP, NULL, 
     493                    EXCEPTION_INVALID_OPERATION, 
     494                    "Bad index for NCI.get_string_keyed_int()"); 
     495        } 
    415496    } 
     497 
     498    VTABLE PMC *get_pmc_keyed_int(INTVAL key) { 
     499        PMC *retval; 
     500        switch (key) { 
     501            case PARROT_NCI_MULTI_SIG: 
     502                GET_ATTR_multi_sig(INTERP, SELF, retval); 
     503            default: 
     504                Parrot_ex_throw_from_c_args(INTERP, NULL, 
     505                    EXCEPTION_INVALID_OPERATION, 
     506                    "Bad index for NCI.get_pmc_keyed_int()"); 
     507        } 
     508        if (retval == NULL) { 
     509            retval = PMCNULL; 
     510        } 
     511        return retval; 
     512    } 
    416513} 
    417514 
    418515/* 
  • src/nci_test.c

     
    102102PARROT_EXPORT void   nci_v(void); 
    103103PARROT_EXPORT void   nci_vP(void *); 
    104104PARROT_EXPORT void   nci_vpii(Outer *, int, int); 
    105 PARROT_EXPORT void   nci_vv(void); 
     105PARROT_EXPORT void   nci_v_2(void); 
    106106PARROT_EXPORT void   nci_vVi(Opaque**, int); 
    107107PARROT_EXPORT void   nci_vp(Opaque*); 
    108108PARROT_EXPORT char * nci_ttt(char *, char *); 
     
    10511051/* 
    10521052 
    10531053=item C<PARROT_EXPORT void 
    1054 nci_vv(void)> 
     1054nci_v_2(void)> 
    10551055 
    10561056Multiplies the global variable C<nci_dlvar_int> by 3. 
    10571057 
     
    10601060*/ 
    10611061 
    10621062PARROT_EXPORT void 
    1063 nci_vv(void) 
     1063nci_v_2(void) 
    10641064{ 
    10651065    nci_dlvar_int *= 3; 
    10661066} 
  • src/extend.c

     
    17291729        (char *) NULL, 0); 
    17301730    Parrot_PMC sub = pmc_new(interp, enum_class_NCI); 
    17311731    VTABLE_set_pointer_keyed_str(interp, sub, sig, F2DPTR(func)); 
    1732     PObj_get_FLAGS(sub) |= PObj_private1_FLAG; 
    17331732    return sub; 
    17341733} 
    17351734 
  • tools/build/nativecall.pl

     
    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 
     43my %sig_table = %Parrot::NativeCall::signature_table; 
    4044 
    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  
    98  
    9945my $temp_cnt = 0; 
    10046my (@put_pointer, @put_pointer_nci_too, @nci_defs); 
    10147my %seen; 
     
    370316{ 
    371317    typedef $ret_type (*func_t)($proto); 
    372318    func_t pointer; 
    373     void *orig_func; 
     319    void *raw_func; 
    374320    $call_object_decl 
    375321    $return_data_decl 
    376322    $other_decl 
    377323    Parrot_pcc_fill_params_from_c_args(interp, call_object, \"$sig\"$fill_params); 
    378324    $extra_preamble 
    379325 
    380     GETATTR_NCI_orig_func(interp, self, orig_func); 
    381     pointer = (func_t)D2FPTR(orig_func); 
     326    GETATTR_NCI_raw_func(interp, self, raw_func); 
     327    pointer = (func_t)D2FPTR(raw_func); 
    382328    $return_assign ($ret_type)(*pointer)($call_params); 
    383329    $final_assign 
    384330    $extra_postamble 
     
    393339pcf_${return}_(PARROT_INTERP, PMC *self) 
    394340{ 
    395341    $ret_type (*pointer)(void); 
    396     void *orig_func; 
     342    void *raw_func; 
    397343    $return_data_decl 
    398344    $other_decl 
    399345    $call_object_decl 
    400346    $extra_preamble 
    401347 
    402     GETATTR_NCI_orig_func(interp, self, orig_func); 
    403     pointer = ($ret_type (*)(void))D2FPTR(orig_func); 
     348    GETATTR_NCI_raw_func(interp, self, raw_func); 
     349    pointer = ($ret_type (*)(void))D2FPTR(raw_func); 
    404350    $return_assign ($ret_type)(*pointer)(); 
    405351    $final_assign 
    406352    $extra_postamble 
  • lib/Parrot/NativeCall.pm

     
     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: 
  • include/parrot/nci.h

     
    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 */ 
  • t/pmc/nci.t

     
    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() ); 
     
    23102342 
    23112343        skip( "nci_dlvar_int hangs on HP-UX", 1 ) if $^O eq 'hpux'; 
    23122344 
    2313         pir_output_is( << 'CODE', << 'OUTPUT', "nci_vv and nci_dlvar_int" ); 
     2345        pir_output_is( << 'CODE', << 'OUTPUT', "nci_v_2 and nci_dlvar_int" ); 
    23142346 
    23152347.include "datatypes.pasm" 
    23162348 
     
    23412373    print $I2 
    23422374    print "\n" 
    23432375 
    2344     .local pmc nci_vv 
    2345     nci_vv = dlfunc libnci_test, "nci_vv", "vv" 
    2346     nci_vv() 
     2376    .local pmc nci_v_2 
     2377    nci_v_2 = dlfunc libnci_test, "nci_v_2", "v" 
     2378    nci_v_2() 
    23472379    $I1 = nci_dlvar_int[0] 
    23482380    print $I1 
    23492381    print "\n" 
    2350     nci_vv() 
     2382    nci_v_2() 
    23512383    $I1 = nci_dlvar_int[0] 
    23522384    print $I1 
    23532385    print "\n" 
    2354     nci_vv() 
     2386    nci_v_2() 
    23552387    $I1 = nci_dlvar_int[0] 
    23562388    print $I1 
    23572389    print "\n" 
    2358     nci_vv() 
     2390    nci_v_2() 
    23592391    $I1 = nci_dlvar_int[0] 
    23602392    print $I1 
    23612393    print "\n" 
  • config/gen/parrot_include.pm

     
    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(