/* Gets the current value for an attribute. */
static PMC * get_attribute_boxed(PARROT_INTERP, STable *st, void *data, PMC *class_handle, STRING *name, INTVAL hint) {
P6opaqueREPRData *repr_data = (P6opaqueREPRData *)st->REPR_data;
INTVAL slot;
/* Try the slot allocation first. */
slot = hint >= 0 && !(repr_data->mi) ? hint :
try_get_slot(interp, repr_data, class_handle, name);
if (slot >= 0) {
if (!repr_data->flattened_stables[slot]) {
PMC *result = get_pmc_at_offset(data, repr_data->attribute_offsets[slot]);
if (result) {
return result;
}
else {
/* Maybe we know how to auto-viv it to a container. */
if (repr_data->auto_viv_values) {
PMC *value = repr_data->auto_viv_values[slot];
if (value != NULL) {
PMC *cloned = REPR(value)->allocate(interp, STABLE(value));
REPR(value)->copy_to(interp, STABLE(value), OBJECT_BODY(value), OBJECT_BODY(cloned));
PARROT_GC_WRITE_BARRIER(interp, cloned);
set_pmc_at_offset(data, repr_data->attribute_offsets[slot], cloned);
return cloned;
}
}
return PMCNULL;
}
}
else {
/* Need to produce a boxed version of this attribute. */
STable *st = repr_data->flattened_stables[slot];
PMC *result = st->REPR->allocate(interp, st);
st->REPR->copy_to(interp, st, (char *)data + repr_data->attribute_offsets[slot],
OBJECT_BODY(result));
PARROT_GC_WRITE_BARRIER(interp, result);
return result;
}
}
/* Otherwise, complain that the attribute doesn't exist. */
no_such_attribute(interp, "get", class_handle, name);
}
/* Attribute name introspection. */
static void attr_name(PARROT_INTERP, PMC *nci) {
PMC * unused;
PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0);
STRING *name = REPR(self)->box_funcs->get_str(interp, STABLE(self), OBJECT_BODY(self));
UNUSED(nci);
unused = Parrot_pcc_build_call_from_c_args(interp, capture, "S", name);
}
/* Marks a collectable item (object, type object, STable). */
void MVM_gc_mark_collectable(MVMThreadContext *tc, MVMGCWorklist *worklist, MVMCollectable *new_addr) {
MVMuint16 i;
MVM_gc_worklist_add(tc, worklist, &new_addr->sc);
if (!(new_addr->flags & (MVM_CF_TYPE_OBJECT | MVM_CF_STABLE))) {
/* Need to view it as an object in here. */
MVMObject *new_addr_obj = (MVMObject *)new_addr;
/* Add the STable to the worklist. */
MVM_gc_worklist_add(tc, worklist, &new_addr_obj->st);
/* If needed, mark it. This will add addresses to the worklist
* that will need updating. Note that we are passing the address
* of the object *after* copying it since those are the addresses
* we care about updating; the old chunk of memory is now dead! */
if (MVM_GC_DEBUG_ENABLED(MVM_GC_DEBUG_COLLECT) && !STABLE(new_addr_obj))
MVM_panic(MVM_exitcode_gcnursery, "Found an outdated reference to address %p", new_addr);
if (REPR(new_addr_obj)->gc_mark)
REPR(new_addr_obj)->gc_mark(tc, STABLE(new_addr_obj), OBJECT_BODY(new_addr_obj), worklist);
}
else if (new_addr->flags & MVM_CF_TYPE_OBJECT) {
/* Add the STable to the worklist. */
MVM_gc_worklist_add(tc, worklist, &((MVMObject *)new_addr)->st);
}
else if (new_addr->flags & MVM_CF_STABLE) {
/* Add all references in the STable to the work list. */
MVMSTable *new_addr_st = (MVMSTable *)new_addr;
MVM_gc_worklist_add(tc, worklist, &new_addr_st->HOW);
MVM_gc_worklist_add(tc, worklist, &new_addr_st->WHAT);
MVM_gc_worklist_add(tc, worklist, &new_addr_st->method_cache);
for (i = 0; i < new_addr_st->vtable_length; i++)
MVM_gc_worklist_add(tc, worklist, &new_addr_st->vtable[i]);
for (i = 0; i < new_addr_st->type_check_cache_length; i++)
MVM_gc_worklist_add(tc, worklist, &new_addr_st->type_check_cache[i]);
if (new_addr_st->container_spec)
if (new_addr_st->container_spec->gc_mark_data)
new_addr_st->container_spec->gc_mark_data(tc, new_addr_st, worklist);
if (new_addr_st->boolification_spec)
MVM_gc_worklist_add(tc, worklist, &new_addr_st->boolification_spec->method);
if (new_addr_st->invocation_spec) {
MVM_gc_worklist_add(tc, worklist, &new_addr_st->invocation_spec->class_handle);
MVM_gc_worklist_add(tc, worklist, &new_addr_st->invocation_spec->attr_name);
MVM_gc_worklist_add(tc, worklist, &new_addr_st->invocation_spec->invocation_handler);
}
MVM_gc_worklist_add(tc, worklist, &new_addr_st->WHO);
/* If it needs to have its REPR data marked, do that. */
if (new_addr_st->REPR->gc_mark_repr_data)
new_addr_st->REPR->gc_mark_repr_data(tc, new_addr_st, worklist);
}
else {
MVM_panic(MVM_exitcode_gcnursery, "Internal error: impossible case encountered in GC marking");
}
}
/* Attribute new method. */
static void attr_new(PARROT_INTERP, PMC *nci) {
PMC * unused;
PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *type = VTABLE_get_pmc_keyed_int(interp, capture, 0);
STRING *name = VTABLE_get_string_keyed_str(interp, capture, name_str);
PMC *self = REPR(type)->allocate(interp, STABLE(type));
UNUSED(nci);
REPR(self)->box_funcs->set_str(interp, STABLE(self), OBJECT_BODY(self), name);
unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", self);
}
static void process_object(MVMThreadContext *tc, MVMHeapSnapshotState *ss,
MVMHeapSnapshotCollectable *col, MVMObject *obj) {
process_collectable(tc, ss, col, (MVMCollectable *)obj);
set_type_index(tc, ss, col, obj->st);
add_reference_const_cstr(tc, ss, "<STable>",
get_collectable_idx(tc, ss, (MVMCollectable *)obj->st));
if (IS_CONCRETE(obj)) {
/* Use object's gc_mark function to find what it references. */
/* XXX We'll also add an API for getting better information, e.g.
* attribute names. */
if (REPR(obj)->describe_refs)
REPR(obj)->describe_refs(tc, ss, STABLE(obj), OBJECT_BODY(obj));
else if (REPR(obj)->gc_mark) {
REPR(obj)->gc_mark(tc, STABLE(obj), OBJECT_BODY(obj), ss->gcwl);
process_gc_worklist(tc, ss, NULL);
}
if (REPR(obj)->unmanaged_size)
col->unmanaged_size += REPR(obj)->unmanaged_size(tc, STABLE(obj),
OBJECT_BODY(obj));
}
}
static void Str_say(MVMThreadContext *tc, MVMCallsite *callsite, MVMRegister *args) {
MVMArgProcContext arg_ctx; arg_ctx.named_used = NULL;
MVM_args_proc_init(tc, &arg_ctx, callsite, args);
MVMObject* self = MVM_args_get_pos_obj(tc, &arg_ctx, 0, MVM_ARG_REQUIRED).arg.o;
MVM_args_proc_cleanup(tc, &arg_ctx);
MVM_gc_root_temp_push(tc, (MVMCollectable **)&self);
MVMString * self_s = REPR(self)->box_funcs->get_str(tc, STABLE(self), self, OBJECT_BODY(self));
MVM_string_say(tc, self_s);
MVM_gc_root_temp_pop_n(tc, 1);
}
/* KnowHOW.new_type method. Creates a new type with this HOW as its meta-object. */
static void new_type(MVMThreadContext *tc, MVMCallsite *callsite, MVMRegister *args) {
MVMObject *self, *HOW, *type_object, *BOOTHash, *stash;
MVMArgInfo repr_arg, name_arg;
MVMString *repr_name, *name;
const MVMREPROps *repr_to_use;
MVMInstance *instance = tc->instance;
/* Get arguments. */
MVMArgProcContext arg_ctx; arg_ctx.named_used = NULL;
MVM_args_proc_init(tc, &arg_ctx, callsite, args);
MVM_args_checkarity(tc, &arg_ctx, 1, 1);
self = MVM_args_get_pos_obj(tc, &arg_ctx, 0, MVM_ARG_REQUIRED).arg.o;
repr_arg = MVM_args_get_named_str(tc, &arg_ctx, instance->str_consts.repr, MVM_ARG_OPTIONAL);
name_arg = MVM_args_get_named_str(tc, &arg_ctx, instance->str_consts.name, MVM_ARG_OPTIONAL);
MVM_args_proc_cleanup(tc, &arg_ctx);
if (REPR(self)->ID != MVM_REPR_ID_KnowHOWREPR)
MVM_exception_throw_adhoc(tc, "KnowHOW methods must be called on object with REPR KnowHOWREPR");
/* See if we have a representation name; if not default to P6opaque. */
repr_name = repr_arg.exists ? repr_arg.arg.s : instance->str_consts.P6opaque;
repr_to_use = MVM_repr_get_by_name(tc, repr_name);
MVM_gc_root_temp_push(tc, (MVMCollectable **)&name_arg);
/* We first create a new HOW instance. */
HOW = REPR(self)->allocate(tc, STABLE(self));
MVM_gc_root_temp_push(tc, (MVMCollectable **)&HOW);
/* Create a new type object of the desired REPR. (Note that we can't
* default to KnowHOWREPR here, since it doesn't know how to actually
* store attributes, it's just for bootstrapping knowhow's. */
type_object = repr_to_use->type_object_for(tc, HOW);
MVM_gc_root_temp_push(tc, (MVMCollectable **)&type_object);
/* This may move name_arg.arg.s so do it first: */
REPR(HOW)->initialize(tc, STABLE(HOW), HOW, OBJECT_BODY(HOW));
/* See if we were given a name; put it into the meta-object if so. */
name = name_arg.exists ? name_arg.arg.s : instance->str_consts.anon;
MVM_ASSIGN_REF(tc, &(HOW->header), ((MVMKnowHOWREPR *)HOW)->body.name, name);
/* Set .WHO to an empty hash. */
BOOTHash = tc->instance->boot_types.BOOTHash;
stash = REPR(BOOTHash)->allocate(tc, STABLE(BOOTHash));
MVM_gc_root_temp_push(tc, (MVMCollectable **)&stash);
MVM_ASSIGN_REF(tc, &(STABLE(type_object)->header), STABLE(type_object)->WHO, stash);
/* Return the type object. */
MVM_args_set_result_obj(tc, type_object, MVM_RETURN_CURRENT_FRAME);
MVM_gc_root_temp_pop_n(tc, 4);
}
/*
=item C<static STRING* dump_signature(PARROT_INTERP, STRING *so_far, PMC *sub)>
Utility for getting hold of the signature dump for a sub, which aids us in
producing awesomer errors.
=cut
*/
static STRING* dump_signature(PARROT_INTERP, STRING *so_far, PMC *sub) {
STRING * const sig_name = Parrot_str_new(interp, "signature", 0);
STRING * const perl_name = Parrot_str_new(interp, "perl", 0);
STRING * const newline = Parrot_str_new(interp, "\n", 0);
PMC * sig_meth, *sig_obj, *perl_meth, * sig_perl;
sig_meth = VTABLE_find_method(interp, sub, sig_name);
Parrot_ext_call(interp, sig_meth, "Pi->P", sub, &sig_obj);
perl_meth = VTABLE_find_method(interp, sig_obj, perl_name);
Parrot_ext_call(interp, perl_meth, "Pi->P", sig_obj, &sig_perl);
so_far = Parrot_str_concat(interp, so_far,
REPR(sig_perl)->box_funcs->get_str(interp, STABLE(sig_perl), OBJECT_BODY(sig_perl)));
so_far = Parrot_str_concat(interp, so_far, newline);
return so_far;
}
MVMint64 MVM_coerce_simple_intify(MVMThreadContext *tc, MVMObject *obj) {
/* Handle null and non-concrete case. */
if (MVM_is_null(tc, obj) || !IS_CONCRETE(obj)) {
return 0;
}
/* Otherwise, guess something appropriate. */
else {
const MVMStorageSpec *ss = REPR(obj)->get_storage_spec(tc, STABLE(obj));
if (ss->can_box & MVM_STORAGE_SPEC_CAN_BOX_INT)
return REPR(obj)->box_funcs.get_int(tc, STABLE(obj), obj, OBJECT_BODY(obj));
else if (ss->can_box & MVM_STORAGE_SPEC_CAN_BOX_NUM)
return (MVMint64)REPR(obj)->box_funcs.get_num(tc, STABLE(obj), obj, OBJECT_BODY(obj));
else if (ss->can_box & MVM_STORAGE_SPEC_CAN_BOX_STR)
return MVM_coerce_s_i(tc, REPR(obj)->box_funcs.get_str(tc, STABLE(obj), obj, OBJECT_BODY(obj)));
else if (REPR(obj)->ID == MVM_REPR_ID_MVMArray)
return REPR(obj)->elems(tc, STABLE(obj), obj, OBJECT_BODY(obj));
else if (REPR(obj)->ID == MVM_REPR_ID_MVMHash)
return REPR(obj)->elems(tc, STABLE(obj), obj, OBJECT_BODY(obj));
else
MVM_exception_throw_adhoc(tc, "cannot intify this");
}
}
static void Str_length(MVMThreadContext *tc, MVMCallsite *callsite, MVMRegister *args) {
MVMArgProcContext arg_ctx; arg_ctx.named_used = NULL;
MVM_args_proc_init(tc, &arg_ctx, callsite, args);
MVMObject* self = MVM_args_get_pos_obj(tc, &arg_ctx, 0, MVM_ARG_REQUIRED).arg.o;
MVM_args_proc_cleanup(tc, &arg_ctx);
MVM_gc_root_temp_push(tc, (MVMCollectable **)&self);
MVMString * self_s = REPR(self)->box_funcs->get_str(tc, STABLE(self), self, OBJECT_BODY(self));
MVMint64 length = NUM_GRAPHS((MVMString*)self_s);
MVM_args_set_result_int(tc, length, MVM_RETURN_CURRENT_FRAME);
MVM_gc_root_temp_pop_n(tc, 1);
}
/* splice - injects an array into another array at a certain point,
* possibly replacing any amount of the existing items. This can be
* done without a copying transaction, by first copying *either the
* head or tail* (which one's shorter) into position, RTL or LTR
* depending on which direction it's moving. Note this copying must
* know *which* copy_index it's attempting to update, so it
* doesn't double-count the slot copy if the source object matches
* what's already in the destination slot and two threads notice
* this at the same time and try to increment copy_index. This
* helps elucidate a general principle of all of the transactions
* applied in these transaction records - each type has a well-
* defined, monotonic sequence of operations, and a reader or
* writer can always know whether a given transaction's activity
* has been recorded for a given cell. */
void MVM_LFA_splice(MVMThreadContext *tc, MVMLFArray *toparr, MVMObject *from, MVMuint64 offset, MVMuint64 count) {
MVMLFA *lfa, *new_lfa, *n;
MVMObject *nah = NULL;
MVMuint64 from_elems = REPR(from)->pos_funcs->elems(
tc, STABLE(from), from, OBJECT_BODY(from));
new_lfa = MVM_LFA_acquire_lfa(tc);
new_lfa->copy_item = from;
new_lfa->copy_start = offset;
new_lfa->copy_count = count;
while (1) {
lfa = MVM_LFA_newest_lfa(tc, toparr);
new_lfa->start = lfa->start;
new_lfa->prev_lfa = lfa;
new_lfa->elems = offset >= lfa->elems
/* the insertion point is at or past the end of the array,
* so count is really irrelevant; just assume it's
* replacing NULLs. */
? offset + from_elems
: lfa->elems - count + from_elems;
new_lfa->ssize = lfa->ssize;
if (new_lfa->elems > new_lfa->ssize) {
/* ugh; need to grow the array *and* splice */
do { /* XXX don't just blindly double eventually */
new_lfa->ssize *= 2;
} while (new_lfa->elems >= new_lfa->ssize);
new_lfa->slots = calloc(
new_lfa->ssize, sizeof(MVMObject *));
}
else {
new_lfa->slots = MVM_LFA_SLOTS(lfa);
}
/* mark it as a splice */
new_lfa->slots = (MVMObject **)(
(uintptr_t)new_lfa->slots | 2);
/* attempt the cas */
if (MVM_LFA_attempt_lfa(tc, toparr, lfa, new_lfa, new_lfa->elems - 1))
return;
}
}
void MVM_coerce_smart_stringify(MVMThreadContext *tc, MVMObject *obj, MVMRegister *res_reg) {
MVMObject *strmeth;
const MVMStorageSpec *ss;
/* Handle null case. */
if (MVM_is_null(tc, obj)) {
res_reg->s = tc->instance->str_consts.empty;
return;
}
/* If it can unbox as a string, that wins right off. */
ss = REPR(obj)->get_storage_spec(tc, STABLE(obj));
if (ss->can_box & MVM_STORAGE_SPEC_CAN_BOX_STR && IS_CONCRETE(obj)) {
res_reg->s = REPR(obj)->box_funcs.get_str(tc, STABLE(obj), obj, OBJECT_BODY(obj));
return;
}
/* Check if there is a Str method. */
strmeth = MVM_6model_find_method_cache_only(tc, obj,
tc->instance->str_consts.Str);
if (!MVM_is_null(tc, strmeth)) {
/* We need to do the invocation; just set it up with our result reg as
* the one for the call. */
MVMObject *code = MVM_frame_find_invokee(tc, strmeth, NULL);
MVMCallsite *inv_arg_callsite = MVM_callsite_get_common(tc, MVM_CALLSITE_ID_INV_ARG);
MVM_args_setup_thunk(tc, res_reg, MVM_RETURN_STR, inv_arg_callsite);
tc->cur_frame->args[0].o = obj;
STABLE(code)->invoke(tc, code, inv_arg_callsite, tc->cur_frame->args);
return;
}
/* Otherwise, guess something appropriate. */
if (!IS_CONCRETE(obj))
res_reg->s = tc->instance->str_consts.empty;
else {
if (REPR(obj)->ID == MVM_REPR_ID_MVMException)
res_reg->s = ((MVMException *)obj)->body.message;
else if (ss->can_box & MVM_STORAGE_SPEC_CAN_BOX_INT)
res_reg->s = MVM_coerce_i_s(tc, REPR(obj)->box_funcs.get_int(tc, STABLE(obj), obj, OBJECT_BODY(obj)));
else if (ss->can_box & MVM_STORAGE_SPEC_CAN_BOX_NUM)
res_reg->s = MVM_coerce_n_s(tc, REPR(obj)->box_funcs.get_num(tc, STABLE(obj), obj, OBJECT_BODY(obj)));
else
MVM_exception_throw_adhoc(tc, "cannot stringify this");
}
}
/* This Parrot-specific addition to the API is used to free an object. */
static void gc_free(PARROT_INTERP, PMC *obj) {
P6opaqueREPRData *repr_data = (P6opaqueREPRData *)STABLE(obj)->REPR_data;
INTVAL i;
/* Cleanup any nested reprs that need it. */
if (repr_data->gc_cleanup_slots) {
for (i = 0; repr_data->gc_cleanup_slots[i] >= 0; i++) {
INTVAL offset = repr_data->attribute_offsets[repr_data->gc_cleanup_slots[i]];
STable *st = repr_data->flattened_stables[repr_data->gc_cleanup_slots[i]];
st->REPR->gc_cleanup(interp, st, (char *)OBJECT_BODY(obj) + offset);
}
}
if (repr_data->allocation_size && !PObj_flag_TEST(private0, obj))
Parrot_gc_free_fixed_size_storage(interp, repr_data->allocation_size, PMC_data(obj));
else
mem_sys_free(PMC_data(obj));
PMC_data(obj) = NULL;
}
/* Adds a method into the KnowHOW.HOW method table. */
static void add_knowhow_how_method(MVMThreadContext *tc, MVMKnowHOWREPR *knowhow_how,
char *name, void (*func) (MVMThreadContext *, MVMCallsite *, MVMRegister *)) {
MVMObject *BOOTCCode, *code_obj, *method_table, *name_str;
/* Create string for name. */
name_str = (MVMObject *)MVM_string_ascii_decode_nt(tc,
tc->instance->VMString, name);
/* Allocate a BOOTCCode and put pointer in. */
BOOTCCode = tc->instance->boot_types->BOOTCCode;
code_obj = REPR(BOOTCCode)->allocate(tc, STABLE(BOOTCCode));
((MVMCFunction *)code_obj)->body.func = func;
/* Add into the table. */
method_table = knowhow_how->body.methods;
REPR(method_table)->ass_funcs->bind_key_boxed(tc, STABLE(method_table),
method_table, OBJECT_BODY(method_table), name_str, code_obj);
}
void MVM_coerce_smart_stringify(MVMThreadContext *tc, MVMObject *obj, MVMRegister *res_reg) {
MVMObject *strmeth;
/* Handle null case. */
if (!obj) {
res_reg->s = tc->instance->str_consts->empty;
return;
}
/* Check if there is a Str method. */
strmeth = MVM_6model_find_method_cache_only(tc, obj,
tc->instance->str_consts->Str);
if (strmeth) {
/* We need to do the invocation; just set it up with our result reg as
* the one for the call. */
MVMObject *code = MVM_frame_find_invokee(tc, strmeth);
tc->cur_frame->return_value = res_reg;
tc->cur_frame->return_type = MVM_RETURN_STR;
tc->cur_frame->return_address = *(tc->interp_cur_op);
tc->cur_frame->args[0].o = obj;
STABLE(code)->invoke(tc, code, get_inv_callsite(), tc->cur_frame->args);
return;
}
/* Otherwise, guess something appropriate. */
if (!IS_CONCRETE(obj))
res_reg->s = tc->instance->str_consts->empty;
else {
MVMStorageSpec ss = REPR(obj)->get_storage_spec(tc, STABLE(obj));
if (REPR(obj)->ID == MVM_REPR_ID_MVMString)
res_reg->s = (MVMString *)obj;
else if (ss.can_box & MVM_STORAGE_SPEC_CAN_BOX_STR)
res_reg->s = REPR(obj)->box_funcs->get_str(tc, STABLE(obj), obj, OBJECT_BODY(obj));
else if (ss.can_box & MVM_STORAGE_SPEC_CAN_BOX_INT)
res_reg->s = MVM_coerce_i_s(tc, REPR(obj)->box_funcs->get_int(tc, STABLE(obj), obj, OBJECT_BODY(obj)));
else if (ss.can_box & MVM_STORAGE_SPEC_CAN_BOX_NUM)
res_reg->s = MVM_coerce_n_s(tc, REPR(obj)->box_funcs->get_num(tc, STABLE(obj), obj, OBJECT_BODY(obj)));
else
MVM_exception_throw_adhoc(tc, "cannot stringify this");
}
}
/* Creates a new serialization context with the specified handle. If any
* compilation units are waiting for an SC with this handle, removes it from
* their to-resolve list after installing itself in the appropriate slot. */
MVMObject * MVM_sc_create(MVMThreadContext *tc, MVMString *handle) {
MVMObject *sc;
MVMCompUnit *cur_cu;
/* Allocate. */
MVMROOT(tc, handle, {
sc = REPR(tc->instance->SCRef)->allocate(tc, STABLE(tc->instance->SCRef));
MVMROOT(tc, sc, {
REPR(sc)->initialize(tc, STABLE(sc), sc, OBJECT_BODY(sc));
/* Set handle. */
MVM_ASSIGN_REF(tc, sc, ((MVMSerializationContext *)sc)->body->handle, handle);
/* Add to weak lookup hash. */
if (apr_thread_mutex_lock(tc->instance->mutex_sc_weakhash) != APR_SUCCESS)
MVM_exception_throw_adhoc(tc, "Unable to lock SC weakhash");
MVM_string_flatten(tc, handle);
MVM_HASH_BIND(tc, tc->instance->sc_weakhash, handle, ((MVMSerializationContext *)sc)->body);
if (apr_thread_mutex_unlock(tc->instance->mutex_sc_weakhash) != APR_SUCCESS)
MVM_exception_throw_adhoc(tc, "Unable to unlock SC weakhash");
/* Visit compilation units that need this SC and resolve it. */
cur_cu = tc->instance->head_compunit;
while (cur_cu) {
if (cur_cu->scs_to_resolve) {
MVMuint32 i;
for (i = 0; i < cur_cu->num_scs; i++) {
MVMString *res = cur_cu->scs_to_resolve[i];
if (res && MVM_string_equal(tc, res, handle)) {
cur_cu->scs[i] = (MVMSerializationContext *)sc;
cur_cu->scs_to_resolve[i] = NULL;
break;
}
}
}
cur_cu = cur_cu->next_compunit;
}
});
});
void MVM_coerce_smart_stringify(MVMThreadContext *tc, MVMObject *obj, MVMRegister *res_reg) {
MVMObject *strmeth;
const MVMStorageSpec *ss;
/* Handle null case. */
if (MVM_is_null(tc, obj)) {
res_reg->s = tc->instance->str_consts.empty;
return;
}
/* If it can unbox as a string, that wins right off. */
ss = REPR(obj)->get_storage_spec(tc, STABLE(obj));
if (ss->can_box & MVM_STORAGE_SPEC_CAN_BOX_STR && IS_CONCRETE(obj)) {
res_reg->s = REPR(obj)->box_funcs.get_str(tc, STABLE(obj), obj, OBJECT_BODY(obj));
return;
}
/* Check if there is a Str method. */
MVMROOT(tc, obj, {
strmeth = MVM_6model_find_method_cache_only(tc, obj,
tc->instance->str_consts.Str);
});
/* Adds a method. */
static void add_method(MVMThreadContext *tc, MVMCallsite *callsite, MVMRegister *args) {
MVMObject *self, *type_obj, *method, *method_table;
MVMString *name;
/* Get arguments. */
MVMArgProcContext arg_ctx; arg_ctx.named_used = NULL;
MVM_args_proc_init(tc, &arg_ctx, callsite, args);
self = MVM_args_get_pos_obj(tc, &arg_ctx, 0, MVM_ARG_REQUIRED).arg.o;
type_obj = MVM_args_get_pos_obj(tc, &arg_ctx, 1, MVM_ARG_REQUIRED).arg.o;
name = MVM_args_get_pos_str(tc, &arg_ctx, 2, MVM_ARG_REQUIRED).arg.s;
method = MVM_args_get_pos_obj(tc, &arg_ctx, 3, MVM_ARG_REQUIRED).arg.o;
MVM_args_proc_cleanup(tc, &arg_ctx);
if (!self || !IS_CONCRETE(self) || REPR(self)->ID != MVM_REPR_ID_KnowHOWREPR)
MVM_exception_throw_adhoc(tc, "KnowHOW methods must be called on object instance with REPR KnowHOWREPR");
/* Add to method table. */
method_table = ((MVMKnowHOWREPR *)self)->body.methods;
REPR(method_table)->ass_funcs->bind_key_boxed(tc, STABLE(method_table),
method_table, OBJECT_BODY(method_table), (MVMObject *)name, method);
/* Return added method as result. */
MVM_args_set_result_obj(tc, method, MVM_RETURN_CURRENT_FRAME);
}
static void set_str(PARROT_INTERP, STable *st, void *data, STRING *value) {
CStrBody *body = (CStrBody *) data;
PMC *old_ctx, *cappy, *meth, *enc_pmc;
STRING *enc;
STR_VTABLE *encoding;
if(body->cstr)
mem_sys_free(body->cstr);
/* Look up "encoding" method. */
meth = VTABLE_find_method(interp, st->WHAT,
Parrot_str_new_constant(interp, "encoding"));
if (PMC_IS_NULL(meth))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"CStr representation expects an 'encoding' method, specifying the encoding");
old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
cappy = Parrot_pmc_new(interp, enum_class_CallContext);
VTABLE_push_pmc(interp, cappy, st->WHAT);
Parrot_pcc_invoke_from_sig_object(interp, meth, cappy);
cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
enc_pmc = decontainerize(interp, VTABLE_get_pmc_keyed_int(interp, cappy, 0));
enc = REPR(enc_pmc)->box_funcs->get_str(interp, STABLE(enc_pmc), OBJECT_BODY(enc_pmc));
if (STRING_equal(interp, enc, Parrot_str_new_constant(interp, "utf8")))
encoding = Parrot_utf8_encoding_ptr;
else if (STRING_equal(interp, enc, Parrot_str_new_constant(interp, "utf16")))
encoding = Parrot_utf16_encoding_ptr;
else if (STRING_equal(interp, enc, Parrot_str_new_constant(interp, "ascii")))
encoding = Parrot_ascii_encoding_ptr;
else
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Unknown encoding passed to CStr representation");
body->cstr = Parrot_str_to_encoded_cstring(interp, value, encoding);
}
/* Composes the meta-object. */
static void compose(PARROT_INTERP, PMC *nci) {
PMC *repr_info_hash, *repr_info, *type_info, *attr_list, *attr_iter, *unused;
PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0);
PMC *obj = VTABLE_get_pmc_keyed_int(interp, capture, 1);
UNUSED(nci);
/* Do REPR composition. */
repr_info = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
type_info = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
VTABLE_push_pmc(interp, repr_info, type_info);
VTABLE_push_pmc(interp, type_info, obj);
attr_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
attr_iter = VTABLE_get_iter(interp, ((KnowHOWREPRInstance *)PMC_data(self))->body.attributes);
while (VTABLE_get_bool(interp, attr_iter)) {
PMC *attr = VTABLE_shift_pmc(interp, attr_iter);
PMC *attr_hash = Parrot_pmc_new(interp, enum_class_Hash);;
VTABLE_set_string_keyed_str(interp, attr_hash, name_str,
REPR(attr)->box_funcs->get_str(interp, STABLE(attr), OBJECT_BODY(attr)));
VTABLE_push_pmc(interp, attr_list, attr_hash);
}
VTABLE_push_pmc(interp, type_info, attr_list);
VTABLE_push_pmc(interp, type_info, Parrot_pmc_new(interp, enum_class_ResizablePMCArray));
repr_info_hash = Parrot_pmc_new(interp, enum_class_Hash);
VTABLE_set_pmc_keyed_str(interp, repr_info_hash, attribute_str, repr_info);
REPR(obj)->compose(interp, STABLE(obj), repr_info_hash);
/* Set up method and type caches. */
STABLE(obj)->method_cache = ((KnowHOWREPRInstance *)PMC_data(self))->body.methods;
STABLE(obj)->mode_flags = METHOD_CACHE_AUTHORITATIVE;
STABLE(obj)->type_check_cache_length = 1;
STABLE(obj)->type_check_cache = (PMC **)mem_sys_allocate(sizeof(PMC *));
STABLE(obj)->type_check_cache[0] = obj;
unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", obj);
}
MVMint64 MVM_proc_spawn(MVMThreadContext *tc, MVMObject *argv, MVMString *cwd, MVMObject *env) {
MVMint64 result = 0, spawn_result = 0;
uv_process_t *process = calloc(1, sizeof(uv_process_t));
uv_process_options_t process_options = {0};
uv_stdio_container_t process_stdio[3];
int i;
char * const _cwd = MVM_string_utf8_encode_C_string(tc, cwd);
const MVMuint64 size = MVM_repr_elems(tc, env);
MVMIter * const iter = (MVMIter *)MVM_iter(tc, env);
char **_env = malloc((size + 1) * sizeof(char *));
const MVMuint64 arg_size = MVM_repr_elems(tc, argv);
char **args = malloc((arg_size + 1) * sizeof(char *));
MVMRegister reg;
i = 0;
while(i < arg_size) {
REPR(argv)->pos_funcs.at_pos(tc, STABLE(argv), argv, OBJECT_BODY(argv), i, ®, MVM_reg_obj);
args[i++] = MVM_string_utf8_encode_C_string(tc, MVM_repr_get_str(tc, reg.o));
}
args[arg_size] = NULL;
INIT_ENV();
SPAWN(arg_size ? args[0] : NULL);
FREE_ENV();
free(_cwd);
i = 0;
while(args[i])
free(args[i++]);
free(args);
return result;
}
/* Creates a new type with this HOW as its meta-object. */
static void new_type(PARROT_INTERP, PMC *nci) {
PMC * unused;
/* We first create a new HOW instance. */
PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *self = VTABLE_get_pmc_keyed_int(interp, capture, 0);
PMC *HOW = REPR(self)->allocate(interp, STABLE(self));
/* See if we have a representation name; if not default to P6opaque. */
STRING *repr_name = VTABLE_exists_keyed_str(interp, capture, repr_str) ?
VTABLE_get_string_keyed_str(interp, capture, repr_str) :
p6opaque_str;
/* Create a new type object of the desired REPR. (Note that we can't
* default to KnowHOWREPR here, since it doesn't know how to actually
* store attributes, it's just for bootstrapping knowhow's. */
REPROps *repr_to_use = REPR_get_by_name(interp, repr_name);
PMC *type_object = repr_to_use->type_object_for(interp, HOW);
/* See if we were given a name; put it into the meta-object if so. */
STRING *name = VTABLE_exists_keyed_str(interp, capture, name_str) ?
VTABLE_get_string_keyed_str(interp, capture, name_str) :
empty_str;
UNUSED(nci);
REPR(HOW)->initialize(interp, STABLE(HOW), OBJECT_BODY(HOW));
((KnowHOWREPRInstance *)PMC_data(HOW))->body.name = name;
PARROT_GC_WRITE_BARRIER(interp, HOW);
/* Set .WHO to an empty hash. */
STABLE(type_object)->WHO = Parrot_pmc_new(interp, enum_class_Hash);
PARROT_GC_WRITE_BARRIER(interp, STABLE_PMC(type_object));
/* Put it into capture to act as return value. */
unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", type_object);
}
void MVM_repr_init(MVMThreadContext *tc, MVMObject *obj) {
if (REPR(obj)->initialize)
REPR(obj)->initialize(tc, STABLE(obj), obj, OBJECT_BODY(obj));
}
void MVM_coerce_istrue(MVMThreadContext *tc, MVMObject *obj, MVMRegister *res_reg,
MVMuint8 *true_addr, MVMuint8 *false_addr, MVMuint8 flip) {
MVMint64 result = 0;
if (!MVM_is_null(tc, obj)) {
MVMBoolificationSpec *bs = obj->st->boolification_spec;
switch (bs == NULL ? MVM_BOOL_MODE_NOT_TYPE_OBJECT : bs->mode) {
case MVM_BOOL_MODE_CALL_METHOD: {
MVMObject *code = MVM_frame_find_invokee(tc, bs->method, NULL);
MVMCallsite *inv_arg_callsite = MVM_callsite_get_common(tc, MVM_CALLSITE_ID_INV_ARG);
if (res_reg) {
/* We need to do the invocation, and set this register
* the result. Then we just do the call. For the flip
* case, just set up special return handler to flip
* the register. */
MVM_args_setup_thunk(tc, res_reg, MVM_RETURN_INT, inv_arg_callsite);
tc->cur_frame->args[0].o = obj;
if (flip) {
tc->cur_frame->special_return = flip_return;
tc->cur_frame->special_return_data = res_reg;
}
STABLE(code)->invoke(tc, code, inv_arg_callsite, tc->cur_frame->args);
}
else {
/* Need to set up special return hook. */
BoolMethReturnData *data = MVM_malloc(sizeof(BoolMethReturnData));
data->true_addr = true_addr;
data->false_addr = false_addr;
data->flip = flip;
tc->cur_frame->special_return = boolify_return;
tc->cur_frame->special_return_data = data;
MVM_args_setup_thunk(tc, &data->res_reg, MVM_RETURN_INT, inv_arg_callsite);
tc->cur_frame->args[0].o = obj;
STABLE(code)->invoke(tc, code, inv_arg_callsite, tc->cur_frame->args);
}
return;
}
case MVM_BOOL_MODE_UNBOX_INT:
result = !IS_CONCRETE(obj) || REPR(obj)->box_funcs.get_int(tc, STABLE(obj), obj, OBJECT_BODY(obj)) == 0 ? 0 : 1;
break;
case MVM_BOOL_MODE_UNBOX_NUM:
result = !IS_CONCRETE(obj) || REPR(obj)->box_funcs.get_num(tc, STABLE(obj), obj, OBJECT_BODY(obj)) == 0.0 ? 0 : 1;
break;
case MVM_BOOL_MODE_UNBOX_STR_NOT_EMPTY: {
MVMString *str;
if (!IS_CONCRETE(obj)) {
result = 0;
break;
}
str = REPR(obj)->box_funcs.get_str(tc, STABLE(obj), obj, OBJECT_BODY(obj));
result = MVM_coerce_istrue_s(tc, str);
break;
}
case MVM_BOOL_MODE_UNBOX_STR_NOT_EMPTY_OR_ZERO: {
MVMString *str;
MVMint64 chars;
if (!IS_CONCRETE(obj)) {
result = 0;
break;
}
str = REPR(obj)->box_funcs.get_str(tc, STABLE(obj), obj, OBJECT_BODY(obj));
if (str == NULL || !IS_CONCRETE(str)) {
result = 0;
break;
}
chars = MVM_string_graphs(tc, str);
result = chars == 0 ||
(chars == 1 && MVM_string_get_grapheme_at_nocheck(tc, str, 0) == 48)
? 0 : 1;
break;
}
case MVM_BOOL_MODE_NOT_TYPE_OBJECT:
result = !IS_CONCRETE(obj) ? 0 : 1;
break;
case MVM_BOOL_MODE_BIGINT:
result = IS_CONCRETE(obj) ? MVM_bigint_bool(tc, obj) : 0;
break;
case MVM_BOOL_MODE_ITER:
result = IS_CONCRETE(obj) ? MVM_iter_istrue(tc, (MVMIter *)obj) : 0;
break;
case MVM_BOOL_MODE_HAS_ELEMS:
result = IS_CONCRETE(obj) ? MVM_repr_elems(tc, obj) != 0 : 0;
break;
default:
MVM_exception_throw_adhoc(tc, "Invalid boolification spec mode used");
}
}
if (flip)
result = result ? 0 : 1;
if (res_reg) {
res_reg->i64 = result;
}
else {
if (result)
*(tc->interp_cur_op) = true_addr;
else
*(tc->interp_cur_op) = false_addr;
}
}
/* Returns the body of a P6bigint, containing the bigint/smallint union, for
* operations that want to explicitly handle the two. */
static MVMP6bigintBody * get_bigint_body(MVMThreadContext *tc, MVMObject *obj) {
return (MVMP6bigintBody *)REPR(obj)->box_funcs.get_boxed_ref(tc,
STABLE(obj), obj, OBJECT_BODY(obj), MVM_REPR_ID_P6bigint);
}
/* Binds a single argument into the lexpad, after doing any checks that are
* needed. Also handles any type captures. If there is a sub signature, then
* re-enters the binder. Returns one of the BIND_RESULT_* codes. */
static INTVAL
Rakudo_binding_bind_one_param(PARROT_INTERP, PMC *lexpad, Rakudo_Signature *signature, Rakudo_Parameter *param,
Rakudo_BindVal orig_bv, INTVAL no_nom_type_check, STRING **error) {
PMC *decont_value = NULL;
INTVAL desired_native;
Rakudo_BindVal bv;
/* Check if boxed/unboxed expections are met. */
desired_native = param->flags & SIG_ELEM_NATIVE_VALUE;
if (desired_native == 0 && orig_bv.type == BIND_VAL_OBJ ||
desired_native == SIG_ELEM_NATIVE_INT_VALUE && orig_bv.type == BIND_VAL_INT ||
desired_native == SIG_ELEM_NATIVE_NUM_VALUE && orig_bv.type == BIND_VAL_NUM ||
desired_native == SIG_ELEM_NATIVE_STR_VALUE && orig_bv.type == BIND_VAL_STR)
{
/* We have what we want. */
bv = orig_bv;
}
else if (desired_native == 0) {
/* We need to do a boxing operation. */
bv.type = BIND_VAL_OBJ;
bv.val.o = create_box(interp, orig_bv);
}
else {
storage_spec spec;
decont_value = Rakudo_cont_decontainerize(interp, orig_bv.val.o);
spec = REPR(decont_value)->get_storage_spec(interp, STABLE(decont_value));
switch (desired_native) {
case SIG_ELEM_NATIVE_INT_VALUE:
if (spec.can_box & STORAGE_SPEC_CAN_BOX_INT) {
bv.type = BIND_VAL_INT;
bv.val.i = REPR(decont_value)->box_funcs->get_int(interp, STABLE(decont_value), OBJECT_BODY(decont_value));
}
else {
if (error)
*error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native int",
param->variable_name);
return BIND_RESULT_FAIL;
}
break;
case SIG_ELEM_NATIVE_NUM_VALUE:
if (spec.can_box & STORAGE_SPEC_CAN_BOX_NUM) {
bv.type = BIND_VAL_NUM;
bv.val.n = REPR(decont_value)->box_funcs->get_num(interp, STABLE(decont_value), OBJECT_BODY(decont_value));
}
else {
if (error)
*error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native num",
param->variable_name);
return BIND_RESULT_FAIL;
}
break;
case SIG_ELEM_NATIVE_STR_VALUE:
if (spec.can_box & STORAGE_SPEC_CAN_BOX_STR) {
bv.type = BIND_VAL_STR;
bv.val.s = REPR(decont_value)->box_funcs->get_str(interp, STABLE(decont_value), OBJECT_BODY(decont_value));
}
else {
if (error)
*error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native str",
param->variable_name);
return BIND_RESULT_FAIL;
}
break;
default:
if (error)
*error = Parrot_sprintf_c(interp, "Cannot unbox argument to '%S' as a native type",
param->variable_name);
return BIND_RESULT_FAIL;
}
decont_value = NULL;
}
/* By this point, we'll either have an object that we might be able to
* bind if it passes the type check, or a native value that needs no
* further checking. */
if (bv.type == BIND_VAL_OBJ) {
/* Ensure the value is a 6model object; if not, marshall it to one. */
if (bv.val.o->vtable->base_type != smo_id) {
bv.val.o = Rakudo_types_parrot_map(interp, bv.val.o);
if (bv.val.o->vtable->base_type != smo_id) {
*error = Parrot_sprintf_c(interp, "Unmarshallable foreign language value passed for parameter '%S'",
param->variable_name);
return BIND_RESULT_FAIL;
}
}
/* We pretty much always need to de-containerized value, so get it
* right off. */
decont_value = Rakudo_cont_decontainerize(interp, bv.val.o);
/* Skip nominal type check if not needed. */
if (!no_nom_type_check) {
PMC *nom_type;
/* Is the nominal type generic and in need of instantiation? (This
* can happen in (::T, T) where we didn't learn about the type until
* during the signature bind). */
if (param->flags & SIG_ELEM_NOMINAL_GENERIC) {
PMC *HOW = STABLE(param->nominal_type)->HOW;
PMC *ig = VTABLE_find_method(interp, HOW, INSTANTIATE_GENERIC_str);
Parrot_ext_call(interp, ig, "PiPP->P", HOW, param->nominal_type,
lexpad, &nom_type);
}
else {
nom_type = param->nominal_type;
}
/* If not, do the check. If the wanted nominal type is Mu, then
* anything goes. */
if (nom_type != Rakudo_types_mu_get() &&
(decont_value->vtable->base_type != smo_id ||
!STABLE(decont_value)->type_check(interp, decont_value, nom_type))) {
/* Type check failed; produce error if needed. */
if (error) {
PMC * got_how = STABLE(decont_value)->HOW;
PMC * exp_how = STABLE(nom_type)->HOW;
PMC * got_name_meth = VTABLE_find_method(interp, got_how, NAME_str);
PMC * exp_name_meth = VTABLE_find_method(interp, exp_how, NAME_str);
STRING * expected, * got;
Parrot_ext_call(interp, got_name_meth, "PiP->S", got_how, bv.val.o, &got);
Parrot_ext_call(interp, exp_name_meth, "PiP->S", exp_how, nom_type, &expected);
*error = Parrot_sprintf_c(interp, "Nominal type check failed for parameter '%S'; expected %S but got %S instead",
param->variable_name, expected, got);
}
/* Report junction failure mode if it's a junction. */
return junc_or_fail(interp, decont_value);
}
/* Also enforce definedness constraints. */
if (param->flags & SIG_ELEM_DEFINEDNES_CHECK) {
INTVAL defined = IS_CONCRETE(decont_value);
if (defined && param->flags & SIG_ELEM_UNDEFINED_ONLY) {
if (error)
*error = Parrot_sprintf_c(interp,
"Parameter '%S' requires a type object, but an object instance was passed",
param->variable_name);
return junc_or_fail(interp, decont_value);
}
if (!defined && param->flags & SIG_ELEM_DEFINED_ONLY) {
if (error)
*error = Parrot_sprintf_c(interp,
"Parameter '%S' requires an instance, but a type object was passed",
param->variable_name);
return junc_or_fail(interp, decont_value);
}
}
}
}
/* Do we have any type captures to bind? */
if (!PMC_IS_NULL(param->type_captures)) {
Rakudo_binding_bind_type_captures(interp, lexpad, param, bv);
}
/* Do a coercion, if one is needed. */
if (!PMC_IS_NULL(param->coerce_type)) {
/* Coercing natives not possible - nothing to call a method on. */
if (bv.type != BIND_VAL_OBJ) {
*error = Parrot_sprintf_c(interp,
"Unable to coerce natively typed parameter '%S'",
param->variable_name);
return BIND_RESULT_FAIL;
}
/* Only coerce if we don't already have the correct type. */
if (!STABLE(decont_value)->type_check(interp, decont_value, param->coerce_type)) {
PMC *coerce_meth = VTABLE_find_method(interp, decont_value, param->coerce_method);
if (!PMC_IS_NULL(coerce_meth)) {
Parrot_ext_call(interp, coerce_meth, "Pi->P", decont_value, &decont_value);
}
else {
/* No coercion method availale; whine and fail to bind. */
if (error) {
PMC * got_how = STABLE(decont_value)->HOW;
PMC * got_name_meth = VTABLE_find_method(interp, got_how, NAME_str);
STRING * got;
Parrot_ext_call(interp, got_name_meth, "PiP->S", got_how, decont_value, &got);
*error = Parrot_sprintf_c(interp,
"Unable to coerce value for '%S' from %S to %S; no coercion method defined",
param->variable_name, got, param->coerce_method);
}
return BIND_RESULT_FAIL;
}
}
}
/* If it's not got attributive binding, we'll go about binding it into the
* lex pad. */
if (!(param->flags & SIG_ELEM_BIND_ATTRIBUTIVE) && !STRING_IS_NULL(param->variable_name)) {
/* Is it native? If so, just go ahead and bind it. */
if (bv.type != BIND_VAL_OBJ) {
switch (bv.type) {
case BIND_VAL_INT:
VTABLE_set_integer_keyed_str(interp, lexpad, param->variable_name, bv.val.i);
break;
case BIND_VAL_NUM:
VTABLE_set_number_keyed_str(interp, lexpad, param->variable_name, bv.val.n);
break;
case BIND_VAL_STR:
VTABLE_set_string_keyed_str(interp, lexpad, param->variable_name, bv.val.s);
break;
}
}
/* Otherwise it's some objecty case. */
else if (param->flags & SIG_ELEM_IS_RW) {
/* XXX TODO Check if rw flag is set; also need to have a
* wrapper container that carries extra constraints. */
VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bv.val.o);
}
else if (param->flags & SIG_ELEM_IS_PARCEL) {
/* Just bind the thing as is into the lexpad. */
VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bv.val.o);
}
else {
/* If it's an array, copy means make a new one and store,
* and a normal bind is a straightforward binding plus
* adding a constraint. */
if (param->flags & SIG_ELEM_ARRAY_SIGIL) {
PMC *bindee = decont_value;
if (param->flags & SIG_ELEM_IS_COPY) {
bindee = Rakudo_binding_create_positional(interp,
Parrot_pmc_new(interp, enum_class_ResizablePMCArray));
Rakudo_cont_store(interp, bindee, decont_value, 0, 0);
}
VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bindee);
}
/* If it's a hash, similar approach to array. */
else if (param->flags & SIG_ELEM_HASH_SIGIL) {
PMC *bindee = decont_value;
if (param->flags & SIG_ELEM_IS_COPY) {
bindee = Rakudo_binding_create_hash(interp,
Parrot_pmc_new(interp, enum_class_Hash));
Rakudo_cont_store(interp, bindee, decont_value, 0, 0);
}
VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, bindee);
}
/* If it's a scalar, we always need to wrap it into a new
* container and store it, for copy or ro case (the rw bit
* in the container descriptor takes care of the rest). */
else {
PMC *new_cont = Rakudo_cont_scalar_from_descriptor(interp, param->container_descriptor);
Rakudo_cont_store(interp, new_cont, decont_value, 0, 0);
VTABLE_set_pmc_keyed_str(interp, lexpad, param->variable_name, new_cont);
}
}
}
/* Is it the invocant? If so, also have to bind to self lexical. */
if (param->flags & SIG_ELEM_INVOCANT)
VTABLE_set_pmc_keyed_str(interp, lexpad, SELF_str, decont_value);
/* Handle any constraint types (note that they may refer to the parameter by
* name, so we need to have bound it already). */
if (!PMC_IS_NULL(param->post_constraints)) {
PMC * code_type = Rakudo_types_code_get();
PMC * const constraints = param->post_constraints;
INTVAL num_constraints = VTABLE_elements(interp, constraints);
INTVAL i;
for (i = 0; i < num_constraints; i++) {
/* Check we meet the constraint. */
PMC *cons_type = VTABLE_get_pmc_keyed_int(interp, constraints, i);
PMC *accepts_meth = VTABLE_find_method(interp, cons_type, ACCEPTS);
PMC *old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *cappy = Parrot_pmc_new(interp, enum_class_CallContext);
if (STABLE(cons_type)->type_check(interp, cons_type, code_type))
Parrot_sub_capture_lex(interp,
VTABLE_get_attr_keyed(interp, cons_type, code_type, DO_str));
VTABLE_push_pmc(interp, cappy, cons_type);
switch (bv.type) {
case BIND_VAL_OBJ:
VTABLE_push_pmc(interp, cappy, bv.val.o);
break;
case BIND_VAL_INT:
VTABLE_push_integer(interp, cappy, bv.val.i);
break;
case BIND_VAL_NUM:
VTABLE_push_float(interp, cappy, bv.val.n);
break;
case BIND_VAL_STR:
VTABLE_push_string(interp, cappy, bv.val.s);
break;
}
Parrot_pcc_invoke_from_sig_object(interp, accepts_meth, cappy);
cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
if (!VTABLE_get_bool(interp, VTABLE_get_pmc_keyed_int(interp, cappy, 0))) {
if (error)
*error = Parrot_sprintf_c(interp, "Constraint type check failed for parameter '%S'",
param->variable_name);
return BIND_RESULT_FAIL;
}
}
}
/* If it's attributive, now we assign it. */
if (param->flags & SIG_ELEM_BIND_ATTRIBUTIVE) {
INTVAL result = Rakudo_binding_assign_attributive(interp, lexpad, param, bv, decont_value, error);
if (result != BIND_RESULT_OK)
return result;
}
/* If it has a sub-signature, bind that. */
if (!PMC_IS_NULL(param->sub_llsig) && bv.type == BIND_VAL_OBJ) {
/* Turn value into a capture, unless we already have one. */
PMC *capture = PMCNULL;
INTVAL result;
if (param->flags & SIG_ELEM_IS_CAPTURE) {
capture = decont_value;
}
else {
PMC *meth = VTABLE_find_method(interp, decont_value, Parrot_str_new(interp, "Capture", 0));
if (PMC_IS_NULL(meth)) {
if (error)
*error = Parrot_sprintf_c(interp, "Could not turn argument into capture");
return BIND_RESULT_FAIL;
}
Parrot_ext_call(interp, meth, "Pi->P", decont_value, &capture);
}
/* Recurse into signature binder. */
result = Rakudo_binding_bind(interp, lexpad, param->sub_llsig,
capture, no_nom_type_check, error);
if (result != BIND_RESULT_OK)
{
if (error) {
/* Note in the error message that we're in a sub-signature. */
*error = Parrot_str_concat(interp, *error,
Parrot_str_new(interp, " in sub-signature", 0));
/* Have we a variable name? */
if (!STRING_IS_NULL(param->variable_name)) {
*error = Parrot_str_concat(interp, *error,
Parrot_str_new(interp, " of parameter ", 0));
*error = Parrot_str_concat(interp, *error, param->variable_name);
}
}
return result;
}
}
/* Binding of this parameter was thus successful - we're done. */
return BIND_RESULT_OK;
}
static void gc_free(PARROT_INTERP, PMC *obj) {
CStrBody *body = (CStrBody *) OBJECT_BODY(obj);
if(IS_CONCRETE(obj) && body->cstr)
mem_sys_free(body->cstr);
}
/* This Parrot-specific addition to the API is used to free an object. */
static void gc_free(PARROT_INTERP, PMC *obj) {
gc_cleanup(interp, STABLE(obj), OBJECT_BODY(obj));
mem_sys_free(PMC_data(obj));
PMC_data(obj) = NULL;
}
/* Dump a spesh graph into string form, for debugging purposes. */
char * MVM_spesh_dump(MVMThreadContext *tc, MVMSpeshGraph *g) {
MVMSpeshBB *cur_bb;
SpeshGraphSizeStats stats;
InlineIndexStack inline_stack;
DumpStr ds;
stats.total_size = 0;
stats.inlined_size = 0;
inline_stack.cur_depth = -1;
/* Allocate buffer. */
ds.alloc = 8192;
ds.buffer = MVM_malloc(ds.alloc);
ds.pos = 0;
/* Dump name and CUID. */
append(&ds, "Spesh of '");
append_str(tc, &ds, g->sf->body.name);
append(&ds, "' (cuid: ");
append_str(tc, &ds, g->sf->body.cuuid);
append(&ds, ", file: ");
dump_fileinfo(tc, &ds, g->sf);
append(&ds, ")\n");
if (g->cs)
dump_callsite(tc, &ds, g->cs);
if (!g->cs)
append(&ds, "\n");
/* Go over all the basic blocks and dump them. */
cur_bb = g->entry;
while (cur_bb) {
dump_bb(tc, &ds, g, cur_bb, &stats, &inline_stack);
cur_bb = cur_bb->linear_next;
}
/* Dump facts. */
if (g->facts) {
append(&ds, "\nFacts:\n");
dump_facts(tc, &ds, g);
}
/* Dump spesh slots. */
if (g->num_spesh_slots) {
MVMuint32 i;
append(&ds, "\nSpesh slots:\n");
for (i = 0; i < g->num_spesh_slots; i++) {
MVMCollectable *value = g->spesh_slots[i];
if (value == NULL)
appendf(&ds, " %d = NULL\n", i);
else if (value->flags & MVM_CF_STABLE)
appendf(&ds, " %d = STable (%s)\n", i,
MVM_6model_get_stable_debug_name(tc, (MVMSTable *)value));
else if (value->flags & MVM_CF_TYPE_OBJECT)
appendf(&ds, " %d = Type Object (%s)\n", i,
MVM_6model_get_debug_name(tc, (MVMObject *)value));
else {
MVMObject *obj = (MVMObject *)value;
MVMuint32 repr_id = REPR(obj)->ID;
appendf(&ds, " %d = Instance (%s)", i,
MVM_6model_get_debug_name(tc, obj));
if (repr_id == MVM_REPR_ID_MVMStaticFrame || repr_id == MVM_REPR_ID_MVMCode) {
MVMStaticFrameBody *body;
char *name_str;
char *cuuid_str;
if (repr_id == MVM_REPR_ID_MVMCode) {
MVMCodeBody *code_body = (MVMCodeBody *)OBJECT_BODY(obj);
obj = (MVMObject *)code_body->sf;
}
body = (MVMStaticFrameBody *)OBJECT_BODY(obj);
name_str = MVM_string_utf8_encode_C_string(tc, body->name);
cuuid_str = MVM_string_utf8_encode_C_string(tc, body->cuuid);
appendf(&ds, " - '%s' (%s)", name_str, cuuid_str);
MVM_free(name_str);
MVM_free(cuuid_str);
}
appendf(&ds, "\n");
}
}
}
/* Dump materialization deopt into. */
dump_deopt_pea(tc, &ds, g);
append(&ds, "\n");
/* Print out frame size */
if (stats.inlined_size)
appendf(&ds, "Frame size: %u bytes (%u from inlined frames)\n", stats.total_size, stats.inlined_size);
else
appendf(&ds, "Frame size: %u bytes\n", stats.total_size);
append_null(&ds);
return ds.buffer;
}
/* Drives optimization of a call. */
static void optimize_call(MVMThreadContext *tc, MVMSpeshGraph *g, MVMSpeshBB *bb,
MVMSpeshIns *ins, MVMint32 callee_idx, MVMSpeshCallInfo *arg_info) {
/* Ensure we know what we're going to be invoking. */
MVMSpeshFacts *callee_facts = MVM_spesh_get_facts(tc, g, ins->operands[callee_idx]);
if (callee_facts->flags & MVM_SPESH_FACT_KNOWN_VALUE) {
MVMObject *code = callee_facts->value.o;
MVMObject *target = NULL;
if (REPR(code)->ID == MVM_REPR_ID_MVMCode) {
/* Already have a code object we know we'll call. */
target = code;
}
else if (STABLE(code)->invocation_spec) {
/* What kind of invocation will it be? */
MVMInvocationSpec *is = STABLE(code)->invocation_spec;
if (!MVM_is_null(tc, is->md_class_handle)) {
/* Multi-dispatch. Check if this is a dispatch where we can
* use the cache directly. */
MVMRegister dest;
REPR(code)->attr_funcs.get_attribute(tc,
STABLE(code), code, OBJECT_BODY(code),
is->md_class_handle, is->md_valid_attr_name,
is->md_valid_hint, &dest, MVM_reg_int64);
if (dest.i64) {
/* Yes. Try to obtain the cache. */
REPR(code)->attr_funcs.get_attribute(tc,
STABLE(code), code, OBJECT_BODY(code),
is->md_class_handle, is->md_cache_attr_name,
is->md_cache_hint, &dest, MVM_reg_obj);
if (!MVM_is_null(tc, dest.o)) {
MVMObject *found = MVM_multi_cache_find_spesh(tc, dest.o, arg_info);
if (found) {
/* Found it. Is it a code object already, or do we
* have futher unpacking to do? */
if (REPR(found)->ID == MVM_REPR_ID_MVMCode) {
target = found;
}
else if (STABLE(found)->invocation_spec) {
MVMInvocationSpec *m_is = STABLE(found)->invocation_spec;
if (!MVM_is_null(tc, m_is->class_handle)) {
REPR(found)->attr_funcs.get_attribute(tc,
STABLE(found), found, OBJECT_BODY(found),
is->class_handle, is->attr_name,
is->hint, &dest, MVM_reg_obj);
if (REPR(dest.o)->ID == MVM_REPR_ID_MVMCode)
target = dest.o;
}
}
}
}
}
}
else if (!MVM_is_null(tc, is->class_handle)) {
/* Single dispatch; retrieve the code object. */
MVMRegister dest;
REPR(code)->attr_funcs.get_attribute(tc,
STABLE(code), code, OBJECT_BODY(code),
is->class_handle, is->attr_name,
is->hint, &dest, MVM_reg_obj);
if (REPR(dest.o)->ID == MVM_REPR_ID_MVMCode)
target = dest.o;
}
}
/* If we resolved to something better than the code object, then add
* the resolved item in a spesh slot and insert a lookup. */
if (target && target != code && !((MVMCode *)target)->body.is_compiler_stub) {
MVMSpeshIns *ss_ins = MVM_spesh_alloc(tc, g, sizeof(MVMSpeshIns));
ss_ins->info = MVM_op_get_op(MVM_OP_sp_getspeshslot);
ss_ins->operands = MVM_spesh_alloc(tc, g, 2 * sizeof(MVMSpeshOperand));
ss_ins->operands[0] = ins->operands[callee_idx];
ss_ins->operands[1].lit_i16 = MVM_spesh_add_spesh_slot(tc, g,
(MVMCollectable *)target);
MVM_spesh_manipulate_insert_ins(tc, bb, ins->prev, ss_ins);
/* XXX TODO: Do this differently so we can eliminate the original
* lookup of the enclosing code object also. */
}
/* See if we can point the call at a particular specialization. */
if (target) {
MVMCode *target_code = (MVMCode *)target;
MVMint32 spesh_cand = try_find_spesh_candidate(tc, target_code, arg_info);
if (spesh_cand >= 0) {
/* Yes. Will we be able to inline? */
MVMSpeshGraph *inline_graph = MVM_spesh_inline_try_get_graph(tc, g,
target_code, &target_code->body.sf->body.spesh_candidates[spesh_cand]);
if (inline_graph) {
/* Yes, have inline graph, so go ahead and do it. */
/*char *c_name_i = MVM_string_utf8_encode_C_string(tc, target_code->body.sf->body.name);
char *c_cuid_i = MVM_string_utf8_encode_C_string(tc, target_code->body.sf->body.cuuid);
char *c_name_t = MVM_string_utf8_encode_C_string(tc, g->sf->body.name);
char *c_cuid_t = MVM_string_utf8_encode_C_string(tc, g->sf->body.cuuid);
printf("Can inline %s (%s) into %s (%s)\n",
c_name_i, c_cuid_i, c_name_t, c_cuid_t);
free(c_name_i);
free(c_cuid_i);
free(c_name_t);
free(c_cuid_t);*/
MVM_spesh_inline(tc, g, arg_info, bb, ins, inline_graph, target_code);
}
else {
/* Can't inline, so just identify candidate. */
MVMSpeshOperand *new_operands = MVM_spesh_alloc(tc, g, 3 * sizeof(MVMSpeshOperand));
if (ins->info->opcode == MVM_OP_invoke_v) {
new_operands[0] = ins->operands[0];
new_operands[1].lit_i16 = spesh_cand;
ins->operands = new_operands;
ins->info = MVM_op_get_op(MVM_OP_sp_fastinvoke_v);
}
else {
new_operands[0] = ins->operands[0];
new_operands[1] = ins->operands[1];
new_operands[2].lit_i16 = spesh_cand;
ins->operands = new_operands;
switch (ins->info->opcode) {
case MVM_OP_invoke_i:
ins->info = MVM_op_get_op(MVM_OP_sp_fastinvoke_i);
break;
case MVM_OP_invoke_n:
ins->info = MVM_op_get_op(MVM_OP_sp_fastinvoke_n);
break;
case MVM_OP_invoke_s:
ins->info = MVM_op_get_op(MVM_OP_sp_fastinvoke_s);
break;
case MVM_OP_invoke_o:
ins->info = MVM_op_get_op(MVM_OP_sp_fastinvoke_o);
break;
default:
MVM_exception_throw_adhoc(tc, "Spesh: unhandled invoke instruction");
}
}
}
}
}
}
}
