* src/mmd.c:
[parrot.git] / src / mmd.c
blob9e99f1ac4454bc992967d3b12c9f8073084a2616
1 /*
2 Copyright (C) 2003-2007, The Perl Foundation.
3 $Id$
5 =head1 NAME
7 src/mmd.c - Multimethod dispatch for binary opcode functions
9 =head1 SYNOPSIS
11 This system is set up to handle type-based dispatching for binary (i.e.
12 two-arg) functions. This includes, though isn't necessarily limited to,
13 binary operators such as addition or subtraction.
15 =head1 DESCRIPTION
17 The MMD system is straightforward, and currently must be explicitly
18 invoked, for example by a vtable function. (We may reserve the right to
19 use MMD in all circumstances, but currently do not).
21 =head2 API
23 For the purposes of the API, each MMD-able function is assigned a unique
24 number which is used to find the correct function table. This is the
25 C<func_num> parameter in the following functions. While Parrot isn't
26 restricted to a predefined set of functions, it I<does> set things up so
27 that all the binary vtable functions have a MMD table preinstalled for
28 them, with default behaviour.
30 =head2 Remarks
32 C<< binop_mmd_funcs->x >> and C<< ->y >> are table sizes
33 not highest type in table.
35 =head2 Functions
39 #include "parrot/compiler.h"
40 #include "parrot/parrot.h"
41 #include "parrot/mmd.h"
42 #include "parrot/oplib/ops.h"
43 #include "mmd.str"
44 #include <assert.h>
46 /* HEADERIZER HFILE: include/parrot/mmd.h */
48 /* HEADERIZER BEGIN: static */
50 static INTVAL distance_cmp( SHIM_INTERP, INTVAL a, INTVAL b );
51 static void dump_mmd( PARROT_INTERP, INTVAL function )
52 __attribute__nonnull__(1);
54 static funcptr_t get_mmd_dispatcher( PARROT_INTERP,
55 PMC *left,
56 PMC *right,
57 INTVAL function,
58 NOTNULL(int *is_pmc) )
59 __attribute__nonnull__(1)
60 __attribute__nonnull__(5);
62 static PMC* mmd_arg_tuple_func( PARROT_INTERP )
63 __attribute__nonnull__(1);
65 static PMC* mmd_arg_tuple_inline( PARROT_INTERP,
66 NOTNULL(STRING *signature),
67 va_list args )
68 __attribute__nonnull__(1)
69 __attribute__nonnull__(2);
71 static void mmd_create_builtin_multi_meth( PARROT_INTERP,
72 PMC *ns,
73 INTVAL type,
74 NOTNULL(const MMD_init *entry) )
75 __attribute__nonnull__(1)
76 __attribute__nonnull__(4);
78 static void mmd_create_builtin_multi_meth_2( PARROT_INTERP,
79 PMC *ns,
80 INTVAL func_nr,
81 INTVAL type,
82 INTVAL right,
83 funcptr_t func_ptr )
84 __attribute__nonnull__(1);
86 static PMC * mmd_create_builtin_multi_stub( PARROT_INTERP,
87 PMC* ns,
88 INTVAL func_nr )
89 __attribute__nonnull__(1);
91 static PMC* mmd_cvt_to_types( PARROT_INTERP, PMC *multi_sig )
92 __attribute__nonnull__(1);
94 static PMC * mmd_deref( PARROT_INTERP, NOTNULL(PMC *value) )
95 __attribute__nonnull__(1)
96 __attribute__nonnull__(2);
98 static UINTVAL mmd_distance( PARROT_INTERP,
99 NOTNULL(PMC *pmc),
100 PMC *arg_tuple )
101 __attribute__nonnull__(1)
102 __attribute__nonnull__(2);
104 static void mmd_ensure_writable( PARROT_INTERP,
105 INTVAL function,
106 NULLOK(PMC *pmc) )
107 __attribute__nonnull__(1);
109 static void mmd_expand_x( PARROT_INTERP, INTVAL func_nr, INTVAL new_x )
110 __attribute__nonnull__(1);
112 static void mmd_expand_y( PARROT_INTERP, INTVAL func_nr, INTVAL new_y )
113 __attribute__nonnull__(1);
115 static PMC* mmd_get_ns( PARROT_INTERP )
116 __attribute__nonnull__(1);
118 static int mmd_is_hidden( PARROT_INTERP, PMC *multi, PMC *cl )
119 __attribute__nonnull__(1);
121 static PMC* mmd_make_ns( PARROT_INTERP )
122 __attribute__nonnull__(1);
124 static int mmd_maybe_candidate( PARROT_INTERP, PMC *pmc, PMC *cl )
125 __attribute__nonnull__(1);
127 static void mmd_search_builtin( PARROT_INTERP, STRING *meth, PMC *cl )
128 __attribute__nonnull__(1);
130 static void mmd_search_classes( PARROT_INTERP,
131 STRING *meth,
132 PMC *arg_tuple,
133 PMC *cl,
134 INTVAL start_at_parent )
135 __attribute__nonnull__(1);
137 static int mmd_search_cur_namespace( PARROT_INTERP, STRING *meth, PMC *cl )
138 __attribute__nonnull__(1);
140 static PMC* mmd_search_default( PARROT_INTERP, STRING *meth, PMC *arg_tuple )
141 __attribute__nonnull__(1);
143 static PMC* mmd_search_scopes( PARROT_INTERP, STRING *meth )
144 __attribute__nonnull__(1);
146 static void mmd_sort_candidates( PARROT_INTERP, PMC *arg_tuple, PMC *cl )
147 __attribute__nonnull__(1);
149 /* HEADERIZER END: static */
152 #define MMD_DEBUG 0
154 #ifndef NDEBUG
155 static void
156 dump_mmd(PARROT_INTERP, INTVAL function)
158 UINTVAL x, y;
159 UINTVAL offset, x_funcs, y_funcs;
160 MMD_table * const table = interp->binop_mmd_funcs + function;
161 funcptr_t func, def; /* XXX Looks like def is never defined */
163 x_funcs = table->x;
164 y_funcs = table->y;
165 printf(" ");
166 for (x = 0; x < x_funcs; ++x) {
167 if (! (x % 10))
168 printf("%d", (int) x / 10);
169 else
170 printf(" ");
172 printf("\n");
173 for (y = 0; y < y_funcs; ++y) {
174 printf("%3d ", (int)y);
175 for (x = 0; x < x_funcs; ++x) {
176 offset = x_funcs * y + x;
177 func = table->mmd_funcs[offset];
178 printf("%c",
179 func == def ? '.' :
180 (UINTVAL)func & 1 ? 'P' :
181 !func ? '0' : 'F');
183 printf("\n");
185 for (y = 0; y < y_funcs; ++y) {
186 for (x = 0; x < x_funcs; ++x) {
187 offset = x_funcs * y + x;
188 func = table->mmd_funcs[offset];
189 if (func && func != def && !((UINTVAL) func & 1))
190 printf("%3d %3d: %p\n", (int)x, (int)y, (void*) func);
194 #endif
196 PARROT_API
197 funcptr_t
198 get_mmd_dispatch_type(PARROT_INTERP, INTVAL func_nr, INTVAL left_type,
199 INTVAL right_type, NOTNULL(int *is_pmc))
200 /* WARN_UNUSED */
202 funcptr_t func, func_;
203 INTVAL r;
204 MMD_table * const table = interp->binop_mmd_funcs + func_nr;
205 const UINTVAL x_funcs = table->x;
206 const UINTVAL y_funcs = table->y;
208 #if MMD_DEBUG
209 fprintf(stderr, "running function %d with left type=%u, right type=%u\n",
210 (int) func_nr, (unsigned) left_type, (unsigned) right_type);
211 #endif
213 func = NULL;
214 assert(left_type >= 0);
215 assert(right_type >=0 ||
216 (right_type >= enum_type_INTVAL && right_type <= enum_type_PMC));
217 r = right_type;
218 if (right_type < 0)
219 right_type -= enum_type_INTVAL;
220 else
221 right_type += 4;
222 if ((UINTVAL)left_type < x_funcs && (UINTVAL)right_type < y_funcs) {
223 const UINTVAL offset = x_funcs * right_type + left_type;
224 func = table->mmd_funcs[offset];
226 if (!func) {
227 const char * const meth_c = Parrot_MMD_method_name(interp, func_nr);
228 STRING * const meth_s = const_string(interp, meth_c);
229 PMC * const method = Parrot_MMD_search_default_infix(interp,
230 meth_s, left_type, r);
231 if (!method)
232 real_exception(interp, 0, 1, "MMD function %s not found "
233 "for types (%d, %d)", meth_c, left_type, r);
234 if (method->vtable->base_type == enum_class_NCI) {
235 /* C function is at struct_val */
236 func = D2FPTR(PMC_struct_val(method));
237 *is_pmc = 0;
238 mmd_register(interp, func_nr, left_type, r,
239 (funcptr_t)PMC_struct_val(method));
241 else {
242 *is_pmc = 1;
243 func = D2FPTR(method);
244 mmd_register_sub(interp, func_nr, left_type, r, method);
246 return func;
248 *is_pmc = (UINTVAL)func & 3;
249 func_ = (funcptr_t)((UINTVAL)func & ~3);
250 #ifndef PARROT_HAS_ALIGNED_FUNCPTR
251 if (!*is_pmc) {
252 return func;
254 else if (!is_pmc_ptr(interp, F2DPTR(func_))) {
255 *is_pmc = 0;
256 return func;
258 #endif
259 return func_;
263 static funcptr_t
264 get_mmd_dispatcher(PARROT_INTERP, PMC *left, PMC *right,
265 INTVAL function, NOTNULL(int *is_pmc))
267 const UINTVAL left_type = VTABLE_type(interp, left);
268 const UINTVAL right_type = VTABLE_type(interp, right);
269 return get_mmd_dispatch_type(interp, function, left_type, right_type,
270 is_pmc);
275 FUNCDOC:
276 If C<value> is a reference-like PMC, dereference it so we can make an MMD
277 call on the 'real' value.
281 static PMC *
282 mmd_deref(PARROT_INTERP, NOTNULL(PMC *value))
284 if (VTABLE_type(interp, value) != value->vtable->base_type)
285 return VTABLE_get_pmc(interp, value);
286 else
287 return value;
292 FUNCDOC:
293 Make sure C<pmc> is writable enough for C<function>.
297 static void
298 mmd_ensure_writable(PARROT_INTERP, INTVAL function, NULLOK(PMC *pmc))
300 if (!PMC_IS_NULL(pmc) && (pmc->vtable->flags & VTABLE_IS_READONLY_FLAG))
301 real_exception(interp, 0, 1, "%s applied to read-only argument",
302 Parrot_MMD_method_name(interp, function));
308 FUNCDOC: mmd_dispatch_p_ppp
310 Dispatch to a multimethod that returns a PMC. C<left>, C<right>, and
311 C<dest> are all PMC pointers, while C<func_num> is the MMD table that
312 should be used to do the dispatching.
313 If the C<dest> pointer is NULL, it dispatches two a two-argument function
314 that returns a new C<dest> always.
316 The MMD system will figure out which function should be called based on
317 the types of C<left> and C<right> and call it, passing in C<left>,
318 C<right>, and possibly C<dest> like any other binary vtable function.
320 FUNCDOC: mmd_dispatch_p_pip
322 Like above, right argument is a native INTVAL.
324 FUNCDOC: mmd_dispatch_p_pnp
326 Like above, right argument is a native FLOATVAL.
328 FUNCDOC: mmd_dispatch_p_psp
330 Like above, right argument is a native STRING *.
332 FUNCDOC: mmd_dispatch_v_pp
334 FUNCDOC: mmd_dispatch_v_pi
336 FUNCDOC: mmd_dispatch_v_pn
338 FUNCDOC: mmd_dispatch_v_ps
340 Inplace dispatch functions for C<< left <op=> right >>.
344 PARROT_API
345 PMC*
346 mmd_dispatch_p_ppp(PARROT_INTERP,
347 NOTNULL(PMC *left), NOTNULL(PMC *right), PMC *dest, INTVAL func_nr)
349 mmd_f_p_ppp real_function;
350 int is_pmc;
352 left = mmd_deref(interp, left);
353 right = mmd_deref(interp, right);
355 real_function = (mmd_f_p_ppp)get_mmd_dispatcher(interp,
356 left, right, func_nr, &is_pmc);
358 if (is_pmc) {
359 PMC * const sub = (PMC*)real_function;
360 if (dest)
361 return Parrot_runops_fromc_args(interp, sub, "PPPP",
362 left, right, dest);
363 else
364 return Parrot_runops_fromc_args(interp, sub, "PPP",
365 left, right);
367 else {
368 return (*real_function)(interp, left, right, dest);
372 PARROT_API
373 PMC*
374 mmd_dispatch_p_pip(PARROT_INTERP,
375 NOTNULL(PMC *left), INTVAL right, PMC *dest, INTVAL func_nr)
377 int is_pmc;
379 UINTVAL left_type;
380 mmd_f_p_pip real_function;
382 left = mmd_deref(interp, left);
384 left_type = left->vtable->base_type;
386 real_function =
387 (mmd_f_p_pip)get_mmd_dispatch_type(interp, func_nr,
388 left_type, enum_type_INTVAL,
389 &is_pmc);
391 if (is_pmc) {
392 PMC * const sub = (PMC*)real_function;
393 if (dest)
394 return Parrot_runops_fromc_args(interp, sub, "PPIP",
395 left, right, dest);
396 else
397 return Parrot_runops_fromc_args(interp, sub, "PPI",
398 left, right);
400 else {
401 return (*real_function)(interp, left, right, dest);
405 PARROT_API
406 PMC*
407 mmd_dispatch_p_pnp(PARROT_INTERP,
408 NOTNULL(PMC *left), FLOATVAL right, PMC *dest, INTVAL func_nr)
410 mmd_f_p_pnp real_function;
411 int is_pmc;
412 UINTVAL left_type;
414 left = mmd_deref(interp, left);
416 left_type = left->vtable->base_type;
417 real_function = (mmd_f_p_pnp)get_mmd_dispatch_type(interp,
418 func_nr, left_type, enum_type_FLOATVAL, &is_pmc);
419 if (is_pmc) {
420 PMC * const sub = (PMC*)real_function;
421 if (dest)
422 return Parrot_runops_fromc_args(interp, sub, "PPNP",
423 left, right, dest);
424 else
425 return Parrot_runops_fromc_args(interp, sub, "PPN",
426 left, right);
428 else {
429 return (*real_function)(interp, left, right, dest);
433 PARROT_API
434 PMC*
435 mmd_dispatch_p_psp(PARROT_INTERP,
436 NOTNULL(PMC *left), STRING *right, PMC *dest, INTVAL func_nr)
438 mmd_f_p_psp real_function;
439 int is_pmc;
440 const UINTVAL left_type = left->vtable->base_type;
442 real_function = (mmd_f_p_psp)get_mmd_dispatch_type(interp,
443 func_nr, left_type, enum_type_STRING, &is_pmc);
444 if (is_pmc) {
445 PMC * const sub = (PMC*)real_function;
446 if (dest)
447 return Parrot_runops_fromc_args(interp, sub, "PPSP",
448 left, right, dest);
449 else
450 return Parrot_runops_fromc_args(interp, sub, "PPS",
451 left, right);
453 else {
454 return (*real_function)(interp, left, right, dest);
459 * inplace variants
461 PARROT_API
462 void
463 mmd_dispatch_v_pp(PARROT_INTERP,
464 NOTNULL(PMC *left), NOTNULL(PMC *right), INTVAL func_nr)
466 mmd_f_v_pp real_function;
467 int is_pmc;
469 left = mmd_deref(interp, left);
470 right = mmd_deref(interp, right);
472 mmd_ensure_writable(interp, func_nr, left);
474 real_function = (mmd_f_v_pp)get_mmd_dispatcher(interp,
475 left, right, func_nr, &is_pmc);
477 if (is_pmc) {
478 PMC * const sub = (PMC*)real_function;
479 Parrot_runops_fromc_args(interp, sub, "vPP", left, right);
481 else {
482 (*real_function)(interp, left, right);
486 void
487 mmd_dispatch_v_pi(PARROT_INTERP,
488 NOTNULL(PMC *left), INTVAL right, INTVAL func_nr)
490 mmd_f_v_pi real_function;
491 int is_pmc;
492 UINTVAL left_type;
494 left = mmd_deref(interp, left);
495 mmd_ensure_writable(interp, func_nr, left);
497 left_type = left->vtable->base_type;
498 real_function = (mmd_f_v_pi)get_mmd_dispatch_type(interp,
499 func_nr, left_type, enum_type_INTVAL, &is_pmc);
500 if (is_pmc) {
501 PMC * const sub = (PMC*)real_function;
502 Parrot_runops_fromc_args(interp, sub, "vPI", left, right);
504 else {
505 (*real_function)(interp, left, right);
509 PARROT_API
510 void
511 mmd_dispatch_v_pn(PARROT_INTERP,
512 NOTNULL(PMC *left), FLOATVAL right, INTVAL func_nr)
514 mmd_f_v_pn real_function;
515 int is_pmc;
516 UINTVAL left_type;
518 left = mmd_deref(interp, left);
519 mmd_ensure_writable(interp, func_nr, left);
521 left_type = left->vtable->base_type;
522 real_function = (mmd_f_v_pn)get_mmd_dispatch_type(interp,
523 func_nr, left_type, enum_type_FLOATVAL, &is_pmc);
524 if (is_pmc) {
525 PMC * const sub = (PMC*)real_function;
526 Parrot_runops_fromc_args(interp, sub, "vPN", left, right);
528 else {
529 (*real_function)(interp, left, right);
533 PARROT_API
534 void
535 mmd_dispatch_v_ps(PARROT_INTERP,
536 NOTNULL(PMC *left), STRING *right, INTVAL func_nr)
538 mmd_f_v_ps real_function;
539 int is_pmc;
540 UINTVAL left_type;
542 left = mmd_deref(interp, left);
543 mmd_ensure_writable(interp, func_nr, left);
545 left_type = VTABLE_type(interp, left);
546 real_function = (mmd_f_v_ps)get_mmd_dispatch_type(interp,
547 func_nr, left_type, enum_type_STRING, &is_pmc);
548 if (is_pmc) {
549 PMC * const sub = (PMC*)real_function;
550 Parrot_runops_fromc_args(interp, sub, "vPS", left, right);
552 else {
553 (*real_function)(interp, left, right);
559 FUNCDOC:
560 Like C<mmd_dispatch_p_ppp()>, only it returns an C<INTVAL>. This is used
561 by MMD compare functions.
565 PARROT_API
566 INTVAL
567 mmd_dispatch_i_pp(PARROT_INTERP,
568 NOTNULL(PMC *left), NOTNULL(PMC *right), INTVAL func_nr)
570 mmd_f_i_pp real_function;
571 int is_pmc;
572 INTVAL ret;
574 left = mmd_deref(interp, left);
575 right = mmd_deref(interp, right);
577 real_function = (mmd_f_i_pp)get_mmd_dispatcher(interp,
578 left, right, func_nr, &is_pmc);
580 if (is_pmc) {
581 PMC * const sub = (PMC*)real_function;
582 ret = Parrot_runops_fromc_args_reti(interp, sub, "IPP",
583 left, right);
585 else {
586 ret = (*real_function)(interp, left, right);
588 return ret;
593 FUNCDOC:
594 Add a new binary MMD function to the list of functions the MMD system knows
595 of. C<func_num> is the number of the new function. C<function> is ignored.
597 TODO change this to a MMD register interface that takes a function *name*.
601 PARROT_API
602 void
603 mmd_add_function(PARROT_INTERP,
604 INTVAL func_nr, SHIM(funcptr_t function))
606 if (func_nr >= (INTVAL)interp->n_binop_mmd_funcs) {
607 INTVAL i;
609 if (interp->binop_mmd_funcs) {
610 interp->binop_mmd_funcs =
611 (MMD_table *)mem_sys_realloc(interp->binop_mmd_funcs,
612 (func_nr + 1) * sizeof (MMD_table));
614 else {
615 interp->binop_mmd_funcs =
616 (MMD_table *)mem_sys_allocate((func_nr + 1) * sizeof (MMD_table));
619 for (i = interp->n_binop_mmd_funcs; i <= func_nr; ++i) {
620 MMD_table * const table = interp->binop_mmd_funcs + i;
621 table->x = 0;
622 table->y = 0;
623 table->mmd_funcs = NULL;
625 interp->n_binop_mmd_funcs = func_nr + 1;
632 FUNCDOC:
633 Expands the function table in the X dimension to include C<new_x>.
637 static void
638 mmd_expand_x(PARROT_INTERP, INTVAL func_nr, INTVAL new_x)
640 funcptr_t *new_table;
641 UINTVAL x;
642 UINTVAL y;
643 UINTVAL i;
644 MMD_table * const table = interp->binop_mmd_funcs + func_nr;
645 char *src_ptr, *dest_ptr;
646 size_t old_dp, new_dp;
648 /* Is the Y 0? If so, nothing to expand, so just set the X for
649 later use */
650 if (table->y == 0) {
651 table->x = new_x;
652 return;
655 /* The Y is not zero. Bleah. This means we have to expand the
656 table in an unpleasant way. */
658 x = table->x;
659 y = table->y;
661 /* First, fill in the whole new table with the default function
662 pointer. We only really need to do the new part, but... */
663 new_table = (funcptr_t *)mem_sys_allocate_zeroed(sizeof (funcptr_t) *
664 y * new_x);
666 /* Then copy the old table over. We have to do this row by row,
667 because the rows in the old and new tables are different
668 lengths */
669 src_ptr = (char*) table->mmd_funcs;
670 dest_ptr = (char*) new_table;
671 old_dp = sizeof (funcptr_t) * x;
672 new_dp = sizeof (funcptr_t) * new_x;
673 for (i = 0; i < y; i++) {
674 STRUCT_COPY_N(dest_ptr, src_ptr, x);
675 src_ptr += old_dp;
676 dest_ptr += new_dp;
678 if (table->mmd_funcs)
679 mem_sys_free(table->mmd_funcs);
680 table->x = new_x;
681 /* Set the old table to point to the new table */
682 table->mmd_funcs = new_table;
687 FUNCDOC:
688 Expands the function table in the Y direction.
692 static void
693 mmd_expand_y(PARROT_INTERP, INTVAL func_nr, INTVAL new_y)
695 UINTVAL new_size, old_size;
696 MMD_table * const table = interp->binop_mmd_funcs + func_nr;
698 assert(table->x);
700 old_size = sizeof (funcptr_t) * table->x * table->y;
701 new_size = sizeof (funcptr_t) * table->x * new_y;
703 if (table->mmd_funcs)
704 table->mmd_funcs = (funcptr_t *)mem_sys_realloc_zeroed(
705 table->mmd_funcs, new_size, old_size);
706 else
707 table->mmd_funcs = (funcptr_t *)mem_sys_allocate_zeroed(new_size);
709 table->y = new_y;
714 FUNCDOC:
715 Add a function to the MMD table by class name, rather than class number.
716 Handles the case where the named class isn't loaded yet.
718 Adds a new MMD function C<funcptr> to the C<func_num> function table
719 that will be invoked when the left parameter is of class C<left_class>
720 and the right parameter is of class C<right_class>. Both classes are
721 C<STRING *>s that hold the PMC class names for the left and right sides.
722 If either class isn't yet loaded, Parrot will cache the information such
723 that the function will be installed if at some point in the future both
724 classes are available.
726 Currently this is done by just assigning class numbers to the classes,
727 which the classes will pick up and use if they're later loaded, but we
728 may later put the functions into a deferred table that we scan when PMC
729 classes are loaded. Either way, the function will be guaranteed to be
730 installed when it's needed.
732 The function table must exist, but if it is too small, it will
733 automatically be expanded.
737 PARROT_API
738 void
739 mmd_add_by_class(PARROT_INTERP,
740 INTVAL functype,
741 NOTNULL(STRING *left_class), NOTNULL(STRING *right_class),
742 NULLOK(funcptr_t funcptr))
744 INTVAL left_type = pmc_type(interp, left_class);
745 INTVAL right_type = pmc_type(interp, right_class);
747 if (left_type == enum_type_undef) {
748 left_type = pmc_register(interp, left_class);
750 if (right_type == enum_type_undef) {
751 right_type = pmc_register(interp, right_class);
754 mmd_register(interp, functype, left_type, right_type, funcptr);
760 FUNCDOC:
761 Register a function C<funcptr> for MMD function table C<func_num> for classes
762 C<left_type> and C<right_type>. The left and right types are C<INTVAL>s that
763 represent the class ID numbers.
765 The function table must exist, but if it is too small, it will
766 automatically be expanded.
768 Adding a new function to the table can be interestingly non-trivial, so
769 we get to be tricky.
771 If the left or right types are larger than anything we've seen so far,
772 it means that we have to expand the table. Making Y larger is simple --
773 just realloc with some more rows. Making X larger is less simple. In
774 either case, we punt to other functions.
776 TODO - Currently the MMD system doesn't handle inheritance and best match
777 searching, as it assumes that all PMC types have no parent type. This
778 can be considered a bug, and will be resolved at some point in the
779 future.
783 PARROT_API
784 void
785 mmd_register(PARROT_INTERP,
786 INTVAL func_nr,
787 INTVAL left_type, INTVAL right_type,
788 NULLOK(funcptr_t funcptr))
791 INTVAL offset;
792 MMD_table *table;
794 assert(func_nr < (INTVAL)interp->n_binop_mmd_funcs);
795 assert(left_type >= 0);
796 assert(right_type >=0 ||
797 (right_type >= enum_type_INTVAL && right_type <= enum_type_PMC));
798 if (right_type < 0)
799 right_type -= enum_type_INTVAL;
800 else
801 right_type += 4;
802 table = interp->binop_mmd_funcs + func_nr;
803 if ((INTVAL)table->x <= left_type) {
804 mmd_expand_x(interp, func_nr, left_type + 1);
807 if ((INTVAL)table->y <= right_type) {
808 mmd_expand_y(interp, func_nr, right_type + 1);
811 offset = table->x * right_type + left_type;
812 table->mmd_funcs[offset] = funcptr;
815 PARROT_API
816 void
817 mmd_register_sub(PARROT_INTERP,
818 INTVAL func_nr,
819 INTVAL left_type, INTVAL right_type,
820 NOTNULL(PMC *sub))
822 if (sub->vtable->base_type == enum_class_NCI) {
823 /* returned from mmdvt_find */
824 mmd_register(interp, func_nr, left_type, right_type,
825 D2FPTR(PMC_struct_val(sub)));
827 else {
828 PMC * const fake = (PMC*)((UINTVAL) sub | 1);
829 mmd_register(interp, func_nr, left_type, right_type, D2FPTR(fake));
835 FUNCDOC:
836 Frees all the memory allocated used the MMD subsystem.
840 PARROT_API
841 void
842 mmd_destroy(PARROT_INTERP)
844 if (interp->n_binop_mmd_funcs) {
845 UINTVAL i;
846 for (i = 0; i <interp->n_binop_mmd_funcs; ++i) {
847 if (interp->binop_mmd_funcs[i].mmd_funcs) {
848 mem_sys_free(interp->binop_mmd_funcs[i].mmd_funcs);
849 interp->binop_mmd_funcs[i].mmd_funcs = NULL;
853 mem_sys_free(interp->binop_mmd_funcs);
854 interp->binop_mmd_funcs = NULL;
859 FUNCDOC:
860 Return an MMD PMC function for the given data types. The return result is
861 either a Sub PMC (for PASM MMD functions) or a NCI PMC holding the
862 C function pointer in PMC_struct_val.
866 PARROT_API
867 PMC *
868 mmd_vtfind(PARROT_INTERP, INTVAL func_nr, INTVAL left, INTVAL right)
869 /* WARN_UNUSED */
871 int is_pmc;
872 PMC *f;
873 const funcptr_t func = get_mmd_dispatch_type(interp,
874 func_nr, left, right, &is_pmc);
875 if (func && is_pmc) {
876 /* TODO if is_pmc == 2 a Bound_NCI is returned, which actually
877 * should be filled with one of the wrapper functions
879 return (PMC*)F2DPTR(func);
881 f = pmc_new(interp, enum_class_NCI);
882 PMC_struct_val(f) = F2DPTR(func);
883 return f;
886 PARROT_API
887 PMC *
888 Parrot_MMD_search_default_infix(PARROT_INTERP, STRING *meth,
889 INTVAL left_type, INTVAL right_type)
891 PMC* const arg_tuple = pmc_new(interp, enum_class_FixedIntegerArray);
893 VTABLE_set_integer_native(interp, arg_tuple, 2);
894 VTABLE_set_integer_keyed_int(interp, arg_tuple, 0, left_type);
895 VTABLE_set_integer_keyed_int(interp, arg_tuple, 1, right_type);
896 return mmd_search_default(interp, meth, arg_tuple);
901 FUNCDOC: Parrot_mmd_sort_candidate_list
903 Given an array PMC (usually a MultiSub) sort the mmd candidates by their
904 manhatten distance to the current args.
908 PARROT_API
909 PMC *
910 Parrot_mmd_sort_candidate_list(PARROT_INTERP, PMC *candidates)
912 PMC *arg_tuple;
913 INTVAL n;
915 n = VTABLE_elements(interp, candidates);
916 if (!n)
917 return PMCNULL;
919 arg_tuple = mmd_arg_tuple_func(interp);
920 candidates = VTABLE_clone(interp, candidates);
921 mmd_sort_candidates(interp, arg_tuple, candidates);
923 /* if there aren't any variants that match the current args, we could end
924 up with an empty list */
925 n = VTABLE_elements(interp, candidates);
926 if (!n)
927 return PMCNULL;
929 return candidates;
934 FUNCDOC: mmd_arg_tuple_inline
936 Return a list of argument types. PMC arguments are specified as function
937 arguments.
939 FUNCDOC: mmd_arg_tuple_func
941 Return a list of argument types. PMC arguments are take from registers
942 according to calling conventions.
946 static PMC*
947 mmd_arg_tuple_inline(PARROT_INTERP, NOTNULL(STRING *signature), va_list args)
949 INTVAL i;
950 PMC *arg;
952 PMC * const arg_tuple = pmc_new(interp, enum_class_FixedIntegerArray);
953 const INTVAL sig_len = string_length(interp, signature);
955 if (!sig_len)
956 return arg_tuple;
957 VTABLE_set_integer_native(interp, arg_tuple, sig_len);
958 for (i = 0; i < sig_len; ++i) {
959 INTVAL type = string_index(interp, signature, i);
960 switch (type) {
961 case 'I':
962 VTABLE_set_integer_keyed_int(interp, arg_tuple,
963 i, enum_type_INTVAL);
964 break;
965 case 'N':
966 VTABLE_set_integer_keyed_int(interp, arg_tuple,
967 i, enum_type_FLOATVAL);
968 break;
969 case 'S':
970 VTABLE_set_integer_keyed_int(interp, arg_tuple,
971 i, enum_type_STRING);
972 break;
973 case 'O':
974 case 'P':
975 arg = va_arg(args, PMC *);
976 type = VTABLE_type(interp, arg);
977 VTABLE_set_integer_keyed_int(interp, arg_tuple,
978 i, type);
979 break;
980 default:
981 real_exception(interp, NULL, 1,
982 "Unknown signature type %d in mmd_arg_tuple", type);
983 break;
987 return arg_tuple;
990 static PMC*
991 mmd_arg_tuple_func(PARROT_INTERP)
993 INTVAL sig_len, i, type, idx;
994 PMC* arg;
995 PMC* args_array; /* from recent set_args opcode */
996 opcode_t *args_op;
997 PackFile_Constant **constants;
1000 * if there is no signature e.g. because of
1001 * m = getattribute l, "__add"
1002 * - we have to return the MultiSub
1003 * - create a BoundMulti
1004 * - dispatch in invoke - yeah ugly
1007 PMC * const arg_tuple = pmc_new(interp, enum_class_ResizableIntegerArray);
1009 args_op = interp->current_args;
1010 if (!args_op)
1011 return arg_tuple;
1012 assert(*args_op == PARROT_OP_set_args_pc);
1013 constants = interp->code->const_table->constants;
1014 ++args_op;
1015 args_array = constants[*args_op]->u.key;
1016 ASSERT_SIG_PMC(args_array);
1017 sig_len = SIG_ELEMS(args_array);
1018 if (!sig_len)
1019 return arg_tuple;
1020 ++args_op;
1022 for (i = 0; i < sig_len; ++i, ++args_op) {
1023 type = SIG_ITEM(args_array, i);
1024 /* named don't MMD */
1025 if (type & PARROT_ARG_NAME)
1026 break;
1027 switch (type & (PARROT_ARG_TYPE_MASK | PARROT_ARG_FLATTEN)) {
1028 case PARROT_ARG_INTVAL:
1029 VTABLE_push_integer(interp, arg_tuple, enum_type_INTVAL);
1030 break;
1031 case PARROT_ARG_FLOATVAL:
1032 VTABLE_push_integer(interp, arg_tuple, enum_type_FLOATVAL);
1033 break;
1034 case PARROT_ARG_STRING:
1035 VTABLE_push_integer(interp, arg_tuple, enum_type_STRING);
1036 break;
1037 case PARROT_ARG_PMC:
1038 idx = *args_op;
1039 if ((type & PARROT_ARG_CONSTANT))
1040 arg = constants[idx]->u.key;
1041 else
1042 arg = REG_PMC(interp, idx);
1043 type = VTABLE_type(interp, arg);
1044 VTABLE_push_integer(interp, arg_tuple, type);
1045 break;
1046 case PARROT_ARG_FLATTEN | PARROT_ARG_PMC: {
1047 /* expand flattening args */
1048 int j, n;
1050 idx = *args_op;
1051 arg = REG_PMC(interp, idx);
1052 n = VTABLE_elements(interp, arg);
1053 for (j = 0; j < n; ++j) {
1054 PMC * const elem = VTABLE_get_pmc_keyed_int(interp, arg, j);
1055 type = VTABLE_type(interp, elem);
1056 VTABLE_push_integer(interp, arg_tuple, type);
1058 break;
1060 default:
1061 real_exception(interp, NULL, 1,
1062 "Unknown signature type %d in mmd_arg_tuple", type);
1063 break;
1067 return arg_tuple;
1072 FUNCDOC: mmd_search_default
1074 Default implementation of MMD search. Search scopes for candidates, walk the
1075 class hierarchy, sort all candidates by their Manhattan distance, and return
1076 result
1080 static PMC*
1081 mmd_search_default(PARROT_INTERP, STRING *meth, PMC *arg_tuple)
1083 INTVAL n;
1086 * 2) create a list of matching functions
1088 PMC * const candidate_list = mmd_search_scopes(interp, meth);
1090 * 3) if list is empty fail
1091 * if the first found function is a plain Sub: finito
1093 n = VTABLE_elements(interp, candidate_list);
1094 if (n == 1) {
1095 PMC * const pmc = VTABLE_get_pmc_keyed_int(interp, candidate_list, 0);
1096 STRING * const _sub = CONST_STRING(interp, "Sub");
1098 if (VTABLE_isa(interp, pmc, _sub)) {
1099 return pmc;
1103 * 4) first was a MultiSub - go through all found MultiSubs and check
1104 * the first arguments MRO, add all MultiSubs and plain methods,
1105 * where the first argument matches
1107 mmd_search_classes(interp, meth, arg_tuple, candidate_list, 0);
1108 n = VTABLE_elements(interp, candidate_list);
1109 if (!n)
1110 return NULL;
1112 * 5) sort the list
1114 if (n > 1)
1115 mmd_sort_candidates(interp, arg_tuple, candidate_list);
1116 n = VTABLE_elements(interp, candidate_list);
1117 if (!n)
1118 return NULL;
1120 * 6) Uff, return first one
1122 return VTABLE_get_pmc_keyed_int(interp, candidate_list, 0);
1127 FUNCDOC: mmd_search_classes
1129 Search all the classes in all MultiSubs of the candidates C<cl> and return
1130 a list of all candidates. C<start_at_parent> is 0 to start at the class itself
1131 or 1 to search from the first parent class.
1135 static void
1136 mmd_search_classes(PARROT_INTERP, STRING *meth, PMC *arg_tuple,
1137 PMC *cl, INTVAL start_at_parent)
1139 INTVAL type1;
1142 * get the class of the first argument
1144 if (!VTABLE_elements(interp, arg_tuple))
1145 return;
1146 type1 = VTABLE_get_integer_keyed_int(interp, arg_tuple, 0);
1147 if (type1 < 0) {
1148 return;
1149 real_exception(interp, NULL, 1, "unimplemented native MMD type");
1150 /* TODO create some class namespace */
1152 else {
1153 PMC * const mro = interp->vtables[type1]->mro;
1154 const INTVAL n = VTABLE_elements(interp, mro);
1155 INTVAL i;
1157 for (i = start_at_parent; i < n; ++i) {
1158 PMC * const _class = VTABLE_get_pmc_keyed_int(interp, mro, i);
1159 PMC * const pmc = Parrot_find_method_with_cache(interp, _class, meth);
1160 if (!PMC_IS_NULL(pmc)) {
1162 * mmd_is_hidden would consider all previous candidates
1163 * XXX pass current n so that only candidates from this
1164 * mro are used?
1166 if (mmd_maybe_candidate(interp, pmc, cl))
1167 break;
1173 static INTVAL
1174 distance_cmp(SHIM_INTERP, INTVAL a, INTVAL b)
1176 short da = (short)(a & 0xffff);
1177 short db = (short)(b & 0xffff);
1178 /* sort first by distance */
1179 if (da > db)
1180 return 1;
1181 if (da < db)
1182 return -1;
1183 /* end then by index in candidate list */
1184 da = (short)(a >> 16);
1185 db = (short)(b >> 16);
1186 return da > db ? 1 : da < db ? -1 : 0;
1189 extern void Parrot_FixedPMCArray_nci_sort(Interp* , PMC* pmc, PMC *cmp_func);
1193 mmd_distance
1195 Create Manhattan Distance of sub C<pmc> against given argument types.
1196 0xffff is the maximum distance
1200 static PMC*
1201 mmd_cvt_to_types(PARROT_INTERP, PMC *multi_sig)
1203 const INTVAL n = VTABLE_elements(interp, multi_sig);
1204 INTVAL i;
1206 PMC * const ar = pmc_new(interp, enum_class_FixedIntegerArray);
1207 VTABLE_set_integer_native(interp, ar, n);
1208 for (i = 0; i < n; ++i) {
1209 PMC * const sig_elem = VTABLE_get_pmc_keyed_int(interp, multi_sig, i);
1210 INTVAL type;
1212 if (sig_elem->vtable->base_type == enum_class_String) {
1213 STRING * const sig = VTABLE_get_string(interp, sig_elem);
1214 if (memcmp(sig->strstart, "__VOID", 6) == 0) {
1215 PMC_int_val(ar)--; /* XXX */
1216 break;
1218 type = pmc_type(interp, sig);
1220 else {
1221 type = pmc_type_p(interp, sig_elem);
1223 VTABLE_set_integer_keyed_int(interp, ar, i, type);
1225 return ar;
1228 #define MMD_BIG_DISTANCE 0x7fff
1230 static UINTVAL
1231 mmd_distance(PARROT_INTERP, NOTNULL(PMC *pmc), PMC *arg_tuple)
1233 PMC *multi_sig, *mro;
1234 INTVAL i, n, args, dist, j, m;
1236 if (pmc->vtable->base_type == enum_class_NCI) {
1237 /* has to be a builtin multi method */
1238 multi_sig = PMC_pmc_val(pmc);
1240 else if (pmc->vtable->base_type == enum_class_Sub ||
1241 pmc->vtable->base_type == enum_class_Closure) {
1242 multi_sig = PMC_sub(pmc)->multi_signature;
1243 if (!multi_sig) {
1244 /* some method */
1245 return 0;
1247 if (multi_sig->vtable->base_type == enum_class_FixedPMCArray) {
1248 multi_sig = PMC_sub(pmc)->multi_signature =
1249 mmd_cvt_to_types(interp, multi_sig);
1252 else
1253 return MMD_BIG_DISTANCE;
1254 n = VTABLE_elements(interp, multi_sig);
1255 args = VTABLE_elements(interp, arg_tuple);
1257 * arg_tuple may have more arguments - only the
1258 * n multi_sig invocants are counted
1260 if (args < n)
1261 return MMD_BIG_DISTANCE;
1262 dist = 0;
1263 if (args > n)
1264 dist = 1000; /* XXX arbitrary > max_class_depth * n */
1266 * now go through args
1268 for (i = 0; i < n; ++i) {
1269 const INTVAL type_sig = VTABLE_get_integer_keyed_int(interp, multi_sig, i);
1270 const INTVAL type_call = VTABLE_get_integer_keyed_int(interp, arg_tuple, i);
1271 if (type_sig == type_call)
1272 continue;
1274 * different native types are very different, except a PMC
1275 * which matches any PMC
1277 if (type_call <= 0 && type_sig == enum_type_PMC) {
1278 dist++;
1279 continue;
1281 if ((type_sig <= 0 && type_sig != enum_type_PMC) || type_call <= 0) {
1282 dist = MMD_BIG_DISTANCE;
1283 break;
1286 * now consider MRO of types the signature type has to be somewhere
1287 * in the MRO of the type_call
1289 mro = interp->vtables[type_call]->mro;
1290 m = VTABLE_elements(interp, mro);
1291 for (j = 0; j < m; ++j) {
1292 const PMC * const cl = VTABLE_get_pmc_keyed_int(interp, mro, j);
1293 if (cl->vtable->base_type == type_sig)
1294 break;
1295 ++dist;
1298 * if the type wasn't in MRO check, if any PMC matches
1299 * in that case use the distance + 1 (of an any PMC parent)
1301 if (j == m && type_sig != enum_type_PMC) {
1302 dist = MMD_BIG_DISTANCE;
1303 break;
1305 ++dist;
1306 #if MMD_DEBUG
1308 STRING *s1, *s2;
1309 if (type_sig < 0)
1310 s1 = Parrot_get_datatype_name(interp, type_sig);
1311 else {
1312 s1 = interp->vtables[type_sig]->whoami;
1314 if (type_call < 0)
1315 s2 = Parrot_get_datatype_name(interp, type_call);
1316 else {
1317 s2 = interp->vtables[type_call]->whoami;
1319 PIO_eprintf(interp, "arg %d: dist %d sig %Ss arg %Ss\n",
1320 i, dist, s1, s2);
1322 #endif
1324 return dist;
1329 FUNCDOC: mmd_sort_candidates
1331 Sort the candidate list C<cl> by Manhattan Distance
1335 static void
1336 mmd_sort_candidates(PARROT_INTERP, PMC *arg_tuple, PMC *cl)
1338 INTVAL i;
1339 PMC *nci;
1340 INTVAL *helper;
1341 PMC **data;
1343 const INTVAL n = VTABLE_elements(interp, cl);
1345 * create a helper structure:
1346 * bits 0..15 = distance
1347 * bits 16..31 = idx in candidate list
1349 * TODO use half of available INTVAL bits
1351 PMC * const sort = pmc_new(interp, enum_class_FixedIntegerArray);
1352 VTABLE_set_integer_native(interp, sort, n);
1353 helper = (INTVAL *)PMC_data(sort);
1354 for (i = 0; i < n; ++i) {
1355 PMC * const pmc = VTABLE_get_pmc_keyed_int(interp, cl, i);
1356 const INTVAL d = mmd_distance(interp, pmc, arg_tuple);
1357 helper[i] = i << 16 | (d & 0xffff);
1360 * need an NCI function pointer
1362 nci = pmc_new(interp, enum_class_NCI);
1363 PMC_struct_val(nci) = F2DPTR(distance_cmp);
1365 * sort it
1367 Parrot_FixedPMCArray_nci_sort(interp, sort, nci);
1369 * now helper has a sorted list of indices in the upper 16 bits
1370 * fill helper with sorted candidates
1372 data = (PMC **)PMC_data(cl);
1373 for (i = 0; i < n; ++i) {
1374 const INTVAL idx = helper[i] >> 16;
1376 * if the distance is big stop
1378 if ((helper[i] & 0xffff) == MMD_BIG_DISTANCE) {
1379 PMC_int_val(cl) = i;
1380 break;
1382 helper[i] = (INTVAL)data[idx];
1385 * use helper structure
1387 PMC_data(cl) = helper;
1388 PMC_data(sort) = data;
1393 FUNCDOC: mmd_search_scopes
1395 Search all scopes for MMD candidates matching the arguments given in
1396 C<arg_tuple>.
1400 static PMC*
1401 mmd_search_scopes(PARROT_INTERP, STRING *meth)
1403 PMC * const candidate_list = pmc_new(interp, enum_class_ResizablePMCArray);
1405 const int stop = mmd_search_cur_namespace(interp, meth, candidate_list);
1406 if (stop)
1407 return candidate_list;
1408 mmd_search_builtin(interp, meth, candidate_list);
1409 return candidate_list;
1414 FUNCDOC: mmd_is_hidden
1416 Check if the given multi sub is hidden by any inner multi sub (already in
1417 the candidate list C<cl>.
1421 static int
1422 mmd_is_hidden(PARROT_INTERP, PMC *multi, PMC *cl)
1425 * if the candidate list already has the a sub with the same
1426 * signature (long name), the outer multi is hidden
1428 * TODO
1430 UNUSED(interp);
1431 UNUSED(multi);
1432 UNUSED(cl);
1433 return 0;
1438 FUNCDOC: mmd_maybe_candidate
1440 If the candidate C<pmc> is a Sub PMC, push it on the candidate list and
1441 return TRUE to stop further search.
1443 If the candidate is a MultiSub remember all matching Subs and return FALSE
1444 to continue searching outer scopes.
1448 static int
1449 mmd_maybe_candidate(PARROT_INTERP, PMC *pmc, PMC *cl)
1451 INTVAL i, n;
1453 STRING * const _sub = CONST_STRING(interp, "Sub");
1454 STRING * const _multi_sub = CONST_STRING(interp, "MultiSub");
1456 if (VTABLE_isa(interp, pmc, _sub)) {
1457 /* a plain sub stops outer searches */
1458 /* TODO check arity of sub */
1460 VTABLE_push_pmc(interp, cl, pmc);
1461 return 1;
1463 if (!VTABLE_isa(interp, pmc, _multi_sub)) {
1464 /* not a Sub or MultiSub - ignore */
1465 return 0;
1468 * ok we have a multi sub pmc, which is an array of candidates
1470 n = VTABLE_elements(interp, pmc);
1471 for (i = 0; i < n; ++i) {
1472 PMC * const multi_sub = VTABLE_get_pmc_keyed_int(interp, pmc, i);
1474 if (!mmd_is_hidden(interp, multi_sub, cl))
1475 VTABLE_push_pmc(interp, cl, multi_sub);
1477 return 0;
1482 FUNCDOC: mmd_search_cur_namespace
1484 Search the current package namespace for matching candidates. Return
1485 TRUE if the MMD search should stop.
1489 static int
1490 mmd_search_cur_namespace(PARROT_INTERP, STRING *meth, PMC *cl)
1492 PMC * const pmc = Parrot_find_global_cur(interp, meth);
1494 return pmc && mmd_maybe_candidate(interp, pmc, cl);
1497 static PMC*
1498 mmd_get_ns(PARROT_INTERP)
1500 STRING * const ns_name = CONST_STRING(interp, "__parrot_core");
1501 PMC * const ns = Parrot_get_namespace_keyed_str(interp,
1502 interp->root_namespace, ns_name);
1503 return ns;
1506 static PMC*
1507 mmd_make_ns(PARROT_INTERP)
1509 STRING * const ns_name = CONST_STRING(interp, "__parrot_core");
1510 PMC * const ns = Parrot_make_namespace_keyed_str(interp,
1511 interp->root_namespace, ns_name);
1512 return ns;
1517 FUNCDOC: mmd_search_builtin
1519 Search the builtin namespace for matching candidates. This is the last
1520 search in all the namespaces.
1524 static void
1525 mmd_search_builtin(PARROT_INTERP, STRING *meth, PMC *cl)
1527 PMC * const ns = mmd_get_ns(interp);
1528 PMC * const pmc = Parrot_find_global_n(interp, ns, meth);
1529 if (pmc)
1530 mmd_maybe_candidate(interp, pmc, cl);
1534 static PMC *
1535 mmd_create_builtin_multi_stub(PARROT_INTERP, PMC* ns, INTVAL func_nr)
1537 const char * name = Parrot_MMD_method_name(interp, func_nr);
1538 /* create in constant pool */
1539 STRING * const s = const_string(interp, name);
1540 PMC * multi = constant_pmc_new(interp, enum_class_MultiSub);
1542 VTABLE_set_pmc_keyed_str(interp, ns, s, multi);
1543 return ns;
1546 static void
1547 mmd_create_builtin_multi_meth_2(PARROT_INTERP, PMC *ns,
1548 INTVAL func_nr, INTVAL type, INTVAL right, funcptr_t func_ptr)
1550 const char *short_name;
1551 char signature[6], val_sig;
1552 STRING *meth_name;
1553 PMC *method, *multi, *_class, *multi_sig;
1555 assert(type != enum_class_Null && type != enum_class_delegate &&
1556 type != enum_class_Ref && type != enum_class_SharedRef &&
1557 type != enum_class_deleg_pmc && type != enum_class_ParrotClass &&
1558 type != enum_class_ParrotObject);
1559 short_name = Parrot_MMD_method_name(interp, func_nr);
1561 * _int, _float, _str are just native variants of the base
1562 * multi
1564 val_sig = 'P';
1565 if (right == enum_type_INTVAL)
1566 val_sig = 'I';
1567 else if (right == enum_type_STRING)
1568 val_sig = 'S';
1569 else if (right == enum_type_FLOATVAL)
1570 val_sig = 'N';
1573 * create NCI method in left class
1575 strcpy(signature, "PJP.P");
1576 signature[3] = val_sig;
1577 if (func_nr >= MMD_EQ && func_nr <= MMD_STRCMP) {
1578 signature[0] = 'I';
1579 signature[4] = '\0';
1581 /* implace infix like __i_add don't return a result */
1582 if (memcmp(short_name, "__i_", 4) == 0)
1583 signature[0] = 'v';
1584 meth_name = const_string(interp, short_name);
1585 _class = interp->vtables[type]->pmc_class;
1586 method = Parrot_find_method_direct(interp, _class, meth_name);
1587 if (PMC_IS_NULL(method)) {
1588 /* first method */
1589 method = constant_pmc_new(interp, enum_class_NCI);
1590 VTABLE_set_pointer_keyed_str(interp, method,
1591 const_string(interp, signature),
1592 F2DPTR(func_ptr));
1593 VTABLE_add_method(interp, _class, meth_name, method);
1595 else {
1596 /* multiple methods with that same name */
1597 if (method->vtable->base_type == enum_class_NCI) {
1598 /* convert first to a multi */
1599 multi = constant_pmc_new(interp, enum_class_MultiSub);
1600 VTABLE_add_method(interp, _class, meth_name, multi);
1601 VTABLE_push_pmc(interp, multi, method);
1603 else {
1604 assert(method->vtable->base_type == enum_class_MultiSub);
1605 multi = method;
1607 method = constant_pmc_new(interp, enum_class_NCI);
1608 VTABLE_set_pointer_keyed_str(interp, method,
1609 const_string(interp, signature),
1610 F2DPTR(func_ptr));
1611 VTABLE_push_pmc(interp, multi, method);
1613 /* mark MMD */
1614 PObj_get_FLAGS(method) |= PObj_private0_FLAG;
1616 * attach the multi_signature array to PMC_pmc_val
1618 multi_sig = constant_pmc_new(interp, enum_class_FixedIntegerArray);
1619 VTABLE_set_integer_native(interp, multi_sig, 2);
1620 VTABLE_set_integer_keyed_int(interp, multi_sig, 0, type);
1621 VTABLE_set_integer_keyed_int(interp, multi_sig, 1, right);
1622 PMC_pmc_val(method) = multi_sig;
1625 * push method onto core multi_sub
1626 * TODO cache the namespace
1628 multi = Parrot_find_global_n(interp, ns,
1629 const_string(interp, short_name));
1630 assert(multi);
1631 VTABLE_push_pmc(interp, multi, method);
1634 static void
1635 mmd_create_builtin_multi_meth(PARROT_INTERP, PMC *ns, INTVAL type,
1636 NOTNULL(const MMD_init *entry))
1638 mmd_create_builtin_multi_meth_2(interp, ns,
1639 entry->func_nr, type, entry->right, entry->func_ptr);
1644 FUNCDOC:
1645 Register MMD functions for this PMC type.
1649 PARROT_API
1650 void
1651 Parrot_mmd_register_table(PARROT_INTERP, INTVAL type,
1652 const MMD_init *mmd_table, INTVAL n)
1654 MMD_table * const table = interp->binop_mmd_funcs;
1655 PMC * const ns = mmd_make_ns(interp);
1656 INTVAL i;
1658 if ((INTVAL)table->x < type && type < enum_class_core_max) {
1660 * pre-allocate the function table
1662 for (i = 0; i < MMD_USER_FIRST; ++i) {
1663 mmd_register(interp, i, enum_class_core_max - 1,
1664 enum_class_core_max - 1, NULL);
1666 * create a MultiSub stub
1668 mmd_create_builtin_multi_stub(interp, ns, i);
1672 * register default mmds for this type
1674 for (i = 0; i < n; ++i) {
1675 /* The following always fails for Intel C++ for unknown reasons,
1676 * but I'm assuming it's optimizer related.
1678 #ifndef __INTEL_COMPILER
1679 assert((PTR2UINTVAL(mmd_table[i].func_ptr) & 3) == 0);
1680 #endif
1681 mmd_register(interp,
1682 mmd_table[i].func_nr, type,
1683 mmd_table[i].right, mmd_table[i].func_ptr);
1684 mmd_create_builtin_multi_meth(interp, ns, type, mmd_table + i);
1691 FUNCDOC: Parrot_mmd_rebuild_table
1693 Rebuild the static MMD_table for the given class type and MMD function
1694 number. If C<type> is negative all classes are rebuilt. If C<func_nr> is
1695 negative all MMD functions are rebuilt.
1699 PARROT_API
1700 void
1701 Parrot_mmd_rebuild_table(PARROT_INTERP, INTVAL type, INTVAL func_nr)
1703 MMD_table *table;
1704 UINTVAL i;
1706 UNUSED(type);
1708 if (!interp->binop_mmd_funcs)
1709 return;
1710 table = interp->binop_mmd_funcs + func_nr;
1711 if (!table)
1712 return;
1714 /* TODO specific parts of table
1715 * the type and it's mro and
1716 * all classes that inherit from type
1718 for (i = 0; i < table->x * table->y; ++i)
1719 table->mmd_funcs[i] = NULL;
1724 =head1 SEE ALSO
1726 F<include/parrot/mmd.h>,
1727 F<http://svn.perl.org/perl6/doc/trunk/design/apo/A12.pod>,
1728 F<http://svn.perl.org/perl6/doc/trunk/design/syn/S12.pod>
1734 * Local variables:
1735 * c-file-style: "parrot"
1736 * End:
1737 * vim: expandtab shiftwidth=4: