/* Log that we've entered a native routine */
void MVM_profile_log_enter_native(MVMThreadContext *tc, MVMObject *nativecallsite) {
MVMProfileThreadData *ptd = get_thread_data(tc);
MVMProfileCallNode *pcn = NULL;
MVMNativeCallBody *callbody;
MVMuint32 i;
/* We locate the right call node by looking at sf being NULL and the
* native_target_name matching our intended target. */
callbody = MVM_nativecall_get_nc_body(tc, nativecallsite);
if (ptd->current_call)
for (i = 0; i < ptd->current_call->num_succ; i++)
if (ptd->current_call->succ[i]->sf == NULL)
if (strcmp(callbody->sym_name,
ptd->current_call->succ[i]->native_target_name) == 0) {
pcn = ptd->current_call->succ[i];
break;
}
/* If we didn't find a call graph node, then create one and add it to the
* graph. */
if (!pcn) {
pcn = MVM_calloc(1, sizeof(MVMProfileCallNode));
pcn->native_target_name = callbody->sym_name;
if (ptd->current_call) {
MVMProfileCallNode *pred = ptd->current_call;
pcn->pred = pred;
if (pred->num_succ == pred->alloc_succ) {
pred->alloc_succ += 8;
pred->succ = MVM_realloc(pred->succ,
pred->alloc_succ * sizeof(MVMProfileCallNode *));
}
pred->succ[pred->num_succ] = pcn;
pred->num_succ++;
}
else {
if (!ptd->call_graph)
ptd->call_graph = pcn;
}
}
/* Increment entry counts. */
pcn->total_entries++;
pcn->entry_mode = 0;
/* Log entry time; clear skip time. */
pcn->cur_entry_time = uv_hrtime();
pcn->cur_skip_time = 0;
/* The current call graph node becomes this one. */
ptd->current_call = pcn;
}
MVMObject * MVM_nativecall_invoke(MVMThreadContext *tc, MVMObject *res_type,
MVMObject *site, MVMObject *args) {
MVMObject *result = NULL;
char **free_strs = NULL;
void **free_rws = NULL;
MVMint16 num_strs = 0;
MVMint16 num_rws = 0;
MVMint16 i;
/* Get native call body, so we can locate the call info. Read out all we
* shall need, since later we may allocate a result and and move it. */
MVMNativeCallBody *body = MVM_nativecall_get_nc_body(tc, site);
MVMint16 num_args = body->num_args;
MVMint16 *arg_types = body->arg_types;
MVMint16 ret_type = body->ret_type;
void *entry_point = body->entry_point;
/* Create and set up call VM. */
DCCallVM *vm = dcNewCallVM(8192);
dcMode(vm, body->convention);
/* Process arguments. */
for (i = 0; i < num_args; i++) {
MVMObject *value = MVM_repr_at_pos_o(tc, args, i);
switch (arg_types[i] & MVM_NATIVECALL_ARG_TYPE_MASK) {
case MVM_NATIVECALL_ARG_CHAR:
handle_arg("integer", cont_i, DCchar, i64, dcArgChar, MVM_nativecall_unmarshal_char);
break;
case MVM_NATIVECALL_ARG_SHORT:
handle_arg("integer", cont_i, DCshort, i64, dcArgShort, MVM_nativecall_unmarshal_short);
break;
case MVM_NATIVECALL_ARG_INT:
handle_arg("integer", cont_i, DCint, i64, dcArgInt, MVM_nativecall_unmarshal_int);
break;
case MVM_NATIVECALL_ARG_LONG:
handle_arg("integer", cont_i, DClong, i64, dcArgLong, MVM_nativecall_unmarshal_long);
break;
case MVM_NATIVECALL_ARG_LONGLONG:
handle_arg("integer", cont_i, DClonglong, i64, dcArgLongLong, MVM_nativecall_unmarshal_longlong);
break;
case MVM_NATIVECALL_ARG_FLOAT:
handle_arg("number", cont_n, DCfloat, n64, dcArgFloat, MVM_nativecall_unmarshal_float);
break;
case MVM_NATIVECALL_ARG_DOUBLE:
handle_arg("number", cont_n, DCdouble, n64, dcArgDouble, MVM_nativecall_unmarshal_double);
break;
case MVM_NATIVECALL_ARG_ASCIISTR:
case MVM_NATIVECALL_ARG_UTF8STR:
case MVM_NATIVECALL_ARG_UTF16STR:
{
MVMint16 free = 0;
char *str = MVM_nativecall_unmarshal_string(tc, value, arg_types[i], &free);
if (free) {
if (!free_strs)
free_strs = (char**)MVM_malloc(num_args * sizeof(char *));
free_strs[num_strs] = str;
num_strs++;
}
dcArgPointer(vm, str);
}
break;
case MVM_NATIVECALL_ARG_CSTRUCT:
dcArgPointer(vm, MVM_nativecall_unmarshal_cstruct(tc, value));
break;
case MVM_NATIVECALL_ARG_CPOINTER:
dcArgPointer(vm, MVM_nativecall_unmarshal_cpointer(tc, value));
break;
case MVM_NATIVECALL_ARG_CARRAY:
dcArgPointer(vm, MVM_nativecall_unmarshal_carray(tc, value));
break;
case MVM_NATIVECALL_ARG_CUNION:
dcArgPointer(vm, MVM_nativecall_unmarshal_cunion(tc, value));
break;
case MVM_NATIVECALL_ARG_VMARRAY:
dcArgPointer(vm, MVM_nativecall_unmarshal_vmarray(tc, value));
break;
case MVM_NATIVECALL_ARG_CALLBACK:
dcArgPointer(vm, unmarshal_callback(tc, value, body->arg_info[i]));
break;
case MVM_NATIVECALL_ARG_UCHAR:
handle_arg("integer", cont_i, DCuchar, i64, dcArgChar, MVM_nativecall_unmarshal_uchar);
break;
case MVM_NATIVECALL_ARG_USHORT:
handle_arg("integer", cont_i, DCushort, i64, dcArgShort, MVM_nativecall_unmarshal_ushort);
break;
case MVM_NATIVECALL_ARG_UINT:
handle_arg("integer", cont_i, DCuint, i64, dcArgInt, MVM_nativecall_unmarshal_uint);
break;
case MVM_NATIVECALL_ARG_ULONG:
handle_arg("integer", cont_i, DCulong, i64, dcArgLong, MVM_nativecall_unmarshal_ulong);
break;
case MVM_NATIVECALL_ARG_ULONGLONG:
handle_arg("integer", cont_i, DCulonglong, i64, dcArgLongLong, MVM_nativecall_unmarshal_ulonglong);
break;
default:
MVM_exception_throw_adhoc(tc, "Internal error: unhandled dyncall argument type");
}
}
/* Call and process return values. */
MVMROOT(tc, args, {
MVMROOT(tc, res_type, {
switch (ret_type & MVM_NATIVECALL_ARG_TYPE_MASK) {
case MVM_NATIVECALL_ARG_VOID:
dcCallVoid(vm, entry_point);
result = res_type;
break;
case MVM_NATIVECALL_ARG_CHAR:
result = MVM_nativecall_make_int(tc, res_type, dcCallChar(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_SHORT:
result = MVM_nativecall_make_int(tc, res_type, dcCallShort(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_INT:
result = MVM_nativecall_make_int(tc, res_type, dcCallInt(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_LONG:
result = MVM_nativecall_make_int(tc, res_type, dcCallLong(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_LONGLONG:
result = MVM_nativecall_make_int(tc, res_type, dcCallLongLong(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_FLOAT:
result = MVM_nativecall_make_num(tc, res_type, dcCallFloat(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_DOUBLE:
result = MVM_nativecall_make_num(tc, res_type, dcCallDouble(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_ASCIISTR:
case MVM_NATIVECALL_ARG_UTF8STR:
case MVM_NATIVECALL_ARG_UTF16STR:
result = MVM_nativecall_make_str(tc, res_type, body->ret_type,
(char *)dcCallPointer(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_CSTRUCT:
result = MVM_nativecall_make_cstruct(tc, res_type, dcCallPointer(vm, body->entry_point));
break;
case MVM_NATIVECALL_ARG_CPOINTER:
result = MVM_nativecall_make_cpointer(tc, res_type, dcCallPointer(vm, body->entry_point));
break;
case MVM_NATIVECALL_ARG_CARRAY:
result = MVM_nativecall_make_carray(tc, res_type, dcCallPointer(vm, body->entry_point));
break;
case MVM_NATIVECALL_ARG_CUNION:
result = MVM_nativecall_make_cunion(tc, res_type, dcCallPointer(vm, body->entry_point));
break;
case MVM_NATIVECALL_ARG_CALLBACK:
/* TODO: A callback -return- value means that we have a C method
* that needs to be wrapped similarly to a is native(...) Perl 6
* sub. */
dcCallPointer(vm, body->entry_point);
result = res_type;
break;
case MVM_NATIVECALL_ARG_UCHAR:
result = MVM_nativecall_make_uint(tc, res_type, (DCuchar)dcCallChar(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_USHORT:
result = MVM_nativecall_make_uint(tc, res_type, (DCushort)dcCallShort(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_UINT:
result = MVM_nativecall_make_uint(tc, res_type, (DCuint)dcCallInt(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_ULONG:
result = MVM_nativecall_make_uint(tc, res_type, (DCulong)dcCallLong(vm, entry_point));
break;
case MVM_NATIVECALL_ARG_ULONGLONG:
result = MVM_nativecall_make_uint(tc, res_type, (DCulonglong)dcCallLongLong(vm, entry_point));
break;
default:
MVM_exception_throw_adhoc(tc, "Internal error: unhandled dyncall return type");
}
});
});