parrotcode: Multimethod dispatch for binary opcode functions | |
Contents | C |
src/mmd.c - Multimethod dispatch for binary opcode functions
This system is set up to handle type-based dispatching for binary (i.e. two-arg) functions. This includes, though isn't necessarily limited to, binary operators such as addition or subtraction.
The MMD system is straightforward, and currently must be explicitly invoked, for example by a vtable function. (We may reserve the right to use MMD in all circumstances, but currently do not).
For the purposes of the API,
each MMD-able function is assigned a unique number which is used to find the correct function table.
This is the func_num
parameter in the following functions.
While Parrot isn't restricted to a predefined set of functions,
it does set things up so that all the binary vtable functions have a MMD table preinstalled for them,
with default behaviour.
binop_mmd_funcs->x
and ->y
are table sizes not highest type in table.
PMC *mmd_dispatch_p_ppp(Interp *, PMC *left, PMC *right, PMC *dest, INTVAL function)
left
,
right
,
and dest
are all PMC pointers,
while func_num
is the MMD table that should be used to do the dispatching.
If the dest
pointer is NULL,
it dispatches two a two-argument function that returns a new dest
always.left
and right
and call it,
passing in left
,
right
,
and possibly dest
like any other binary vtable function.PMC *mmd_dispatch_p_pip(Interp *, PMC *left, INTVAL right, PMC *dest, INTVAL function)
PMC *mmd_dispatch_p_pnp(Interp *, PMC *left, FLOATVAL right, PMC *dest, INTVAL function)
PMC *mmd_dispatch_p_psp(Interp *, PMC *left, STRING *right, PMC *dest, INTVAL function)
void mmd_dispatch_v_pp(Interp *, PMC *left, PMC *right, INTVAL function)
void mmd_dispatch_v_pi(Interp *, PMC *left, INTVAL right, INTVAL function)
void mmd_dispatch_v_pn(Interp *, PMC *left, FLOATVAL right, INTVAL function)
void mmd_dispatch_v_ps(Interp *, PMC *left, STRING *right, INTVAL function)
left <op=> right
. if (isa_deleg_pmc(interpreter, left)) {
attrib_array = PMC_data(left);
l = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
n = left;
}
else
l = left;
if (isa_deleg_pmc(interpreter, right)) {
attrib_array = PMC_data(right);
r = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
n = right;
}
else
r = right;
if (dest && isa_deleg_pmc(interpreter, dest)) {
attrib_array = PMC_data(dest);
d = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
}
else {
d = dest;
attrib_array = NULL;
}
real_function = (mmd_f_p_ppp)D2FPTR(PMC_struct_val(nci));
d = (real_function)(interpreter, l, r, d);
if (attrib_array) {
attrib_array[POD_FIRST_ATTRIB] = d;
return dest;
}
if (!n)
return d;
dest = VTABLE_clone(interpreter, n);
attrib_array = PMC_data(dest);
attrib_array[POD_FIRST_ATTRIB] = d;
return dest;
real_function = (mmd_f_p_ppp)get_mmd_dispatcher(interpreter,
left, right, func_nr, &is_pmc);
if (is_pmc) {
sub = (PMC*)real_function;
if (is_pmc == 2) {
/* mmd_register the wrapper */
mmd_register(interpreter, func_nr, left->vtable->base_type,
right->vtable->base_type,
D2FPTR((UINTVAL) sub | 3));
#if 0
mmd_create_builtin_multi_meth_2(interpreter,
func_nr, left->vtable->base_type,
right->vtable->base_type, (funcptr_t)mmd_wrap_p_ppp);
#endif
is_pmc = 3;
}
if (is_pmc == 3) {
PMC_pmc_val(sub) = left;
return mmd_wrap_p_ppp(interpreter, sub, right, dest);
}
if (dest)
return Parrot_runops_fromc_args(interpreter, sub, "PPPP",
left, right, dest);
else
return Parrot_runops_fromc_args(interpreter, sub, "PPP",
left, right);
}
else {
return (*real_function)(interpreter, left, right, dest);
}
}
if (isa_deleg_pmc(interpreter, left)) {
attrib_array = PMC_data(left);
l = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
n = left;
}
else
l = left;
if (dest && isa_deleg_pmc(interpreter, dest)) {
attrib_array = PMC_data(dest);
d = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
}
else {
d = dest;
attrib_array = NULL;
}
real_function = (mmd_f_p_pip)D2FPTR(PMC_struct_val(nci));
d = (real_function)(interpreter, l, right, d);
if (attrib_array) {
attrib_array[POD_FIRST_ATTRIB] = d;
return dest;
}
if (!n)
return d;
dest = VTABLE_clone(interpreter, n);
attrib_array = PMC_data(dest);
attrib_array[POD_FIRST_ATTRIB] = d;
return dest;
left_type = left->vtable->base_type;
real_function = (mmd_f_p_pip)get_mmd_dispatch_type(interpreter,
func_nr, left_type, enum_type_INTVAL, &is_pmc);
if (is_pmc) {
sub = (PMC*)real_function;
if (is_pmc == 2) {
/* mmd_register the wrapper */
mmd_register(interpreter, func_nr, left->vtable->base_type,
enum_type_INTVAL,
D2FPTR((UINTVAL) sub | 3));
is_pmc = 3;
}
if (is_pmc == 3) {
PMC_pmc_val(sub) = left;
return mmd_wrap_p_pip(interpreter, sub, right, dest);
}
if (dest)
return Parrot_runops_fromc_args(interpreter, sub, "PPIP",
left, right, dest);
else
return Parrot_runops_fromc_args(interpreter, sub, "PPI",
left, right);
}
else {
return (*real_function)(interpreter, left, right, dest);
}
}
if (isa_deleg_pmc(interpreter, left)) {
attrib_array = PMC_data(left);
l = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
n = left;
}
else
l = left;
if (dest && isa_deleg_pmc(interpreter, dest)) {
attrib_array = PMC_data(dest);
d = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
}
else {
d = dest;
attrib_array = NULL;
}
real_function = (mmd_f_p_pnp)D2FPTR(PMC_struct_val(nci));
d = (real_function)(interpreter, l, right, d);
if (attrib_array) {
attrib_array[POD_FIRST_ATTRIB] = d;
return dest;
}
if (!n)
return d;
dest = VTABLE_clone(interpreter, n);
attrib_array = PMC_data(dest);
attrib_array[POD_FIRST_ATTRIB] = d;
return dest;
left_type = left->vtable->base_type;
real_function = (mmd_f_p_pnp)get_mmd_dispatch_type(interpreter,
func_nr, left_type, enum_type_FLOATVAL, &is_pmc);
if (is_pmc) {
sub = (PMC*)real_function;
if (is_pmc == 2) {
/* mmd_register the wrapper */
mmd_register(interpreter, func_nr, left->vtable->base_type,
enum_type_FLOATVAL,
D2FPTR((UINTVAL) sub | 3));
is_pmc = 3;
}
if (is_pmc == 3) {
PMC_pmc_val(sub) = left;
return mmd_wrap_p_pnp(interpreter, sub, right, dest);
}
if (dest)
return Parrot_runops_fromc_args(interpreter, sub, "PPNP",
left, right, dest);
else
return Parrot_runops_fromc_args(interpreter, sub, "PPN",
left, right);
}
else {
return (*real_function)(interpreter, left, right, dest);
}
}
if (isa_deleg_pmc(interpreter, left)) {
attrib_array = PMC_data(left);
l = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
n = left;
}
else
l = left;
if (dest && isa_deleg_pmc(interpreter, dest)) {
attrib_array = PMC_data(dest);
d = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
}
else {
d = dest;
attrib_array = NULL;
}
real_function = (mmd_f_p_psp)D2FPTR(PMC_struct_val(nci));
d = (real_function)(interpreter, l, right, d);
if (attrib_array) {
attrib_array[POD_FIRST_ATTRIB] = d;
return dest;
}
if (!n)
return d;
dest = VTABLE_clone(interpreter, n);
attrib_array = PMC_data(dest);
attrib_array[POD_FIRST_ATTRIB] = d;
return dest;
left_type = left->vtable->base_type;
real_function = (mmd_f_p_psp)get_mmd_dispatch_type(interpreter,
func_nr, left_type, enum_type_STRING, &is_pmc);
if (is_pmc) {
sub = (PMC*)real_function;
if (is_pmc == 2) {
/* mmd_register the wrapper */
mmd_register(interpreter, func_nr, left->vtable->base_type,
enum_type_STRING,
D2FPTR((UINTVAL) sub | 3));
is_pmc = 3;
}
if (is_pmc == 3) {
PMC_pmc_val(sub) = left;
return mmd_wrap_p_psp(interpreter, sub, right, dest);
}
if (dest)
return Parrot_runops_fromc_args(interpreter, sub, "PPSP",
left, right, dest);
else
return Parrot_runops_fromc_args(interpreter, sub, "PPS",
left, right);
}
else {
return (*real_function)(interpreter, left, right, dest);
}
}
if (isa_deleg_pmc(interpreter, left)) {
attrib_array = PMC_data(left);
l = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
}
else
l = left;
if (isa_deleg_pmc(interpreter, right)) {
attrib_array = PMC_data(right);
r = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
}
else
r = right;
real_function = (mmd_f_v_pp)D2FPTR(PMC_struct_val(nci));
(real_function)(interpreter, l, r);
}
real_function = (mmd_f_v_pp)get_mmd_dispatcher(interpreter,
left, right, func_nr, &is_pmc);
if (is_pmc) {
sub = (PMC*)real_function;
if (is_pmc == 2) {
/* mmd_register the wrapper */
mmd_register(interpreter, func_nr, left->vtable->base_type,
right->vtable->base_type,
D2FPTR((UINTVAL) sub | 3));
is_pmc = 3;
}
if (is_pmc == 3) {
PMC_pmc_val(sub) = left;
mmd_wrap_v_pp(interpreter, sub, right);
return;
}
Parrot_runops_fromc_args(interpreter, sub, "vPP", left, right);
}
else {
(*real_function)(interpreter, left, right);
}
}
if (isa_deleg_pmc(interpreter, left)) {
attrib_array = PMC_data(left);
l = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
}
else
l = left;
assert(l != left);
real_function = (mmd_f_v_pi)D2FPTR(PMC_struct_val(nci));
(real_function)(interpreter, l, right);
}
left_type = left->vtable->base_type;
real_function = (mmd_f_v_pi)get_mmd_dispatch_type(interpreter,
func_nr, left_type, enum_type_INTVAL, &is_pmc);
if (is_pmc) {
sub = (PMC*)real_function;
if (is_pmc == 2) {
/* mmd_register the wrapper */
mmd_register(interpreter, func_nr, left->vtable->base_type,
enum_type_INTVAL,
D2FPTR((UINTVAL) sub | 3));
is_pmc = 3;
}
if (is_pmc == 3) {
PMC_pmc_val(sub) = left;
mmd_wrap_v_pi(interpreter, sub, right);
return;
}
Parrot_runops_fromc_args(interpreter, sub, "vPI", left, right);
}
else {
(*real_function)(interpreter, left, right);
}
}
if (isa_deleg_pmc(interpreter, left)) {
attrib_array = PMC_data(left);
l = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
}
else
l = left;
assert(l != left);
real_function = (mmd_f_v_pn)D2FPTR(PMC_struct_val(nci));
(real_function)(interpreter, l, right);
}
left_type = left->vtable->base_type;
real_function = (mmd_f_v_pn)get_mmd_dispatch_type(interpreter,
func_nr, left_type, enum_type_FLOATVAL, &is_pmc);
if (is_pmc) {
sub = (PMC*)real_function;
if (is_pmc == 2) {
/* mmd_register the wrapper */
mmd_register(interpreter, func_nr, left->vtable->base_type,
enum_type_FLOATVAL,
D2FPTR((UINTVAL) sub | 3));
is_pmc = 3;
}
if (is_pmc == 3) {
PMC_pmc_val(sub) = left;
mmd_wrap_v_pn(interpreter, sub, right);
return;
}
Parrot_runops_fromc_args(interpreter, sub, "vPN", left, right);
}
else {
(*real_function)(interpreter, left, right);
}
}
if (isa_deleg_pmc(interpreter, left)) {
attrib_array = PMC_data(left);
l = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
}
else
l = left;
assert(l != left);
real_function = (mmd_f_v_ps)D2FPTR(PMC_struct_val(nci));
(real_function)(interpreter, l, right);
}
void
mmd_dispatch_v_ps(Interp *interpreter,
PMC *left, STRING *right, INTVAL func_nr)
{
mmd_f_v_ps real_function;
PMC *sub;
int is_pmc;
UINTVAL left_type;
left_type = left->vtable->base_type;
real_function = (mmd_f_v_ps)get_mmd_dispatch_type(interpreter,
func_nr, left_type, enum_type_STRING, &is_pmc);
if (is_pmc) {
sub = (PMC*)real_function;
if (is_pmc == 2) {
/* mmd_register the wrapper */
mmd_register(interpreter, func_nr, left->vtable->base_type,
enum_type_STRING,
D2FPTR((UINTVAL) sub | 3));
is_pmc = 3;
}
if (is_pmc == 3) {
PMC_pmc_val(sub) = left;
mmd_wrap_v_ps(interpreter, sub, right);
return;
}
Parrot_runops_fromc_args(interpreter, sub, "vPS", left, right);
}
else {
(*real_function)(interpreter, left, right);
}
}
if (isa_deleg_pmc(interpreter, left)) {
attrib_array = PMC_data(left);
l = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
}
else
l = left;
if (isa_deleg_pmc(interpreter, right)) {
attrib_array = PMC_data(right);
r = get_attrib_num(attrib_array, POD_FIRST_ATTRIB);
}
else
r = right;
real_function = (mmd_f_i_pp)D2FPTR(PMC_struct_val(nci));
return (real_function)(interpreter, l, r);
}
/*
INTVAL mmd_dispatch_i_pp(Interp *interpreter, PMC *left, PMC *right, INTVAL func_nr)
mmd_dispatch_p_ppp()
, only it returns an INTVAL
. This is used by MMD compare functions.void mmd_add_function(Interp *interpreter, INTVAL funcnum, funcptr_t function)
func_num
is the number of the new function. function
is ignored.static void mmd_expand_x(Interp *interpreter, INTVAL func_nr, INTVAL new_x)
new_x
.static void mmd_expand_y(Interp *interpreter, INTVAL func_nr, INTVAL new_y)
void mmd_add_by_class(Interp *interpreter, INTVAL functype, STRING *left_class, STRING *right_class, funcptr_t funcptr)
funcptr
to the func_num
function table that will be invoked when the left parameter is of class left_class
and the right parameter is of class right_class
. Both classes are STRING *
s that hold the PMC class names for the left and right sides. If either class isn't yet loaded, Parrot will cache the information such that the function will be installed if at some point in the future both classes are available.void mmd_register(Interp *interpreter, INTVAL func_num, INTVAL left_type, INTVAL right_type, funcptr_t funcptr)
funcptr
for MMD function table func_num
for classes left_type
and right_type
. The left and right types are INTVAL
s that represent the class ID numbers.void mmd_destroy(Parrot_Interp interpreter)
PMC *mmd_vtfind(Parrot_Interp interpreter, INTVAL type, INTVAL left, INTVAL right)
PMC *Parrot_MMD_search_default_inline(Interp *, STRING *meth, STRING *signature, ...)
PMC *Parrot_MMD_search_default_func(Interp *, STRING *meth, STRING *signature)
P5
and up according to calling conventions.PMC *Parrot_MMD_dispatch_func(Interp *, PMC *multi, STRING *signature)
static PMC *mmd_arg_tuple_inline(Interp *, STRING *signature, va_list args)
static PMC *mmd_arg_tuple_func(Interp *, STRING *signature)
static PMC *mmd_search_default(Interp *, STRING *meth, PMC *arg_tuple)
static void mmd_search_classes(Interp *, STRING *meth, PMC *arg_tuple, PMC *cl, INTVAL start_at_parent)
cl
and return a list of all candidates. start_at_parent
is 0 to start at the class itself or 1 to search from the first parent class.static UINTVAL mmd_distance(Interp *, PMC *pmc, PMC *arg_tuple)
pmc
against given argument types. 0xffff is the maximum distancestatic void mmd_sort_candidates(Interp *, PMC *arg_tuple, PMC *cl)
cl
by Manhattan Distancestatic PMC *mmd_search_scopes(Interp *, STRING *meth, PMC *arg_tuple)
arg_tuple
.static int mmd_is_hidden(Interp *, PMC *multi, PMC *cl)
cl
.static int mmd_maybe_candidate(Interp *, PMC *pmc, PMC *arg_tuple, PMC *cl)
pmc
is a Sub PMC, push it on the candidate list and return TRUE to stop further search.static int mmd_search_lexical(Interp *, STRING *meth, PMC *arg_tuple, PMC *cl)
static int mmd_search_package(Interp *, STRING *meth, PMC *arg_tuple, PMC *cl)
static int mmd_search_global(Interp *, STRING *meth, PMC *arg_tuple, PMC *cl)
static void mmd_search_builtin(Interp *, STRING *meth, PMC *arg_tuple, PMC *cl)
void Parrot_mmd_register_table(Interp*, INTVAL type, MMD_init *, INTVAL)
void Parrot_mmd_rebuild_table(Interp*, INTVAL type, INTVAL func_nr)
type
is negative all classes are rebuilt. If func_nr
is negative all MMD functions are rebuilt.include/parrot/mmd.h, http://svn.perl.org/perl6/doc/trunk/design/apo/A12.pod, http://svn.perl.org/perl6/doc/trunk/design/syn/S12.pod
|