/* 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; 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); }
/* 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) { if (IS_CONCRETE(value)) { 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; } else { set_pmc_at_offset(data, repr_data->attribute_offsets[slot], value); return value; } } } 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); }
/* Composes the representation. */ static void compose(PARROT_INTERP, STable *st, PMC *repr_info) { /* Compute allocation strategy. */ CStructREPRData *repr_data = (CStructREPRData *) st->REPR_data; PMC *attr_info = VTABLE_get_pmc_keyed_str(interp, repr_info, Parrot_str_new_constant(interp, "attribute")); compute_allocation_strategy(interp, attr_info, repr_data); PARROT_GC_WRITE_BARRIER(interp, st->stable_pmc); }
/* Gets the hint for the given attribute ID. */ static INTVAL hint_for(PARROT_INTERP, STable *st, PMC *class_key, STRING *name) { INTVAL slot; P6opaqueREPRData *repr_data = (P6opaqueREPRData *)st->REPR_data; if (!repr_data->allocation_size) { compute_allocation_strategy(interp, st->WHAT, repr_data); PARROT_GC_WRITE_BARRIER(interp, st->stable_pmc); } slot = try_get_slot(interp, repr_data, class_key, name); return slot >= 0 ? slot : NO_HINT; }
/* Serializes the REPR data. */ static void serialize_repr_data(PARROT_INTERP, STable *st, SerializationWriter *writer) { P6opaqueREPRData *repr_data = (P6opaqueREPRData *)st->REPR_data; INTVAL i, num_classes; if (!repr_data->allocation_size) { compute_allocation_strategy(interp, st->WHAT, repr_data); PARROT_GC_WRITE_BARRIER(interp, st->stable_pmc); } writer->write_int(interp, writer, repr_data->num_attributes); for (i = 0; i < repr_data->num_attributes; i++) { writer->write_int(interp, writer, repr_data->flattened_stables[i] != NULL); if (repr_data->flattened_stables[i]) writer->write_stable_ref(interp, writer, repr_data->flattened_stables[i]); } writer->write_int(interp, writer, repr_data->mi); if (repr_data->auto_viv_values) { writer->write_int(interp, writer, 1); for (i = 0; i < repr_data->num_attributes; i++) writer->write_ref(interp, writer, repr_data->auto_viv_values[i]); } else { writer->write_int(interp, writer, 0); } writer->write_int(interp, writer, repr_data->unbox_int_slot); writer->write_int(interp, writer, repr_data->unbox_num_slot); writer->write_int(interp, writer, repr_data->unbox_str_slot); if (repr_data->unbox_slots) { writer->write_int(interp, writer, 1); for (i = 0; i < repr_data->num_attributes; i++) { writer->write_int(interp, writer, repr_data->unbox_slots[i].repr_id); writer->write_int(interp, writer, repr_data->unbox_slots[i].slot); } } else { writer->write_int(interp, writer, 0); } num_classes = i = 0; while (repr_data->name_to_index_mapping[i].class_key) num_classes++, i++; writer->write_int(interp, writer, num_classes); for (i = 0; i < num_classes; i++) { writer->write_ref(interp, writer, repr_data->name_to_index_mapping[i].class_key); writer->write_ref(interp, writer, repr_data->name_to_index_mapping[i].name_map); } }
/* 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) { CStructREPRData *repr_data = (CStructREPRData *)st->REPR_data; CStructBody *body = (CStructBody *)data; INTVAL slot; /* Look up slot, then offset and compute address. */ slot = hint >= 0 ? hint : try_get_slot(interp, repr_data, class_handle, name); if (slot >= 0) { INTVAL type = repr_data->attribute_locations[slot] & CSTRUCT_ATTR_MASK; INTVAL real_slot = repr_data->attribute_locations[slot] >> CSTRUCT_ATTR_SHIFT; if(type == CSTRUCT_ATTR_IN_STRUCT) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "CStruct Can't perform boxed get on flattened attributes yet"); else { PMC *obj = body->child_objs[real_slot]; PMC *typeobj = repr_data->member_types[slot]; if(!obj) { void *cobj = get_ptr_at_offset(body->cstruct, repr_data->struct_offsets[slot]); if(cobj) { if(type == CSTRUCT_ATTR_CARRAY) { obj = make_carray_result(interp, typeobj, cobj); } else if(type == CSTRUCT_ATTR_CSTRUCT) { obj = make_cstruct_result(interp, typeobj, cobj); } else if(type == CSTRUCT_ATTR_CPTR) { obj = make_cpointer_result(interp, typeobj, cobj); } else if(type == CSTRUCT_ATTR_STRING) { char *cstr = (char *) cobj; STRING *str = Parrot_str_new_init(interp, cstr, strlen(cstr), Parrot_utf8_encoding_ptr, 0); obj = REPR(typeobj)->allocate(interp, STABLE(typeobj)); REPR(obj)->initialize(interp, STABLE(obj), OBJECT_BODY(obj)); REPR(obj)->box_funcs->set_str(interp, STABLE(obj), OBJECT_BODY(obj), str); PARROT_GC_WRITE_BARRIER(interp, obj); } body->child_objs[real_slot] = obj; } else { obj = typeobj; } } return obj; } }
/* Creates a new type object of this representation, and associates it with * the given HOW. */ static PMC * type_object_for(PARROT_INTERP, PMC *HOW) { /* Create new type object instance. */ UninstantiableInstance *obj = mem_allocate_zeroed_typed(UninstantiableInstance); /* Build an STable. */ PMC *st_pmc = create_stable(interp, this_repr, HOW); STable *st = STABLE_STRUCT(st_pmc); /* Create type object and point it back at the STable. */ obj->common.stable = st_pmc; st->WHAT = wrap_object(interp, obj); PARROT_GC_WRITE_BARRIER(interp, st_pmc); return st->WHAT; }
/* Creates a new type object of this representation, and associates it with * the given HOW. */ static PMC * type_object_for(PARROT_INTERP, PMC *HOW) { /* Create new object instance. */ HashAttrStoreInstance *obj = mem_allocate_zeroed_typed(HashAttrStoreInstance); /* Build an STable. */ PMC *st_pmc = create_stable(interp, this_repr, HOW); STable *st = STABLE_STRUCT(st_pmc); /* Create type object and point it back at the STable. We leave the * hash store pointer null to flag it's the type object. */ obj->common.stable = st_pmc; st->WHAT = wrap_object(interp, obj); PARROT_GC_WRITE_BARRIER(interp, st_pmc); return st->WHAT; }
/* Creates a new instance based on the type object. */ static PMC * allocate(PARROT_INTERP, STable *st) { P6opaqueInstance * obj; /* Compute allocation strategy if we've not already done so. */ P6opaqueREPRData * repr_data = (P6opaqueREPRData *) st->REPR_data; if (!repr_data->allocation_size) { compute_allocation_strategy(interp, st->WHAT, repr_data); PARROT_GC_WRITE_BARRIER(interp, st->stable_pmc); } /* Allocate and set up object instance. */ obj = (P6opaqueInstance *) Parrot_gc_allocate_fixed_size_storage(interp, repr_data->allocation_size); memset(obj, 0, repr_data->allocation_size); obj->common.stable = st->stable_pmc; return wrap_object(interp, obj); }
/* Creates a new type object of this representation, and associates it with * the given HOW. */ static PMC * type_object_for(PARROT_INTERP, PMC *HOW) { /* Create new object instance. */ P6bigintInstance *obj = mem_allocate_zeroed_typed(P6bigintInstance); /* Build an STable. */ PMC *st_pmc = create_stable_func(interp, this_repr, HOW); STable *st = STABLE_STRUCT(st_pmc); /* Create type object and point it back at the STable. */ obj->common.stable = st_pmc; st->WHAT = wrap_object_func(interp, obj); PARROT_GC_WRITE_BARRIER(interp, st_pmc); /* Flag it as a type object. */ MARK_AS_TYPE_OBJECT(st->WHAT); return st->WHAT; }
/* Creates a new type object of this representation, and associates it with * the given HOW. */ static PMC * type_object_for(PARROT_INTERP, PMC *HOW) { /* Create new object instance. */ P6opaqueInstance *obj = mem_allocate_zeroed_typed(P6opaqueInstance); /* Build an STable. */ PMC *st_pmc = create_stable(interp, this_repr, HOW); STable *st = STABLE_STRUCT(st_pmc); /* Create REPR data structure and hand it off the STable. */ st->REPR_data = mem_allocate_zeroed_typed(P6opaqueREPRData); /* Create type object and point it back at the STable. Note that we * do *not* populate the spill pointer at all, we leave it null. A * non-null value (even PMCNULL) is what indicates we have a defined * object. Yes, I know, it's sick. */ obj->common.stable = st_pmc; st->WHAT = wrap_object(interp, obj); PARROT_GC_WRITE_BARRIER(interp, st_pmc); return st->WHAT; }
/* Creates a new instance based on the type object. */ static PMC * instance_of(PARROT_INTERP, PMC *WHAT) { P6opaqueInstance * obj; /* Compute allocation strategy if we've not already done so. */ P6opaqueREPRData * repr_data = (P6opaqueREPRData *) STABLE(WHAT)->REPR_data; if (!repr_data->allocation_size) { compute_allocation_strategy(interp, WHAT, repr_data); PARROT_GC_WRITE_BARRIER(interp, STABLE_PMC(WHAT)); } /* Allocate and set up object instance. */ obj = (P6opaqueInstance *) Parrot_gc_allocate_fixed_size_storage(interp, repr_data->allocation_size); memset(obj, 0, repr_data->allocation_size); obj->common.stable = STABLE_PMC(WHAT); /* The spill slot gets set to PMCNULL; it not being (C) NULL is what * lets us know it's actually a real instance, not a type object. */ obj->spill = PMCNULL; return wrap_object(interp, obj); }
/* Creates a new type object of this representation, and associates it with * the given HOW. */ static PMC *type_object_for(PARROT_INTERP, PMC *HOW) { /* Create new object instance. */ CStrInstance *obj = mem_allocate_zeroed_typed(CStrInstance); /* Build an STable. */ PMC *st_pmc = create_stable_func(interp, this_repr, HOW); STable *st = STABLE_STRUCT(st_pmc); /* Create REPR data structure and hang it off the STable. */ /* Don't need any REPR data yet. */ /*st->REPR_data = mem_allocate_zeroed_typed(CStrREPRData);*/ /* Create type object and point it back at the STable. */ obj->common.stable = st_pmc; st->WHAT = wrap_object_func(interp, obj); PARROT_GC_WRITE_BARRIER(interp, st_pmc); /* Flag it as a type object. */ MARK_AS_TYPE_OBJECT(st->WHAT); return st->WHAT; }
/* Gets (creating if needed) a multi-dispatch cache. */ static NQP_md_cache *get_dispatch_cache(PARROT_INTERP, PMC *dispatcher) { PMC *cache_ptr; if (!smo_id) smo_id = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, "SixModelObject", 0)); if (dispatcher->vtable->base_type == enum_class_Sub && PARROT_SUB(dispatcher)->multi_signature->vtable->base_type == smo_id) { NQP_Routine *r = (NQP_Routine *)PMC_data(PARROT_SUB(dispatcher)->multi_signature); if (PMC_IS_NULL(r->dispatch_cache)) { NQP_md_cache *c = mem_sys_allocate_zeroed(sizeof(NQP_md_cache)); cache_ptr = Parrot_pmc_new(interp, enum_class_Pointer); VTABLE_set_pointer(interp, cache_ptr, c); r->dispatch_cache = cache_ptr; PARROT_GC_WRITE_BARRIER(interp, PARROT_SUB(dispatcher)->multi_signature); } else { cache_ptr = r->dispatch_cache; } } else { Parrot_ex_throw_from_c_args(interp, 0, 1, "Could not find multi-dispatch list"); } return (NQP_md_cache *)VTABLE_get_pointer(interp, cache_ptr); }
/* Creates a new type object of this representation, and associates it with * the given HOW. */ static PMC * type_object_for(PARROT_INTERP, PMC *HOW) { /* Create new object instance. */ P6numInstance *obj = mem_allocate_zeroed_typed(P6numInstance); P6numREPRData *repr_data = mem_allocate_zeroed_typed(P6numREPRData); /* Build an STable. */ PMC *st_pmc = create_stable(interp, this_repr, HOW); STable *st = STABLE_STRUCT(st_pmc); /* Set default bit width value in the REPR data and attach it to the * STable. */ repr_data->bits = sizeof(FLOATVAL)*8; st->REPR_data = repr_data; /* Create type object and point it back at the STable. */ obj->common.stable = st_pmc; st->WHAT = wrap_object(interp, obj); PARROT_GC_WRITE_BARRIER(interp, st_pmc); /* Flag it as a type object. */ MARK_AS_TYPE_OBJECT(st->WHAT); return st->WHAT; }
/* Serializes the data. */ static void serialize(PARROT_INTERP, STable *st, void *data, SerializationWriter *writer) { P6opaqueREPRData *repr_data = (P6opaqueREPRData *)st->REPR_data; INTVAL num_attributes, i; if (!repr_data->allocation_size) { compute_allocation_strategy(interp, st->WHAT, repr_data); PARROT_GC_WRITE_BARRIER(interp, st->stable_pmc); } num_attributes = repr_data->num_attributes; for (i = 0; i < num_attributes; i++) { INTVAL a_offset = repr_data->attribute_offsets[i]; STable *a_st = repr_data->flattened_stables[i]; if (a_st) { if (a_st->REPR->serialize) a_st->REPR->serialize(interp, a_st, (char *)data + a_offset, writer); else Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Missing serialize REPR function"); } else writer->write_ref(interp, writer, get_pmc_at_offset(data, a_offset)); } }
/* Takes a signature along with positional and named arguments and binds them * into the provided lexpad (actually, anything that has a Hash interface will * do). Returns BIND_RESULT_OK if binding works out, BIND_RESULT_FAIL if there * is a failure and BIND_RESULT_JUNCTION if the failure was because of a * Junction being passed (meaning we need to auto-thread). */ INTVAL Rakudo_binding_bind(PARROT_INTERP, PMC *lexpad, PMC *sig_pmc, PMC *capture, INTVAL no_nom_type_check, STRING **error) { INTVAL i, num_pos_args; INTVAL bind_fail = 0; INTVAL cur_pos_arg = 0; Rakudo_Signature *sig = (Rakudo_Signature *)PMC_data(sig_pmc); PMC *params = sig->params; INTVAL num_params = VTABLE_elements(interp, params); Rakudo_BindVal cur_bv; /* If we do have some named args, we want to make a clone of the hash * to work on. We'll delete stuff from it as we bind, and what we have * left over can become the slurpy hash or - if we aren't meant to be * taking one - tell us we have a problem. */ PMC *named_args_copy = PMCNULL; /* If we have a |$foo that's followed by slurpies, then we can suppress * any future arity checks. */ INTVAL suppress_arity_fail = 0; /* If it's a Parrot capture, it may contain natively typed arguments. * NOTE: This is a really an encapsulation breakage; if Parrot folks * change stuff and this breaks, it's not Parrot's fault. */ struct Pcc_cell * pc_positionals = NULL; /* Set up statics. */ if (!smo_id) setup_binder_statics(interp); /* If we've got a CallContext, just has an attribute with list of named * parameter names. Otherwise, it's probably a Perl 6 Capture and we need * to extract its parts. */ if (capture->vtable->base_type == enum_class_CallContext) { PMC *named_names = VTABLE_get_attr_str(interp, capture, NAMED_str); if (!PMC_IS_NULL(named_names)) { PMC *iter = VTABLE_get_iter(interp, named_names); named_args_copy = Parrot_pmc_new(interp, enum_class_Hash); while (VTABLE_get_bool(interp, iter)) { STRING *name = VTABLE_shift_string(interp, iter); VTABLE_set_pmc_keyed_str(interp, named_args_copy, name, VTABLE_get_pmc_keyed_str(interp, capture, name)); } } GETATTR_CallContext_positionals(interp, capture, pc_positionals); } else if (capture->vtable->base_type == smo_id && STABLE(capture)->type_check(interp, capture, Rakudo_types_capture_get())) { PMC *captype = Rakudo_types_capture_get(); PMC *list_part = VTABLE_get_attr_keyed(interp, capture, captype, LIST_str); PMC *hash_part = VTABLE_get_attr_keyed(interp, capture, captype, HASH_str); capture = Rakudo_isnqplist(list_part) ? list_part : Parrot_pmc_new(interp, enum_class_ResizablePMCArray); if (hash_part->vtable->base_type == enum_class_Hash) { PMC *iter = VTABLE_get_iter(interp, hash_part); named_args_copy = Parrot_pmc_new(interp, enum_class_Hash); while (VTABLE_get_bool(interp, iter)) { STRING *arg_copy_name = VTABLE_shift_string(interp, iter); VTABLE_set_pmc_keyed_str(interp, named_args_copy, arg_copy_name, VTABLE_get_pmc_keyed_str(interp, hash_part, arg_copy_name)); } } } else { Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Internal Error: Rakudo_binding_bind passed invalid Capture"); } /* Now we'll walk through the signature and go about binding things. */ num_pos_args = VTABLE_elements(interp, capture); for (i = 0; i < num_params; i++) { Rakudo_Parameter *param = (Rakudo_Parameter *)PMC_data( VTABLE_get_pmc_keyed_int(interp, params, i)); /* Is it looking for us to bind a capture here? */ if (param->flags & SIG_ELEM_IS_CAPTURE) { /* Capture the arguments from this point forwards into a Capture. * Of course, if there's no variable name we can (cheaply) do pretty * much nothing. */ if (STRING_IS_NULL(param->variable_name)) { bind_fail = BIND_RESULT_OK; } else { PMC *captype = Rakudo_types_capture_get(); PMC *capsnap = REPR(captype)->allocate(interp, STABLE(captype)); PMC *pos_args = Parrot_pmc_new(interp, enum_class_ResizablePMCArray); PMC *named_args = Parrot_pmc_new(interp, enum_class_Hash); INTVAL k; VTABLE_set_attr_keyed(interp, capsnap, captype, LIST_str, pos_args); VTABLE_set_attr_keyed(interp, capsnap, captype, HASH_str, named_args); for (k = cur_pos_arg; k < num_pos_args; k++) { cur_bv = get_positional_bind_val(interp, pc_positionals, capture, k); VTABLE_push_pmc(interp, pos_args, cur_bv.type == BIND_VAL_OBJ ? cur_bv.val.o : create_box(interp, cur_bv)); } if (!PMC_IS_NULL(named_args_copy)) { PMC *iter = VTABLE_get_iter(interp, named_args_copy); while (VTABLE_get_bool(interp, iter)) { STRING *name = VTABLE_shift_string(interp, iter); VTABLE_set_pmc_keyed_str(interp, named_args, name, VTABLE_get_pmc_keyed_str(interp, named_args_copy, name)); } } cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = capsnap; bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, no_nom_type_check, error); } if (bind_fail) { return bind_fail; } else if (i + 1 == num_params) { /* Since a capture acts as "the ultimate slurpy" in a sense, if * this is the last parameter in the signature we can return * success right off the bat. */ return BIND_RESULT_OK; } else { Rakudo_Parameter *next_param = (Rakudo_Parameter *)PMC_data( VTABLE_get_pmc_keyed_int(interp, params, i + 1)); if (next_param->flags & (SIG_ELEM_SLURPY_POS | SIG_ELEM_SLURPY_NAMED)) suppress_arity_fail = 1; } } /* Could it be a named slurpy? */ else if (param->flags & SIG_ELEM_SLURPY_NAMED) { /* Can cheat a bit if it's the default method %_. * We give the hash to the lexpad. */ if (param->flags & SIG_ELEM_METHOD_SLURPY_NAMED && lexpad->vtable->base_type == p6l_id) { SETATTR_Perl6LexPad_default_named_slurpy(interp, lexpad, named_args_copy); PARROT_GC_WRITE_BARRIER(interp, lexpad); } else { /* We'll either take the current named arguments copy hash which * will by definition contain all unbound named parameters and use * that, or just create an empty one. */ PMC *slurpy = PMC_IS_NULL(named_args_copy) ? Parrot_pmc_new(interp, enum_class_Hash) : named_args_copy; cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = Rakudo_binding_create_hash(interp, slurpy); bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, no_nom_type_check, error); if (bind_fail) return bind_fail; } /* Nullify named arguments hash now we've consumed it, to mark all * is well. */ named_args_copy = PMCNULL; } /* Otherwise, maybe it's a positional. */ else if (PMC_IS_NULL(param->named_names)) { /* Slurpy or LoL-slurpy? */ if (param->flags & (SIG_ELEM_SLURPY_POS | SIG_ELEM_SLURPY_LOL)) { /* Create Perl 6 array, create RPA of all remaining things, then * store it. */ PMC *temp = Parrot_pmc_new(interp, enum_class_ResizablePMCArray); while (cur_pos_arg < num_pos_args) { cur_bv = get_positional_bind_val(interp, pc_positionals, capture, cur_pos_arg); VTABLE_push_pmc(interp, temp, cur_bv.type == BIND_VAL_OBJ ? cur_bv.val.o : create_box(interp, cur_bv)); cur_pos_arg++; } cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = param->flags & SIG_ELEM_SLURPY_POS ? Rakudo_binding_create_positional(interp, temp) : Rakudo_binding_create_lol(interp, temp); bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, no_nom_type_check, error); if (bind_fail) return bind_fail; } /* Otherwise, a positional. */ else { /* Do we have a value?. */ if (cur_pos_arg < num_pos_args) { /* Easy - just bind that. */ cur_bv = get_positional_bind_val(interp, pc_positionals, capture, cur_pos_arg); bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, no_nom_type_check, error); if (bind_fail) return bind_fail; cur_pos_arg++; } else { /* No value. If it's optional, fetch a default and bind that; * if not, we're screwed. Note that we never nominal type check * an optional with no value passed. */ if (param->flags & SIG_ELEM_IS_OPTIONAL) { cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = Rakudo_binding_handle_optional(interp, param, lexpad); bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, 0, error); if (bind_fail) return bind_fail; } else { if (error) *error = Rakudo_binding_arity_fail(interp, params, num_params, num_pos_args, 0); return BIND_RESULT_FAIL; } } } } /* Else, it's a non-slurpy named. */ else { /* Try and get hold of value. */ PMC *value = PMCNULL; INTVAL num_names = VTABLE_elements(interp, param->named_names); INTVAL j; if (!PMC_IS_NULL(named_args_copy)) { for (j = 0; j < num_names; j++) { STRING *name = VTABLE_get_string_keyed_int(interp, param->named_names, j); value = VTABLE_get_pmc_keyed_str(interp, named_args_copy, name); if (!PMC_IS_NULL(value)) { /* Found a value. Delete entry from to-bind args and stop looking. */ VTABLE_delete_keyed_str(interp, named_args_copy, name); break; } } } /* Did we get one? */ if (PMC_IS_NULL(value)) { /* Nope. We'd better hope this param was optional... */ if (param->flags & SIG_ELEM_IS_OPTIONAL) { cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = Rakudo_binding_handle_optional(interp, param, lexpad); bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, 0, error); } else if (!suppress_arity_fail) { if (error) *error = Parrot_sprintf_c(interp, "Required named parameter '%S' not passed", VTABLE_get_string_keyed_int(interp, param->named_names, 0)); return BIND_RESULT_FAIL; } } else { cur_bv.type = BIND_VAL_OBJ; cur_bv.val.o = value; bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, sig, param, cur_bv, 0, error); } /* If we got a binding failure, return it. */ if (bind_fail) return bind_fail; } } /* Do we have any left-over args? */ if (cur_pos_arg < num_pos_args && !suppress_arity_fail) { /* Oh noes, too many positionals passed. */ if (error) *error = Rakudo_binding_arity_fail(interp, params, num_params, num_pos_args, 1); return BIND_RESULT_FAIL; } if (!PMC_IS_NULL(named_args_copy) && VTABLE_elements(interp, named_args_copy)) { /* Oh noes, unexpected named args. */ if (error) { INTVAL num_extra = VTABLE_elements(interp, named_args_copy); PMC *iter = VTABLE_get_iter(interp, named_args_copy); if (num_extra == 1) { *error = Parrot_sprintf_c(interp, "Unexpected named parameter '%S' passed", VTABLE_shift_string(interp, iter)); } else { INTVAL first = 1; STRING *comma = Parrot_str_new(interp, ", ", 0); *error = Parrot_sprintf_c(interp, "%d unexpected named parameters passed (", num_extra); while (VTABLE_get_bool(interp, iter)) { STRING *name = VTABLE_shift_string(interp, iter); if (!first) *error = Parrot_str_concat(interp, *error, comma); else first = 0; *error = Parrot_str_concat(interp, *error, name); } *error = Parrot_str_concat(interp, *error, Parrot_str_new(interp, ")", 0)); } } return BIND_RESULT_FAIL; } /* If we get here, we're done. */ return BIND_RESULT_OK; }
/* 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, PMC *llsig, llsig_element *sig_info, PMC *value, INTVAL no_nom_type_check, STRING **error) { /* If we need to do a type check, do one. */ if (!no_nom_type_check) { /* See if we get a hit in the type cache. */ INTVAL cache_matched = 0; INTVAL value_type = VTABLE_type(interp, value); if (value_type != 0) { INTVAL i; for (i = 0; i < NOM_TYPE_CACHE_SIZE; i++) { if (sig_info->nom_type_cache[i] == value_type) { cache_matched = 1; break; } } } /* If not, do the check. */ if (!cache_matched) { PMC * const type_obj = sig_info->nominal_type; PMC * accepts_meth = VTABLE_find_method(interp, type_obj, ACCEPTS); PMC * result = PMCNULL; Parrot_ext_call(interp, accepts_meth, "PiP->P", type_obj, value, &result); if (VTABLE_get_bool(interp, result)) { /* Cache if possible. */ if (value_type != 0 && value_type != p6r_id && value_type != p6o_id) { INTVAL i; for (i = 0; i < NOM_TYPE_CACHE_SIZE; i++) { if (sig_info->nom_type_cache[i] == 0) { sig_info->nom_type_cache[i] = value_type; PARROT_GC_WRITE_BARRIER(interp, llsig); break; } } } } else { /* Type check failed. However, for language inter-op, we do some * extra checks if the type is just Positional, Associative, or * Callable and the thingy we have matches those enough. */ /* XXX TODO: Implement language interop checks. */ if (error) { STRING * const perl = PERL_str; PMC * perl_meth = VTABLE_find_method(interp, type_obj, perl); PMC * how_meth = VTABLE_find_method(interp, value, HOW); STRING * expected, * got; PMC * value_how, * value_type; Parrot_ext_call(interp, perl_meth, "Pi->S", type_obj, &expected); Parrot_ext_call(interp, how_meth, "Pi->P", value, &value_how); value_type = VTABLE_get_attr_str(interp, value_how, SHORTNAME_str); got = VTABLE_get_string(interp, value_type); *error = Parrot_sprintf_c(interp, "Nominal type check failed for parameter '%S'; expected %S but got %S instead", sig_info->variable_name, expected, got); } if (VTABLE_isa(interp, value, JUNCTION_str)) return BIND_RESULT_JUNCTION; else return BIND_RESULT_FAIL; } } } /* Do we have any type captures to bind? */ if (!PMC_IS_NULL(sig_info->type_captures)) Rakudo_binding_bind_type_captures(interp, lexpad, sig_info, value); /* Do a coercion, if one is needed. */ if (!STRING_IS_NULL(sig_info->coerce_to)) { PMC *coerce_meth = VTABLE_find_method(interp, value, sig_info->coerce_to); if (!PMC_IS_NULL(coerce_meth)) { Parrot_ext_call(interp, coerce_meth, "Pi->P", value, &value); } else { /* No coercion method availale; whine and fail to bind. */ if (error) { PMC * how_meth = VTABLE_find_method(interp, value, HOW); PMC * value_how, * value_type; STRING * got; Parrot_ext_call(interp, how_meth, "Pi->P", value, &value_how); value_type = VTABLE_get_attr_str(interp, value_how, SHORTNAME_str); got = VTABLE_get_string(interp, value_type); *error = Parrot_sprintf_c(interp, "Unable to coerce value for '%S' from %S to %S; no coercion method defined", sig_info->variable_name, got, sig_info->coerce_to); } return BIND_RESULT_FAIL; } } /* If it's not got attributive binding, we'll go about binding it into the * lex pad. */ if (!(sig_info->flags & SIG_ELEM_BIND_ATTRIBUTIVE)) { /* Is it "is rw"? */ if (sig_info->flags & SIG_ELEM_IS_RW) { /* XXX TODO Check if rw flag is set. */ if (!STRING_IS_NULL(sig_info->variable_name)) VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, value); } else if (sig_info->flags & SIG_ELEM_IS_PARCEL) { /* Just bind the thing as is into the lexpad. */ if (!STRING_IS_NULL(sig_info->variable_name)) VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, value); } else if (sig_info->flags & SIG_ELEM_IS_COPY) { /* Place the value into a new container instead of binding to an existing one */ value = descalarref(interp, value); if (!STRING_IS_NULL(sig_info->variable_name)) { PMC *copy, *ref, *store_meth; if (sig_info->flags & SIG_ELEM_ARRAY_SIGIL) { copy = Rakudo_binding_create_positional(interp, PMCNULL, ARRAY_str); store_meth = VTABLE_find_method(interp, copy, STORE_str); Parrot_ext_call(interp, store_meth, "PiP", copy, value); } else if (sig_info->flags & SIG_ELEM_HASH_SIGIL) { copy = Rakudo_binding_create_hash(interp, pmc_new(interp, enum_class_Hash)); store_meth = VTABLE_find_method(interp, copy, STORE_str); Parrot_ext_call(interp, store_meth, "PiP", copy, value); } else { copy = pmc_new_init(interp, p6s_id, value); VTABLE_setprop(interp, copy, SCALAR_str, copy); } VTABLE_setprop(interp, copy, RW_str, copy); VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, copy); } } else { /* Read only. Wrap it into a ObjectRef, mark readonly and bind it. */ if (!STRING_IS_NULL(sig_info->variable_name)) { PMC *ref = pmc_new_init(interp, or_id, value); if (!(sig_info->flags & (SIG_ELEM_ARRAY_SIGIL | SIG_ELEM_HASH_SIGIL))) VTABLE_setprop(interp, ref, SCALAR_str, ref); VTABLE_set_pmc_keyed_str(interp, lexpad, sig_info->variable_name, ref); } } } /* Is it the invocant? If so, also have to bind to self lexical. */ if (sig_info->flags & SIG_ELEM_INVOCANT) VTABLE_set_pmc_keyed_str(interp, lexpad, SELF_str, 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(sig_info->post_constraints)) { PMC * const constraints = sig_info->post_constraints; INTVAL num_constraints = VTABLE_elements(interp, constraints); PMC * result = PMCNULL; INTVAL i; for (i = 0; i < num_constraints; i++) { PMC *cons_type = VTABLE_get_pmc_keyed_int(interp, constraints, i); PMC *accepts_meth = VTABLE_find_method(interp, cons_type, ACCEPTS); if (VTABLE_isa(interp, cons_type, BLOCK_str)) Parrot_sub_capture_lex(interp, VTABLE_get_attr_str(interp, cons_type, DO_str)); Parrot_ext_call(interp, accepts_meth, "PiP->P", cons_type, value, &result); if (!VTABLE_get_bool(interp, result)) { if (error) *error = Parrot_sprintf_c(interp, "Constraint type check failed for parameter '%S'", sig_info->variable_name); return BIND_RESULT_FAIL; } } } /* If it's attributive, now we assign it. */ if (sig_info->flags & SIG_ELEM_BIND_ATTRIBUTIVE) { INTVAL result = Rakudo_binding_assign_attributive(interp, lexpad, sig_info, value, error); if (result != BIND_RESULT_OK) return result; } /* If it has a sub-signature, bind that. */ if (!PMC_IS_NULL(sig_info->sub_llsig)) { /* Turn value into a capture, unless we already have one. */ PMC *capture = PMCNULL; INTVAL result; if (sig_info->flags & SIG_ELEM_IS_CAPTURE) { capture = value; } else { PMC *meth = VTABLE_find_method(interp, 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", value, &capture); } /* Recurse into signature binder. */ result = Rakudo_binding_bind_llsig(interp, lexpad, sig_info->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(sig_info->variable_name)) { *error = Parrot_str_concat(interp, *error, Parrot_str_new(interp, " of parameter ", 0)); *error = Parrot_str_concat(interp, *error, sig_info->variable_name); } } return result; } } /* Binding of this parameter was thus successful - we're done. */ return BIND_RESULT_OK; }
/* Takes a signature along with positional and named arguments and binds them * into the provided lexpad (actually, anything that has a Hash interface will * do). Returns BIND_RESULT_OK if binding works out, BIND_RESULT_FAIL if there * is a failure and BIND_RESULT_JUNCTION if the failure was because of a * Junction being passed (meaning we need to auto-thread). */ INTVAL Rakudo_binding_bind_llsig(PARROT_INTERP, PMC *lexpad, PMC *llsig, PMC *capture, INTVAL no_nom_type_check, STRING **error) { INTVAL i; INTVAL bind_fail; INTVAL cur_pos_arg = 0; INTVAL num_pos_args = VTABLE_elements(interp, capture); PMC *named_names = PMCNULL; llsig_element **elements; INTVAL num_elements; PMC *named_to_pos_cache; /* Lazily allocated array of bindings to positionals of nameds. */ PMC **pos_from_named = NULL; /* If we do have some named args, we want to make a clone of the hash * to work on. We'll delete stuff from it as we bind, and what we have * left over can become the slurpy hash or - if we aren't meant to be * taking one - tell us we have a problem. */ PMC *named_args_copy = PMCNULL; /* If we have a |$foo that's followed by slurpies, then we can suppress * any future arity checks. */ INTVAL suppress_arity_fail = 0; /* Check that we have a valid signature and pull the bits out of it. */ if (!lls_id) setup_binder_statics(interp); if (llsig->vtable->base_type != lls_id) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Internal Error: Rakudo_binding_bind_llsig passed invalid signature"); GETATTR_P6LowLevelSig_elements(interp, llsig, elements); GETATTR_P6LowLevelSig_num_elements(interp, llsig, num_elements); GETATTR_P6LowLevelSig_named_to_pos_cache(interp, llsig, named_to_pos_cache); /* Build nameds -> position hash for named positional arguments, * if it was not yet built. */ if (PMC_IS_NULL(named_to_pos_cache)) { named_to_pos_cache = pmc_new(interp, enum_class_Hash); PARROT_GC_WRITE_BARRIER(interp, llsig); SETATTR_P6LowLevelSig_named_to_pos_cache(interp, llsig, named_to_pos_cache); for (i = 0; i < num_elements; i++) { /* If we find a named argument, we're done with the positionals. */ if (!PMC_IS_NULL(elements[i]->named_names)) break; /* Skip slurpies (may be a slurpy block, so can't just break). */ if (elements[i]->flags & SIG_ELEM_SLURPY) continue; /* Provided it has a name... */ if (!STRING_IS_NULL(elements[i]->variable_name)) { /* Strip any sigil, then stick in named to positional array. */ STRING *store = elements[i]->variable_name; STRING *sigil = Parrot_str_substr(interp, store, 0, 1); STRING *twigil = Parrot_str_substr(interp, store, 1, 1); if (Parrot_str_equal(interp, sigil, SCALAR_SIGIL_str) || Parrot_str_equal(interp, sigil, ARRAY_SIGIL_str) || Parrot_str_equal(interp, sigil, HASH_SIGIL_str)) store = Parrot_str_substr(interp, store, 1, Parrot_str_byte_length(interp, store)); if (Parrot_str_equal(interp, twigil, BANG_TWIGIL_str)) store = Parrot_str_substr(interp, store, 1, Parrot_str_byte_length(interp, store)); VTABLE_set_integer_keyed_str(interp, named_to_pos_cache, store, i); } } } /* If we've got a CallContext, just has an attribute with list of named * parameter names. Otherwise, it's a Capture and we need to do .hash and * grab out the keys. */ if (capture->vtable->base_type == enum_class_CallContext || VTABLE_isa(interp, capture, CALLCONTEXT_str)) { named_names = VTABLE_get_attr_str(interp, capture, Parrot_str_new(interp, "named", 0)); } else if (VTABLE_isa(interp, capture, CAPTURE_str)) { PMC *meth = VTABLE_find_method(interp, capture, Parrot_str_new(interp, "!PARROT_NAMEDS", 0)); PMC *hash = PMCNULL; PMC *iter; Parrot_ext_call(interp, meth, "Pi->P", capture, &hash); iter = VTABLE_get_iter(interp, hash); if (VTABLE_get_bool(interp, iter)) { named_names = pmc_new(interp, enum_class_ResizableStringArray); while (VTABLE_get_bool(interp, iter)) VTABLE_push_string(interp, named_names, VTABLE_shift_string(interp, iter)); } } else { Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Internal Error: Rakudo_binding_bind_llsig passed invalid Capture"); } /* First, consider named arguments, to see if there are any that we will * be wanting to bind positionally. */ if (!PMC_IS_NULL(named_names)) { PMC *iter = VTABLE_get_iter(interp, named_names); named_args_copy = pmc_new(interp, enum_class_Hash); while (VTABLE_get_bool(interp, iter)) { STRING *name = VTABLE_shift_string(interp, iter); if (VTABLE_exists_keyed_str(interp, named_to_pos_cache, name)) { /* Found one. We'll stash it away for quick access to bind it * later. */ INTVAL pos = VTABLE_get_integer_keyed_str(interp, named_to_pos_cache, name); if (!pos_from_named) pos_from_named = mem_allocate_n_zeroed_typed(num_elements, PMC *); pos_from_named[pos] = VTABLE_get_pmc_keyed_str(interp, capture, name); } else { /* Otherwise, we'll enter it into the hash of things to bind * to nameds. */ VTABLE_set_pmc_keyed_str(interp, named_args_copy, name, VTABLE_get_pmc_keyed_str(interp, capture, name)); } }
/* Performs a change of type, where possible. */ static void change_type(PARROT_INTERP, PMC *obj, PMC *new_type) { P6opaqueInstance *instance = (P6opaqueInstance *)PMC_data(obj); P6opaqueREPRData *cur_repr_data = (P6opaqueREPRData *)STABLE(obj)->REPR_data; P6opaqueREPRData *new_repr_data = (P6opaqueREPRData *)STABLE(new_type)->REPR_data; STRING *mro_str = Parrot_str_new_constant(interp, "mro"); PMC *cur_mro, *new_mro; INTVAL cur_mro_elems, new_mro_elems, mro_is_suffix; /* Ensure we're not trying to change the type of a type object. */ if (PObj_flag_TEST(private0, obj)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "Cannot change the type of a type object"); /* Ensure that the destination type REPR is P6opaque also. */ if (REPR(obj) != REPR(new_type)) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "P6opaque can only change type to another type with P6opaque REPR"); /* Ensure that MRO of new type has current type's MRO as a suffix. */ mro_is_suffix = 1; cur_mro = introspection_call(interp, STABLE(obj)->WHAT, STABLE(obj)->HOW, mro_str, 0); new_mro = introspection_call(interp, STABLE(new_type)->WHAT, STABLE(new_type)->HOW, mro_str, 0); cur_mro_elems = VTABLE_elements(interp, cur_mro); new_mro_elems = VTABLE_elements(interp, new_mro); if (new_mro_elems >= cur_mro_elems) { INTVAL start = new_mro_elems - cur_mro_elems; INTVAL i; for (i = 0; i < cur_mro_elems; i++) { PMC *cur_elem = VTABLE_get_pmc_keyed_int(interp, cur_mro, i); PMC *new_elem = VTABLE_get_pmc_keyed_int(interp, new_mro, i + start); if (decontainerize(interp, cur_elem) != decontainerize(interp, new_elem)) { mro_is_suffix = 0; break; } } } else { mro_is_suffix = 0; } if (!mro_is_suffix) Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION, "P6opaque only supports type changes where the MRO of the original type is a suffix of the MRO of the new type"); /* If the new REPR never calculated it's object layout, do so now. */ if (!new_repr_data->allocation_size) { compute_allocation_strategy(interp, new_type, new_repr_data); PARROT_GC_WRITE_BARRIER(interp, STABLE_PMC(new_type)); } /* Reallocate ourself to the new allocation size, if needed, and * ensure new chunk of the memory is zeroed. Note that we can't * really re-alloc, we need to go deal with the fixed size pool * allocator. */ if (new_repr_data->allocation_size > cur_repr_data->allocation_size) { P6opaqueInstance *new_body = (P6opaqueInstance *) Parrot_gc_allocate_fixed_size_storage(interp, new_repr_data->allocation_size); memset(new_body, 0, new_repr_data->allocation_size); memcpy(new_body, instance, cur_repr_data->allocation_size); PMC_data(obj) = new_body; Parrot_gc_free_fixed_size_storage(interp, cur_repr_data->allocation_size, instance); instance = new_body; } /* Finally, we're ready to switch the S-Table pointer. */ instance->common.stable = STABLE_PMC(new_type); PARROT_GC_WRITE_BARRIER(interp, obj); }