2 Copyright (C) 2003-2006, The Perl Foundation.
7 src/mmd.c - Multimethod dispatch for binary opcode functions
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.
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).
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.
32 C<< binop_mmd_funcs->x >> and C<< ->y >> are table sizes
33 not highest type in table.
43 #include "parrot/parrot.h"
44 #include "parrot/oplib/ops.h"
50 static void mmd_create_builtin_multi_meth_2(Interp
*, PMC
*ns
,
51 INTVAL func_nr
, INTVAL type
, INTVAL right
, funcptr_t func_ptr
);
55 dump_mmd(Interp
*interpreter
, INTVAL function
)
58 UINTVAL offset
, x_funcs
, y_funcs
;
59 MMD_table
* const table
= interpreter
->binop_mmd_funcs
+ function
;
65 for (x
= 0; x
< x_funcs
; ++x
) {
67 printf("%d", (int) x
/ 10);
72 for (y
= 0; y
< y_funcs
; ++y
) {
73 printf("%3d ", (int)y
);
74 for (x
= 0; x
< x_funcs
; ++x
) {
75 offset
= x_funcs
* y
+ x
;
76 func
= table
->mmd_funcs
[offset
];
79 (UINTVAL
)func
& 1 ? 'P' :
84 for (y
= 0; y
< y_funcs
; ++y
) {
85 for (x
= 0; x
< x_funcs
; ++x
) {
86 offset
= x_funcs
* y
+ x
;
87 func
= table
->mmd_funcs
[offset
];
88 if (func
&& func
!= def
&& !((UINTVAL
) func
& 1))
89 printf("%3d %3d: %p\n", (int)x
, (int)y
, (void*) func
);
97 get_mmd_dispatch_type(Interp
*interpreter
, INTVAL func_nr
, INTVAL left_type
,
98 INTVAL right_type
, int *is_pmc
)
100 funcptr_t func
, func_
;
101 UINTVAL offset
, x_funcs
, y_funcs
;
103 MMD_table
*table
= interpreter
->binop_mmd_funcs
+ func_nr
;
108 fprintf(stderr
, "running function %d with left type=%u, right type=%u\n",
109 (int) func_nr
, (unsigned) left_type
, (unsigned) right_type
);
113 assert(left_type
>= 0);
114 assert(right_type
>=0 ||
115 (right_type
>= enum_type_INTVAL
&& right_type
<= enum_type_PMC
));
118 right_type
-= enum_type_INTVAL
;
121 if ((UINTVAL
)left_type
< x_funcs
&& (UINTVAL
)right_type
< y_funcs
) {
122 offset
= x_funcs
* right_type
+ left_type
;
123 func
= table
->mmd_funcs
[offset
];
126 const char *meth_c
= Parrot_MMD_method_name(interpreter
, func_nr
);
127 STRING
*meth_s
= const_string(interpreter
, meth_c
);
128 PMC
*method
= Parrot_MMD_search_default_infix(interpreter
,
129 meth_s
, left_type
, r
);
131 real_exception(interpreter
, 0, 1, "MMD function %s not found "
132 "for types (%d, %d)", meth_c
, left_type
, r
);
133 if (method
->vtable
->base_type
== enum_class_NCI
) {
134 /* C function is at struct_val */
135 func
= D2FPTR(PMC_struct_val(method
));
137 mmd_register(interpreter
, func_nr
, left_type
, r
,
138 PMC_struct_val(method
));
142 func
= D2FPTR(method
);
143 mmd_register_sub(interpreter
, func_nr
, left_type
, r
, method
);
147 *is_pmc
= (UINTVAL
)func
& 3;
148 func_
= (funcptr_t
)((UINTVAL
)func
& ~3);
149 #ifndef PARROT_HAS_ALIGNED_FUNCPTR
153 else if (!is_pmc_ptr(interpreter
, F2DPTR(func_
))) {
163 get_mmd_dispatcher(Interp
*interpreter
, PMC
*left
, PMC
* right
,
164 INTVAL function
, int *is_pmc
)
166 UINTVAL left_type
, right_type
;
167 left_type
= VTABLE_type(interpreter
, left
);
168 right_type
= VTABLE_type(interpreter
, right
);
169 return get_mmd_dispatch_type(interpreter
, function
, left_type
, right_type
,
176 mmd_deref(Interp *interpreter, INTVAL function, PMC *value)>
178 If C<value> is a reference-like PMC, dereference it so we can make an MMD
179 call on the 'real' value.
186 mmd_deref(Interp
*interpreter
, INTVAL function
, PMC
*value
)
188 if (VTABLE_type(interpreter
, value
) != value
->vtable
->base_type
)
189 return VTABLE_get_pmc(interpreter
, value
);
197 mmd_ensure_writable(Interp *, INTVAL function, PMC *pmc)>
199 Make sure C<pmc> is writable enough for C<function>.
206 mmd_ensure_writable(Interp
*interpreter
, INTVAL function
, PMC
*pmc
) {
207 if (!PMC_IS_NULL(pmc
) && (pmc
->vtable
->flags
& VTABLE_IS_READONLY_FLAG
))
208 real_exception(interpreter
, 0, 1, "%s applied to read-only argument",
209 Parrot_MMD_method_name(interpreter
, function
));
216 mmd_dispatch_p_ppp(Interp *,
217 PMC *left, PMC *right, PMC *dest, INTVAL function)>
219 Dispatch to a multimethod that returns a PMC. C<left>, C<right>, and
220 C<dest> are all PMC pointers, while C<func_num> is the MMD table that
221 should be used to do the dispatching.
222 If the C<dest> pointer is NULL, it dispatches two a two-argument function
223 that returns a new C<dest> always.
225 The MMD system will figure out which function should be called based on
226 the types of C<left> and C<right> and call it, passing in C<left>,
227 C<right>, and possibly C<dest> like any other binary vtable function.
230 mmd_dispatch_p_pip(Interp *,
231 PMC *left, INTVAL right, PMC *dest, INTVAL function)>
233 Like above, right argument is a native INTVAL.
236 mmd_dispatch_p_pnp(Interp *,
237 PMC *left, FLOATVAL right, PMC *dest, INTVAL function)>
239 Like above, right argument is a native FLOATVAL.
242 mmd_dispatch_p_psp(Interp *,
243 PMC *left, STRING *right, PMC *dest, INTVAL function)>
245 Like above, right argument is a native STRING *.
250 mmd_dispatch_v_pp(Interp *, PMC *left, PMC *right, INTVAL function)>
253 mmd_dispatch_v_pi(Interp *, PMC *left, INTVAL right, INTVAL function)>
256 mmd_dispatch_v_pn(Interp *, PMC *left, FLOATVAL right, INTVAL function)>
259 mmd_dispatch_v_ps(Interp *, PMC *left, STRING *right, INTVAL function)>
261 Inplace dispatch functions for C<< left <op=> right >>.
266 mmd_dispatch_p_ppp(Interp
*interpreter
,
267 PMC
*left
, PMC
*right
, PMC
*dest
, INTVAL func_nr
)
269 mmd_f_p_ppp real_function
;
273 left
= mmd_deref(interpreter
, func_nr
, left
);
274 right
= mmd_deref(interpreter
, func_nr
, right
);
276 real_function
= (mmd_f_p_ppp
)get_mmd_dispatcher(interpreter
,
277 left
, right
, func_nr
, &is_pmc
);
280 sub
= (PMC
*)real_function
;
282 return Parrot_runops_fromc_args(interpreter
, sub
, "PPPP",
285 return Parrot_runops_fromc_args(interpreter
, sub
, "PPP",
289 return (*real_function
)(interpreter
, left
, right
, dest
);
294 mmd_dispatch_p_pip(Interp
*interpreter
,
295 PMC
*left
, INTVAL right
, PMC
*dest
, INTVAL func_nr
)
300 mmd_f_p_pip real_function
;
302 left
= mmd_deref(interpreter
, func_nr
, left
);
304 left_type
= left
->vtable
->base_type
;
307 (mmd_f_p_pip
)get_mmd_dispatch_type(interpreter
, func_nr
,
308 left_type
, enum_type_INTVAL
,
312 PMC
* const sub
= (PMC
*)real_function
;
314 return Parrot_runops_fromc_args(interpreter
, sub
, "PPIP",
317 return Parrot_runops_fromc_args(interpreter
, sub
, "PPI",
321 return (*real_function
)(interpreter
, left
, right
, dest
);
326 mmd_dispatch_p_pnp(Interp
*interpreter
,
327 PMC
*left
, FLOATVAL right
, PMC
*dest
, INTVAL func_nr
)
329 mmd_f_p_pnp real_function
;
334 left
= mmd_deref(interpreter
, func_nr
, left
);
336 left_type
= left
->vtable
->base_type
;
337 real_function
= (mmd_f_p_pnp
)get_mmd_dispatch_type(interpreter
,
338 func_nr
, left_type
, enum_type_FLOATVAL
, &is_pmc
);
340 sub
= (PMC
*)real_function
;
342 return Parrot_runops_fromc_args(interpreter
, sub
, "PPNP",
345 return Parrot_runops_fromc_args(interpreter
, sub
, "PPN",
349 return (*real_function
)(interpreter
, left
, right
, dest
);
354 mmd_dispatch_p_psp(Interp
*interpreter
,
355 PMC
*left
, STRING
*right
, PMC
*dest
, INTVAL func_nr
)
357 mmd_f_p_psp real_function
;
362 left_type
= left
->vtable
->base_type
;
363 real_function
= (mmd_f_p_psp
)get_mmd_dispatch_type(interpreter
,
364 func_nr
, left_type
, enum_type_STRING
, &is_pmc
);
366 sub
= (PMC
*)real_function
;
368 return Parrot_runops_fromc_args(interpreter
, sub
, "PPSP",
371 return Parrot_runops_fromc_args(interpreter
, sub
, "PPS",
375 return (*real_function
)(interpreter
, left
, right
, dest
);
383 mmd_dispatch_v_pp(Interp
*interpreter
,
384 PMC
*left
, PMC
*right
, INTVAL func_nr
)
386 mmd_f_v_pp real_function
;
391 left
= mmd_deref(interpreter
, func_nr
, left
);
392 right
= mmd_deref(interpreter
, func_nr
, right
);
394 mmd_ensure_writable(interpreter
, func_nr
, left
);
396 real_function
= (mmd_f_v_pp
)get_mmd_dispatcher(interpreter
,
397 left
, right
, func_nr
, &is_pmc
);
400 sub
= (PMC
*)real_function
;
401 Parrot_runops_fromc_args(interpreter
, sub
, "vPP", left
, right
);
404 (*real_function
)(interpreter
, left
, right
);
409 mmd_dispatch_v_pi(Interp
*interpreter
,
410 PMC
*left
, INTVAL right
, INTVAL func_nr
)
412 mmd_f_v_pi real_function
;
417 left
= mmd_deref(interpreter
, func_nr
, left
);
418 mmd_ensure_writable(interpreter
, func_nr
, left
);
420 left_type
= left
->vtable
->base_type
;
421 real_function
= (mmd_f_v_pi
)get_mmd_dispatch_type(interpreter
,
422 func_nr
, left_type
, enum_type_INTVAL
, &is_pmc
);
424 sub
= (PMC
*)real_function
;
425 Parrot_runops_fromc_args(interpreter
, sub
, "vPI", left
, right
);
428 (*real_function
)(interpreter
, left
, right
);
433 mmd_dispatch_v_pn(Interp
*interpreter
,
434 PMC
*left
, FLOATVAL right
, INTVAL func_nr
)
436 mmd_f_v_pn real_function
;
441 left
= mmd_deref(interpreter
, func_nr
, left
);
442 mmd_ensure_writable(interpreter
, func_nr
, left
);
444 left_type
= left
->vtable
->base_type
;
445 real_function
= (mmd_f_v_pn
)get_mmd_dispatch_type(interpreter
,
446 func_nr
, left_type
, enum_type_FLOATVAL
, &is_pmc
);
448 sub
= (PMC
*)real_function
;
449 Parrot_runops_fromc_args(interpreter
, sub
, "vPN", left
, right
);
452 (*real_function
)(interpreter
, left
, right
);
457 mmd_dispatch_v_ps(Interp
*interpreter
,
458 PMC
*left
, STRING
*right
, INTVAL func_nr
)
460 mmd_f_v_ps real_function
;
465 left
= mmd_deref(interpreter
, func_nr
, left
);
466 mmd_ensure_writable(interpreter
, func_nr
, left
);
468 left_type
= VTABLE_type(interpreter
, left
);
469 real_function
= (mmd_f_v_ps
)get_mmd_dispatch_type(interpreter
,
470 func_nr
, left_type
, enum_type_STRING
, &is_pmc
);
472 sub
= (PMC
*)real_function
;
473 Parrot_runops_fromc_args(interpreter
, sub
, "vPS", left
, right
);
476 (*real_function
)(interpreter
, left
, right
);
483 mmd_dispatch_i_pp(Interp *interpreter,
484 PMC *left, PMC *right, INTVAL func_nr)>
486 Like C<mmd_dispatch_p_ppp()>, only it returns an C<INTVAL>. This is used
487 by MMD compare functions.
494 mmd_dispatch_i_pp(Interp
*interpreter
,
495 PMC
*left
, PMC
*right
, INTVAL func_nr
)
497 mmd_f_i_pp real_function
;
502 left
= mmd_deref(interpreter
, func_nr
, left
);
503 right
= mmd_deref(interpreter
, func_nr
, right
);
505 real_function
= (mmd_f_i_pp
)get_mmd_dispatcher(interpreter
,
506 left
, right
, func_nr
, &is_pmc
);
509 sub
= (PMC
*)real_function
;
510 ret
= Parrot_runops_fromc_args_reti(interpreter
, sub
, "IPP",
514 ret
= (*real_function
)(interpreter
, left
, right
);
520 Parrot_run_maybe_mmd_meth(Interp
* interpreter
, PMC
*object
,
528 char *c_meth
, *c_sig
;
529 int ret
= 0, inplace
, compare
;
533 * check if it's a known MMD function
535 c_meth
= string_to_cstring(interpreter
, meth
);
536 c_sig
= string_to_cstring(interpreter
, sig
);
537 if ( (mmd_func
= Parrot_MMD_method_idx(interpreter
, c_meth
)) >= 0) {
538 /* yep - run it instantly */
540 inplace
= c_meth
[2] == 'i' && c_meth
[3] == '_';
541 compare
= mmd_func
>= MMD_EQ
&& mmd_func
<= MMD_STRCMP
;
542 assert(c_sig
[0] == 'O');
546 mmd_dispatch_v_pp(interpreter
,
547 object
, REG_PMC(5), mmd_func
);
549 REG_INT(5) = mmd_dispatch_i_pp(interpreter
,
550 object
, REG_PMC(5), mmd_func
);
552 REG_PMC(5) = mmd_dispatch_p_ppp(interpreter
,
553 object
, REG_PMC(5), NULL
, mmd_func
);
557 mmd_dispatch_v_pi(interpreter
,
558 object
, REG_INT(5), mmd_func
);
560 REG_PMC(5) = mmd_dispatch_p_pip(interpreter
,
561 object
, REG_INT(5), NULL
, mmd_func
);
565 mmd_dispatch_v_pn(interpreter
,
566 object
, REG_NUM(5), mmd_func
);
568 REG_PMC(5) = mmd_dispatch_p_pnp(interpreter
,
569 object
, REG_NUM(5), NULL
, mmd_func
);
573 mmd_dispatch_v_ps(interpreter
,
574 object
, REG_STR(5), mmd_func
);
576 REG_PMC(5) = mmd_dispatch_p_psp(interpreter
,
577 object
, REG_STR(5), NULL
, mmd_func
);
582 string_cstring_free(c_meth
);
583 string_cstring_free(c_sig
);
592 mmd_add_function(Interp *interpreter,
593 INTVAL funcnum, funcptr_t function)>
595 Add a new binary MMD function to the list of functions the MMD system knows
596 of. C<func_num> is the number of the new function. C<function> is ignored.
598 TODO change this to a MMD register interface that takes a function *name*.
605 mmd_add_function(Interp
*interpreter
,
606 INTVAL func_nr
, funcptr_t function
)
609 if (func_nr
>= (INTVAL
)interpreter
->n_binop_mmd_funcs
) {
610 if (interpreter
->binop_mmd_funcs
) {
611 interpreter
->binop_mmd_funcs
=
612 mem_sys_realloc(interpreter
->binop_mmd_funcs
,
613 (func_nr
+ 1) * sizeof(MMD_table
));
616 interpreter
->binop_mmd_funcs
=
617 mem_sys_allocate((func_nr
+ 1) * sizeof(MMD_table
));
620 for (i
= interpreter
->n_binop_mmd_funcs
; i
<= func_nr
; ++i
) {
621 MMD_table
*table
= interpreter
->binop_mmd_funcs
+ i
;
622 table
->x
= table
->y
= 0;
623 table
->mmd_funcs
= NULL
;
625 interpreter
->n_binop_mmd_funcs
= func_nr
+ 1;
633 mmd_expand_x(Interp *interpreter, INTVAL func_nr, INTVAL new_x)>
635 Expands the function table in the X dimension to include C<new_x>.
642 mmd_expand_x(Interp
*interpreter
, INTVAL func_nr
, INTVAL new_x
)
644 funcptr_t
*new_table
;
648 MMD_table
*table
= interpreter
->binop_mmd_funcs
+ func_nr
;
649 char *src_ptr
, *dest_ptr
;
650 size_t old_dp
, new_dp
;
652 /* Is the Y 0? If so, nothing to expand, so just set the X for
659 /* The Y is not zero. Bleah. This means we have to expand the
660 table in an unpleasant way. */
665 /* First, fill in the whole new table with the default function
666 pointer. We only really need to do the new part, but... */
667 new_table
= mem_sys_allocate(sizeof(funcptr_t
) * y
* new_x
);
668 for (i
= 0; i
< y
* new_x
; i
++) {
672 /* Then copy the old table over. We have to do this row by row,
673 because the rows in the old and new tables are different
675 src_ptr
= (char*) table
->mmd_funcs
;
676 dest_ptr
= (char*) new_table
;
677 old_dp
= sizeof(funcptr_t
) * x
;
678 new_dp
= sizeof(funcptr_t
) * new_x
;
679 for (i
= 0; i
< y
; i
++) {
680 memcpy(dest_ptr
, src_ptr
, sizeof(funcptr_t
) * x
);
684 if (table
->mmd_funcs
)
685 mem_sys_free(table
->mmd_funcs
);
687 /* Set the old table to point to the new table */
688 table
->mmd_funcs
= new_table
;
694 mmd_expand_y(Interp *interpreter, INTVAL func_nr, INTVAL new_y)>
696 Expands the function table in the Y direction.
703 mmd_expand_y(Interp
*interpreter
, INTVAL func_nr
, INTVAL new_y
)
705 funcptr_t
*new_table
;
709 MMD_table
*table
= interpreter
->binop_mmd_funcs
+ func_nr
;
715 /* First, fill in the whole new table with the default function
716 pointer. We only really need to do the new part, but... */
717 new_table
= mem_sys_allocate(sizeof(funcptr_t
) * x
* new_y
);
718 for (i
= 0; i
< x
* new_y
; i
++) {
722 /* Then copy the old table over, if it existed in the first place. */
723 if (table
->mmd_funcs
) {
724 memcpy(new_table
, table
->mmd_funcs
,
725 sizeof(funcptr_t
) * x
* y
);
726 mem_sys_free(table
->mmd_funcs
);
729 table
->mmd_funcs
= new_table
;
736 mmd_add_by_class(Interp *interpreter,
738 STRING *left_class, STRING *right_class,
741 Add a function to the MMD table by class name, rather than class number.
742 Handles the case where the named class isn't loaded yet.
744 Adds a new MMD function C<funcptr> to the C<func_num> function table
745 that will be invoked when the left parameter is of class C<left_class>
746 and the right parameter is of class C<right_class>. Both classes are
747 C<STRING *>s that hold the PMC class names for the left and right sides.
748 If either class isn't yet loaded, Parrot will cache the information such
749 that the function will be installed if at some point in the future both
750 classes are available.
752 Currently this is done by just assigning class numbers to the classes,
753 which the classes will pick up and use if they're later loaded, but we
754 may later put the functions into a deferred table that we scan when PMC
755 classes are loaded. Either way, the function will be guaranteed to be
756 installed when it's needed.
758 The function table must exist, but if it is too small, it will
759 automatically be expanded.
766 mmd_add_by_class(Interp
*interpreter
,
768 STRING
*left_class
, STRING
*right_class
,
771 INTVAL left_type
= pmc_type(interpreter
, left_class
);
772 INTVAL right_type
= pmc_type(interpreter
, right_class
);
774 if (left_type
== enum_type_undef
) {
775 left_type
= pmc_register(interpreter
, left_class
);
777 if (right_type
== enum_type_undef
) {
778 right_type
= pmc_register(interpreter
, right_class
);
781 mmd_register(interpreter
, functype
, left_type
, right_type
, funcptr
);
788 mmd_register(Interp *interpreter,
790 INTVAL left_type, INTVAL right_type,
793 Register a function C<funcptr> for MMD function table C<func_num> for classes
794 C<left_type> and C<right_type>. The left and right types are C<INTVAL>s that
795 represent the class ID numbers.
797 The function table must exist, but if it is too small, it will
798 automatically be expanded.
800 Adding a new function to the table can be interestingly non-trivial, so
803 If the left or right types are larger than anything we've seen so far,
804 it means that we have to expand the table. Making Y larger is simple --
805 just realloc with some more rows. Making X larger is less simple. In
806 either case, we punt to other functions.
808 TODO - Currently the MMD system doesn't handle inheritance and best match
809 searching, as it assumes that all PMC types have no parent type. This
810 can be considered a bug, and will be resolved at some point in the
818 mmd_register(Interp
*interpreter
,
820 INTVAL left_type
, INTVAL right_type
,
827 assert(func_nr
< (INTVAL
)interpreter
->n_binop_mmd_funcs
);
828 assert(left_type
>= 0);
829 assert(right_type
>=0 ||
830 (right_type
>= enum_type_INTVAL
&& right_type
<= enum_type_PMC
));
832 right_type
-= enum_type_INTVAL
;
835 table
= interpreter
->binop_mmd_funcs
+ func_nr
;
836 if ((INTVAL
)table
->x
<= left_type
) {
837 mmd_expand_x(interpreter
, func_nr
, left_type
+ 1);
840 if ((INTVAL
)table
->y
<= right_type
) {
841 mmd_expand_y(interpreter
, func_nr
, right_type
+ 1);
844 offset
= table
->x
* right_type
+ left_type
;
845 table
->mmd_funcs
[offset
] = funcptr
;
849 mmd_register_sub(Interp
*interpreter
,
851 INTVAL left_type
, INTVAL right_type
,
855 if (sub
->vtable
->base_type
== enum_class_CSub
) {
856 /* returned from mmdvt_find */
857 mmd_register(interpreter
, func_nr
, left_type
, right_type
,
858 D2FPTR(PMC_struct_val(sub
)));
861 fake
= (PMC
*)((UINTVAL
) sub
| 1);
862 mmd_register(interpreter
, func_nr
, left_type
, right_type
, D2FPTR(fake
));
869 mmd_destroy(Parrot_Interp interpreter)>
871 Frees all the memory allocated used the MMD subsystem.
878 mmd_destroy(Parrot_Interp interpreter
)
880 if (interpreter
->n_binop_mmd_funcs
) {
882 for (i
= 0; i
<interpreter
->n_binop_mmd_funcs
; ++i
) {
883 if (interpreter
->binop_mmd_funcs
[i
].mmd_funcs
) {
884 mem_sys_free(interpreter
->binop_mmd_funcs
[i
].mmd_funcs
);
885 interpreter
->binop_mmd_funcs
[i
].mmd_funcs
= NULL
;
889 mem_sys_free(interpreter
->binop_mmd_funcs
);
890 interpreter
->binop_mmd_funcs
= NULL
;
896 mmd_vtfind(Parrot_Interp interpreter, INTVAL type, INTVAL left, INTVAL right)>
898 Return an MMD PMC function for the given data types. The return result is
899 either a Sub PMC (for PASM MMD functions) or a CSub PMC holding the
900 C function pointer in PMC_struct_val. This CSub is not invocable, you have to
901 wrap it into an NCI function to get the required function arguments passed.
908 mmd_vtfind(Parrot_Interp interpreter
, INTVAL func_nr
,
909 INTVAL left
, INTVAL right
) {
912 funcptr_t func
= get_mmd_dispatch_type(interpreter
,
913 func_nr
, left
, right
, &is_pmc
);
914 if (func
&& is_pmc
) {
915 /* TODO if is_pmc == 2 a Bound_NCI is returned, which actually
916 * should be filled with one of the wrapper functions
918 return (PMC
*)F2DPTR(func
);
920 f
= pmc_new(interpreter
, enum_class_CSub
);
921 PMC_struct_val(f
) = F2DPTR(func
);
926 static PMC
* mmd_arg_tuple_inline(Interp
*, STRING
*signature
, va_list args
);
927 static PMC
* mmd_arg_tuple_func(Interp
*);
928 static PMC
* mmd_search_default(Interp
*, STRING
*meth
, PMC
*arg_tuple
);
929 static PMC
* mmd_search_scopes(Interp
*, STRING
*meth
, PMC
*arg_tuple
);
930 static void mmd_search_classes(Interp
*, STRING
*meth
, PMC
*arg_tuple
, PMC
*,
932 static int mmd_search_lexical(Interp
*, STRING
*meth
, PMC
*arg_tuple
, PMC
*);
933 static int mmd_search_package(Interp
*, STRING
*meth
, PMC
*arg_tuple
, PMC
*);
934 static int mmd_search_global(Interp
*, STRING
*meth
, PMC
*arg_tuple
, PMC
*);
935 static void mmd_search_builtin(Interp
*, STRING
*meth
, PMC
*arg_tuple
, PMC
*);
936 static int mmd_maybe_candidate(Interp
*, PMC
*pmc
, PMC
*arg_tuple
, PMC
*cl
);
937 static void mmd_sort_candidates(Interp
*, PMC
*arg_tuple
, PMC
*cl
);
941 =item C<PMC *Parrot_MMD_search_default_inline(Interp *,
943 STRING *signature, ...)>
945 Default implementation of MMD lookup. The signature contains the letters
946 "INSP" for the argument types. B<PMC> arguments are given in the function call.
948 =item C<PMC *Parrot_MMD_search_default_func(Interp *, STRING *meth)>
950 Default implementation of MMD lookup. The signature contains the letters
951 "INSP" for the argument types. B<PMC> arguments are taken from
959 * TODO move to header, when API is sane
963 Parrot_MMD_search_default_inline(Interp
*interpreter
, STRING
*meth
,
964 STRING
*signature
, ...)
969 * 1) create argument tuple
971 va_start(args
, signature
);
972 arg_tuple
= mmd_arg_tuple_inline(interpreter
, signature
, args
);
975 * default search policy
977 return mmd_search_default(interpreter
, meth
, arg_tuple
);
981 Parrot_MMD_search_default_func(Interp
*interpreter
, STRING
*meth
)
985 * 1) create argument tuple
987 arg_tuple
= mmd_arg_tuple_func(interpreter
);
989 * default search policy
991 return mmd_search_default(interpreter
, meth
, arg_tuple
);
995 Parrot_MMD_search_default_infix(Interp
*interpreter
, STRING
*meth
,
996 INTVAL left_type
, INTVAL right_type
)
1000 arg_tuple
= pmc_new(interpreter
, enum_class_FixedIntegerArray
);
1001 VTABLE_set_integer_native(interpreter
, arg_tuple
, 2);
1002 VTABLE_set_integer_keyed_int(interpreter
, arg_tuple
, 0, left_type
);
1003 VTABLE_set_integer_keyed_int(interpreter
, arg_tuple
, 1, right_type
);
1004 return mmd_search_default(interpreter
, meth
, arg_tuple
);
1009 =item C<PMC* Parrot_MMD_dispatch_func(Interp *, PMC *multi)>
1011 Given a multi sub PMC (usually the multi method of one class) return the
1012 best matching function for the call signature and call arguments according
1020 Parrot_MMD_dispatch_func(Interp
*interpreter
, PMC
*multi
, STRING
*meth
)
1022 PMC
* arg_tuple
, *pmc
;
1023 PMC
*candidate_list
;
1026 * 1) create argument tuple
1028 arg_tuple
= mmd_arg_tuple_func(interpreter
);
1030 n
= VTABLE_elements(interpreter
, multi
);
1034 candidate_list
= VTABLE_clone(interpreter
, multi
);
1036 * 4) go through all parents of MRO and check for methods
1037 * where the first argument matches
1039 * XXX do we need this?
1042 mmd_search_classes(interpreter
, meth
, arg_tuple
, candidate_list
, 1);
1047 mmd_sort_candidates(interpreter
, arg_tuple
, candidate_list
);
1048 n
= VTABLE_elements(interpreter
, candidate_list
);
1052 * 6) Uff, return first one
1054 pmc
= VTABLE_get_pmc_keyed_int(interpreter
, candidate_list
, 0);
1061 static PMC* mmd_arg_tuple_inline(Interp *, STRING *signature, va_list args)>
1063 Return a list of argument types. PMC arguments are specified as function
1067 static PMC* mmd_arg_tuple_func(Interp *)>
1069 Return a list of argument types. PMC arguments are take from registers
1070 according to calling conventions.
1077 mmd_arg_tuple_inline(Interp
*interpreter
, STRING
*signature
, va_list args
)
1079 INTVAL sig_len
, i
, type
;
1080 PMC
* arg_tuple
, *arg
;
1082 arg_tuple
= pmc_new(interpreter
, enum_class_FixedIntegerArray
);
1083 sig_len
= string_length(interpreter
, signature
);
1086 VTABLE_set_integer_native(interpreter
, arg_tuple
, sig_len
);
1087 for (i
= 0; i
< sig_len
; ++i
) {
1088 type
= string_index(interpreter
, signature
, i
);
1091 VTABLE_set_integer_keyed_int(interpreter
, arg_tuple
,
1092 i
, enum_type_INTVAL
);
1095 VTABLE_set_integer_keyed_int(interpreter
, arg_tuple
,
1096 i
, enum_type_FLOATVAL
);
1099 VTABLE_set_integer_keyed_int(interpreter
, arg_tuple
,
1100 i
, enum_type_STRING
);
1104 arg
= va_arg(args
, PMC
*);
1105 type
= VTABLE_type(interpreter
, arg
);
1106 VTABLE_set_integer_keyed_int(interpreter
, arg_tuple
,
1110 internal_exception(1,
1111 "Unknown signature type %d in mmd_arg_tuple", type
);
1120 mmd_arg_tuple_func(Interp
*interpreter
)
1122 INTVAL sig_len
, i
, type
, idx
;
1123 PMC
* arg_tuple
, *arg
;
1124 PMC
* args_array
; /* from recent set_args opcode */
1126 struct PackFile_Constant
**constants
;
1129 * if there is no signature e.g. because of
1130 * m = getattribute l, "__add"
1131 * - we have to return the MultiSub
1132 * - create a BoundMulit
1133 * - dispatch in invoke - yeah ugly
1136 arg_tuple
= pmc_new(interpreter
, enum_class_ResizableIntegerArray
);
1137 args_op
= interpreter
->current_args
;
1140 assert(*args_op
== PARROT_OP_set_args_pc
);
1141 constants
= interpreter
->code
->const_table
->constants
;
1143 args_array
= constants
[*args_op
]->u
.key
;
1144 ASSERT_SIG_PMC(args_array
);
1145 sig_len
= SIG_ELEMS(args_array
);
1150 for (i
= 0; i
< sig_len
; ++i
, ++args_op
) {
1151 type
= SIG_ITEM(args_array
, i
);
1152 /* named don't MMD */
1153 if (type
& PARROT_ARG_NAME
)
1155 /* expand flattening args */
1156 if (type
& PARROT_ARG_FLATTEN
) {
1161 n
= VTABLE_elements(interpreter
, arg
);
1162 for (j
= 0; j
< n
; ++j
) {
1163 PMC
*elem
= VTABLE_get_pmc_keyed_int(interpreter
, arg
, j
);
1164 type
= VTABLE_type(interpreter
, elem
);
1165 VTABLE_push_integer(interpreter
, arg_tuple
, type
);
1169 switch (type
& PARROT_ARG_TYPE_MASK
) {
1170 case PARROT_ARG_INTVAL
:
1171 VTABLE_push_integer(interpreter
, arg_tuple
, enum_type_INTVAL
);
1173 case PARROT_ARG_FLOATVAL
:
1174 VTABLE_push_integer(interpreter
, arg_tuple
, enum_type_FLOATVAL
);
1176 case PARROT_ARG_STRING
:
1177 VTABLE_push_integer(interpreter
, arg_tuple
, enum_type_STRING
);
1179 case PARROT_ARG_PMC
:
1181 if ((type
& PARROT_ARG_CONSTANT
))
1182 arg
= constants
[idx
]->u
.key
;
1185 type
= VTABLE_type(interpreter
, arg
);
1186 VTABLE_push_integer(interpreter
, arg_tuple
, type
);
1189 internal_exception(1,
1190 "Unknown signature type %d in mmd_arg_tuple", type
);
1200 =item C<static PMC* mmd_search_default(Interp *, STRING *meth, PMC *arg_tuple)>
1202 Default implementation of MMD search. Search scopes for candidates, walk the
1203 class hierarchy, sort all candidates by their Manhattan distance, and return
1211 mmd_search_default(Interp
*interpreter
, STRING
*meth
, PMC
*arg_tuple
)
1213 PMC
*candidate_list
, *pmc
;
1218 * 2) create a list of matching functions
1220 candidate_list
= mmd_search_scopes(interpreter
, meth
, arg_tuple
);
1222 * 3) if list is empty fail
1223 * if the first found function is a plain Sub: finito
1225 n
= VTABLE_elements(interpreter
, candidate_list
);
1227 pmc
= VTABLE_get_pmc_keyed_int(interpreter
, candidate_list
, 0);
1228 _sub
= CONST_STRING(interpreter
, "Sub");
1230 if (VTABLE_isa(interpreter
, pmc
, _sub
)) {
1235 * 4) first was a MultiSub - go through all found MultiSubs and check
1236 * the first arguments MRO, add all MultiSubs and plain methods,
1237 * where the first argument matches
1239 mmd_search_classes(interpreter
, meth
, arg_tuple
, candidate_list
, 0);
1240 n
= VTABLE_elements(interpreter
, candidate_list
);
1247 mmd_sort_candidates(interpreter
, arg_tuple
, candidate_list
);
1248 n
= VTABLE_elements(interpreter
, candidate_list
);
1252 * 6) Uff, return first one
1254 pmc
= VTABLE_get_pmc_keyed_int(interpreter
, candidate_list
, 0);
1260 =item C<static void mmd_search_classes(Interp *, STRING *meth,
1261 PMC *arg_tuple, PMC *cl,
1262 INTVAL start_at_parent)>
1264 Search all the classes in all MultiSubs of the candidates C<cl> and return
1265 a list of all candidates. C<start_at_parent> is 0 to start at the class itself
1266 or 1 to search from the first parent class.
1273 mmd_search_classes(Interp
*interpreter
, STRING
*meth
, PMC
*arg_tuple
,
1274 PMC
*cl
, INTVAL start_at_parent
)
1276 PMC
*pmc
, *mro
, *class;
1280 * get the class of the first argument
1282 if (!VTABLE_elements(interpreter
, arg_tuple
))
1284 type1
= VTABLE_get_integer_keyed_int(interpreter
, arg_tuple
, 0);
1287 internal_exception(1, "unimplemented native MMD type");
1288 /* TODO create some class namespace */
1291 mro
= interpreter
->vtables
[type1
]->mro
;
1292 n
= VTABLE_elements(interpreter
, mro
);
1293 for (i
= start_at_parent
; i
< n
; ++i
) {
1294 class = VTABLE_get_pmc_keyed_int(interpreter
, mro
, i
);
1295 pmc
= Parrot_find_method_with_cache(interpreter
, class, meth
);
1298 * mmd_is_hidden would consider all previous candidates
1299 * XXX pass current n so that only candidates from this
1302 if (mmd_maybe_candidate(interpreter
, pmc
, arg_tuple
, cl
))
1310 distance_cmp(Interp
*interpreter
, INTVAL a
, INTVAL b
)
1312 short da
= (short)a
& 0xffff;
1313 short db
= (short)b
& 0xffff;
1314 /* sort first by distance */
1319 /* end then by index in candidate list */
1320 da
= (short)(a
>> 16);
1321 db
= (short)(b
>> 16);
1322 return da
> db
? 1 : da
< db
? -1 : 0;
1325 extern void Parrot_FixedPMCArray_sort(Interp
* , PMC
* pmc
, PMC
*cmp_func
);
1329 =item C<static UINTVAL mmd_distance(Interp *, PMC *pmc, PMC *arg_tuple)>
1331 Create Manhattan Distance of sub C<pmc> against given argument types.
1332 0xffff is the maximum distance
1339 mmd_cvt_to_types(Interp
* interpreter
, PMC
*multi_sig
)
1345 n
= VTABLE_elements(interpreter
, multi_sig
);
1346 ar
= pmc_new(interpreter
, enum_class_FixedIntegerArray
);
1347 VTABLE_set_integer_native(interpreter
, ar
, n
);
1348 for (i
= 0; i
< n
; ++i
) {
1349 sig_elem
= VTABLE_get_pmc_keyed_int(interpreter
, multi_sig
, i
);
1350 if (sig_elem
->vtable
->base_type
== enum_class_String
) {
1351 sig
= VTABLE_get_string(interpreter
, sig_elem
);
1352 if (memcmp(sig
->strstart
, "__VOID", 6) == 0) {
1353 PMC_int_val(ar
)--; /* XXX */
1356 type
= pmc_type(interpreter
, sig
);
1359 type
= pmc_type_p(interpreter
, sig_elem
);
1361 VTABLE_set_integer_keyed_int(interpreter
, ar
, i
, type
);
1366 #define MMD_BIG_DISTANCE 0x7fff
1369 mmd_distance(Interp
*interpreter
, PMC
*pmc
, PMC
*arg_tuple
)
1371 PMC
*multi_sig
, *mro
;
1372 INTVAL i
, n
, args
, dist
, j
, m
;
1373 INTVAL type_sig
, type_call
;
1375 if (pmc
->vtable
->base_type
== enum_class_NCI
) {
1376 /* has to be a builtin multi method */
1377 multi_sig
= PMC_pmc_val(pmc
);
1379 else if (pmc
->vtable
->base_type
== enum_class_Sub
) {
1380 multi_sig
= PMC_sub(pmc
)->multi_signature
;
1385 if (multi_sig
->vtable
->base_type
== enum_class_FixedPMCArray
) {
1386 multi_sig
= PMC_sub(pmc
)->multi_signature
=
1387 mmd_cvt_to_types(interpreter
, multi_sig
);
1391 return MMD_BIG_DISTANCE
;
1392 n
= VTABLE_elements(interpreter
, multi_sig
);
1393 args
= VTABLE_elements(interpreter
, arg_tuple
);
1395 * arg_tuple may have more arguments - only the
1396 * n multi_sig invocants are counted
1399 return MMD_BIG_DISTANCE
;
1402 dist
= 1000; /* XXX arbitrary > max_class_depth * n */
1404 * now go through args
1406 for (i
= 0; i
< n
; ++i
) {
1407 type_sig
= VTABLE_get_integer_keyed_int(interpreter
, multi_sig
, i
);
1408 type_call
= VTABLE_get_integer_keyed_int(interpreter
, arg_tuple
, i
);
1409 if (type_sig
== type_call
)
1412 * different native types are very different, except a PMC
1413 * which matches any PMC
1415 if ((type_sig
<= 0 && type_sig
!= enum_type_PMC
) || type_call
<= 0) {
1416 dist
= MMD_BIG_DISTANCE
;
1420 * now consider MRO of types the signature type has to be somewhere
1421 * in the MRO of the type_call
1423 mro
= interpreter
->vtables
[type_call
]->mro
;
1424 m
= VTABLE_elements(interpreter
, mro
);
1425 for (j
= 0; j
< m
; ++j
) {
1426 PMC
*cl
= VTABLE_get_pmc_keyed_int(interpreter
, mro
, j
);
1427 if (cl
->vtable
->base_type
== type_sig
)
1432 * if the type wasn't in MRO check, if any PMC matches
1433 * in that case use the distance + 1 (of an any PMC parent)
1435 if (j
== m
&& type_sig
!= enum_type_PMC
) {
1436 dist
= MMD_BIG_DISTANCE
;
1444 s1
= Parrot_get_datatype_name(interpreter
, type_sig
);
1446 s1
= interpreter
->vtables
[type_sig
]->whoami
;
1449 s2
= Parrot_get_datatype_name(interpreter
, type_call
);
1451 s2
= interpreter
->vtables
[type_call
]->whoami
;
1453 PIO_eprintf(interpreter
, "arg %d: dist %d sig %Ss arg %Ss\n",
1463 =item C<static void mmd_sort_candidates(Interp *, PMC *arg_tuple, PMC *cl)>
1465 Sort the candidate list C<cl> by Manhattan Distance
1472 mmd_sort_candidates(Interp
*interpreter
, PMC
*arg_tuple
, PMC
*cl
)
1475 PMC
*nci
, *pmc
, *sort
;
1479 n
= VTABLE_elements(interpreter
, cl
);
1481 * create a helper structure:
1482 * bits 0..15 = distance
1483 * bits 16..31 = idx in candidate list
1485 * TODO use half of available INTVAL bits
1487 sort
= pmc_new(interpreter
, enum_class_FixedIntegerArray
);
1488 VTABLE_set_integer_native(interpreter
, sort
, n
);
1489 helper
= PMC_data(sort
);
1490 for (i
= 0; i
< n
; ++i
) {
1491 pmc
= VTABLE_get_pmc_keyed_int(interpreter
, cl
, i
);
1492 d
= mmd_distance(interpreter
, pmc
, arg_tuple
);
1493 helper
[i
] = i
<< 16 | (d
& 0xffff);
1496 * need an NCI function pointer
1498 nci
= pmc_new(interpreter
, enum_class_NCI
);
1499 PMC_struct_val(nci
) = F2DPTR(distance_cmp
);
1503 Parrot_FixedPMCArray_sort(interpreter
, sort
, nci
);
1505 * now helper has a sorted list of indices in the upper 16 bits
1506 * fill helper with sorted candidates
1508 data
= PMC_data(cl
);
1509 for (i
= 0; i
< n
; ++i
) {
1510 INTVAL idx
= helper
[i
] >> 16;
1512 * if the distance is big stop
1514 if ((helper
[i
] & 0xffff) == MMD_BIG_DISTANCE
) {
1515 PMC_int_val(cl
) = i
;
1518 helper
[i
] = (INTVAL
)data
[idx
];
1521 * use helper structure
1523 PMC_data(cl
) = helper
;
1524 PMC_data(sort
) = data
;
1529 =item C<static PMC* mmd_search_scopes(Interp *, STRING *meth, PMC *arg_tuple)>
1531 Search all scopes for MMD candidates matching the arguments given in
1539 mmd_search_scopes(Interp
*interpreter
, STRING
*meth
, PMC
*arg_tuple
)
1541 PMC
*candidate_list
;
1544 candidate_list
= pmc_new(interpreter
, enum_class_ResizablePMCArray
);
1546 * XXX disabled during LexPad / ScratchPad transisition
1547 stop = mmd_search_lexical(interpreter, meth, arg_tuple, candidate_list);
1549 return candidate_list;
1551 stop
= mmd_search_package(interpreter
, meth
, arg_tuple
, candidate_list
);
1553 return candidate_list
;
1554 stop
= mmd_search_global(interpreter
, meth
, arg_tuple
, candidate_list
);
1556 return candidate_list
;
1557 mmd_search_builtin(interpreter
, meth
, arg_tuple
, candidate_list
);
1558 return candidate_list
;
1563 =item C<static int mmd_is_hidden(Interp *, PMC *multi, PMC *cl)>
1565 Check if the given multi sub is hidden by any inner multi sub (already in
1566 the candidate list C<cl>.
1573 mmd_is_hidden(Interp
*interpreter
, PMC
*multi
, PMC
*cl
)
1576 * if the candidate list already has the a sub with the same
1577 * signature (long name), the outer multi is hidden
1586 =item C<static int mmd_maybe_candidate(Interp *, PMC *pmc,
1587 PMC *arg_tuple, PMC *cl)>
1589 If the candidate C<pmc> is a Sub PMC, push it on the candidate list and
1590 return TRUE to stop further search.
1592 If the candidate is a MultiSub remember all matching Subs and return FALSE
1593 to continue searching outer scopes.
1600 mmd_maybe_candidate(Interp
*interpreter
, PMC
*pmc
, PMC
*arg_tuple
, PMC
*cl
)
1602 STRING
*_sub
, *_multi_sub
;
1605 _sub
= CONST_STRING(interpreter
, "Sub");
1606 _multi_sub
= CONST_STRING(interpreter
, "MultiSub");
1608 if (VTABLE_isa(interpreter
, pmc
, _sub
)) {
1609 /* a plain sub stops outer searches */
1610 /* TODO check arity of sub */
1612 VTABLE_push_pmc(interpreter
, cl
, pmc
);
1615 if (!VTABLE_isa(interpreter
, pmc
, _multi_sub
)) {
1616 /* not a Sub or MultiSub - ignore */
1620 * ok we have a multi sub pmc, which is an array of candidates
1622 n
= VTABLE_elements(interpreter
, pmc
);
1623 for (i
= 0; i
< n
; ++i
) {
1626 multi_sub
= VTABLE_get_pmc_keyed_int(interpreter
, pmc
, i
);
1627 if (!mmd_is_hidden(interpreter
, multi_sub
, cl
))
1628 VTABLE_push_pmc(interpreter
, cl
, multi_sub
);
1635 =item C<static int mmd_search_lexical(Interp *, STRING *meth,
1636 PMC *arg_tuple, PMC *cl)>
1638 Search the current lexical pad for matching candidates. Return TRUE if the
1639 MMD search should stop.
1646 mmd_search_lexical(Interp
*interpreter
, STRING
*meth
, PMC
*arg_tuple
, PMC
*cl
)
1654 =item C<static int mmd_search_package(Interp *, STRING *meth,
1655 PMC *arg_tuple, PMC *cl)>
1657 Search the current package namespace for matching candidates. Return
1658 TRUE if the MMD search should stop.
1665 mmd_search_package(Interp
*interpreter
, STRING
*meth
, PMC
*arg_tuple
, PMC
*cl
)
1669 pmc
= Parrot_find_global_cur(interpreter
, meth
);
1671 if (mmd_maybe_candidate(interpreter
, pmc
, arg_tuple
, cl
))
1679 =item C<static int mmd_search_global(Interp *, STRING *meth,
1680 PMC *arg_tuple, PMC *cl)>
1682 Search the global namespace for matching candidates. Return TRUE if
1683 the MMD search should stop.
1690 mmd_search_global(Interp
*interpreter
, STRING
*meth
, PMC
*arg_tuple
, PMC
*cl
)
1694 pmc
= Parrot_find_global_n(interpreter
, interpreter
->root_namespace
, meth
);
1696 if (mmd_maybe_candidate(interpreter
, pmc
, arg_tuple
, cl
))
1704 =item C<static void mmd_search_builtin(Interp *, STRING *meth,
1705 PMC *arg_tuple, PMC *cl)>
1707 Search the builtin namespace for matching candidates. This is the last
1708 search in all the namespaces.
1715 mmd_get_ns(Interp
*interpreter
)
1720 ns_name
= CONST_STRING(interpreter
, "__parrot_core");
1721 ns
= Parrot_get_namespace_keyed_str(interpreter
,
1722 interpreter
->root_namespace
, ns_name
);
1727 mmd_make_ns(Interp
*interpreter
)
1732 ns_name
= CONST_STRING(interpreter
, "__parrot_core");
1733 ns
= Parrot_make_namespace_keyed_str(interpreter
,
1734 interpreter
->root_namespace
, ns_name
);
1739 mmd_search_builtin(Interp
*interpreter
, STRING
*meth
, PMC
*arg_tuple
, PMC
*cl
)
1742 ns
= mmd_get_ns(interpreter
);
1743 pmc
= Parrot_find_global_n(interpreter
, ns
, meth
);
1745 mmd_maybe_candidate(interpreter
, pmc
, arg_tuple
, cl
);
1750 mmd_create_builtin_multi_stub(Interp
*interpreter
, PMC
* ns
, INTVAL func_nr
)
1756 name
= Parrot_MMD_method_name(interpreter
, func_nr
);
1757 /* create in constant pool */
1758 s
= const_string(interpreter
, name
);
1759 multi
= constant_pmc_new(interpreter
, enum_class_MultiSub
);
1760 VTABLE_set_pmc_keyed_str(interpreter
, ns
, s
, multi
);
1765 mmd_create_builtin_multi_meth_2(Interp
*interpreter
, PMC
*ns
,
1766 INTVAL func_nr
, INTVAL type
, INTVAL right
, funcptr_t func_ptr
)
1768 const char *short_name
;
1769 char signature
[6], val_sig
;
1770 STRING
*meth_name
, *_sub
;
1771 PMC
*method
, *multi
, *class, *multi_sig
;
1773 assert (type
!= enum_class_Null
&& type
!= enum_class_delegate
&&
1774 type
!= enum_class_Ref
&& type
!= enum_class_SharedRef
&&
1775 type
!= enum_class_deleg_pmc
&& type
!= enum_class_ParrotClass
&&
1776 type
!= enum_class_ParrotObject
);
1777 short_name
= Parrot_MMD_method_name(interpreter
, func_nr
);
1779 * _int, _float, _str are just native variants of the base
1783 if (right
== enum_type_INTVAL
)
1785 else if (right
== enum_type_STRING
)
1787 else if (right
== enum_type_FLOATVAL
)
1791 * create NCI method in left class
1793 strcpy(signature
, "PJP.P");
1794 signature
[3] = val_sig
;
1795 if (func_nr
>= MMD_EQ
&& func_nr
<= MMD_STRCMP
) {
1797 signature
[4] = '\0';
1799 /* implace infix like __i_add don't return a result */
1800 if (memcmp(short_name
, "__i_", 4) == 0)
1802 meth_name
= const_string(interpreter
, short_name
);
1803 class = interpreter
->vtables
[type
]->class;
1804 method
= Parrot_find_method_direct(interpreter
, class, meth_name
);
1807 method
= constant_pmc_new(interpreter
, enum_class_NCI
);
1808 VTABLE_set_pointer_keyed_str(interpreter
, method
,
1809 const_string(interpreter
, signature
),
1811 VTABLE_add_method(interpreter
, class, meth_name
, method
);
1814 _sub
= CONST_STRING(interpreter
, "Sub");
1815 /* multiple methods with that same name */
1816 if (method
->vtable
->base_type
== enum_class_NCI
) {
1817 /* convert first to a multi */
1818 multi
= constant_pmc_new(interpreter
, enum_class_MultiSub
);
1819 VTABLE_add_method(interpreter
, class, meth_name
, multi
);
1820 VTABLE_push_pmc(interpreter
, multi
, method
);
1823 assert(method
->vtable
->base_type
== enum_class_MultiSub
);
1826 method
= constant_pmc_new(interpreter
, enum_class_NCI
);
1827 VTABLE_set_pointer_keyed_str(interpreter
, method
,
1828 const_string(interpreter
, signature
),
1830 VTABLE_push_pmc(interpreter
, multi
, method
);
1833 PObj_get_FLAGS(method
) |= PObj_private0_FLAG
;
1835 * attach the multi_signature array to PMC_pmc_val
1837 multi_sig
= constant_pmc_new(interpreter
, enum_class_FixedIntegerArray
);
1838 VTABLE_set_integer_native(interpreter
, multi_sig
, 2);
1839 VTABLE_set_integer_keyed_int(interpreter
, multi_sig
, 0, type
);
1840 VTABLE_set_integer_keyed_int(interpreter
, multi_sig
, 1, right
);
1841 PMC_pmc_val(method
) = multi_sig
;
1844 * push method onto core multi_sub
1845 * TODO cache the namespace
1847 multi
= Parrot_find_global_n(interpreter
, ns
,
1848 const_string(interpreter
, short_name
));
1850 VTABLE_push_pmc(interpreter
, multi
, method
);
1854 mmd_create_builtin_multi_meth(Interp
*interpreter
, PMC
*ns
, INTVAL type
,
1855 const MMD_init
*entry
)
1857 mmd_create_builtin_multi_meth_2(interpreter
, ns
,
1858 entry
->func_nr
, type
, entry
->right
, entry
->func_ptr
);
1863 =item C<void Parrot_mmd_register_table(Interp*, INTVAL type,
1864 MMD_init *, INTVAL)>
1866 Register MMD functions for this PMC type.
1874 Parrot_mmd_register_table(Interp
* interpreter
, INTVAL type
,
1875 const MMD_init
*mmd_table
, INTVAL n
)
1881 table
= interpreter
->binop_mmd_funcs
;
1882 ns
= mmd_make_ns(interpreter
);
1883 if ((INTVAL
)table
->x
< type
&& type
< enum_class_core_max
) {
1885 * pre-allocate the function table
1887 for (i
= 0; i
< MMD_USER_FIRST
; ++i
) {
1888 mmd_register(interpreter
, i
, enum_class_core_max
- 1,
1889 enum_class_core_max
- 1, NULL
);
1891 * create a MultiSub stub
1893 mmd_create_builtin_multi_stub(interpreter
, ns
, i
);
1897 * register default mmds for this type
1899 for (i
= 0; i
< n
; ++i
) {
1900 assert((PTR2UINTVAL(mmd_table
[i
].func_ptr
) & 3) == 0);
1901 mmd_register(interpreter
,
1902 mmd_table
[i
].func_nr
, type
,
1903 mmd_table
[i
].right
, mmd_table
[i
].func_ptr
);
1904 mmd_create_builtin_multi_meth(interpreter
, ns
, type
, mmd_table
+ i
);
1911 =item C<void Parrot_mmd_rebuild_table(Interp*, INTVAL type, INTVAL func_nr)>
1913 Rebuild the static MMD_table for the given class type and MMD function
1914 number. If C<type> is negative all classes are rebuilt. If C<func_nr> is
1915 negative all MMD functions are rebuilt.
1922 Parrot_mmd_rebuild_table(Interp
* interpreter
, INTVAL type
, INTVAL func_nr
)
1927 if (!interpreter
->binop_mmd_funcs
)
1929 table
= interpreter
->binop_mmd_funcs
+ func_nr
;
1933 /* TODO specific parts of table
1934 * the type and it's mro and
1935 * all classes that inherit from type
1937 for (i
= 0; i
< table
->x
* table
->y
; ++i
)
1938 table
->mmd_funcs
[i
] = NULL
;
1947 F<include/parrot/mmd.h>,
1948 F<http://svn.perl.org/perl6/doc/trunk/design/apo/A12.pod>,
1949 F<http://svn.perl.org/perl6/doc/trunk/design/syn/S12.pod>
1958 * c-file-style: "parrot"
1960 * vim: expandtab shiftwidth=4: