/* Initializes the representations registry, building up all of the various
* representations. */
void REPR_initialize_registry(PARROT_INTERP) {
PMC *dyn_reg_func;
/* Allocate name to ID map, and anchor it with the GC. */
repr_name_to_id_map = Parrot_pmc_new(interp, enum_class_Hash);
Parrot_pmc_gc_register(interp, repr_name_to_id_map);
/* Add all core representations. */
register_repr(interp, Parrot_str_new_constant(interp, "KnowHOWREPR"),
KnowHOWREPR_initialize(interp));
register_repr(interp, Parrot_str_new_constant(interp, "P6opaque"),
P6opaque_initialize(interp));
register_repr(interp, Parrot_str_new_constant(interp, "P6int"),
P6int_initialize(interp));
register_repr(interp, Parrot_str_new_constant(interp, "P6num"),
P6num_initialize(interp));
register_repr(interp, Parrot_str_new_constant(interp, "P6str"),
P6str_initialize(interp));
register_repr(interp, Parrot_str_new_constant(interp, "HashAttrStore"),
HashAttrStore_initialize(interp));
register_repr(interp, Parrot_str_new_constant(interp, "Uninstantiable"),
Uninstantiable_initialize(interp));
/* Set up object for dynamically registering extra representations. */
dyn_reg_func = Parrot_pmc_new(interp, enum_class_Pointer);
VTABLE_set_pointer(interp, dyn_reg_func, REPR_register_dynamic);
VTABLE_set_pmc_keyed_str(interp, interp->root_namespace,
Parrot_str_new_constant(interp, "_REGISTER_REPR"), dyn_reg_func);
}
/* Sets up a very simple attribute meta-object. Just supports having a
* name, and even uses the P6str representation to store it, so that's
* really all that it supports. */
PMC * SixModelObject_setup_knowhow_attribute(PARROT_INTERP, PMC *sc, PMC *knowhow) {
PMC *old_ctx, *cappy, *meth, *knowhow_attr, *how;
/* Create a new KnowHOWAttribute type using P6str repr.. */
meth = STABLE(knowhow)->find_method(interp, knowhow,
Parrot_str_new_constant(interp, "new_type"), NO_HINT);
old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
cappy = Parrot_pmc_new(interp, enum_class_CallContext);
VTABLE_push_pmc(interp, cappy, knowhow);
VTABLE_set_string_keyed_str(interp, cappy, name_str,
Parrot_str_new_constant(interp, "KnowHOWAttribute"));
VTABLE_set_string_keyed_str(interp, cappy, repr_str,
Parrot_str_new_constant(interp, "P6str"));
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);
knowhow_attr = VTABLE_get_pmc_keyed_int(interp, cappy, 0);
how = STABLE(knowhow_attr)->HOW;
/* Add new method. */
meth = STABLE(how)->find_method(interp, how,
Parrot_str_new_constant(interp, "add_method"), NO_HINT);
cappy = Parrot_pmc_new(interp, enum_class_CallContext);
VTABLE_push_pmc(interp, cappy, how);
VTABLE_push_pmc(interp, cappy, knowhow_attr);
VTABLE_push_string(interp, cappy, Parrot_str_new_constant(interp, "new"));
VTABLE_push_pmc(interp, cappy, wrap_c(interp, F2DPTR(attr_new)));
Parrot_pcc_invoke_from_sig_object(interp, meth, cappy);
Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
/* Add name method. */
cappy = Parrot_pmc_new(interp, enum_class_CallContext);
VTABLE_push_pmc(interp, cappy, how);
VTABLE_push_pmc(interp, cappy, knowhow_attr);
VTABLE_push_string(interp, cappy, name_str);
VTABLE_push_pmc(interp, cappy, wrap_c(interp, F2DPTR(attr_name)));
Parrot_pcc_invoke_from_sig_object(interp, meth, cappy);
Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
/* Compose. */
meth = STABLE(knowhow)->find_method(interp, how,
Parrot_str_new_constant(interp, "compose"), NO_HINT);
cappy = Parrot_pmc_new(interp, enum_class_CallContext);
VTABLE_push_pmc(interp, cappy, how);
VTABLE_push_pmc(interp, cappy, knowhow_attr);
Parrot_pcc_invoke_from_sig_object(interp, meth, cappy);
Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
/* Associate the created object with the intial core serialization
* context. */
VTABLE_set_pmc_keyed_int(interp, sc, 2, knowhow_attr);
SC_PMC(knowhow_attr) = sc;
STABLE(knowhow_attr)->sc = sc;
return knowhow_attr;
}
static void
pcf_ptr_ptr_STRING(PARROT_INTERP, PMC *nci, SHIM(PMC *self))
{
typedef void *(* func_t)(void *, STRING *);
func_t fn_pointer;
void *orig_func;
PMC * const ctx = CURRENT_CONTEXT(interp);
PMC * const call_object = Parrot_pcc_get_signature(interp, ctx);
PMC * t_0; void * v_0;
PMC * t_1; void * v_1;
STRING * t_2; STRING * v_2;
Parrot_pcc_fill_params_from_c_args(interp, call_object, "PS", &t_1, &t_2);
v_1 = PMC_IS_NULL(t_1) ? NULL : VTABLE_get_pointer(interp, t_1);;
v_2 = t_2;
GETATTR_NCI_orig_func(interp, nci, orig_func);
fn_pointer = (func_t)D2FPTR(orig_func);
v_0 = (*fn_pointer)(v_1, v_2);
if (v_0 != NULL) {
t_0 = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, t_0, v_0);
}
else {
t_0 = PMCNULL;
};
Parrot_pcc_set_call_from_c_args(interp, call_object, "P", t_0);
}
static STRING *get_str(PARROT_INTERP, STable *st, void *data) {
CStrBody *body = (CStrBody *) data;
PMC *old_ctx, *cappy, *meth, *enc_pmc;
STRING *enc;
STR_VTABLE *encoding;
if (!body->cstr)
return (STRING *) NULL;
/* 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));
return new_from_cstring(interp, body->cstr, enc);
}
void
blizkost_call_in(BLIZKOST_NEXUS, SV *what, U32 mode, PMC *positp, PMC *namedp,
PMC **retp) {
dBNPERL; dBNINTERP;
int num_returns, i;
{
/* Set up the stack. */
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
PUTBACK;
blizkost_slurpy_to_stack(nexus, positp, namedp);
/* Invoke the methods. */
num_returns = call_sv(what, mode);
SPAGAIN;
/* Build the results PMC array. */
*retp = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
for (i = 0; i < num_returns; i++) {
SV *result_sv = POPs;
PMC *result_pmc = blizkost_wrap_sv(nexus, result_sv);
VTABLE_unshift_pmc(interp, *retp, result_pmc);
}
PUTBACK;
FREETMPS;
LEAVE;
}
}
static void
pcf_ptr_int_int_int_int(PARROT_INTERP, PMC *nci, SHIM(PMC *self))
{
typedef void *(* func_t)(int, int, int, int);
func_t fn_pointer;
void *orig_func;
PMC * const ctx = CURRENT_CONTEXT(interp);
PMC * const call_object = Parrot_pcc_get_signature(interp, ctx);
PMC * t_0; void * v_0;
INTVAL t_1; int v_1;
INTVAL t_2; int v_2;
INTVAL t_3; int v_3;
INTVAL t_4; int v_4;
Parrot_pcc_fill_params_from_c_args(interp, call_object, "IIII", &t_1, &t_2, &t_3, &t_4);
v_1 = (int)t_1;
v_2 = (int)t_2;
v_3 = (int)t_3;
v_4 = (int)t_4;
GETATTR_NCI_orig_func(interp, nci, orig_func);
fn_pointer = (func_t)D2FPTR(orig_func);
v_0 = (*fn_pointer)(v_1, v_2, v_3, v_4);
if (v_0 != NULL) {
t_0 = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, t_0, v_0);
}
else {
t_0 = PMCNULL;
};
Parrot_pcc_set_call_from_c_args(interp, call_object, "P", t_0);
}
/* 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);
}
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
PMC *
Parrot_io_accept_win32(PARROT_INTERP, ARGMOD(PMC *socket))
{
ASSERT_ARGS(Parrot_io_accept_win32)
const Parrot_Socket_attributes * const io = PARROT_SOCKET(socket);
PMC * newio = Parrot_io_new_socket_pmc(interp,
PIO_F_SOCKET | PIO_F_READ|PIO_F_WRITE);
Parrot_Socklen_t addrlen = sizeof (struct sockaddr_in);
struct sockaddr_in *saddr;
int newsock;
PARROT_SOCKET(newio)->local = PARROT_SOCKET(socket)->local;
PARROT_SOCKET(newio)->remote = Parrot_pmc_new(interp, enum_class_Sockaddr);
saddr = SOCKADDR_REMOTE(newio);
newsock = accept((int)io->os_handle, (struct sockaddr *)saddr, &addrlen);
if (newsock == -1) {
return PMCNULL;
}
PARROT_SOCKET(newio)->os_handle = (void*)newsock;
/* XXX FIXME: Need to do a getsockname and getpeername here to
* fill in the sockaddr_in structs for local and peer */
/* Optionally do a gethostyaddr() to resolve remote IP address.
* This should be based on an option set in the master socket */
return newio;
}
/* Introspects the MRO. That's just a list with ourself. */
static void mro(PARROT_INTERP, PMC *nci) {
PMC * unused;
PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *obj = VTABLE_get_pmc_keyed_int(interp, capture, 1);
PMC *mro = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
VTABLE_push_pmc(interp, mro, STABLE(obj)->WHAT);
unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", mro);
}
/* Introspects the parents. Since a KnowHOW doesn't support inheritance,
* just hand back an empty list. */
static void parents(PARROT_INTERP, PMC *nci) {
PMC * unused;
PMC *capture = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *empty = Parrot_pmc_new(interp, enum_class_FixedPMCArray);
UNUSED(nci);
unused = Parrot_pcc_build_call_from_c_args(interp, capture, "P", empty);
}
PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
PMC *
io_get_new_socket(PARROT_INTERP)
{
ASSERT_ARGS(io_get_new_socket)
const INTVAL typenum = Parrot_hll_get_ctx_HLL_type(interp,
enum_class_Socket);
return Parrot_pmc_new(interp, typenum);
}
static void
callback_CD(PARROT_INTERP, ARGIN(char *external_data), ARGMOD(PMC *user_data))
{
ASSERT_ARGS(callback_CD)
PMC *passed_interp; /* the interp that originated the CB */
PMC *passed_synchronous; /* flagging synchronous execution */
int synchronous = 0; /* cb is hitting this sub somewhen
* inmidst, or not */
STRING *sc;
/*
* 3) check interpreter ...
*/
sc = CONST_STRING(interp, "_interpreter");
passed_interp = Parrot_pmc_getprop(interp, user_data, sc);
if (VTABLE_get_pointer(interp, passed_interp) != interp)
PANIC(interp, "callback gone to wrong interpreter");
sc = CONST_STRING(interp, "_synchronous");
passed_synchronous = Parrot_pmc_getprop(interp, user_data, sc);
if (!PMC_IS_NULL(passed_synchronous) &&
VTABLE_get_bool(interp, passed_synchronous))
synchronous = 1;
/*
* 4) check if the call_back is synchronous:
* - if yes we are inside the NCI call
* we could run the Sub immediately now (I think)
* - if no, and that's always safe, post a callback event
*/
if (synchronous) {
/*
* just call the sub
*/
Parrot_run_callback(interp, user_data, external_data);
}
else {
/*
* create a CB_EVENT, put user_data and data inside and finito
*
* *if* this function is finally no void, i.e. the calling
* C program awaits a return result from the callback,
* then wait for the CB_EVENT_xx to finish and return the
* result
*/
PMC * const callback = Parrot_pmc_new(interp, enum_class_Callback);
Parrot_Callback_attributes * const cb_data = PARROT_CALLBACK(callback);
cb_data->user_data = user_data;
cb_data->external_data = (PMC*) external_data;
Parrot_cx_schedule_immediate(interp, callback);
}
}
/* This takes a signature element and either runs the closure to get a default
* value if there is one, or creates an appropriate undefined-ish thingy. */
static PMC *
Rakudo_binding_handle_optional(PARROT_INTERP, Rakudo_Parameter *param, PMC *lexpad) {
PMC *cur_lex;
/* Is the "get default from outer" flag set? */
if (param->flags & SIG_ELEM_DEFAULT_FROM_OUTER) {
PMC *outer_ctx = Parrot_pcc_get_outer_ctx(interp, CURRENT_CONTEXT(interp));
PMC *outer_lexpad = Parrot_pcc_get_lex_pad(interp, outer_ctx);
return VTABLE_get_pmc_keyed_str(interp, outer_lexpad, param->variable_name);
}
/* Do we have a default value or value closure? */
else if (!PMC_IS_NULL(param->default_value)) {
if (param->flags & SIG_ELEM_DEFAULT_IS_LITERAL) {
return param->default_value;
}
else {
/* Thunk; run it to get a value. */
PMC *old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
PMC *cappy = Parrot_pmc_new(interp, enum_class_CallContext);
Parrot_pcc_invoke_from_sig_object(interp, param->default_value, cappy);
cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
return VTABLE_get_pmc_keyed_int(interp, cappy, 0);
}
}
/* Otherwise, go by sigil to pick the correct default type of value. */
else {
if (param->flags & SIG_ELEM_ARRAY_SIGIL) {
return Rakudo_binding_create_positional(interp, PMCNULL);
}
else if (param->flags & SIG_ELEM_HASH_SIGIL) {
return Rakudo_binding_create_hash(interp, Parrot_pmc_new(interp, enum_class_Hash));
}
else {
return param->nominal_type;
}
}
}
PARROT_CAN_RETURN_NULL
static PMC *
make_local_copy(PARROT_INTERP, ARGIN(Parrot_Interp from), ARGIN(PMC *arg))
{
ASSERT_ARGS(make_local_copy)
PMC *ret_val;
STRING * const _sub = interp->vtables[enum_class_Sub]->whoami;
STRING * const _multi_sub = interp->vtables[enum_class_MultiSub]->whoami;
if (PMC_IS_NULL(arg)) {
ret_val = PMCNULL;
}
else if (PObj_is_PMC_shared_TEST(arg)) {
ret_val = arg;
}
else if (VTABLE_isa(from, arg, _multi_sub)) {
INTVAL i = 0;
const INTVAL n = VTABLE_elements(from, arg);
ret_val = Parrot_pmc_new(interp, enum_class_MultiSub);
for (i = 0; i < n; ++i) {
PMC *const orig = VTABLE_get_pmc_keyed_int(from, arg, i);
PMC *const copy = make_local_copy(interp, from, orig);
VTABLE_push_pmc(interp, ret_val, copy);
}
}
else if (VTABLE_isa(from, arg, _sub)) {
/* this is a workaround for cloning subroutines not actually
* working as one might expect mainly because the segment is
* not correctly copied
*/
Parrot_Sub_attributes *ret_val_sub, *arg_sub;
ret_val = Parrot_clone(interp, arg);
PMC_get_sub(interp, ret_val, ret_val_sub);
PMC_get_sub(interp, arg, arg_sub);
ret_val_sub->seg = arg_sub->seg;
/* Skip vtable overrides and methods. */
if (ret_val_sub->vtable_index == -1
&& !(ret_val_sub->comp_flags & SUB_COMP_FLAG_METHOD)) {
Parrot_ns_store_sub(interp, ret_val);
}
}
else {
ret_val = Parrot_clone(interp, arg);
}
return ret_val;
}
/*
=item C<PMC * Parrot_ex_build_exception(PARROT_INTERP, INTVAL severity, long
error, STRING *msg)>
Constructs a new exception object from the passed in arguments.
=cut
*/
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_ex_build_exception(PARROT_INTERP, INTVAL severity,
long error, ARGIN_NULLOK(STRING *msg))
{
ASSERT_ARGS(Parrot_ex_build_exception)
const int exception_type_id = Parrot_hll_get_ctx_HLL_type(interp, enum_class_Exception);
PMC * const exception = Parrot_pmc_new(interp, exception_type_id);
VTABLE_set_integer_keyed_str(interp, exception, CONST_STRING(interp, "severity"), severity);
VTABLE_set_integer_keyed_str(interp, exception, CONST_STRING(interp, "type"), error);
if (msg)
VTABLE_set_string_native(interp, exception, msg);
return exception;
}
/* Helper to make an accessor call. */
static PMC * accessor_call(PARROT_INTERP, PMC *obj, STRING *name) {
PMC *old_ctx, *cappy;
/* Look up method; if there is none hand back a null. */
PMC *meth = VTABLE_find_method(interp, obj, name);
if (PMC_IS_NULL(meth))
return meth;
/* Set up call capture. */
old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
cappy = Parrot_pmc_new(interp, enum_class_CallContext);
VTABLE_push_pmc(interp, cappy, obj);
/* Call. */
Parrot_pcc_invoke_from_sig_object(interp, meth, cappy);
/* Grab result. */
cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
return VTABLE_get_pmc_keyed_int(interp, cappy, 0);
}
/* 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);
}
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);
}
/* Helper to make an introspection call, possibly with :local. */
static PMC * introspection_call(PARROT_INTERP, PMC *WHAT, PMC *HOW, STRING *name, INTVAL local) {
PMC *old_ctx, *cappy;
/* Look up method; if there is none hand back a null. */
PMC *meth = VTABLE_find_method(interp, HOW, name);
if (PMC_IS_NULL(meth))
return meth;
/* Set up call capture. */
old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
cappy = Parrot_pmc_new(interp, enum_class_CallContext);
VTABLE_push_pmc(interp, cappy, HOW);
VTABLE_push_pmc(interp, cappy, WHAT);
if (local)
VTABLE_set_integer_keyed_str(interp, cappy, Parrot_str_new_constant(interp, "local"), 1);
/* Call. */
Parrot_pcc_invoke_from_sig_object(interp, meth, cappy);
/* Grab result. */
cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
return VTABLE_get_pmc_keyed_int(interp, cappy, 0);
}
static void
parrot_set_config_hash_interpreter(PARROT_INTERP)
{
ASSERT_ARGS(parrot_set_config_hash_interpreter)
PMC *iglobals = interp->iglobals;
PMC *config_hash = NULL;
if (parrot_config_size_stored > 1) {
STRING * const config_string =
Parrot_str_new_init(interp,
(const char *)parrot_config_stored, parrot_config_size_stored,
Parrot_default_encoding_ptr,
PObj_external_FLAG|PObj_constant_FLAG);
config_hash = Parrot_thaw(interp, config_string);
}
else {
config_hash = Parrot_pmc_new(interp, enum_class_Hash);
}
VTABLE_set_pmc_keyed_int(interp, iglobals,
(INTVAL) IGLOBALS_CONFIG_HASH, config_hash);
}
/* 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);
}
void
Parrot_nci_load_core_thunks(PARROT_INTERP) {
PMC * const iglobals = interp->iglobals;
PMC *nci_funcs;
PMC *temp_pmc;
PARROT_ASSERT(!(PMC_IS_NULL(iglobals)));
nci_funcs = VTABLE_get_pmc_keyed_int(interp, iglobals, IGLOBALS_NCI_FUNCS);
PARROT_ASSERT(!(PMC_IS_NULL(nci_funcs)));
{
const int n = 1;
static const int sig[] = { 5, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_char);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 3;
static const int sig[] = { 5, 6, 5, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_char_short_char);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 1;
static const int sig[] = { 16, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_double);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 2;
static const int sig[] = { 16, 16, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_double_double);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 1;
static const int sig[] = { 15, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_float);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 3;
static const int sig[] = { 15, 15, 15, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_float_float_float);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 1;
static const int sig[] = { 7, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 4;
static const int sig[] = { 7, 7, 7, 7, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int_int_int_int);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 2;
static const int sig[] = { 7, 30, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int_ptr);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 3;
static const int sig[] = { 7, 30, 30, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int_ptr_ptr);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 3;
static const int sig[] = { 7, 6, 5, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int_short_char);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 2;
static const int sig[] = { 7, 31, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_int_cstr);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 1;
static const int sig[] = { 8, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_long);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 1;
static const int sig[] = { 30, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 2;
static const int sig[] = { 30, 7, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_int);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 3;
static const int sig[] = { 30, 7, 7, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_int_int);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 5;
static const int sig[] = { 30, 7, 7, 7, 7, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_int_int_int_int);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 3;
static const int sig[] = { 30, 7, 30, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_int_ptr);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 2;
static const int sig[] = { 30, 30, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_ptr);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 3;
static const int sig[] = { 30, 30, 3, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_ptr_ptr_STRING);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 1;
static const int sig[] = { 6, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_short);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 3;
static const int sig[] = { 6, 6, 5, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_short_short_char);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 1;
static const int sig[] = { 31, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_cstr);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 2;
static const int sig[] = { 31, 31, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_cstr_cstr);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 3;
static const int sig[] = { 31, 31, 31, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_cstr_cstr_cstr);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 1;
static const int sig[] = { 29, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 4;
static const int sig[] = { 29, 15, 15, 15, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void_float_float_float);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 2;
static const int sig[] = { 29, 30, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void_ptr);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 2;
static const int sig[] = { 29, 4, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void_PMC);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 4;
static const int sig[] = { 29, 30, 7, 7, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void_ptr_int_int);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
{
const int n = 3;
static const int sig[] = { 29, 30, 4, };
PMC *sig_pmc = Parrot_pmc_new_init_int(interp, enum_class_FixedIntegerArray, n);
int i;
for (i = 0; i < n; i++)
VTABLE_set_integer_keyed_int(interp, sig_pmc, i, sig[i]);
temp_pmc = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
VTABLE_set_pointer(interp, temp_pmc, (void *)pcf_void_ptr_PMC);
VTABLE_set_pmc_keyed(interp, nci_funcs, sig_pmc, temp_pmc);
}
}
=item C<static void set_cstring_prop(PARROT_INTERP, PMC *lib_pmc, const char
*what, STRING *name)>
Sets a property C<name> with value C<what> on the C<ParrotLibrary> C<lib_pmc>.
=cut
*/
static void
set_cstring_prop(PARROT_INTERP, ARGMOD(PMC *lib_pmc), ARGIN(const char *what),
ARGIN(STRING *name))
{
ASSERT_ARGS(set_cstring_prop)
STRING * const key = Parrot_str_new_constant(interp, what);
PMC * const prop = Parrot_pmc_new(interp, enum_class_String);
VTABLE_set_string_native(interp, prop, name);
Parrot_pmc_setprop(interp, lib_pmc, key, prop);
}
/*
=item C<static void store_lib_pmc(PARROT_INTERP, PMC *lib_pmc, STRING *path,
STRING *type, STRING *lib_name)>
Stores a C<ParrotLibrary> PMC in the interpreter's C<iglobals>.
=cut
/* Bootstraps the KnowHOW. This is were things "bottom out" in the meta-model
* so it's a tad loopy. Basically, we create a KnowHOW type object. We then
* create an instance from that and add a bunch of methods to it. Returns the
* bootstrapped object. */
PMC * SixModelObject_bootstrap_knowhow(PARROT_INTERP, PMC *sc) {
/* Create our KnowHOW type object. Note we don't have a HOW just yet, so
* pass in null. */
REPROps *REPR = REPR_get_by_name(interp, Parrot_str_new_constant(interp, "KnowHOWREPR"));
PMC *knowhow_pmc = REPR->type_object_for(interp, PMCNULL);
/* We create a KnowHOW instance that can describe itself. This means
* .HOW.HOW.HOW.HOW etc will always return that, which closes the model
* up. Also pull out its underlying struct. */
PMC *knowhow_how_pmc = REPR->allocate(interp, NULL);
KnowHOWREPRInstance *knowhow_how = (KnowHOWREPRInstance *)PMC_data(knowhow_how_pmc);
/* Need to give the knowhow_how a twiddled STable with a different
* dispatcher, so things bottom out. */
PMC *st_copy = create_stable(interp, REPR, knowhow_how_pmc);
STABLE_STRUCT(st_copy)->WHAT = knowhow_pmc;
STABLE_STRUCT(st_copy)->find_method = bottom_find_method;
knowhow_how->common.stable = st_copy;
/* Add various methods to the KnowHOW's HOW. */
knowhow_how->body.methods = Parrot_pmc_new(interp, enum_class_Hash);
knowhow_how->body.attributes = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
VTABLE_set_pmc_keyed_str(interp, knowhow_how->body.methods,
Parrot_str_new_constant(interp, "new_type"),
wrap_c(interp, F2DPTR(new_type)));
VTABLE_set_pmc_keyed_str(interp, knowhow_how->body.methods,
Parrot_str_new_constant(interp, "find_method"),
wrap_c(interp, F2DPTR(find_method)));
VTABLE_set_pmc_keyed_str(interp, knowhow_how->body.methods,
Parrot_str_new_constant(interp, "add_method"),
wrap_c(interp, F2DPTR(add_method)));
VTABLE_set_pmc_keyed_str(interp, knowhow_how->body.methods,
Parrot_str_new_constant(interp, "add_attribute"),
wrap_c(interp, F2DPTR(add_attribute)));
VTABLE_set_pmc_keyed_str(interp, knowhow_how->body.methods,
Parrot_str_new_constant(interp, "compose"),
wrap_c(interp, F2DPTR(compose)));
VTABLE_set_pmc_keyed_str(interp, knowhow_how->body.methods,
Parrot_str_new_constant(interp, "parents"),
wrap_c(interp, F2DPTR(parents)));
VTABLE_set_pmc_keyed_str(interp, knowhow_how->body.methods,
Parrot_str_new_constant(interp, "attributes"),
wrap_c(interp, F2DPTR(attributes)));
VTABLE_set_pmc_keyed_str(interp, knowhow_how->body.methods,
Parrot_str_new_constant(interp, "methods"),
wrap_c(interp, F2DPTR(methods)));
VTABLE_set_pmc_keyed_str(interp, knowhow_how->body.methods,
Parrot_str_new_constant(interp, "mro"),
wrap_c(interp, F2DPTR(mro)));
VTABLE_set_pmc_keyed_str(interp, knowhow_how->body.methods,
Parrot_str_new_constant(interp, "name"),
wrap_c(interp, F2DPTR(name)));
/* Set name KnowHOW for the KnowHOW's HOW. */
knowhow_how->body.name = Parrot_str_new_constant(interp, "KnowHOW");
/* Set this built up HOW as the KnowHOW's HOW. */
STABLE(knowhow_pmc)->HOW = knowhow_how_pmc;
/* Give it an authoritative method cache. */
STABLE(knowhow_pmc)->method_cache = knowhow_how->body.methods;
STABLE(knowhow_pmc)->mode_flags = METHOD_CACHE_AUTHORITATIVE;
/* Set up some string constants that the methods here use. */
repr_str = Parrot_str_new_constant(interp, "repr");
name_str = Parrot_str_new_constant(interp, "name");
empty_str = Parrot_str_new_constant(interp, "");
p6opaque_str = Parrot_str_new_constant(interp, "P6opaque");
/* Associate the created objects with the intial core serialization
* context. */
VTABLE_set_pmc_keyed_int(interp, sc, 0, knowhow_pmc);
SC_PMC(knowhow_pmc) = sc;
VTABLE_set_pmc_keyed_int(interp, sc, 1, knowhow_how_pmc);
SC_PMC(knowhow_how_pmc) = sc;
STABLE(knowhow_pmc)->sc = sc;
STABLE(knowhow_how_pmc)->sc = sc;
return knowhow_pmc;
}
/* Locates all of the attributes. Puts them onto a flattened, ordered
* list of attributes (populating the passed flat_list). Also builds
* the index mapping for doing named lookups. Note index is not related
* to the storage position. */
static PMC * index_mapping_and_flat_list(PARROT_INTERP, PMC *WHAT, P6opaqueREPRData *repr_data) {
PMC *flat_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
PMC *class_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
PMC *attr_map_list = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
STRING *attributes_str = Parrot_str_new_constant(interp, "attributes");
STRING *parents_str = Parrot_str_new_constant(interp, "parents");
STRING *name_str = Parrot_str_new_constant(interp, "name");
STRING *mro_str = Parrot_str_new_constant(interp, "mro");
INTVAL current_slot = 0;
INTVAL num_classes, i;
P6opaqueNameMap * result = NULL;
/* Get the MRO. */
PMC *mro = introspection_call(interp, WHAT, STABLE(WHAT)->HOW, mro_str, 0);
INTVAL mro_idx = VTABLE_elements(interp, mro);
/* Walk through the parents list. */
while (mro_idx)
{
/* Get current class in MRO. */
PMC *current_class = decontainerize(interp, VTABLE_get_pmc_keyed_int(interp, mro, --mro_idx));
PMC *HOW = STABLE(current_class)->HOW;
/* Get its local parents. */
PMC *parents = introspection_call(interp, current_class, HOW, parents_str, 1);
INTVAL num_parents = VTABLE_elements(interp, parents);
/* Get attributes and iterate over them. */
PMC *attributes = introspection_call(interp, current_class, HOW, attributes_str, 1);
PMC *attr_map = PMCNULL;
PMC *attr_iter = VTABLE_get_iter(interp, attributes);
while (VTABLE_get_bool(interp, attr_iter)) {
/* Get attribute. */
PMC * attr = VTABLE_shift_pmc(interp, attr_iter);
/* Get its name. */
PMC *name_pmc = accessor_call(interp, attr, name_str);
STRING *name = VTABLE_get_string(interp, name_pmc);
/* Allocate a slot. */
if (PMC_IS_NULL(attr_map))
attr_map = Parrot_pmc_new(interp, enum_class_Hash);
VTABLE_set_pmc_keyed_str(interp, attr_map, name,
Parrot_pmc_new_init_int(interp, enum_class_Integer, current_slot));
current_slot++;
/* Push attr onto the flat list. */
VTABLE_push_pmc(interp, flat_list, attr);
}
/* Add to class list and map list. */
VTABLE_push_pmc(interp, class_list, current_class);
VTABLE_push_pmc(interp, attr_map_list, attr_map);
/* If there's more than one parent, flag that we in an MI
* situation. */
if (num_parents > 1)
repr_data->mi = 1;
}
/* We can now form the name map. */
num_classes = VTABLE_elements(interp, class_list);
result = (P6opaqueNameMap *) mem_sys_allocate_zeroed(sizeof(P6opaqueNameMap) * (1 + num_classes));
for (i = 0; i < num_classes; i++) {
result[i].class_key = VTABLE_get_pmc_keyed_int(interp, class_list, i);
result[i].name_map = VTABLE_get_pmc_keyed_int(interp, attr_map_list, i);
}
repr_data->name_to_index_mapping = result;
return flat_list;
}
/* Wraps up a C function as a raw NCI method. */
static PMC * wrap_c(PARROT_INTERP, void *func) {
PMC * const wrapped = Parrot_pmc_new(interp, enum_class_NativePCCMethod);
VTABLE_set_pointer_keyed_str(interp, wrapped, Parrot_str_new_constant(interp, "->"), func);
return wrapped;
}
=cut
*/
void
Parrot_cx_init_scheduler(PARROT_INTERP)
{
ASSERT_ARGS(Parrot_cx_init_scheduler)
if (!interp->parent_interpreter) {
PMC *scheduler;
/* Add the very first interpreter to the list of interps. */
pt_add_to_interpreters(interp, NULL);
scheduler = Parrot_pmc_new(interp, enum_class_Scheduler);
scheduler = VTABLE_share_ro(interp, scheduler);
interp->scheduler = scheduler;
}
}
/*
=item C<void Parrot_cx_check_tasks(PARROT_INTERP, PMC *scheduler)>
If a wake request has been received, handle tasks.
=cut
*/
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_io_open_handle(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(STRING *path), ARGIN(STRING *mode))
{
ASSERT_ARGS(Parrot_io_open_handle)
PMC *filehandle;
const INTVAL typenum = Parrot_hll_get_ctx_HLL_type(interp,
Parrot_PMC_typenum(interp, "FileHandle"));
if (PMC_IS_NULL(pmc)) {
filehandle = Parrot_pmc_new(interp, typenum);
}
else
filehandle = pmc;
if (STRING_IS_NULL(path))
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"Cannot open filehandle, no path");
if (filehandle->vtable->base_type == typenum) {
INTVAL flags = Parrot_io_parse_open_flags(interp, mode);
PIOHANDLE os_handle;
/* TODO: a filehandle shouldn't allow a NULL path. */
PARROT_ASSERT(filehandle->vtable->base_type == typenum);
if (flags & PIO_F_PIPE) {
const int f_read = (flags & PIO_F_READ) != 0;
const int f_write = (flags & PIO_F_WRITE) != 0;
INTVAL pid;
if (f_read == f_write)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"Invalid pipe mode: %X", flags);
os_handle = PIO_OPEN_PIPE(interp, path, flags, &pid);
/* Save the pid of the child, we'll wait for it when closing */
VTABLE_set_integer_keyed_int(interp, filehandle, 0, pid);
}
else {
if ((flags & (PIO_F_WRITE | PIO_F_READ)) == 0)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Invalid mode for file open");
os_handle = PIO_OPEN(interp, path, flags);
if (os_handle == PIO_INVALID_HANDLE)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
"Unable to open filehandle from path '%Ss'", path);
flags |= PIO_F_FILE;
/* Set generic flag here if is a terminal then
* FileHandle can know how to setup buffering.
* STDIN, STDOUT, STDERR would be in this case
* so we would setup linebuffering.
*/
if (PIO_IS_TTY(interp, os_handle))
flags |= PIO_F_CONSOLE;
}
if (STRING_IS_NULL(mode))
mode = CONST_STRING(interp, "r");
else if (STRING_index(interp, mode, CONST_STRING(interp, "b"), 0) >= 0)
SETATTR_FileHandle_encoding(interp, filehandle, CONST_STRING(interp, "binary"));
SETATTR_FileHandle_os_handle(interp, filehandle, os_handle);
SETATTR_FileHandle_flags(interp, filehandle, flags);
SETATTR_FileHandle_filename(interp, filehandle, path);
SETATTR_FileHandle_mode(interp, filehandle, mode);
Parrot_io_setbuf(interp, filehandle, PIO_UNBOUND);
}
else
Parrot_pcc_invoke_method_from_c_args(interp, filehandle, CONST_STRING(interp, "open"), "SS->P", path, mode, &filehandle);
return filehandle;
}
/* 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, 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;
}
