Starting release 0.7.0
[parrot.git] / src / mmd.c
blobfd22ab33b3625a49a4115117341431c7a72b29da
1 /*
2 Copyright (C) 2003-2008, 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 (two
12 argument) functions. This includes, though isn't necessarily limited to, binary
13 operators such as addition or subtraction.
15 =head1 DESCRIPTION
17 The MMD system is straightforward, and currently must be explicitly invoked,
18 for example by a vtable function. (We reserve the right to use MMD in all
19 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
37 =over 4
39 =cut
43 #include "parrot/compiler.h"
44 #include "parrot/parrot.h"
45 #include "parrot/mmd.h"
46 #include "parrot/oplib/ops.h"
47 #include "mmd.str"
49 /* HEADERIZER HFILE: include/parrot/mmd.h */
51 /* HEADERIZER BEGIN: static */
52 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
54 static INTVAL distance_cmp(SHIM_INTERP, INTVAL a, INTVAL b);
55 static void dump_mmd(PARROT_INTERP, INTVAL function)
56 __attribute__nonnull__(1);
58 PARROT_WARN_UNUSED_RESULT
59 PARROT_CANNOT_RETURN_NULL
60 static funcptr_t get_mmd_dispatcher(PARROT_INTERP,
61 ARGIN(PMC *left),
62 ARGIN(PMC *right),
63 INTVAL function,
64 ARGOUT(int *is_pmc))
65 __attribute__nonnull__(1)
66 __attribute__nonnull__(2)
67 __attribute__nonnull__(3)
68 __attribute__nonnull__(5)
69 FUNC_MODIFIES(*is_pmc);
71 PARROT_WARN_UNUSED_RESULT
72 PARROT_CANNOT_RETURN_NULL
73 static PMC* mmd_arg_tuple_func(PARROT_INTERP)
74 __attribute__nonnull__(1);
76 PARROT_CANNOT_RETURN_NULL
77 PARROT_WARN_UNUSED_RESULT
78 static PMC* mmd_arg_tuple_inline(PARROT_INTERP,
79 ARGIN(STRING *signature),
80 va_list args)
81 __attribute__nonnull__(1)
82 __attribute__nonnull__(2);
84 static void mmd_create_builtin_multi_meth(PARROT_INTERP,
85 ARGIN(PMC *ns),
86 INTVAL type,
87 ARGIN(const MMD_init *entry))
88 __attribute__nonnull__(1)
89 __attribute__nonnull__(2)
90 __attribute__nonnull__(4);
92 static void mmd_create_builtin_multi_meth_2(PARROT_INTERP,
93 ARGIN(PMC *ns),
94 INTVAL func_nr,
95 INTVAL type,
96 INTVAL right,
97 funcptr_t func_ptr)
98 __attribute__nonnull__(1)
99 __attribute__nonnull__(2);
101 PARROT_CANNOT_RETURN_NULL
102 PARROT_WARN_UNUSED_RESULT
103 static PMC* mmd_cvt_to_types(PARROT_INTERP, ARGIN(PMC *multi_sig))
104 __attribute__nonnull__(1)
105 __attribute__nonnull__(2);
107 PARROT_CANNOT_RETURN_NULL
108 static PMC * mmd_deref(PARROT_INTERP, ARGIN(PMC *value))
109 __attribute__nonnull__(1)
110 __attribute__nonnull__(2);
112 static UINTVAL mmd_distance(PARROT_INTERP,
113 ARGIN(PMC *pmc),
114 ARGIN(PMC *arg_tuple))
115 __attribute__nonnull__(1)
116 __attribute__nonnull__(2)
117 __attribute__nonnull__(3);
119 static void mmd_ensure_writable(PARROT_INTERP,
120 INTVAL function,
121 ARGIN_NULLOK(const PMC *pmc))
122 __attribute__nonnull__(1);
124 static void mmd_expand_x(PARROT_INTERP, INTVAL func_nr, INTVAL new_x)
125 __attribute__nonnull__(1);
127 static void mmd_expand_y(PARROT_INTERP, INTVAL func_nr, INTVAL new_y)
128 __attribute__nonnull__(1);
130 PARROT_CANNOT_RETURN_NULL
131 PARROT_WARN_UNUSED_RESULT
132 static PMC* mmd_get_ns(PARROT_INTERP)
133 __attribute__nonnull__(1);
135 PARROT_WARN_UNUSED_RESULT
136 static int mmd_is_hidden(PARROT_INTERP, ARGIN(PMC *multi), ARGIN(PMC *cl))
137 __attribute__nonnull__(1)
138 __attribute__nonnull__(2)
139 __attribute__nonnull__(3);
141 PARROT_CANNOT_RETURN_NULL
142 PARROT_WARN_UNUSED_RESULT
143 static PMC* mmd_make_ns(PARROT_INTERP)
144 __attribute__nonnull__(1);
146 static int mmd_maybe_candidate(PARROT_INTERP,
147 ARGIN(PMC *pmc),
148 ARGIN(PMC *cl))
149 __attribute__nonnull__(1)
150 __attribute__nonnull__(2)
151 __attribute__nonnull__(3);
153 static void mmd_search_builtin(PARROT_INTERP,
154 ARGIN(STRING *meth),
155 ARGIN(PMC *cl))
156 __attribute__nonnull__(1)
157 __attribute__nonnull__(2)
158 __attribute__nonnull__(3);
160 static void mmd_search_classes(PARROT_INTERP,
161 ARGIN(STRING *meth),
162 ARGIN(PMC *arg_tuple),
163 ARGIN(PMC *cl),
164 INTVAL start_at_parent)
165 __attribute__nonnull__(1)
166 __attribute__nonnull__(2)
167 __attribute__nonnull__(3)
168 __attribute__nonnull__(4);
170 static int mmd_search_cur_namespace(PARROT_INTERP,
171 ARGIN(STRING *meth),
172 ARGIN(PMC *cl))
173 __attribute__nonnull__(1)
174 __attribute__nonnull__(2)
175 __attribute__nonnull__(3);
177 PARROT_CAN_RETURN_NULL
178 PARROT_WARN_UNUSED_RESULT
179 static PMC* mmd_search_default(PARROT_INTERP,
180 ARGIN(STRING *meth),
181 ARGIN(PMC *arg_tuple))
182 __attribute__nonnull__(1)
183 __attribute__nonnull__(2)
184 __attribute__nonnull__(3);
186 PARROT_CANNOT_RETURN_NULL
187 PARROT_WARN_UNUSED_RESULT
188 static PMC* mmd_search_scopes(PARROT_INTERP, ARGIN(STRING *meth))
189 __attribute__nonnull__(1)
190 __attribute__nonnull__(2);
192 static void mmd_sort_candidates(PARROT_INTERP,
193 ARGIN(PMC *arg_tuple),
194 ARGIN(PMC *cl))
195 __attribute__nonnull__(1)
196 __attribute__nonnull__(2)
197 __attribute__nonnull__(3);
199 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
200 /* HEADERIZER END: static */
203 #define MMD_DEBUG 0
205 #ifndef NDEBUG
208 =item C<static void dump_mmd>
210 RT #48260: Not yet documented!!!
212 =cut
216 static void
217 dump_mmd(PARROT_INTERP, INTVAL function)
219 UINTVAL x, y;
220 UINTVAL offset;
221 MMD_table * const table = interp->binop_mmd_funcs + function;
222 funcptr_t func;
223 const UINTVAL x_funcs = table->x;
224 const UINTVAL y_funcs = table->y;
226 printf(" ");
227 for (x = 0; x < x_funcs; ++x) {
228 if (x % 10)
229 printf(" ");
230 else
231 printf("%d", (int) x / 10);
234 printf("\n");
236 for (y = 0; y < y_funcs; ++y) {
237 printf("%3d ", (int)y);
238 for (x = 0; x < x_funcs; ++x) {
239 offset = x_funcs * y + x;
240 func = table->mmd_funcs[offset];
242 printf("%c",
243 (UINTVAL)func & 1 ? 'P' :
244 !func ? '0' : 'F');
247 printf("\n");
250 for (y = 0; y < y_funcs; ++y) {
251 for (x = 0; x < x_funcs; ++x) {
252 offset = x_funcs * y + x;
253 func = table->mmd_funcs[offset];
255 if (func && !((UINTVAL) func & 1))
256 printf("%3d %3d: %p\n", (int)x, (int)y, (void*) func);
260 #endif
265 =item C<funcptr_t get_mmd_dispatch_type>
267 RT #48260: Not yet documented!!!
269 =cut
273 PARROT_API
274 PARROT_WARN_UNUSED_RESULT
275 PARROT_CANNOT_RETURN_NULL
276 funcptr_t
277 get_mmd_dispatch_type(PARROT_INTERP, INTVAL func_nr, INTVAL left_type,
278 INTVAL right_type, ARGOUT(int *is_pmc))
280 funcptr_t func = NULL;
281 MMD_table * const table = interp->binop_mmd_funcs + func_nr;
282 const UINTVAL x_funcs = table->x;
283 const UINTVAL y_funcs = table->y;
284 INTVAL r = right_type;
285 funcptr_t func_;
287 #if MMD_DEBUG
288 fprintf(stderr, "running function %d with left type=%u, right type=%u\n",
289 (int) func_nr, (unsigned) left_type, (unsigned) right_type);
290 #endif
292 PARROT_ASSERT(left_type >= 0);
293 PARROT_ASSERT(right_type >=0 ||
294 (right_type >= enum_type_INTVAL && right_type <= enum_type_PMC));
296 if (right_type < 0)
297 right_type -= enum_type_INTVAL;
298 else
299 right_type += 4;
301 if ((UINTVAL)left_type < x_funcs && (UINTVAL)right_type < y_funcs) {
302 const UINTVAL offset = x_funcs * right_type + left_type;
303 func = table->mmd_funcs[offset];
306 if (!func) {
307 const char * const meth_c = Parrot_MMD_method_name(interp, func_nr);
308 STRING * const meth_s = const_string(interp, meth_c);
309 PMC * const method = Parrot_MMD_search_default_infix(interp,
310 meth_s, left_type, r);
311 if (!method)
312 Parrot_ex_throw_from_c_args(interp, 0, 1, "MMD function %s not found "
313 "for types (%d, %d)", meth_c, left_type, r);
316 if (method->vtable->base_type == enum_class_NCI) {
317 /* C function is at struct_val */
318 func = D2FPTR(PMC_struct_val(method));
319 *is_pmc = 0;
320 mmd_register(interp, func_nr, left_type, r,
321 (funcptr_t)PMC_struct_val(method));
323 else {
324 *is_pmc = 1;
325 func = D2FPTR(method);
326 mmd_register_sub(interp, func_nr, left_type, r, method);
329 return func;
332 *is_pmc = (UINTVAL)func & 3;
333 func_ = (funcptr_t)((UINTVAL)func & ~3);
335 #ifndef PARROT_HAS_ALIGNED_FUNCPTR
336 if (!*is_pmc) {
337 return func;
339 else if (!is_pmc_ptr(interp, F2DPTR(func_))) {
340 *is_pmc = 0;
341 return func;
343 #endif
344 return func_;
350 =item C<static funcptr_t get_mmd_dispatcher>
352 RT #48260: Not yet documented!!!
354 =cut
358 PARROT_WARN_UNUSED_RESULT
359 PARROT_CANNOT_RETURN_NULL
360 static funcptr_t
361 get_mmd_dispatcher(PARROT_INTERP, ARGIN(PMC *left), ARGIN(PMC *right),
362 INTVAL function, ARGOUT(int *is_pmc))
364 const UINTVAL left_type = VTABLE_type(interp, left);
365 const UINTVAL right_type = VTABLE_type(interp, right);
366 return get_mmd_dispatch_type(interp, function, left_type, right_type,
367 is_pmc);
373 =item C<static PMC * mmd_deref>
375 If C<value> is a reference-like PMC, dereference it so we can make an MMD
376 call on the 'real' value.
378 =cut
382 PARROT_CANNOT_RETURN_NULL
383 static PMC *
384 mmd_deref(PARROT_INTERP, ARGIN(PMC *value))
386 if (!PObj_is_object_TEST(value)
387 && VTABLE_type(interp, value) != value->vtable->base_type)
388 return VTABLE_get_pmc(interp, value);
389 else
390 return value;
396 =item C<static void mmd_ensure_writable>
398 Make sure C<pmc> is writable enough for C<function>.
400 =cut
404 static void
405 mmd_ensure_writable(PARROT_INTERP, INTVAL function, ARGIN_NULLOK(const PMC *pmc))
407 if (!PMC_IS_NULL(pmc) && (pmc->vtable->flags & VTABLE_IS_READONLY_FLAG))
408 Parrot_ex_throw_from_c_args(interp, 0, 1, "%s applied to read-only argument",
409 Parrot_MMD_method_name(interp, function));
415 =item C<PMC* mmd_dispatch_p_ppp>
417 Dispatch to a multimethod that returns a PMC. C<left>, C<right>, and
418 C<dest> are all PMC pointers, while C<func_num> is the MMD table that
419 should be used to do the dispatching.
420 If the C<dest> pointer is NULL, it dispatches two a two-argument function
421 that returns a new C<dest> always.
423 The MMD system will figure out which function should be called based on
424 the types of C<left> and C<right> and call it, passing in C<left>,
425 C<right>, and possibly C<dest> like any other binary vtable function.
427 =cut
431 PARROT_API
432 PARROT_WARN_UNUSED_RESULT
433 PARROT_CANNOT_RETURN_NULL
434 PMC*
435 mmd_dispatch_p_ppp(PARROT_INTERP, ARGIN(PMC *left), ARGIN(PMC *right),
436 ARGIN_NULLOK(PMC *dest), INTVAL func_nr)
438 mmd_f_p_ppp real_function;
439 int is_pmc;
441 left = mmd_deref(interp, left);
442 right = mmd_deref(interp, right);
444 real_function = (mmd_f_p_ppp)get_mmd_dispatcher(interp,
445 left, right, func_nr, &is_pmc);
447 if (is_pmc) {
448 PMC * const sub = (PMC*)real_function;
449 if (dest)
450 return Parrot_runops_fromc_args(interp, sub, "PPPP",
451 left, right, dest);
452 else
453 return Parrot_runops_fromc_args(interp, sub, "PPP", left, right);
456 return (*real_function)(interp, left, right, dest);
462 =item C<PMC* mmd_dispatch_p_pip>
464 Like C<mmd_dispatch_p_ppp>, right argument is a native INTVAL.
466 =cut
470 PARROT_API
471 PARROT_CAN_RETURN_NULL
472 PMC*
473 mmd_dispatch_p_pip(PARROT_INTERP,
474 ARGIN(PMC *left), INTVAL right, ARGIN_NULLOK(PMC *dest), INTVAL func_nr)
476 int is_pmc;
477 UINTVAL left_type;
478 mmd_f_p_pip real_function;
480 left = mmd_deref(interp, left);
481 left_type = VTABLE_type(interp, left);
483 real_function =
484 (mmd_f_p_pip)get_mmd_dispatch_type(interp, func_nr, left_type,
485 enum_type_INTVAL, &is_pmc);
487 if (is_pmc) {
488 PMC * const sub = (PMC *)real_function;
489 if (dest)
490 return Parrot_runops_fromc_args(interp, sub, "PPIP",
491 left, right, dest);
492 else
493 return Parrot_runops_fromc_args(interp, sub, "PPI", left, right);
496 return (*real_function)(interp, left, right, dest);
502 =item C<PMC* mmd_dispatch_p_pnp>
504 Like C<mmd_dispatch_p_ppp>, right argument is a native FLOATVAL.
506 =cut
510 PARROT_API
511 PARROT_CAN_RETURN_NULL
512 PMC*
513 mmd_dispatch_p_pnp(PARROT_INTERP,
514 ARGIN(PMC *left), FLOATVAL right, ARGIN_NULLOK(PMC *dest), INTVAL func_nr)
516 mmd_f_p_pnp real_function;
517 int is_pmc;
518 UINTVAL left_type;
520 left = mmd_deref(interp, left);
521 left_type = VTABLE_type(interp, left);
523 real_function = (mmd_f_p_pnp)get_mmd_dispatch_type(interp,
524 func_nr, left_type, enum_type_FLOATVAL, &is_pmc);
526 if (is_pmc) {
527 PMC * const sub = (PMC*)real_function;
528 if (dest)
529 return Parrot_runops_fromc_args(interp, sub, "PPNP",
530 left, right, dest);
531 else
532 return Parrot_runops_fromc_args(interp, sub, "PPN", left, right);
535 return (*real_function)(interp, left, right, dest);
541 =item C<PMC* mmd_dispatch_p_psp>
543 Like C<mmd_dispatch_p_ppp>, right argument is a native STRING *.
545 =cut
549 PARROT_API
550 PARROT_CAN_RETURN_NULL
551 PMC*
552 mmd_dispatch_p_psp(PARROT_INTERP, ARGIN(PMC *left), ARGIN(STRING *right),
553 ARGIN_NULLOK(PMC *dest), INTVAL func_nr)
555 int is_pmc;
556 const UINTVAL left_type = VTABLE_type(interp, left);
557 const mmd_f_p_psp real_function =
558 (mmd_f_p_psp)get_mmd_dispatch_type(interp,
559 func_nr, left_type, enum_type_STRING, &is_pmc);
561 if (is_pmc) {
562 PMC * const sub = (PMC*)real_function;
563 if (dest)
564 return Parrot_runops_fromc_args(interp, sub, "PPSP",
565 left, right, dest);
566 else
567 return Parrot_runops_fromc_args(interp, sub, "PPS", left, right);
570 return (*real_function)(interp, left, right, dest);
576 =item C<void mmd_dispatch_v_pp>
578 Inplace dispatch function for C<< left <op=> right >>.
580 =cut
584 PARROT_API
585 void
586 mmd_dispatch_v_pp(PARROT_INTERP,
587 ARGIN(PMC *left), ARGIN(PMC *right), INTVAL func_nr)
589 mmd_f_v_pp real_function;
590 int is_pmc;
592 left = mmd_deref(interp, left);
593 right = mmd_deref(interp, right);
595 mmd_ensure_writable(interp, func_nr, left);
597 real_function = (mmd_f_v_pp)get_mmd_dispatcher(interp,
598 left, right, func_nr, &is_pmc);
600 if (is_pmc) {
601 PMC * const sub = (PMC*)real_function;
602 Parrot_runops_fromc_args(interp, sub, "vPP", left, right);
605 (*real_function)(interp, left, right);
611 =item C<void mmd_dispatch_v_pi>
613 Inplace dispatch function for C<< left <op=> right >>.
615 =cut
619 PARROT_API
620 void
621 mmd_dispatch_v_pi(PARROT_INTERP,
622 ARGIN(PMC *left), INTVAL right, INTVAL func_nr)
624 int is_pmc;
625 UINTVAL left_type;
626 mmd_f_v_pi real_function;
628 left = mmd_deref(interp, left);
629 mmd_ensure_writable(interp, func_nr, left);
631 left_type = VTABLE_type(interp, left);
632 real_function = (mmd_f_v_pi)get_mmd_dispatch_type(interp,
633 func_nr, left_type, enum_type_INTVAL, &is_pmc);
635 if (is_pmc) {
636 PMC * const sub = (PMC *)real_function;
637 Parrot_runops_fromc_args(interp, sub, "vPI", left, right);
640 (*real_function)(interp, left, right);
646 =item C<void mmd_dispatch_v_pn>
648 Inplace dispatch function for C<< left <op=> right >>.
650 =cut
654 PARROT_API
655 void
656 mmd_dispatch_v_pn(PARROT_INTERP,
657 ARGIN(PMC *left), FLOATVAL right, INTVAL func_nr)
659 int is_pmc;
660 UINTVAL left_type;
661 mmd_f_v_pn real_function;
663 left = mmd_deref(interp, left);
664 mmd_ensure_writable(interp, func_nr, left);
666 left_type = VTABLE_type(interp, left);
667 real_function = (mmd_f_v_pn)get_mmd_dispatch_type(interp,
668 func_nr, left_type, enum_type_FLOATVAL, &is_pmc);
670 if (is_pmc) {
671 PMC * const sub = (PMC *)real_function;
672 Parrot_runops_fromc_args(interp, sub, "vPN", left, right);
675 (*real_function)(interp, left, right);
681 =item C<void mmd_dispatch_v_ps>
683 Inplace dispatch function for C<< left <op=> right >>.
685 =cut
689 PARROT_API
690 void
691 mmd_dispatch_v_ps(PARROT_INTERP,
692 ARGIN(PMC *left), ARGIN(STRING *right), INTVAL func_nr)
694 int is_pmc;
695 UINTVAL left_type;
696 mmd_f_v_ps real_function;
698 left = mmd_deref(interp, left);
699 mmd_ensure_writable(interp, func_nr, left);
701 left_type = VTABLE_type(interp, left);
702 real_function = (mmd_f_v_ps)get_mmd_dispatch_type(interp,
703 func_nr, left_type, enum_type_STRING, &is_pmc);
705 if (is_pmc) {
706 PMC * const sub = (PMC *)real_function;
707 Parrot_runops_fromc_args(interp, sub, "vPS", left, right);
710 (*real_function)(interp, left, right);
716 =item C<INTVAL mmd_dispatch_i_pp>
718 Like C<mmd_dispatch_p_ppp()>, only it returns an C<INTVAL>. This is used
719 by MMD compare functions.
721 =cut
725 PARROT_API
726 INTVAL
727 mmd_dispatch_i_pp(PARROT_INTERP,
728 ARGIN(PMC *left), ARGIN(PMC *right), INTVAL func_nr)
730 int is_pmc;
731 mmd_f_i_pp real_function;
733 left = mmd_deref(interp, left);
734 right = mmd_deref(interp, right);
736 real_function = (mmd_f_i_pp)get_mmd_dispatcher(interp,
737 left, right, func_nr, &is_pmc);
739 if (is_pmc) {
740 PMC * const sub = (PMC *)real_function;
741 return Parrot_runops_fromc_args_reti(interp, sub, "IPP",
742 left, right);
745 return (*real_function)(interp, left, right);
751 =item C<void mmd_add_function>
753 Add a new binary MMD function to the list of functions the MMD system knows
754 of. C<func_num> is the number of the new function. C<function> is ignored.
756 RT #45941 change this to a MMD register interface that takes a function *name*.
758 =cut
762 PARROT_API
763 void
764 mmd_add_function(PARROT_INTERP, INTVAL func_nr, SHIM(funcptr_t function))
766 /* XXX Something looks wrong here. n_binop_mmd_funcs gets incremented,
767 * but the function doesn't get saved */
768 if (func_nr >= (INTVAL)interp->n_binop_mmd_funcs) {
769 INTVAL i;
770 mem_realloc_n_typed(interp->binop_mmd_funcs, func_nr+1, MMD_table);
772 for (i = interp->n_binop_mmd_funcs; i <= func_nr; ++i) {
773 MMD_table * const table = interp->binop_mmd_funcs + i;
775 table->x = 0;
776 table->y = 0;
777 table->mmd_funcs = NULL;
780 interp->n_binop_mmd_funcs = func_nr + 1;
787 =item C<static void mmd_expand_x>
789 Expands the function table in the X dimension to include C<new_x>.
791 =cut
795 static void
796 mmd_expand_x(PARROT_INTERP, INTVAL func_nr, INTVAL new_x)
798 funcptr_t *new_table;
799 UINTVAL x;
800 UINTVAL y;
801 UINTVAL i;
802 char *src_ptr, *dest_ptr;
803 size_t old_dp, new_dp;
804 MMD_table * const table = interp->binop_mmd_funcs + func_nr;
806 /* Is the Y 0? If so, nothing to expand, so just set the X for later use */
807 if (table->y == 0) {
808 table->x = new_x;
809 return;
812 /* The Y is not zero. Bleah. This means we have to expand the
813 table in an unpleasant way. */
815 x = table->x;
816 y = table->y;
818 /* First, fill in the whole new table with the default function
819 pointer. We only really need to do the new part, but... */
820 new_table = mem_allocate_n_zeroed_typed(y * new_x, funcptr_t);
822 /* Then copy the old table over. We have to do this row by row,
823 because the rows in the old and new tables are different lengths */
824 src_ptr = (char *)table->mmd_funcs;
825 dest_ptr = (char *)new_table;
826 old_dp = sizeof (funcptr_t) * x;
827 new_dp = sizeof (funcptr_t) * new_x;
829 for (i = 0; i < y; i++) {
830 STRUCT_COPY_N(dest_ptr, src_ptr, x);
831 src_ptr += old_dp;
832 dest_ptr += new_dp;
835 if (table->mmd_funcs)
836 mem_sys_free(table->mmd_funcs);
838 table->x = new_x;
840 /* Set the old table to point to the new table */
841 table->mmd_funcs = new_table;
847 =item C<static void mmd_expand_y>
849 Expands the function table in the Y direction.
851 =cut
855 static void
856 mmd_expand_y(PARROT_INTERP, INTVAL func_nr, INTVAL new_y)
858 UINTVAL new_size, old_size;
859 MMD_table * const table = interp->binop_mmd_funcs + func_nr;
861 PARROT_ASSERT(table->x);
863 old_size = sizeof (funcptr_t) * table->x * table->y;
864 new_size = sizeof (funcptr_t) * table->x * new_y;
866 if (table->mmd_funcs)
867 table->mmd_funcs = (funcptr_t *)mem_sys_realloc_zeroed(
868 table->mmd_funcs, new_size, old_size);
869 else
870 table->mmd_funcs = (funcptr_t *)mem_sys_allocate_zeroed(new_size);
872 table->y = new_y;
878 =item C<void mmd_add_by_class>
880 Add a function to the MMD table by class name, rather than class number.
881 Handles the case where the named class isn't loaded yet.
883 Adds a new MMD function C<funcptr> to the C<func_num> function table
884 that will be invoked when the left parameter is of class C<left_class>
885 and the right parameter is of class C<right_class>. Both classes are
886 C<STRING *>s that hold the PMC class names for the left and right sides.
887 If either class isn't yet loaded, Parrot will cache the information such
888 that the function will be installed if at some point in the future both
889 classes are available.
891 Currently this is done by just assigning class numbers to the classes,
892 which the classes will pick up and use if they're later loaded, but we
893 may later put the functions into a deferred table that we scan when PMC
894 classes are loaded. Either way, the function will be guaranteed to be
895 installed when it's needed.
897 The function table must exist, but if it is too small, it will
898 automatically be expanded.
900 =cut
904 PARROT_API
905 void
906 mmd_add_by_class(PARROT_INTERP,
907 INTVAL functype,
908 ARGIN(STRING *left_class), ARGIN(STRING *right_class),
909 NULLOK(funcptr_t funcptr))
911 INTVAL left_type = pmc_type(interp, left_class);
912 INTVAL right_type = pmc_type(interp, right_class);
914 if (left_type == enum_type_undef)
915 left_type = pmc_register(interp, left_class);
917 if (right_type == enum_type_undef)
918 right_type = pmc_register(interp, right_class);
920 mmd_register(interp, functype, left_type, right_type, funcptr);
927 =item C<void mmd_register>
929 Register a function C<funcptr> for MMD function table C<func_num> for classes
930 C<left_type> and C<right_type>. The left and right types are C<INTVAL>s that
931 represent the class ID numbers.
933 The function table must exist, but if it is too small, it will
934 automatically be expanded.
936 Adding a new function to the table can be interestingly non-trivial, so
937 we get to be tricky.
939 If the left or right types are larger than anything we've seen so far,
940 it means that we have to expand the table. Making Y larger is simple --
941 just realloc with some more rows. Making X larger is less simple. In
942 either case, we punt to other functions.
944 RT #45943 - Currently the MMD system doesn't handle inheritance and best match
945 searching, as it assumes that all PMC types have no parent type. This
946 can be considered a bug, and will be resolved at some point in the
947 future.
949 =cut
953 PARROT_API
954 void
955 mmd_register(PARROT_INTERP, INTVAL func_nr, INTVAL left_type, INTVAL right_type,
956 NULLOK(funcptr_t funcptr))
959 INTVAL offset;
960 MMD_table *table;
962 PARROT_ASSERT(func_nr < (INTVAL)interp->n_binop_mmd_funcs);
963 PARROT_ASSERT(left_type >= 0);
964 PARROT_ASSERT(right_type >=0 ||
965 (right_type >= enum_type_INTVAL && right_type <= enum_type_PMC));
967 if (right_type < 0)
968 right_type -= enum_type_INTVAL;
969 else
970 right_type += 4;
972 table = interp->binop_mmd_funcs + func_nr;
974 if ((INTVAL)table->x <= left_type)
975 mmd_expand_x(interp, func_nr, left_type + 1);
977 if ((INTVAL)table->y <= right_type)
978 mmd_expand_y(interp, func_nr, right_type + 1);
980 offset = table->x * right_type + left_type;
981 table->mmd_funcs[offset] = funcptr;
987 =item C<void mmd_register_sub>
989 RT #48260: Not yet documented!!!
991 =cut
995 PARROT_API
996 void
997 mmd_register_sub(PARROT_INTERP, INTVAL func_nr,
998 INTVAL left_type, INTVAL right_type, ARGIN(const PMC *sub))
1000 /* returned from mmdvt_find */
1001 if (sub->vtable->base_type == enum_class_NCI) {
1002 mmd_register(interp, func_nr, left_type, right_type,
1003 D2FPTR(PMC_struct_val(sub)));
1005 else {
1006 PMC * const fake = (PMC *)((UINTVAL) sub | 1);
1007 mmd_register(interp, func_nr, left_type, right_type, D2FPTR(fake));
1014 =item C<void mmd_destroy>
1016 Frees all the memory allocated used the MMD subsystem.
1018 =cut
1022 PARROT_API
1023 void
1024 mmd_destroy(PARROT_INTERP)
1026 if (interp->n_binop_mmd_funcs) {
1027 UINTVAL i;
1028 for (i = 0; i <interp->n_binop_mmd_funcs; ++i) {
1029 if (interp->binop_mmd_funcs[i].mmd_funcs) {
1030 mem_sys_free(interp->binop_mmd_funcs[i].mmd_funcs);
1031 interp->binop_mmd_funcs[i].mmd_funcs = NULL;
1035 mem_sys_free(interp->binop_mmd_funcs);
1036 interp->binop_mmd_funcs = NULL;
1042 =item C<PMC * mmd_vtfind>
1044 Return an MMD PMC function for the given data types. The return result is
1045 either a Sub PMC (for PASM MMD functions) or a NCI PMC holding the
1046 C function pointer in PMC_struct_val.
1048 =cut
1052 PARROT_API
1053 PARROT_CANNOT_RETURN_NULL
1054 PARROT_WARN_UNUSED_RESULT
1055 PMC *
1056 mmd_vtfind(PARROT_INTERP, INTVAL func_nr, INTVAL left, INTVAL right)
1058 int is_pmc;
1059 const funcptr_t func = get_mmd_dispatch_type(interp,
1060 func_nr, left, right, &is_pmc);
1061 PMC *f;
1063 /* RT #45945 if is_pmc == 2 a Bound_NCI is returned, which actually should
1064 * be filled with one of the wrapper functions */
1065 if (func && is_pmc)
1066 return (PMC *)F2DPTR(func);
1068 f = pmc_new(interp, enum_class_NCI);
1069 VTABLE_set_pointer(interp, f, F2DPTR(func));
1070 return f;
1076 =item C<PMC * Parrot_MMD_search_default_infix>
1078 RT #48260: Not yet documented!!!
1080 =cut
1084 PARROT_API
1085 PARROT_CANNOT_RETURN_NULL
1086 PARROT_WARN_UNUSED_RESULT
1087 PMC *
1088 Parrot_MMD_search_default_infix(PARROT_INTERP, ARGIN(STRING *meth),
1089 INTVAL left_type, INTVAL right_type)
1091 PMC* const arg_tuple = pmc_new(interp, enum_class_FixedIntegerArray);
1093 VTABLE_set_integer_native(interp, arg_tuple, 2);
1094 VTABLE_set_integer_keyed_int(interp, arg_tuple, 0, left_type);
1095 VTABLE_set_integer_keyed_int(interp, arg_tuple, 1, right_type);
1097 return mmd_search_default(interp, meth, arg_tuple);
1103 =item C<PMC * Parrot_mmd_sort_candidate_list>
1105 Given an array PMC (usually a MultiSub) sort the mmd candidates by their
1106 manhatten distance to the current args.
1108 =cut
1112 PARROT_API
1113 PARROT_CAN_RETURN_NULL
1114 PARROT_WARN_UNUSED_RESULT
1115 PMC *
1116 Parrot_mmd_sort_candidate_list(PARROT_INTERP, ARGIN(PMC *candidates))
1118 PMC *arg_tuple;
1119 INTVAL n = VTABLE_elements(interp, candidates);
1121 if (!n)
1122 return PMCNULL;
1124 arg_tuple = mmd_arg_tuple_func(interp);
1125 candidates = VTABLE_clone(interp, candidates);
1127 mmd_sort_candidates(interp, arg_tuple, candidates);
1129 /* if there aren't any variants that match the current args, we could end
1130 up with an empty list */
1131 n = VTABLE_elements(interp, candidates);
1133 if (!n)
1134 return PMCNULL;
1136 return candidates;
1142 =item C<static PMC* mmd_arg_tuple_inline>
1144 Return a list of argument types. PMC arguments are specified as function
1145 arguments.
1147 =cut
1150 PARROT_CANNOT_RETURN_NULL
1151 PARROT_WARN_UNUSED_RESULT
1152 static PMC*
1153 mmd_arg_tuple_inline(PARROT_INTERP, ARGIN(STRING *signature), va_list args)
1155 INTVAL i;
1156 PMC * const arg_tuple = pmc_new(interp, enum_class_FixedIntegerArray);
1157 const INTVAL sig_len = string_length(interp, signature);
1159 if (!sig_len)
1160 return arg_tuple;
1162 VTABLE_set_integer_native(interp, arg_tuple, sig_len);
1164 for (i = 0; i < sig_len; ++i) {
1165 INTVAL type = string_index(interp, signature, i);
1166 switch (type) {
1167 case 'I':
1168 VTABLE_set_integer_keyed_int(interp, arg_tuple,
1169 i, enum_type_INTVAL);
1170 break;
1171 case 'N':
1172 VTABLE_set_integer_keyed_int(interp, arg_tuple,
1173 i, enum_type_FLOATVAL);
1174 break;
1175 case 'S':
1176 VTABLE_set_integer_keyed_int(interp, arg_tuple,
1177 i, enum_type_STRING);
1178 break;
1179 case 'O':
1180 case 'P':
1182 PMC *arg = va_arg(args, PMC *);
1183 type = VTABLE_type(interp, arg);
1184 VTABLE_set_integer_keyed_int(interp, arg_tuple, i, type);
1185 break;
1187 default:
1188 Parrot_ex_throw_from_c_args(interp, NULL, 1,
1189 "Unknown signature type %d in mmd_arg_tuple", type);
1190 break;
1194 return arg_tuple;
1200 =item C<static PMC* mmd_arg_tuple_func>
1202 Return a list of argument types. PMC arguments are take from registers
1203 according to calling conventions.
1205 =cut
1209 PARROT_WARN_UNUSED_RESULT
1210 PARROT_CANNOT_RETURN_NULL
1211 static PMC*
1212 mmd_arg_tuple_func(PARROT_INTERP)
1214 INTVAL sig_len, i, type;
1215 PMC *arg;
1216 PMC *args_array; /* from recent set_args opcode */
1217 PackFile_Constant **constants;
1220 * if there is no signature e.g. because of
1221 * m = getattribute l, "__add"
1222 * - we have to return the MultiSub
1223 * - create a BoundMulti
1224 * - dispatch in invoke - yeah ugly
1227 PMC * const arg_tuple = pmc_new(interp, enum_class_ResizableIntegerArray);
1228 opcode_t *args_op = interp->current_args;
1230 if (!args_op)
1231 return arg_tuple;
1233 PARROT_ASSERT(*args_op == PARROT_OP_set_args_pc);
1234 constants = interp->code->const_table->constants;
1235 ++args_op;
1236 args_array = constants[*args_op]->u.key;
1238 ASSERT_SIG_PMC(args_array);
1240 sig_len = SIG_ELEMS(args_array);
1241 if (!sig_len)
1242 return arg_tuple;
1244 ++args_op;
1246 for (i = 0; i < sig_len; ++i, ++args_op) {
1247 type = SIG_ITEM(args_array, i);
1249 /* named don't MMD */
1250 if (type & PARROT_ARG_NAME)
1251 break;
1252 switch (type & (PARROT_ARG_TYPE_MASK | PARROT_ARG_FLATTEN)) {
1253 case PARROT_ARG_INTVAL:
1254 VTABLE_push_integer(interp, arg_tuple, enum_type_INTVAL);
1255 break;
1256 case PARROT_ARG_FLOATVAL:
1257 VTABLE_push_integer(interp, arg_tuple, enum_type_FLOATVAL);
1258 break;
1259 case PARROT_ARG_STRING:
1260 VTABLE_push_integer(interp, arg_tuple, enum_type_STRING);
1261 break;
1262 case PARROT_ARG_PMC:
1264 const int idx = *args_op;
1265 if ((type & PARROT_ARG_CONSTANT))
1266 arg = constants[idx]->u.key;
1267 else
1268 arg = REG_PMC(interp, idx);
1269 type = VTABLE_type(interp, arg);
1270 VTABLE_push_integer(interp, arg_tuple, type);
1272 break;
1273 case PARROT_ARG_FLATTEN | PARROT_ARG_PMC: {
1274 /* expand flattening args */
1275 int j, n;
1277 const int idx = *args_op;
1278 arg = REG_PMC(interp, idx);
1279 n = VTABLE_elements(interp, arg);
1281 for (j = 0; j < n; ++j) {
1282 PMC * const elem = VTABLE_get_pmc_keyed_int(interp, arg, j);
1283 type = VTABLE_type(interp, elem);
1284 VTABLE_push_integer(interp, arg_tuple, type);
1286 break;
1288 default:
1289 Parrot_ex_throw_from_c_args(interp, NULL, 1,
1290 "Unknown signature type %d in mmd_arg_tuple", type);
1291 break;
1296 return arg_tuple;
1302 =item C<static PMC* mmd_search_default>
1304 Default implementation of MMD search. Search scopes for candidates, walk the
1305 class hierarchy, sort all candidates by their Manhattan distance, and return
1306 result
1308 =cut
1312 PARROT_CAN_RETURN_NULL
1313 PARROT_WARN_UNUSED_RESULT
1314 static PMC*
1315 mmd_search_default(PARROT_INTERP, ARGIN(STRING *meth), ARGIN(PMC *arg_tuple))
1317 /* 2) create a list of matching functions */
1318 PMC * const candidate_list = mmd_search_scopes(interp, meth);
1321 * 3) if list is empty fail
1322 * if the first found function is a plain Sub: finito
1324 INTVAL n = VTABLE_elements(interp, candidate_list);
1326 if (n == 1) {
1327 PMC * const pmc = VTABLE_get_pmc_keyed_int(interp, candidate_list, 0);
1328 STRING * const _sub = CONST_STRING(interp, "Sub");
1330 if (VTABLE_isa(interp, pmc, _sub))
1331 return pmc;
1335 * 4) first was a MultiSub - go through all found MultiSubs and check
1336 * the first arguments MRO, add all MultiSubs and plain methods,
1337 * where the first argument matches
1339 mmd_search_classes(interp, meth, arg_tuple, candidate_list, 0);
1340 n = VTABLE_elements(interp, candidate_list);
1341 if (!n)
1342 return NULL;
1344 /* 5) sort the list */
1346 if (n > 1)
1347 mmd_sort_candidates(interp, arg_tuple, candidate_list);
1349 n = VTABLE_elements(interp, candidate_list);
1351 if (!n)
1352 return NULL;
1354 /* 6) Uff, return first one */
1355 return VTABLE_get_pmc_keyed_int(interp, candidate_list, 0);
1361 =item C<static void mmd_search_classes>
1363 Search all the classes in all MultiSubs of the candidates C<cl> and return
1364 a list of all candidates. C<start_at_parent> is 0 to start at the class itself
1365 or 1 to search from the first parent class.
1367 =cut
1371 static void
1372 mmd_search_classes(PARROT_INTERP, ARGIN(STRING *meth),
1373 ARGIN(PMC *arg_tuple), ARGIN(PMC *cl), INTVAL start_at_parent)
1375 INTVAL type1;
1377 /* get the class of the first argument */
1378 if (!VTABLE_elements(interp, arg_tuple))
1379 return;
1381 type1 = VTABLE_get_integer_keyed_int(interp, arg_tuple, 0);
1383 if (type1 < 0) {
1384 return;
1385 /* RT #45947 create some class namespace */
1387 else {
1388 PMC * const mro = interp->vtables[type1]->mro;
1389 const INTVAL n = VTABLE_elements(interp, mro);
1390 INTVAL i;
1392 for (i = start_at_parent; i < n; ++i) {
1393 PMC * const _class = VTABLE_get_pmc_keyed_int(interp, mro, i);
1394 PMC *ns, *methodobj;
1396 if (PObj_is_class_TEST(_class))
1397 ns = Parrot_oo_get_namespace(interp, _class);
1398 else
1399 ns = VTABLE_get_namespace(interp, _class);
1401 methodobj = VTABLE_get_pmc_keyed_str(interp, ns, meth);
1403 if (!PMC_IS_NULL(methodobj)) {
1405 * mmd_is_hidden would consider all previous candidates
1406 * RT #45949 pass current n so that only candidates from this
1407 * mro are used?
1409 if (mmd_maybe_candidate(interp, methodobj, cl))
1410 break;
1419 =item C<static INTVAL distance_cmp>
1421 RT #48260: Not yet documented!!!
1423 =cut
1427 static INTVAL
1428 distance_cmp(SHIM_INTERP, INTVAL a, INTVAL b)
1430 short da = (short)(a & 0xffff);
1431 short db = (short)(b & 0xffff);
1433 /* sort first by distance */
1434 if (da > db)
1435 return 1;
1437 if (da < db)
1438 return -1;
1440 /* end then by index in candidate list */
1441 da = (short)(a >> 16);
1442 db = (short)(b >> 16);
1444 return da > db ? 1 : da < db ? -1 : 0;
1450 =item C<static PMC* mmd_cvt_to_types>
1452 RT #48260: Not yet documented!!!
1454 =cut
1458 PARROT_CANNOT_RETURN_NULL
1459 PARROT_WARN_UNUSED_RESULT
1460 static PMC*
1461 mmd_cvt_to_types(PARROT_INTERP, ARGIN(PMC *multi_sig))
1463 PMC * const ar = pmc_new(interp, enum_class_FixedIntegerArray);
1464 const INTVAL n = VTABLE_elements(interp, multi_sig);
1465 INTVAL i;
1467 VTABLE_set_integer_native(interp, ar, n);
1469 for (i = 0; i < n; ++i) {
1470 PMC * const sig_elem = VTABLE_get_pmc_keyed_int(interp, multi_sig, i);
1471 INTVAL type;
1473 if (sig_elem->vtable->base_type == enum_class_String) {
1474 STRING * const sig = VTABLE_get_string(interp, sig_elem);
1475 if (memcmp(sig->strstart, "__VOID", 6) == 0) {
1476 PMC_int_val(ar)--; /* RT #45951 */
1477 break;
1479 type = pmc_type(interp, sig);
1481 else {
1482 type = pmc_type_p(interp, sig_elem);
1485 VTABLE_set_integer_keyed_int(interp, ar, i, type);
1488 return ar;
1492 #define MMD_BIG_DISTANCE 0x7fff
1496 =item C<static UINTVAL mmd_distance>
1498 Create Manhattan Distance of sub C<pmc> against given argument types.
1499 0xffff is the maximum distance
1501 =cut
1505 static UINTVAL
1506 mmd_distance(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *arg_tuple))
1508 PMC *multi_sig, *mro;
1509 INTVAL i, n, args, dist, j, m;
1511 /* has to be a builtin multi method */
1512 if (pmc->vtable->base_type == enum_class_NCI) {
1513 multi_sig = PMC_pmc_val(pmc);
1515 else if (VTABLE_isa(interp, pmc, CONST_STRING(interp, "Sub"))
1516 || VTABLE_isa(interp, pmc, CONST_STRING(interp, "Closure"))) {
1517 multi_sig = PMC_sub(pmc)->multi_signature;
1519 /* some method */
1520 if (!multi_sig)
1521 return 0;
1523 if (multi_sig->vtable->base_type == enum_class_FixedPMCArray) {
1524 multi_sig = PMC_sub(pmc)->multi_signature =
1525 mmd_cvt_to_types(interp, multi_sig);
1528 else
1529 return MMD_BIG_DISTANCE;
1531 n = VTABLE_elements(interp, multi_sig);
1532 args = VTABLE_elements(interp, arg_tuple);
1535 * arg_tuple may have more arguments - only the
1536 * n multi_sig invocants are counted
1538 if (args < n)
1539 return MMD_BIG_DISTANCE;
1541 dist = 0;
1543 if (args > n)
1544 dist = PARROT_MMD_MAX_CLASS_DEPTH;
1546 /* now go through args */
1547 for (i = 0; i < n; ++i) {
1548 const INTVAL type_sig = VTABLE_get_integer_keyed_int(interp, multi_sig, i);
1549 const INTVAL type_call = VTABLE_get_integer_keyed_int(interp, arg_tuple, i);
1550 if (type_sig == type_call)
1551 continue;
1554 * different native types are very different, except a PMC
1555 * which matches any PMC
1557 if (type_call <= 0 && type_sig == enum_type_PMC) {
1558 dist++;
1559 continue;
1562 if ((type_sig <= 0 && type_sig != enum_type_PMC) || type_call <= 0) {
1563 dist = MMD_BIG_DISTANCE;
1564 break;
1568 * now consider MRO of types the signature type has to be somewhere
1569 * in the MRO of the type_call
1571 mro = interp->vtables[type_call]->mro;
1572 m = VTABLE_elements(interp, mro);
1574 for (j = 0; j < m; ++j) {
1575 PMC * const cl = VTABLE_get_pmc_keyed_int(interp, mro, j);
1577 if (cl->vtable->base_type == type_sig)
1578 break;
1579 if (VTABLE_type(interp, cl) == type_sig)
1580 break;
1582 ++dist;
1586 * if the type wasn't in MRO check, if any PMC matches
1587 * in that case use the distance + 1 (of an any PMC parent)
1589 if (j == m && type_sig != enum_type_PMC) {
1590 dist = MMD_BIG_DISTANCE;
1591 break;
1594 ++dist;
1595 #if MMD_DEBUG
1597 STRING *s1, *s2;
1598 if (type_sig < 0)
1599 s1 = Parrot_get_datatype_name(interp, type_sig);
1600 else {
1601 s1 = interp->vtables[type_sig]->whoami;
1603 if (type_call < 0)
1604 s2 = Parrot_get_datatype_name(interp, type_call);
1605 else {
1606 s2 = interp->vtables[type_call]->whoami;
1608 PIO_eprintf(interp, "arg %d: dist %d sig %Ss arg %Ss\n",
1609 i, dist, s1, s2);
1611 #endif
1614 return dist;
1620 =item C<static void mmd_sort_candidates>
1622 Sort the candidate list C<cl> by Manhattan Distance
1624 =cut
1628 static void
1629 mmd_sort_candidates(PARROT_INTERP, ARGIN(PMC *arg_tuple), ARGIN(PMC *cl))
1631 INTVAL i;
1632 PMC *nci;
1633 INTVAL *helper;
1634 PMC **data;
1636 const INTVAL n = VTABLE_elements(interp, cl);
1637 PMC * const sort = pmc_new(interp, enum_class_FixedIntegerArray);
1640 * create a helper structure:
1641 * bits 0..15 = distance
1642 * bits 16..31 = idx in candidate list
1644 * RT #45955 use half of available INTVAL bits
1647 VTABLE_set_integer_native(interp, sort, n);
1648 helper = (INTVAL *)PMC_data(sort);
1650 for (i = 0; i < n; ++i) {
1651 PMC * const pmc = VTABLE_get_pmc_keyed_int(interp, cl, i);
1652 const INTVAL d = mmd_distance(interp, pmc, arg_tuple);
1653 helper[i] = i << 16 | (d & 0xffff);
1656 /* need an NCI function pointer */
1657 nci = pmc_new(interp, enum_class_NCI);
1658 PMC_struct_val(nci) = F2DPTR(distance_cmp);
1660 /* sort it */
1661 Parrot_quicksort(interp, (void **)helper, n, nci);
1664 * now helper has a sorted list of indices in the upper 16 bits
1665 * fill helper with sorted candidates
1667 data = (PMC **)PMC_data(cl);
1669 for (i = 0; i < n; ++i) {
1670 const INTVAL idx = helper[i] >> 16;
1672 /* if the distance is big stop */
1673 if ((helper[i] & 0xffff) == MMD_BIG_DISTANCE) {
1674 PMC_int_val(cl) = i;
1675 break;
1678 helper[i] = (INTVAL)data[idx];
1681 /* use helper structure */
1682 PMC_data(cl) = helper;
1683 PMC_data(sort) = data;
1689 =item C<static PMC* mmd_search_scopes>
1691 Search all scopes for MMD candidates matching the arguments given in
1692 C<arg_tuple>.
1694 =cut
1698 PARROT_CANNOT_RETURN_NULL
1699 PARROT_WARN_UNUSED_RESULT
1700 static PMC*
1701 mmd_search_scopes(PARROT_INTERP, ARGIN(STRING *meth))
1703 PMC * const candidates = pmc_new(interp, enum_class_ResizablePMCArray);
1705 const int stop = mmd_search_cur_namespace(interp, meth, candidates);
1707 if (!stop)
1708 mmd_search_builtin(interp, meth, candidates);
1710 return candidates;
1716 =item C<static int mmd_is_hidden>
1718 Check if the given multi sub is hidden by any inner multi sub (already in
1719 the candidate list C<cl>.
1721 =cut
1725 PARROT_WARN_UNUSED_RESULT
1726 static int
1727 mmd_is_hidden(PARROT_INTERP, ARGIN(PMC *multi), ARGIN(PMC *cl))
1730 * if the candidate list already has the a sub with the same
1731 * signature (long name), the outer multi is hidden
1733 * RT #45957
1735 UNUSED(interp);
1736 UNUSED(multi);
1737 UNUSED(cl);
1738 return 0;
1744 =item C<static int mmd_maybe_candidate>
1746 If the candidate C<pmc> is a Sub PMC, push it on the candidate list and
1747 return TRUE to stop further search.
1749 If the candidate is a MultiSub remember all matching Subs and return FALSE
1750 to continue searching outer scopes.
1752 =cut
1756 static int
1757 mmd_maybe_candidate(PARROT_INTERP, ARGIN(PMC *pmc), ARGIN(PMC *cl))
1759 INTVAL i, n;
1761 STRING * const _sub = CONST_STRING(interp, "Sub");
1762 STRING * const _multi_sub = CONST_STRING(interp, "MultiSub");
1764 if (VTABLE_isa(interp, pmc, _sub)) {
1765 /* a plain sub stops outer searches */
1766 /* RT #45959 check arity of sub */
1768 VTABLE_push_pmc(interp, cl, pmc);
1769 return 1;
1772 /* not a Sub or MultiSub - ignore */
1773 if (!VTABLE_isa(interp, pmc, _multi_sub))
1774 return 0;
1776 /* ok we have a multi sub pmc, which is an array of candidates */
1777 n = VTABLE_elements(interp, pmc);
1779 for (i = 0; i < n; ++i) {
1780 PMC * const multi_sub = VTABLE_get_pmc_keyed_int(interp, pmc, i);
1782 if (!mmd_is_hidden(interp, multi_sub, cl))
1783 VTABLE_push_pmc(interp, cl, multi_sub);
1786 return 0;
1792 =item C<static int mmd_search_cur_namespace>
1794 Search the current package namespace for matching candidates. Return
1795 TRUE if the MMD search should stop.
1797 =cut
1801 static int
1802 mmd_search_cur_namespace(PARROT_INTERP, ARGIN(STRING *meth), ARGIN(PMC *cl))
1804 PMC * const pmc = Parrot_find_global_cur(interp, meth);
1806 return pmc && mmd_maybe_candidate(interp, pmc, cl);
1812 =item C<static PMC* mmd_get_ns>
1814 RT #48260: Not yet documented!!!
1816 =cut
1820 PARROT_CANNOT_RETURN_NULL
1821 PARROT_WARN_UNUSED_RESULT
1822 static PMC*
1823 mmd_get_ns(PARROT_INTERP)
1825 STRING * const ns_name = CONST_STRING(interp, "__parrot_core");
1826 return Parrot_get_namespace_keyed_str(interp, interp->root_namespace,
1827 ns_name);
1833 =item C<static PMC* mmd_make_ns>
1835 RT #48260: Not yet documented!!!
1837 =cut
1841 PARROT_CANNOT_RETURN_NULL
1842 PARROT_WARN_UNUSED_RESULT
1843 static PMC*
1844 mmd_make_ns(PARROT_INTERP)
1846 STRING * const ns_name = CONST_STRING(interp, "__parrot_core");
1847 return Parrot_make_namespace_keyed_str(interp, interp->root_namespace,
1848 ns_name);
1854 =item C<static void mmd_search_builtin>
1856 Search the builtin namespace for matching candidates. This is the last
1857 search in all the namespaces.
1859 =cut
1863 static void
1864 mmd_search_builtin(PARROT_INTERP, ARGIN(STRING *meth), ARGIN(PMC *cl))
1866 PMC * const ns = mmd_get_ns(interp);
1867 PMC * const pmc = Parrot_find_global_n(interp, ns, meth);
1869 if (pmc)
1870 mmd_maybe_candidate(interp, pmc, cl);
1876 =item C<void mmd_create_builtin_multi_stub>
1878 RT #48260: Not yet documented!!!
1880 =cut
1884 void
1885 mmd_create_builtin_multi_stub(PARROT_INTERP, ARGIN(PMC *ns), INTVAL func_nr)
1887 const char * name = Parrot_MMD_method_name(interp, func_nr);
1889 /* create in constant pool */
1890 STRING * const s = const_string(interp, name);
1891 PMC * multi = constant_pmc_new(interp, enum_class_MultiSub);
1893 VTABLE_set_pmc_keyed_str(interp, ns, s, multi);
1899 =item C<static void mmd_create_builtin_multi_meth_2>
1901 RT #48260: Not yet documented!!!
1903 =cut
1907 static void
1908 mmd_create_builtin_multi_meth_2(PARROT_INTERP, ARGIN(PMC *ns),
1909 INTVAL func_nr, INTVAL type, INTVAL right, funcptr_t func_ptr)
1911 const char *short_name;
1912 char signature[6], val_sig;
1913 STRING *meth_name;
1914 PMC *method, *multi, *_class, *multi_sig;
1916 PARROT_ASSERT(type != enum_class_Null
1917 && type != enum_class_delegate
1918 && type != enum_class_Ref
1919 && type != enum_class_SharedRef
1920 && type != enum_class_deleg_pmc
1921 && type != enum_class_Class
1922 && type != enum_class_Object);
1924 short_name = Parrot_MMD_method_name(interp, func_nr);
1926 /* _int, _float, _str are just native variants of the base multi */
1927 val_sig = 'P';
1929 if (right == enum_type_INTVAL)
1930 val_sig = 'I';
1931 else if (right == enum_type_STRING)
1932 val_sig = 'S';
1933 else if (right == enum_type_FLOATVAL)
1934 val_sig = 'N';
1936 /* create NCI method in left class */
1937 strcpy(signature, "PJP.P");
1938 signature[3] = val_sig;
1940 if (func_nr >= MMD_EQ && func_nr <= MMD_STRCMP) {
1941 signature[0] = 'I';
1942 signature[4] = '\0';
1945 /* implace infix like __i_add don't return a result */
1946 if (memcmp(short_name, "__i_", 4) == 0)
1947 signature[0] = 'v';
1949 meth_name = const_string(interp, short_name);
1950 _class = interp->vtables[type]->pmc_class;
1951 method = Parrot_find_method_direct(interp, _class, meth_name);
1953 if (PMC_IS_NULL(method)) {
1954 /* first method */
1955 method = constant_pmc_new(interp, enum_class_NCI);
1956 VTABLE_set_pointer_keyed_str(interp, method,
1957 const_string(interp, signature),
1958 F2DPTR(func_ptr));
1959 VTABLE_add_method(interp, _class, meth_name, method);
1961 else {
1962 /* multiple methods with that same name */
1963 if (method->vtable->base_type == enum_class_NCI) {
1964 /* convert first to a multi */
1965 multi = constant_pmc_new(interp, enum_class_MultiSub);
1966 VTABLE_add_method(interp, _class, meth_name, multi);
1967 VTABLE_push_pmc(interp, multi, method);
1969 else {
1970 PARROT_ASSERT(method->vtable->base_type == enum_class_MultiSub);
1971 multi = method;
1973 method = constant_pmc_new(interp, enum_class_NCI);
1974 VTABLE_set_pointer_keyed_str(interp, method,
1975 const_string(interp, signature),
1976 F2DPTR(func_ptr));
1977 VTABLE_push_pmc(interp, multi, method);
1980 /* mark MMD */
1981 PObj_get_FLAGS(method) |= PObj_private0_FLAG;
1983 /* attach the multi_signature array to PMC_pmc_val */
1984 multi_sig = constant_pmc_new(interp, enum_class_FixedIntegerArray);
1986 VTABLE_set_integer_native(interp, multi_sig, 2);
1987 VTABLE_set_integer_keyed_int(interp, multi_sig, 0, type);
1988 VTABLE_set_integer_keyed_int(interp, multi_sig, 1, right);
1990 PMC_pmc_val(method) = multi_sig;
1993 * push method onto core multi_sub
1994 * RT #45961 cache the namespace
1996 multi = Parrot_find_global_n(interp, ns, meth_name);
1997 PARROT_ASSERT(multi);
1998 VTABLE_push_pmc(interp, multi, method);
2004 =item C<static void mmd_create_builtin_multi_meth>
2006 RT #48260: Not yet documented!!!
2008 =cut
2012 static void
2013 mmd_create_builtin_multi_meth(PARROT_INTERP, ARGIN(PMC *ns), INTVAL type,
2014 ARGIN(const MMD_init *entry))
2016 mmd_create_builtin_multi_meth_2(interp, ns,
2017 entry->func_nr, type, entry->right, entry->func_ptr);
2023 =item C<void Parrot_mmd_register_table>
2025 Register MMD functions for this PMC type.
2027 =cut
2031 PARROT_API
2032 void
2033 Parrot_mmd_register_table(PARROT_INTERP, INTVAL type,
2034 ARGIN(const MMD_init *mmd_table), INTVAL n)
2036 MMD_table * const table = interp->binop_mmd_funcs;
2037 PMC * const ns = mmd_make_ns(interp);
2038 INTVAL i;
2040 if ((INTVAL)table->x < type && type < enum_class_core_max) {
2042 /* pre-allocate the function table */
2043 for (i = MMD_USER_FIRST - 1; i >= 0; i--) {
2044 mmd_register(interp, i, enum_class_core_max - 1,
2045 enum_class_core_max - 1, NULL);
2047 /* create a MultiSub stub */
2048 mmd_create_builtin_multi_stub(interp, ns, i);
2052 /* register default mmds for this type */
2053 for (i = 0; i < n; ++i) {
2054 #ifdef PARROT_HAS_ALIGNED_FUNCPTR
2055 PARROT_ASSERT((PTR2UINTVAL(mmd_table[i].func_ptr) & 3) == 0);
2056 #endif
2057 mmd_register(interp,
2058 mmd_table[i].func_nr, type,
2059 mmd_table[i].right, mmd_table[i].func_ptr);
2060 mmd_create_builtin_multi_meth(interp, ns, type, mmd_table + i);
2067 =item C<void Parrot_mmd_rebuild_table>
2069 Rebuild the static MMD_table for the given class type and MMD function
2070 number. If C<type> is negative all classes are rebuilt. If C<func_nr> is
2071 negative all MMD functions are rebuilt.
2073 =cut
2077 PARROT_API
2078 void
2079 Parrot_mmd_rebuild_table(PARROT_INTERP, INTVAL type, INTVAL func_nr)
2081 MMD_table *table;
2082 UINTVAL i;
2084 UNUSED(type);
2086 if (!interp->binop_mmd_funcs)
2087 return;
2089 table = interp->binop_mmd_funcs + func_nr;
2091 if (!table)
2092 return;
2094 /* RT #45963 specific parts of table
2095 * the type and it's mro and
2096 * all classes that inherit from type
2098 for (i = 0; i < table->x * table->y; ++i)
2099 table->mmd_funcs[i] = NULL;
2105 =back
2107 =head1 SEE ALSO
2109 F<include/parrot/mmd.h>,
2110 F<http://svn.perl.org/perl6/doc/trunk/design/apo/A12.pod>,
2111 F<http://svn.perl.org/perl6/doc/trunk/design/syn/S12.pod>
2113 =cut
2119 * Local variables:
2120 * c-file-style: "parrot"
2121 * End:
2122 * vim: expandtab shiftwidth=4: