Ticket #1147: nci_pmc_fixup.patch
| File nci_pmc_fixup.patch, 33.4 KB (added by plobsing, 12 years ago) |
|---|
-
src/ops/core.ops
1322 1322 else { 1323 1323 $1 = pmc_new(interp, enum_class_NCI); 1324 1324 VTABLE_set_pointer_keyed_str(interp, $1, $4, F2DPTR(p)); 1325 PObj_get_FLAGS($1) |= PObj_private1_FLAG;1326 1325 } 1327 1326 Parrot_str_free_cstring(name); 1328 1327 } -
src/pmc/nci.pmc
18 18 19 19 */ 20 20 21 #include "parrot/nci.h" 22 21 23 typedef INTVAL (*nci_sub_t)(PARROT_INTERP, PMC *); 22 typedef INTVAL (*nci_jit_sub_t)(PARROT_INTERP, PMC *, char *);24 typedef nci_sub_t nci_jit_sub_t; 23 25 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 34 27 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; 28 STRING *pcc_sig_ret(PARROT_INTERP, STRING *sig); 29 STRING *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"); 79 60 default: 80 if (sig_length > 7)81 mem_sys_free(param_sig);82 61 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); 86 64 } 87 65 } 66 } 88 67 89 PARROT_ASSERT(j <= sig_length); 68 STRING *pcc_sig_params(PARROT_INTERP, STRING *sig); 69 STRING *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]; 90 72 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 } 95 127 } 96 else97 nci_info->pcc_params_signature = CONST_STRING(interp, "");98 128 99 if (sig_length > 7) 100 mem_sys_free(param_sig); 129 return string_make(interp, param_buf, j, NULL, PObj_constant_FLAG); 101 130 } 102 131 103 132 /* actually build the NCI thunk */ … … 106 135 static 107 136 nci_sub_t build_func(PARROT_INTERP, PMC *pmc, Parrot_NCI_attributes *nci_info) 108 137 { 109 STRING *key = nci_info->signature; 110 size_t key_length = Parrot_str_byte_length(interp, key); 138 STRING *key = nci_info->nci_signature; 111 139 int jitted = 0; 112 140 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 118 141 /* Build call function. */ 119 142 nci_info->func = (PMC *)(build_call_func(interp, pmc, key, &jitted)); 120 nci_info->jitted = jitted;121 143 122 144 return (nci_sub_t)nci_info->func; 123 145 } 124 146 125 147 126 148 pmclass 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 */ 136 153 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 137 164 /* 138 165 139 =item C< METHOD get_multisig()>166 =item C<void init()> 140 167 141 Return the MMD signature PMC, if any or a Null PMC.168 Initializes the NCI with a C<NULL> function pointer. 142 169 143 170 =cut 144 171 145 172 */ 146 173 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); 153 179 } 154 180 155 181 /* 156 182 157 =item C< METHOD set_raw_nci_ptr(void *func)>183 =item C<void *get_pointer()> 158 184 159 Sets the specified function pointer and raw flag. 185 =item C<void set_pointer(void *ptr)> 160 186 187 Get/Set the pointer being wrapped. Setting through this interface sets 188 the raw flag. 189 161 190 =cut 162 191 163 192 */ 164 193 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; 167 196 } 168 197 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 169 203 /* 170 204 171 =item C< void init()>205 =item C<STRING *get_string()> 172 206 173 Initializes the NCI with a C<NULL> function pointer. 207 =item C<void set_string(STRING *str)> 174 208 209 Get/Set the NCI signature. 210 175 211 =cut 176 212 177 213 */ 178 214 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; 183 217 } 184 218 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 185 232 /* 186 233 187 234 =item C<void set_pointer_keyed_str(STRING *key, void *func)> 188 235 189 Sets the specified function pointer and signature (C<*key>). 236 Roughly equivalent to C<set_string(key)> and C<set_pointer(func)>. 237 Setting through this interface clears the raw flag. 190 238 191 239 =cut 192 240 193 241 */ 194 242 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 204 243 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; 220 247 } 221 248 222 249 /* … … 232 259 if (PARROT_NCI(SELF)) { 233 260 Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); 234 261 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); 237 265 Parrot_gc_mark_STRING_alive(interp, nci_info->long_signature); 238 266 Parrot_gc_mark_PMC_alive(interp, nci_info->multi_sig); 239 267 } … … 252 280 VTABLE PMC *clone() { 253 281 Parrot_NCI_attributes * const nci_info_self = PARROT_NCI(SELF); 254 282 Parrot_NCI_attributes *nci_info_ret; 255 void * orig_func;283 void *raw_func; 256 284 257 285 PMC * const ret = pmc_new(INTERP, SELF->vtable->base_type); 258 286 nci_info_ret = PARROT_NCI(ret); … … 262 290 * ManagedStruct or Buffer? 263 291 */ 264 292 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; 268 299 nci_info_ret->arity = nci_info_self->arity; 269 nci_info_ret->jitted = nci_info_self->jitted;270 300 PObj_get_FLAGS(ret) |= (PObj_get_FLAGS(SELF) & 0x7); 271 301 272 302 return ret; … … 284 314 285 315 VTABLE INTVAL defined() { 286 316 Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); 287 return nci_info-> orig_func != NULL;317 return nci_info->raw_func != NULL; 288 318 } 289 319 290 320 /* … … 302 332 Parrot_NCI_attributes * const nci_info = PARROT_NCI(SELF); 303 333 nci_sub_t func; 304 334 char *sig_str; 305 void * orig_func;335 void *raw_func; 306 336 PMC *cont; 307 337 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) 311 341 : (nci_sub_t) D2FPTR(nci_info->func); 312 342 313 343 if (!func) { … … 320 350 "attempt to call NULL function"); 321 351 } 322 352 323 if (nci_info->jitted) { 324 nci_jit_sub_t jit_func = (nci_jit_sub_t) D2FPTR(nci_info->func); 353 func(INTERP, SELF); 325 354 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 }340 355 cont = INTERP->current_cont; 341 356 342 357 /* … … 384 399 385 400 VTABLE INTVAL get_bool() { 386 401 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); 388 403 } 389 404 390 405 /* 391 406 407 =item C<METHOD get_multisig()> 408 409 Return 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 392 426 =item C<METHOD arity()> 393 427 394 428 Return the arity of the NCI (the number of arguments). … … 397 431 398 432 */ 399 433 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 } 402 438 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 447 Accessors for all attributes of this class not otherwise accessible through VTABLES. 448 Integers are used for keys to make access easier for JIT. These are also available to 449 PIR from F<runtime/parrot/include/nci.pasm> 450 451 =over 452 453 =item INTVAL keys 454 455 C<PARROT_NCI_ARITY> 456 457 =item STRING keys 458 459 C<PARROT_NCI_PCC_SIGNATURE_PARAMS>, C<PARROT_NCI_PCC_SIGNATURE_RET>, 460 C<PARROT_LONG_SIGNATURE> 461 462 =item PMC keys 463 464 C<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()"); 410 480 } 481 } 411 482 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 } 415 496 } 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 } 416 513 } 417 514 418 515 /* -
src/nci_test.c
102 102 PARROT_EXPORT void nci_v(void); 103 103 PARROT_EXPORT void nci_vP(void *); 104 104 PARROT_EXPORT void nci_vpii(Outer *, int, int); 105 PARROT_EXPORT void nci_v v(void);105 PARROT_EXPORT void nci_v_2(void); 106 106 PARROT_EXPORT void nci_vVi(Opaque**, int); 107 107 PARROT_EXPORT void nci_vp(Opaque*); 108 108 PARROT_EXPORT char * nci_ttt(char *, char *); … … 1051 1051 /* 1052 1052 1053 1053 =item C<PARROT_EXPORT void 1054 nci_v v(void)>1054 nci_v_2(void)> 1055 1055 1056 1056 Multiplies the global variable C<nci_dlvar_int> by 3. 1057 1057 … … 1060 1060 */ 1061 1061 1062 1062 PARROT_EXPORT void 1063 nci_v v(void)1063 nci_v_2(void) 1064 1064 { 1065 1065 nci_dlvar_int *= 3; 1066 1066 } -
src/extend.c
1729 1729 (char *) NULL, 0); 1730 1730 Parrot_PMC sub = pmc_new(interp, enum_class_NCI); 1731 1731 VTABLE_set_pointer_keyed_str(interp, sub, sig, F2DPTR(func)); 1732 PObj_get_FLAGS(sub) |= PObj_private1_FLAG;1733 1732 return sub; 1734 1733 } 1735 1734 -
tools/build/nativecall.pl
30 30 use strict; 31 31 use warnings; 32 32 33 use lib 'lib'; 34 use Parrot::NativeCall; 35 33 36 my $opt_warndups = 0; 34 37 35 38 # This file will eventually be compiled … … 37 40 38 41 print_head( \@ARGV ); 39 42 43 my %sig_table = %Parrot::NativeCall::signature_table; 40 44 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 future73 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 99 45 my $temp_cnt = 0; 100 46 my (@put_pointer, @put_pointer_nci_too, @nci_defs); 101 47 my %seen; … … 370 316 { 371 317 typedef $ret_type (*func_t)($proto); 372 318 func_t pointer; 373 void * orig_func;319 void *raw_func; 374 320 $call_object_decl 375 321 $return_data_decl 376 322 $other_decl 377 323 Parrot_pcc_fill_params_from_c_args(interp, call_object, \"$sig\"$fill_params); 378 324 $extra_preamble 379 325 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); 382 328 $return_assign ($ret_type)(*pointer)($call_params); 383 329 $final_assign 384 330 $extra_postamble … … 393 339 pcf_${return}_(PARROT_INTERP, PMC *self) 394 340 { 395 341 $ret_type (*pointer)(void); 396 void * orig_func;342 void *raw_func; 397 343 $return_data_decl 398 344 $other_decl 399 345 $call_object_decl 400 346 $extra_preamble 401 347 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); 404 350 $return_assign ($ret_type)(*pointer)(); 405 351 $final_assign 406 352 $extra_postamble -
lib/Parrot/NativeCall.pm
1 # Copyright (C) 2009, Parrot Foundation. 2 # $Id$ 3 4 package Parrot::NativeCall; 5 6 use strict; 7 use warnings; 8 9 use base 'Exporter'; 10 our @EXPORT_OK = qw{ signature_nci_to_pcc }; 11 12 =head1 NAME 13 14 Parrot::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 24 C<Parrot::NativeCall> knows how to map NCI signatures to nci frame 25 functions. 26 27 =head1 GLOBAL VARIABLES 28 29 =over 30 31 =item C<%signature_table> 32 33 Maps NCI signature items to elements of a native call routine. 34 35 For use by F<tools/build/nativecall.pl>. New code should probably write 36 a wrapper in this module to encapsulate the access. 37 38 =cut 39 40 our %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 84 for (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 105 Converts an NCI signature to a PCC signature. 106 107 =cut 108 109 sub 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 117 1; 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
15 15 16 16 #include "parrot/parrot.h" 17 17 18 /* NCI PMC interface constants */ 19 /* &gen_from_enum(nci.pasm) */ 20 typedef 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 18 29 void *build_call_func(PARROT_INTERP, SHIM(PMC *pmc_nci), NOTNULL(STRING *signature), NOTNULL(int *jitted)); 19 30 20 31 #endif /* PARROT_NCI_H_GUARD */ -
t/pmc/nci.t
5 5 use strict; 6 6 use warnings; 7 7 use lib qw( . lib ../lib ../../lib ); 8 use Parrot::BuildUtil; 9 use Parrot::NativeCall 'signature_nci_to_pcc'; 10 11 my @nci_sigs; 12 BEGIN { 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 8 19 use Test::More; 9 use Parrot::Test tests => 70;20 use Parrot::Test tests => (70 + @nci_sigs); 10 21 use Parrot::Config qw(%PConfig); 11 22 12 23 =head1 NAME … … 32 43 33 44 $ENV{TEST_PROG_ARGS} ||= ''; 34 45 46 foreach 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 64 CODE 65 } 66 35 67 SKIP: { 36 68 unless ( -e "runtime/parrot/dynext/libnci_test$PConfig{load_ext}" ) { 37 69 skip( "Please make libnci_test$PConfig{load_ext}", Test::Builder->expected_tests() ); … … 2310 2342 2311 2343 skip( "nci_dlvar_int hangs on HP-UX", 1 ) if $^O eq 'hpux'; 2312 2344 2313 pir_output_is( << 'CODE', << 'OUTPUT', "nci_v vand nci_dlvar_int" );2345 pir_output_is( << 'CODE', << 'OUTPUT', "nci_v_2 and nci_dlvar_int" ); 2314 2346 2315 2347 .include "datatypes.pasm" 2316 2348 … … 2341 2373 print $I2 2342 2374 print "\n" 2343 2375 2344 .local pmc nci_v v2345 nci_v v = dlfunc libnci_test, "nci_vv", "vv"2346 nci_v v()2376 .local pmc nci_v_2 2377 nci_v_2 = dlfunc libnci_test, "nci_v_2", "v" 2378 nci_v_2() 2347 2379 $I1 = nci_dlvar_int[0] 2348 2380 print $I1 2349 2381 print "\n" 2350 nci_v v()2382 nci_v_2() 2351 2383 $I1 = nci_dlvar_int[0] 2352 2384 print $I1 2353 2385 print "\n" 2354 nci_v v()2386 nci_v_2() 2355 2387 $I1 = nci_dlvar_int[0] 2356 2388 print $I1 2357 2389 print "\n" 2358 nci_v v()2390 nci_v_2() 2359 2391 $I1 = nci_dlvar_int[0] 2360 2392 print $I1 2361 2393 print "\n" -
config/gen/parrot_include.pm
39 39 include/parrot/library.h 40 40 include/parrot/longopt.h 41 41 include/parrot/multidispatch.h 42 include/parrot/nci.h 42 43 include/parrot/packfile.h 43 44 include/parrot/stat.h 44 45 include/parrot/string.h 45 46 include/parrot/pmc.h 46 47 include/parrot/warnings.h 47 48 include/parrot/gc_api.h 48 src/pmc/timer.pmc49 49 src/utils.c 50 50 ) ]; 51 51 $data{generated_files} = [ qw(
