src/oo.c

   1 /*
   2 Copyright (C) 2007-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 oo.c - Class and object
   8
   9 =head1 DESCRIPTION
  10
  11 Handles class and object manipulation.
  12
  13 =head2 Functions
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #define PARROT_IN_OO_C
  22 #define PARROT_IN_OBJECTS_C /* To get the vtable.h imports we want. */
  23 #include "parrot/parrot.h"
  24 #include "parrot/oo_private.h"
  25 #include "pmc/pmc_class.h"
  26
  27 #include "oo.str"
  28
  29 /* HEADERIZER HFILE: include/parrot/oo.h */
  30
  31 /* HEADERIZER BEGIN: static */
  32 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  33
  34 PARROT_WARN_UNUSED_RESULT
  35 PARROT_CAN_RETURN_NULL
  36 static PMC* C3_merge(PARROT_INTERP, ARGIN(PMC *merge_list))
  37         __attribute__nonnull__(1)
  38         __attribute__nonnull__(2);
  39
  40 static void debug_trace_find_meth(PARROT_INTERP,
  41     ARGIN(const PMC *_class),
  42     ARGIN(const STRING *name),
  43     ARGIN_NULLOK(const PMC *sub))
  44         __attribute__nonnull__(1)
  45         __attribute__nonnull__(2)
  46         __attribute__nonnull__(3);
  47
  48 static void do_initcall(PARROT_INTERP,
  49     ARGIN_NULLOK(PMC* _class),
  50     ARGIN_NULLOK(PMC *object),
  51     ARGIN_NULLOK(PMC *init))
  52         __attribute__nonnull__(1);
  53
  54 static void fail_if_type_exists(PARROT_INTERP, ARGIN(PMC *name))
  55         __attribute__nonnull__(1)
  56         __attribute__nonnull__(2);
  57
  58 PARROT_WARN_UNUSED_RESULT
  59 PARROT_CAN_RETURN_NULL
  60 static PMC * find_method_direct_1(PARROT_INTERP,
  61     ARGIN(PMC *_class),
  62     ARGIN(STRING *method_name))
  63         __attribute__nonnull__(1)
  64         __attribute__nonnull__(2)
  65         __attribute__nonnull__(3);
  66
  67 PARROT_WARN_UNUSED_RESULT
  68 PARROT_CAN_RETURN_NULL
  69 static PMC* find_vtable_meth_ns(PARROT_INTERP,
  70     ARGIN(PMC *ns),
  71     INTVAL vtable_index)
  72         __attribute__nonnull__(1)
  73         __attribute__nonnull__(2);
  74
  75 PARROT_WARN_UNUSED_RESULT
  76 PARROT_CAN_RETURN_NULL
  77 static PMC* get_init_meth(PARROT_INTERP,
  78     ARGIN(PMC *_class),
  79     ARGIN(STRING *prop_str),
  80     ARGOUT(STRING **meth_str))
  81         __attribute__nonnull__(1)
  82         __attribute__nonnull__(2)
  83         __attribute__nonnull__(3)
  84         __attribute__nonnull__(4)
  85         FUNC_MODIFIES(*meth_str);
  86
  87 static void instantiate_object(PARROT_INTERP,
  88     ARGMOD(PMC *object),
  89     ARGIN_NULLOK(PMC *init))
  90         __attribute__nonnull__(1)
  91         __attribute__nonnull__(2)
  92         FUNC_MODIFIES(*object);
  93
  94 static void invalidate_all_caches(PARROT_INTERP)
  95         __attribute__nonnull__(1);
  96
  97 static void invalidate_type_caches(PARROT_INTERP, UINTVAL type)
  98         __attribute__nonnull__(1);
  99
 100 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 101 /* HEADERIZER END: static */
 102
 103 /*
 104
 105 =item C<void Parrot_oo_extract_methods_from_namespace>
 106
 107 Extract methods and vtable overrides from the given namespace and insert them
 108 into the class.
 109
 110 =cut
 111
 112 */
 113
 114 void
 115 Parrot_oo_extract_methods_from_namespace(PARROT_INTERP, ARGIN(PMC *self), ARGIN(PMC *ns))
 116 {
 117    PMC *methods, *vtable_overrides;
 118
 119     /* Pull in methods from the namespace, if any. */
 120    if (PMC_IS_NULL(ns))
 121        return;
 122
 123     /* Import any methods. */
 124     Parrot_PCCINVOKE(interp, ns,
 125         CONST_STRING(interp, "get_associated_methods"), "->P", &methods);
 126
 127     if (!PMC_IS_NULL(methods)) {
 128         PMC * const iter = VTABLE_get_iter(interp, methods);
 129
 130         while (VTABLE_get_bool(interp, iter)) {
 131             STRING * const meth_name = VTABLE_shift_string(interp, iter);
 132             PMC    * const meth_sub  = VTABLE_get_pmc_keyed_str(interp, methods,
 133                 meth_name);
 134             VTABLE_add_method(interp, self, meth_name, meth_sub);
 135         }
 136     }
 137
 138     /* Import any vtable methods. */
 139     Parrot_PCCINVOKE(interp, ns,
 140         CONST_STRING(interp, "get_associated_vtable_methods"), "->P", &vtable_overrides);
 141
 142     if (!PMC_IS_NULL(vtable_overrides)) {
 143         PMC * const iter = VTABLE_get_iter(interp, vtable_overrides);
 144         while (VTABLE_get_bool(interp, iter)) {
 145             STRING * const vtable_index_str = VTABLE_shift_string(interp, iter);
 146             PMC    * const vtable_sub       = VTABLE_get_pmc_keyed_str(interp,
 147                 vtable_overrides, vtable_index_str);
 148
 149             /* Look up the name of the vtable function from the index. */
 150             const INTVAL vtable_index = string_to_int(interp, vtable_index_str);
 151             const char * const meth_c = Parrot_vtable_slot_names[vtable_index];
 152             STRING     *vtable_name   = string_from_cstring(interp, meth_c, 0);
 153
 154             /* Strip leading underscores in the vtable name */
 155             if (string_str_index(interp, vtable_name,
 156                 CONST_STRING(interp, "__"), 0) == 0) {
 157                 vtable_name = string_substr(interp, vtable_name, 2,
 158                     string_length(interp, vtable_name) - 2, NULL, 0);
 159             }
 160
 161             VTABLE_add_vtable_override(interp, self, vtable_name, vtable_sub);
 162         }
 163     }
 164 }
 165
 166
 167 /*
 168
 169 =item C<PMC * Parrot_oo_get_namespace>
 170
 171 Lookup a namespace object from a class PMC.
 172
 173 =cut
 174
 175 */
 176
 177 PARROT_CAN_RETURN_NULL
 178 PARROT_WARN_UNUSED_RESULT
 179 PMC *
 180 Parrot_oo_get_namespace(SHIM_INTERP, ARGIN(const PMC *classobj))
 181 {
 182     Parrot_Class * const _class     = PARROT_CLASS(classobj);
 183     PMC          * const _namespace = _class->_namespace;
 184
 185     if (PMC_IS_NULL(_namespace))
 186         return PMCNULL;
 187
 188     return _namespace;
 189 }
 190
 191
 192 /*
 193
 194 =item C<PMC * Parrot_oo_get_class>
 195
 196 Lookup a class object from a namespace, string, or key PMC.
 197
 198 =cut
 199
 200 */
 201
 202 PARROT_API
 203 PARROT_CAN_RETURN_NULL
 204 PARROT_WARN_UNUSED_RESULT
 205 PMC *
 206 Parrot_oo_get_class(PARROT_INTERP, ARGIN(PMC *key))
 207 {
 208     PMC *classobj = PMCNULL;
 209
 210     if (PObj_is_class_TEST(key))
 211         classobj = key;
 212     else {
 213         /* Fast select of behavior based on type of the lookup key */
 214         switch (key->vtable->base_type) {
 215             case enum_class_NameSpace:
 216                 classobj = VTABLE_get_class(interp, key);
 217                 break;
 218
 219             case enum_class_String:
 220             case enum_class_Key:
 221             case enum_class_ResizableStringArray:
 222                 {
 223                 PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp,
 224                                         interp->HLL_namespace,
 225                                         CONTEXT(interp)->current_HLL);
 226                 PMC * const ns     = Parrot_get_namespace_keyed(interp,
 227                                         hll_ns, key);
 228
 229                 if (!PMC_IS_NULL(ns))
 230                     classobj = VTABLE_get_class(interp, ns);
 231                 }
 232             default:
 233                 break;
 234         }
 235     }
 236
 237     if (PMC_IS_NULL(classobj)) {
 238         /* Look up a low-level class and create a proxy */
 239         const INTVAL type = pmc_type(interp, VTABLE_get_string(interp, key));
 240
 241         /* Reject invalid type numbers */
 242         if (type > interp->n_vtable_max || type <= 0)
 243             return PMCNULL;
 244         else {
 245              PMC * const type_num = pmc_new(interp, enum_class_Integer);
 246              VTABLE_set_integer_native(interp, type_num, type);
 247              classobj = pmc_new_init(interp, enum_class_PMCProxy, type_num);
 248         }
 249     }
 250
 251     return classobj;
 252 }
 253
 254
 255 /*
 256
 257 =item C<PMC * Parrot_oo_get_class_str>
 258
 259 Lookup a class object from a builtin string.
 260
 261 =cut
 262
 263 */
 264
 265 PARROT_API
 266 PARROT_CAN_RETURN_NULL
 267 PARROT_WARN_UNUSED_RESULT
 268 PMC *
 269 Parrot_oo_get_class_str(PARROT_INTERP, ARGIN(STRING *name))
 270 {
 271     PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace,
 272                            CONTEXT(interp)->current_HLL);
 273     PMC * const ns     = Parrot_get_namespace_keyed_str(interp, hll_ns, name);
 274     PMC * const _class = PMC_IS_NULL(ns)
 275                        ? PMCNULL : VTABLE_get_class(interp, ns);
 276
 277     /* Look up a low-level class and create a proxy */
 278     if (PMC_IS_NULL(_class)) {
 279         const INTVAL type = pmc_type(interp, name);
 280
 281         /* Reject invalid type numbers */
 282         if (type > interp->n_vtable_max || type <= 0)
 283             return PMCNULL;
 284         else {
 285             PMC * const type_num = pmc_new(interp, enum_class_Integer);
 286             VTABLE_set_integer_native(interp, type_num, type);
 287             return pmc_new_init(interp, enum_class_PMCProxy, type_num);
 288         }
 289     }
 290
 291     return _class;
 292 }
 293
 294
 295 /*
 296
 297 =item C<PMC * Parrot_oo_newclass_from_str>
 298
 299 Create a new class object from a string name.
 300
 301 =cut
 302
 303 */
 304
 305 PARROT_CAN_RETURN_NULL
 306 PARROT_WARN_UNUSED_RESULT
 307 PMC *
 308 Parrot_oo_newclass_from_str(PARROT_INTERP, ARGIN(STRING *name))
 309 {
 310     PMC * const namearg  = pmc_new(interp, enum_class_String);
 311     PMC        *namehash = pmc_new(interp, enum_class_Hash);
 312     PMC        *classobj;
 313
 314     VTABLE_set_string_native(interp, namearg, name);
 315     VTABLE_set_pmc_keyed_str(interp, namehash, CONST_STRING(interp, "name"), namearg);
 316
 317     classobj = pmc_new_init(interp, enum_class_Class, namehash);
 318
 319     PARROT_ASSERT(classobj);
 320     return classobj;
 321 }
 322
 323
 324 /*
 325
 326 =item C<PMC * Parrot_oo_find_vtable_override_for_class>
 327
 328 Lookup a vtable override in a specific class object.
 329
 330 =cut
 331
 332 */
 333
 334 PARROT_CAN_RETURN_NULL
 335 PARROT_WARN_UNUSED_RESULT
 336 PMC *
 337 Parrot_oo_find_vtable_override_for_class(PARROT_INTERP,
 338         ARGIN(PMC *classobj), ARGIN(STRING *name))
 339 {
 340     Parrot_Class *class_info;
 341     PARROT_ASSERT(PObj_is_class_TEST(classobj));
 342
 343     class_info = PARROT_CLASS(classobj);
 344     return VTABLE_get_pmc_keyed_str(interp, class_info->vtable_overrides, name);
 345 }
 346
 347
 348 /*
 349
 350 =item C<PMC * Parrot_oo_find_vtable_override>
 351
 352 Lookup a vtable override in a class, including any vtable overrides inherited
 353 from parents.
 354
 355 =cut
 356
 357 */
 358
 359 PARROT_CAN_RETURN_NULL
 360 PARROT_WARN_UNUSED_RESULT
 361 PMC *
 362 Parrot_oo_find_vtable_override(PARROT_INTERP,
 363         ARGIN(PMC *classobj), ARGIN(STRING *name))
 364 {
 365     Parrot_Class * const _class = PARROT_CLASS(classobj);
 366
 367     if (VTABLE_exists_keyed_str(interp, _class->parent_overrides, name))
 368         return VTABLE_get_pmc_keyed_str(interp, _class->parent_overrides, name);
 369     else {
 370         /* Walk and search for the vtable method. */
 371         const INTVAL num_classes = VTABLE_elements(interp, _class->all_parents);
 372         PMC         *result      = PMCNULL;
 373         INTVAL       i;
 374
 375         for (i = 0; i < num_classes; i++) {
 376             /* Get the class. */
 377             PMC * const cur_class =
 378                 VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
 379
 380             result = Parrot_oo_find_vtable_override_for_class(interp,
 381                         cur_class, name);
 382
 383             if (!PMC_IS_NULL(result))
 384                 break;
 385         }
 386
 387         VTABLE_set_pmc_keyed_str(interp, _class->parent_overrides, name, result);
 388
 389         return result;
 390     }
 391 }
 392
 393
 394 /*
 395
 396 =item C<INTVAL Parrot_get_vtable_index>
 397
 398 Return index if C<name> is a valid vtable slot name.
 399
 400 =cut
 401
 402 */
 403
 404 PARROT_API
 405 INTVAL
 406 Parrot_get_vtable_index(PARROT_INTERP, ARGIN(const STRING *name))
 407 {
 408     char * const name_c      = string_to_cstring(interp, name);
 409
 410     /* some of the first "slots" don't have names. skip 'em. */
 411     INTVAL low               = PARROT_VTABLE_LOW;
 412     INTVAL high              = NUM_VTABLE_FUNCTIONS + PARROT_VTABLE_LOW;
 413
 414     while (low < high) {
 415         const INTVAL       mid    = (low + high) / 2;
 416         const char * const meth_c = Parrot_vtable_slot_names[mid];
 417
 418         /* RT#45965 slot_names still have __ in front */
 419         const INTVAL cmp = strcmp(name_c, meth_c + 2);
 420
 421         if (cmp == 0) {
 422             string_cstring_free(name_c);
 423             return mid;
 424         }
 425         else if (cmp > 0)
 426             low  = mid + 1;
 427         else
 428             high = mid;
 429     }
 430
 431     string_cstring_free(name_c);
 432
 433     return -1;
 434 }
 435
 436
 437 /*
 438
 439 =item C<static PMC* find_vtable_meth_ns>
 440
 441 Return Sub PMC if a method with the vtable name exists in ns
 442
 443 =cut
 444
 445 */
 446
 447 PARROT_WARN_UNUSED_RESULT
 448 PARROT_CAN_RETURN_NULL
 449 static PMC*
 450 find_vtable_meth_ns(PARROT_INTERP, ARGIN(PMC *ns), INTVAL vtable_index)
 451 {
 452     return VTABLE_get_pmc_keyed_int(interp, ns, vtable_index);
 453 }
 454
 455
 456 /*
 457
 458 =item C<STRING* readable_name>
 459
 460 Given a String or Key PMC return the STRING* representation
 461
 462 RT#45967 this function, key_set_to_string, and the key PMC get_repr should be
 463 consolidated
 464
 465 =cut
 466
 467 */
 468
 469 PARROT_API
 470 PARROT_WARN_UNUSED_RESULT
 471 PARROT_CANNOT_RETURN_NULL
 472 STRING*
 473 readable_name(PARROT_INTERP, ARGIN(PMC *name))
 474 {
 475     PMC    *array;
 476
 477     if (name->vtable->base_type == enum_class_String)
 478         return VTABLE_get_string(interp, name);
 479
 480     array   = pmc_new(interp, enum_class_ResizableStringArray);
 481
 482     PARROT_ASSERT(name->vtable->base_type == enum_class_Key);
 483
 484     while (name) {
 485         VTABLE_push_string(interp, array, key_string(interp, name));
 486         name = key_next(interp, name);
 487     }
 488
 489     return string_join(interp, CONST_STRING(interp, ";"), array);
 490 }
 491
 492
 493 /*
 494
 495 =item C<const char* Parrot_MMD_method_name>
 496
 497 Return the method name for the given MMD enum.
 498
 499 =cut
 500
 501 */
 502
 503 PARROT_API
 504 PARROT_PURE_FUNCTION
 505 PARROT_CAN_RETURN_NULL
 506 const char*
 507 Parrot_MMD_method_name(SHIM_INTERP, INTVAL idx)
 508 {
 509     PARROT_ASSERT(idx >= 0);
 510
 511     if (idx >= MMD_USER_FIRST)
 512         return NULL;
 513
 514     return Parrot_mmd_func_names[idx];
 515 }
 516
 517
 518 /*
 519
 520 =item C<INTVAL Parrot_MMD_method_idx>
 521
 522 Return the MMD function number for method name or -1 on failure.
 523
 524 RT#45973 allow dynamic expansion at runtime.
 525
 526 =cut
 527
 528 */
 529
 530 PARROT_API
 531 PARROT_PURE_FUNCTION
 532 INTVAL
 533 Parrot_MMD_method_idx(SHIM_INTERP, ARGIN(const char *name))
 534 {
 535     INTVAL i;
 536
 537     for (i = 0; i < MMD_USER_FIRST; ++i) {
 538         if (STREQ(Parrot_mmd_func_names[i], name))
 539             return i;
 540     }
 541
 542     return -1;
 543 }
 544
 545
 546 /*
 547
 548 =item C<PMC * Parrot_class_lookup>
 549
 550 Looks for the class named C<class_name> and returns it if it exists.
 551 Otherwise it returns C<PMCNULL>.
 552
 553 =cut
 554
 555 */
 556
 557 PARROT_API
 558 PARROT_CAN_RETURN_NULL
 559 PARROT_WARN_UNUSED_RESULT
 560 PMC *
 561 Parrot_class_lookup(PARROT_INTERP, ARGIN(STRING *class_name))
 562 {
 563     const INTVAL type = pmc_type(interp, class_name);
 564     PMC         *pmc;
 565
 566     if (type <= 0)
 567         return PMCNULL;
 568
 569     pmc = interp->vtables[type]->pmc_class;
 570     PARROT_ASSERT(pmc);
 571     return pmc;
 572 }
 573
 574
 575 /*
 576
 577 =item C<PMC * Parrot_class_lookup_p>
 578
 579 Looks for the class named C<class_name> and returns it if it exists.
 580 Otherwise it returns C<PMCNULL>.
 581
 582 =cut
 583
 584 */
 585
 586 PARROT_CAN_RETURN_NULL
 587 PARROT_WARN_UNUSED_RESULT
 588 PMC *
 589 Parrot_class_lookup_p(PARROT_INTERP, ARGIN(PMC *class_name))
 590 {
 591     const INTVAL type = pmc_type_p(interp, class_name);
 592     PMC         *pmc;
 593
 594     if (type <= 0)
 595         return PMCNULL;
 596
 597     pmc = interp->vtables[type]->pmc_class;
 598     PARROT_ASSERT(pmc);
 599     return pmc;
 600 }
 601
 602
 603 /*
 604
 605 =item C<static void fail_if_type_exists>
 606
 607 This function throws an exception if a PMC or class with the same name *
 608 already exists in the global type registry. The global type registry
 609 will go away eventually, but this allows the new object metamodel to
 610 interact with the old one until it does.
 611
 612 =cut
 613
 614 */
 615
 616 static void
 617 fail_if_type_exists(PARROT_INTERP, ARGIN(PMC *name))
 618 {
 619     INTVAL      type;
 620
 621     PMC * const classname_hash = interp->class_hash;
 622     PMC * const type_pmc       = (PMC *)VTABLE_get_pointer_keyed(interp,
 623                                         classname_hash, name);
 624
 625     if (PMC_IS_NULL(type_pmc)
 626     ||  type_pmc->vtable->base_type == enum_class_NameSpace)
 627         type = 0;
 628     else
 629         type = VTABLE_get_integer(interp, type_pmc);
 630
 631     if (type > enum_type_undef)
 632         real_exception(interp, NULL, INVALID_OPERATION,
 633                 "Class '%Ss' already registered!\n",
 634                 string_escape_string(interp, VTABLE_get_string(interp, name)));
 635
 636     if (type < enum_type_undef)
 637         real_exception(interp, NULL, INVALID_OPERATION,
 638                 "native type with name '%s' already exists - "
 639                 "can't register Class", data_types[type].name);
 640 }
 641
 642
 643 /*
 644
 645 =item C<INTVAL Parrot_oo_register_type>
 646
 647 This function registers a type in the global registry, first checking if it
 648 already exists. The global type registry will go away eventually, but this
 649 allows the new object metamodel to interact with the old one until it does.
 650
 651 =cut
 652
 653 */
 654
 655 PARROT_WARN_UNUSED_RESULT
 656 INTVAL
 657 Parrot_oo_register_type(PARROT_INTERP, ARGIN(PMC *name))
 658 {
 659     INTVAL type;
 660     PMC   *classname_hash, *item;
 661
 662     fail_if_type_exists(interp, name);
 663
 664     /* Type doesn't exist, so go ahead and register it. Lock interpreter so
 665      * pt_shared_fixup() can safely do a type lookup. */
 666     LOCK_INTERPRETER(interp);
 667     classname_hash = interp->class_hash;
 668
 669     type = interp->n_vtable_max++;
 670
 671     /* Have we overflowed the table? */
 672     if (type >= interp->n_vtable_alloced)
 673         parrot_realloc_vtables(interp);
 674
 675     /* set entry in name->type hash */
 676     item              = pmc_new(interp, enum_class_Integer);
 677     PMC_int_val(item) = type;
 678
 679     VTABLE_set_pmc_keyed(interp, classname_hash, name, item);
 680     UNLOCK_INTERPRETER(interp);
 681
 682     return type;
 683 }
 684
 685
 686 /*
 687
 688 =item C<static PMC* get_init_meth>
 689
 690 RT#48260: Not yet documented!!!
 691
 692 =cut
 693
 694 */
 695
 696 PARROT_WARN_UNUSED_RESULT
 697 PARROT_CAN_RETURN_NULL
 698 static PMC*
 699 get_init_meth(PARROT_INTERP, ARGIN(PMC *_class),
 700         ARGIN(STRING *prop_str), ARGOUT(STRING **meth_str))
 701 {
 702     STRING     *meth;
 703     HashBucket *b;
 704     PMC        *props, *ns, *method;
 705
 706     *meth_str = NULL;
 707 #if 0
 708     PMC * const prop = VTABLE_getprop(interp, _class, prop_str);
 709     if (!VTABLE_defined(interp, prop))
 710         return PMCNULL;
 711     meth = VTABLE_get_string(interp, prop);
 712 #else
 713     props = PMC_metadata(_class);
 714     if (!props)
 715         return PMCNULL;
 716
 717     b = parrot_hash_get_bucket(interp,
 718                 (Hash*) PMC_struct_val(props), prop_str);
 719     if (!b)
 720         return PMCNULL;
 721
 722     meth = PMC_str_val((PMC*) b->value);
 723 #endif
 724
 725     *meth_str = meth;
 726     ns        = VTABLE_get_namespace(interp, _class);
 727     method    = VTABLE_get_pmc_keyed_str(interp, ns, meth);
 728
 729     return method;
 730 }
 731
 732
 733 /*
 734
 735 =item C<static void do_initcall>
 736
 737 RT#48260: Not yet documented!!!
 738
 739 =cut
 740
 741 */
 742
 743 static void
 744 do_initcall(PARROT_INTERP, ARGIN_NULLOK(PMC* _class), ARGIN_NULLOK(PMC *object),
 745         ARGIN_NULLOK(PMC *init))
 746 {
 747     PMC * const classsearch_array = _class->vtable->mro;
 748     INTVAL      i, nparents;
 749
 750     /*
 751      * 1) if class has a CONSTRUCT property run it on the object
 752      *    no redispatch
 753      *
 754      * RT#45985 isn't CONSTRUCT for creating new objects?
 755      */
 756     STRING *meth_str;
 757     PMC    *meth = get_init_meth(interp, _class,
 758             CONST_STRING(interp, "CONSTRUCT"), &meth_str);
 759     int     default_meth;
 760
 761     if (!PMC_IS_NULL(meth)) {
 762         if (init)
 763             Parrot_run_meth_fromc_args(interp, meth,
 764                     object, meth_str, "vP", init);
 765         else
 766             Parrot_run_meth_fromc_args(interp, meth,
 767                     object, meth_str, "v");
 768     }
 769     /*
 770      * 2. if class has a BUILD property call it for all classes
 771      *    in reverse search order - this class last.
 772      *
 773      *    Note: mro contains this class as first element
 774      */
 775     nparents = VTABLE_elements(interp, classsearch_array);
 776
 777     for (i = nparents - 1; i >= 0; --i) {
 778         PMC * const parent_class =
 779             VTABLE_get_pmc_keyed_int(interp, classsearch_array, i);
 780
 781         /* if it's a PMC, we put one PMC of that type into
 782          * the attribute slot #0 and call init() on that PMC */
 783         if (!PObj_is_class_TEST(parent_class)) {
 784             PMC *attr, *next_parent;
 785             SLOTTYPE *obj_data;
 786
 787             /* but only if init isn't inherited
 788              * or rather just on the last non-class parent */
 789             PARROT_ASSERT(i >= 1);
 790             next_parent = VTABLE_get_pmc_keyed_int(interp,
 791                     classsearch_array, i - 1);
 792
 793             if (!PObj_is_class_TEST(next_parent))
 794                 continue;
 795
 796             attr     = pmc_new_noinit(interp, parent_class->vtable->base_type);
 797             obj_data = PMC_data_typed(object, SLOTTYPE *);
 798             set_attrib_num(object, obj_data, 0, attr);
 799             VTABLE_init(interp, attr);
 800             continue;
 801         }
 802
 803         meth = get_init_meth(interp, parent_class,
 804                 CONST_STRING(interp, "BUILD"), &meth_str);
 805
 806         /* no method found and no BUILD property set? */
 807         if (PMC_IS_NULL(meth) && meth_str == NULL) {
 808             PMC   *ns;
 809             INTVAL vtable_index;
 810
 811             /* use __init or __init_pmc (depending on if an argument was passed)
 812              * as fallback constructor method, if it exists */
 813             if (init)
 814                 meth_str = CONST_STRING(interp, "init_pmc");
 815             else
 816                 meth_str = CONST_STRING(interp, "init");
 817
 818             ns   = VTABLE_get_namespace(interp, parent_class);
 819
 820             /* can't use find_method, it walks mro */
 821             vtable_index = Parrot_get_vtable_index(interp, meth_str);
 822             meth         = find_vtable_meth_ns(interp, ns, vtable_index);
 823             default_meth = 1;
 824         }
 825         else
 826             default_meth = 0;
 827
 828         if (!PMC_IS_NULL(meth)) {
 829             if (init)
 830                 Parrot_run_meth_fromc_args(interp, meth,
 831                         object, meth_str, "vP", init);
 832             else
 833                 Parrot_run_meth_fromc_args(interp, meth,
 834                         object, meth_str, "v");
 835         }
 836         else if (meth_str != NULL &&
 837                 string_length(interp, meth_str) != 0 && !default_meth) {
 838             real_exception(interp, NULL, METH_NOT_FOUND,
 839                     "Class BUILD method ('%Ss') not found", meth_str);
 840         }
 841     }
 842 }
 843
 844
 845 /*
 846
 847 =item C<void Parrot_instantiate_object_init>
 848
 849 Creates a Parrot object. Takes a passed-in class PMC that has sufficient
 850 information to describe the layout of the object and makes the object.
 851
 852 =cut
 853
 854 */
 855
 856 PARROT_API
 857 void
 858 Parrot_instantiate_object_init(PARROT_INTERP, ARGIN(PMC *object), ARGIN(PMC *init))
 859 {
 860     instantiate_object(interp, object, init);
 861 }
 862
 863
 864 /*
 865
 866 =item C<void Parrot_instantiate_object>
 867
 868 Wrapper for instantiate_object, passing NULL as initialization.
 869 Returns a new Parrot object.
 870
 871 =cut
 872
 873 */
 874
 875 PARROT_API
 876 void
 877 Parrot_instantiate_object(PARROT_INTERP, ARGMOD(PMC *object))
 878 {
 879     instantiate_object(interp, object, NULL);
 880 }
 881
 882
 883 /*
 884
 885 =item C<static void instantiate_object>
 886
 887 RT#48260: Not yet documented!!!
 888
 889 =cut
 890
 891 */
 892
 893 static void
 894 instantiate_object(PARROT_INTERP, ARGMOD(PMC *object), ARGIN_NULLOK(PMC *init))
 895 {
 896     SLOTTYPE *new_object_array;
 897     INTVAL    attrib_count, i;
 898
 899     PMC * const _class = object->vtable->pmc_class;
 900
 901     /* put in the real vtable */
 902     PMC * const vtable_pmc = get_attrib_num((SLOTTYPE *)PMC_data(_class),
 903                                             PCD_OBJECT_VTABLE);
 904     object->vtable         = (VTABLE *)PMC_struct_val(vtable_pmc);
 905
 906     /* Grab the attribute count from the class */
 907     attrib_count = CLASS_ATTRIB_COUNT(_class);
 908
 909     /* Build the array that hangs off the new object */
 910     /* First presize it */
 911     set_attrib_array_size(object, attrib_count);
 912     new_object_array = PMC_data_typed(object, SLOTTYPE *);
 913
 914     /* fill with PMCNULL, so that access doesn't segfault */
 915     for (i = 0; i < attrib_count; ++i)
 916         set_attrib_num(object, new_object_array, i, PMCNULL);
 917
 918     /* turn marking on */
 919     set_attrib_flags(object);
 920
 921     /* We are an object now */
 922     PObj_is_object_SET(object);
 923
 924     /* We really ought to call the class init routines here...
 925      * this assumes that an object isa delegate */
 926     do_initcall(interp, _class, object, init);
 927 }
 928
 929
 930 /*
 931
 932 =item C<PMC * Parrot_remove_parent>
 933
 934 This currently does nothing but return C<PMCNULL>.
 935 RT#50646
 936
 937 =cut
 938
 939 */
 940
 941 PARROT_API
 942 PARROT_IGNORABLE_RESULT
 943 PARROT_CAN_RETURN_NULL
 944 PMC *
 945 Parrot_remove_parent(PARROT_INTERP, ARGIN(PMC *removed_class),
 946         ARGIN(PMC *existing_class))
 947 {
 948     UNUSED(interp);
 949     UNUSED(removed_class);
 950     UNUSED(existing_class);
 951
 952     return PMCNULL;
 953 }
 954
 955
 956 /*
 957
 958 =item C<void mark_object_cache>
 959
 960 Marks all PMCs in the object method cache as live.  This shouldn't strictly be
 961 necessary, as they're likely all reachable from namespaces and classes, but
 962 it's unlikely to hurt anything except mark phase performance.
 963
 964 =cut
 965
 966 */
 967
 968 #define TBL_SIZE_MASK 0x1ff   /* x bits 2..10 */
 969 #define TBL_SIZE (1 + TBL_SIZE_MASK)
 970
 971 void
 972 mark_object_cache(PARROT_INTERP)
 973 {
 974     Caches * const mc = interp->caches;
 975     UINTVAL type, entry;
 976
 977     if (!mc)
 978         return;
 979
 980     for (type = 0; type < mc->mc_size; type++) {
 981         if (!mc->idx[type])
 982             continue;
 983
 984         for (entry = 0; entry < TBL_SIZE; ++entry) {
 985             Meth_cache_entry *e = mc->idx[type][entry];
 986             while (e) {
 987                 pobject_lives(interp, (PObj *)e->pmc);
 988                 e = e->next;
 989             }
 990         }
 991     }
 992 }
 993
 994
 995 /*
 996
 997 =item C<void init_object_cache>
 998
 999 Allocate memory for object cache.
1000
1001 =cut
1002
1003 */
1004
1005 void
1006 init_object_cache(PARROT_INTERP)
1007 {
1008     Caches * const mc = interp->caches = mem_allocate_zeroed_typed(Caches);
1009     mc->idx = NULL;
1010 }
1011
1012
1013 /*
1014
1015 =item C<void destroy_object_cache>
1016
1017 RT#48260: Not yet documented!!!
1018
1019 =cut
1020
1021 */
1022
1023 void
1024 destroy_object_cache(PARROT_INTERP)
1025 {
1026     UINTVAL i;
1027     Caches * const mc = interp->caches;
1028
1029     /* mc->idx[type][bits] = e; */
1030     for (i = 0; i < mc->mc_size; i++) {
1031         if (mc->idx[i])
1032             invalidate_type_caches(interp, i);
1033     }
1034
1035     mem_sys_free(mc->idx);
1036     mem_sys_free(mc);
1037 }
1038
1039
1040 /*
1041
1042 =item C<static void invalidate_type_caches>
1043
1044 RT#48260: Not yet documented!!!
1045
1046 =cut
1047
1048 */
1049
1050 static void
1051 invalidate_type_caches(PARROT_INTERP, UINTVAL type)
1052 {
1053     Caches * const mc = interp->caches;
1054     INTVAL i;
1055
1056     if (!mc)
1057         return;
1058
1059     /* is it a valid entry */
1060     if (type >= mc->mc_size || !mc->idx[type])
1061         return;
1062
1063     for (i = 0; i < TBL_SIZE; ++i) {
1064         Meth_cache_entry *e = mc->idx[type][i];
1065         while (e) {
1066             Meth_cache_entry * const next = e->next;
1067             mem_sys_free(e);
1068             e = next;
1069         }
1070     }
1071
1072     mem_sys_free(mc->idx[type]);
1073     mc->idx[type] = NULL;
1074 }
1075
1076
1077 /*
1078
1079 =item C<static void invalidate_all_caches>
1080
1081 RT#48260: Not yet documented!!!
1082
1083 =cut
1084
1085 */
1086
1087 static void
1088 invalidate_all_caches(PARROT_INTERP)
1089 {
1090     UINTVAL i;
1091     for (i = 1; i < (UINTVAL)interp->n_vtable_max; ++i)
1092         invalidate_type_caches(interp, i);
1093 }
1094
1095
1096 /*
1097
1098 =item C<void Parrot_invalidate_method_cache>
1099
1100 Clear method cache for the given class. If class is NULL, caches for
1101 all classes are invalidated.
1102
1103 =cut
1104
1105 */
1106
1107 PARROT_API
1108 void
1109 Parrot_invalidate_method_cache(PARROT_INTERP, ARGIN_NULLOK(STRING *_class), ARGIN(STRING *meth))
1110 {
1111     INTVAL type;
1112
1113     /* during interp creation and NCI registration the class_hash
1114      * isn't yet up */
1115     if (!interp->class_hash)
1116         return;
1117
1118     if (interp->resume_flag & RESUME_INITIAL)
1119         return;
1120
1121     if (!_class) {
1122         invalidate_all_caches(interp);
1123         return;
1124     }
1125
1126     type = pmc_type(interp, _class);
1127
1128     if (type == 0)
1129         invalidate_all_caches(interp);
1130     else if (type > 0)
1131         invalidate_type_caches(interp, (UINTVAL)type);
1132 }
1133
1134
1135 /*
1136  * quick'n'dirty method cache
1137  * RT#45987: use a hash if method_name is not constant
1138  *       i.e. from obj.$Sreg(args)
1139  *       If this hash is implemented mark it during DOD
1140  */
1141
1142 /*
1143
1144 =item C<PMC * Parrot_find_method_direct>
1145
1146 Find a method PMC for a named method, given the class PMC, current
1147 interpreter, and name of the method. Don't use a possible method cache.
1148
1149 =cut
1150
1151 */
1152
1153 PARROT_API
1154 PARROT_CAN_RETURN_NULL
1155 PARROT_WARN_UNUSED_RESULT
1156 PMC *
1157 Parrot_find_method_direct(PARROT_INTERP, ARGIN(PMC *_class), ARGIN(STRING *method_name))
1158 {
1159     PMC * const found = find_method_direct_1(interp, _class, method_name);
1160
1161     if (!PMC_IS_NULL(found))
1162         return found;
1163
1164
1165     if (!string_equal(interp, method_name, CONST_STRING(interp, "__get_string")))
1166         return find_method_direct_1(interp, _class,
1167             CONST_STRING(interp, "__get_repr"));
1168
1169     return PMCNULL;
1170 }
1171
1172
1173 /*
1174
1175 =item C<PMC * Parrot_find_method_with_cache>
1176
1177 Find a method PMC for a named method, given the class PMC, current
1178 interp, and name of the method.
1179
1180 This routine should use the current scope's method cache, if there is
1181 one. If not, it creates a new method cache. Or, rather, it will when
1182 we've got that bit working. For now it unconditionally goes and looks up
1183 the name in the global stash.
1184
1185 =cut
1186
1187 */
1188
1189 PARROT_API
1190 PARROT_CAN_RETURN_NULL
1191 PARROT_WARN_UNUSED_RESULT
1192 PMC *
1193 Parrot_find_method_with_cache(PARROT_INTERP, ARGIN(PMC *_class), ARGIN(STRING *method_name))
1194 {
1195     UINTVAL type, bits;
1196
1197     Caches           *mc;
1198     Meth_cache_entry *e, *old;
1199
1200     PARROT_ASSERT(method_name != 0);
1201
1202 #if DISABLE_METH_CACHE
1203     return Parrot_find_method_direct(interp, _class, method_name);
1204 #endif
1205
1206     if (! PObj_constant_TEST(method_name))
1207         return Parrot_find_method_direct(interp, _class, method_name);
1208
1209     mc   = interp->caches;
1210     type = _class->vtable->base_type;
1211     bits = (((UINTVAL) method_name->strstart) >> 2) & TBL_SIZE_MASK;
1212
1213     if (type >= mc->mc_size) {
1214         if (mc->idx) {
1215             mc->idx = (Meth_cache_entry ***)mem_sys_realloc_zeroed(mc->idx,
1216                 sizeof (Meth_cache_entry ***) * (type + 1),
1217                 sizeof (Meth_cache_entry ***) * mc->mc_size);
1218         }
1219         else {
1220             mc->idx = (Meth_cache_entry ***)mem_sys_allocate_zeroed(
1221                 sizeof (Meth_cache_entry ***) * (type + 1));
1222         }
1223         mc->mc_size = type + 1;
1224     }
1225
1226     if (!mc->idx[type]) {
1227         mc->idx[type] = (Meth_cache_entry **)mem_sys_allocate_zeroed(
1228             sizeof (Meth_cache_entry *) * TBL_SIZE);
1229     }
1230
1231     e   = mc->idx[type][bits];
1232     old = NULL;
1233
1234     while (e && e->strstart != method_name->strstart) {
1235         old = e;
1236         e   = e->next;
1237     }
1238
1239     if (!e) {
1240         /* when here no or no correct entry was at [bits] */
1241         e     = mem_allocate_typed(Meth_cache_entry);
1242
1243         if (old)
1244             old->next = e;
1245         else
1246             mc->idx[type][bits] = e;
1247
1248         e->pmc      = Parrot_find_method_direct(interp, _class, method_name);
1249         e->next     = NULL;
1250         e->strstart = method_name->strstart;
1251     }
1252
1253     return e->pmc;
1254 }
1255
1256
1257 /*
1258
1259 =item C<static void debug_trace_find_meth>
1260
1261 RT#48260: Not yet documented!!!
1262
1263 =cut
1264
1265 */
1266
1267 #ifdef NDEBUG
1268 #  define TRACE_FM(i, c, m, sub)
1269 #else
1270 #  define TRACE_FM(i, c, m, sub) \
1271     debug_trace_find_meth((i), (c), (m), (sub))
1272
1273 static void
1274 debug_trace_find_meth(PARROT_INTERP, ARGIN(const PMC *_class),
1275         ARGIN(const STRING *name), ARGIN_NULLOK(const PMC *sub))
1276 {
1277     STRING *class_name;
1278     const char *result;
1279     Interp *tracer;
1280
1281     if (!Interp_trace_TEST(interp, PARROT_TRACE_FIND_METH_FLAG))
1282         return;
1283
1284     if (PObj_is_class_TEST(_class)) {
1285         SLOTTYPE * const class_array = PMC_data_typed(_class, SLOTTYPE *);
1286         PMC *const class_name_pmc = get_attrib_num(class_array, PCD_CLASS_NAME);
1287         class_name = PMC_str_val(class_name_pmc);
1288     }
1289     else
1290         class_name = _class->vtable->whoami;
1291
1292     if (sub) {
1293         if (sub->vtable->base_type == enum_class_NCI)
1294             result = "NCI";
1295         else
1296             result = "Sub";
1297     }
1298     else
1299         result = "no";
1300
1301     tracer = interp->debugger ? interp->debugger : interp;
1302     PIO_eprintf(tracer, "# find_method class '%Ss' method '%Ss': %s\n",
1303             class_name, name, result);
1304 }
1305
1306 #endif
1307
1308
1309 /*
1310
1311 =item C<static PMC * find_method_direct_1>
1312
1313 RT#48260: Not yet documented!!!
1314
1315 =cut
1316
1317 */
1318
1319 PARROT_WARN_UNUSED_RESULT
1320 PARROT_CAN_RETURN_NULL
1321 static PMC *
1322 find_method_direct_1(PARROT_INTERP, ARGIN(PMC *_class),
1323                               ARGIN(STRING *method_name))
1324 {
1325     INTVAL i;
1326
1327     PMC * const  mro = _class->vtable->mro;
1328     const INTVAL n   = VTABLE_elements(interp, mro);
1329
1330     for (i = 0; i < n; ++i) {
1331         PMC *method, *ns;
1332
1333         _class = VTABLE_get_pmc_keyed_int(interp, mro, i);
1334         ns     = VTABLE_get_namespace(interp, _class);
1335         method = VTABLE_get_pmc_keyed_str(interp, ns, method_name);
1336
1337         TRACE_FM(interp, _class, method_name, method);
1338
1339         if (!PMC_IS_NULL(method))
1340             return method;
1341     }
1342
1343     TRACE_FM(interp, _class, method_name, NULL);
1344     return PMCNULL;
1345 }
1346
1347
1348 /* ************************************************************************ */
1349 /* ********* BELOW HERE IS NEW PPD15 IMPLEMENTATION RELATED STUFF ********* */
1350 /* ************************************************************************ */
1351
1352 /*
1353
1354 =item C<static PMC* C3_merge>
1355
1356 RT#48260: Not yet documented!!!
1357
1358 =cut
1359
1360 */
1361
1362 PARROT_WARN_UNUSED_RESULT
1363 PARROT_CAN_RETURN_NULL
1364 static PMC*
1365 C3_merge(PARROT_INTERP, ARGIN(PMC *merge_list))
1366 {
1367     PMC      *accepted   = PMCNULL;
1368     PMC      *result     = pmc_new(interp, enum_class_ResizablePMCArray);
1369     const int list_count = VTABLE_elements(interp, merge_list);
1370     int       cand_count = 0;
1371     int       i;
1372
1373     /* Try and find something appropriate to add to the MRO - basically, the
1374      * first list head that is not in the tail of all the other lists. */
1375     for (i = 0; i < list_count; i++) {
1376         PMC * const cand_list = VTABLE_get_pmc_keyed_int(interp, merge_list, i);
1377
1378         PMC *cand_class;
1379         int reject = 0;
1380         int j;
1381
1382         if (VTABLE_elements(interp, cand_list) == 0)
1383             continue;
1384
1385         cand_class = VTABLE_get_pmc_keyed_int(interp, cand_list, 0);
1386         cand_count++;
1387
1388         for (j = 0; j < list_count; j++) {
1389             /* Skip the current list. */
1390             if (j != i) {
1391                 /* Is it in the tail? If so, reject. */
1392                 PMC * const check_list =
1393                         VTABLE_get_pmc_keyed_int(interp, merge_list, j);
1394
1395                 const int check_length = VTABLE_elements(interp, check_list);
1396                 int k;
1397
1398                 for (k = 1; k < check_length; k++) {
1399                     if (VTABLE_get_pmc_keyed_int(interp, check_list, k) ==
1400                         cand_class) {
1401                         reject = 1;
1402                         break;
1403                     }
1404                 }
1405             }
1406         }
1407
1408         /* If we didn't reject it, this candidate will do. */
1409         if (!reject) {
1410             accepted = cand_class;
1411             break;
1412         }
1413     }
1414
1415     /* If we never found any candidates, return an empty list. */
1416     if (cand_count == 0)
1417         return pmc_new(interp, enum_class_ResizablePMCArray);
1418
1419     /* If we didn't find anything to accept, error. */
1420     if (PMC_IS_NULL(accepted))
1421         real_exception(interp, NULL, ILL_INHERIT,
1422             "Could not build C3 linearization: ambiguous hierarchy");
1423
1424     /* Otherwise, remove what was accepted from the merge lists. */
1425     for (i = 0; i < list_count; i++) {
1426         int j;
1427
1428         PMC * const list       = VTABLE_get_pmc_keyed_int(interp, merge_list, i);
1429         const int   list_count = VTABLE_elements(interp, list);
1430
1431         for (j = 0; j < list_count; j++) {
1432             if (VTABLE_get_pmc_keyed_int(interp, list, j) == accepted) {
1433                 VTABLE_delete_keyed_int(interp, list, j);
1434                 break;
1435             }
1436         }
1437     }
1438
1439     /* Need to merge what remains of the list, then put what was accepted on
1440      * the start of the list, and we're done. */
1441     result = C3_merge(interp, merge_list);
1442     VTABLE_unshift_pmc(interp, result, accepted);
1443
1444     return result;
1445 }
1446
1447
1448 /*
1449
1450 =item C<PMC* Parrot_ComputeMRO_C3>
1451
1452 Computes the C3 linearization for the given class.
1453
1454 =cut
1455
1456 */
1457
1458 PARROT_API
1459 PARROT_WARN_UNUSED_RESULT
1460 PARROT_CAN_RETURN_NULL
1461 PMC*
1462 Parrot_ComputeMRO_C3(PARROT_INTERP, ARGIN(PMC *_class))
1463 {
1464     PMC *result;
1465     PMC * const merge_list = pmc_new(interp, enum_class_ResizablePMCArray);
1466     PMC *immediate_parents;
1467     int i, parent_count;
1468
1469     /* Now get immediate parents list. */
1470     Parrot_PCCINVOKE(interp, _class, CONST_STRING(interp, "parents"),
1471         "->P", &immediate_parents);
1472
1473     if (!immediate_parents)
1474         real_exception(interp, NULL, METH_NOT_FOUND,
1475             "Failed to get parents list from class!");
1476
1477     parent_count = VTABLE_elements(interp, immediate_parents);
1478
1479     if (parent_count == 0) {
1480         /* No parents - MRO just contains this class. */
1481         result = pmc_new(interp, enum_class_ResizablePMCArray);
1482         VTABLE_push_pmc(interp, result, _class);
1483         return result;
1484     }
1485
1486     /* Otherwise, need to do merge. For that, need linearizations of all of
1487      * our parents added to the merge list. */
1488     for (i = 0; i < parent_count; i++) {
1489         PMC * const lin = Parrot_ComputeMRO_C3(interp,
1490             VTABLE_get_pmc_keyed_int(interp, immediate_parents, i));
1491
1492         if (PMC_IS_NULL(lin))
1493             return PMCNULL;
1494
1495         VTABLE_push_pmc(interp, merge_list, lin);
1496     }
1497
1498     /* Finally, need list of direct parents on the end of the merge list, then
1499      * we can merge. */
1500     VTABLE_push_pmc(interp, merge_list, immediate_parents);
1501     result = C3_merge(interp, merge_list);
1502
1503     if (PMC_IS_NULL(result))
1504         return PMCNULL;
1505
1506     /* Merged result needs this class on the start, and then we're done. */
1507     VTABLE_unshift_pmc(interp, result, _class);
1508
1509     return result;
1510 }
1511
1512
1513 /*
1514
1515 =item C<void Parrot_ComposeRole>
1516
1517 Used by the Class and Object PMCs internally to compose a role into either of
1518 them. The C<role> parameter is the role that we are composing into the class
1519 or role. C<methods_hash> is the hash of method names to invokable PMCs that
1520 contains the methods the class or role has. C<roles_list> is the list of roles
1521 the the class or method does.
1522
1523 The C<role> parameter is only dealt with by its external interface. Whether
1524 this routine is usable by any other object system implemented in Parrot very
1525 much depends on how closely the role composition semantics they want are to
1526 the default implementation.
1527
1528 =cut
1529
1530 */
1531
1532 PARROT_API
1533 void
1534 Parrot_ComposeRole(PARROT_INTERP, ARGIN(PMC *role),
1535                         ARGIN(PMC *exclude), int got_exclude,
1536                         ARGIN(PMC *alias),   int got_alias,
1537                         ARGIN(PMC *methods_hash), ARGIN(PMC *roles_list))
1538 {
1539     PMC *methods;
1540     PMC *methods_iter;
1541     PMC *roles_of_role;
1542     PMC *proposed_add_methods;
1543
1544     int i, roles_of_role_count;
1545
1546     /* Check we have not already composed the role; if so, just ignore it. */
1547     int roles_count = VTABLE_elements(interp, roles_list);
1548
1549     for (i = 0; i < roles_count; i++)
1550         if (VTABLE_get_pmc_keyed_int(interp, roles_list, i) == role)
1551             return;
1552
1553     /* Get the methods from the role. */
1554     Parrot_PCCINVOKE(interp, role,
1555         CONST_STRING(interp, "methods"), "->P", &methods);
1556
1557     if (PMC_IS_NULL(methods))
1558         return;
1559
1560     /* We need to check for conflicts before we do the composition. We
1561      * put each method that would be OK to add into a proposal list, and
1562      * bail out right away if we find a problem. */
1563     proposed_add_methods = pmc_new(interp, enum_class_Hash);
1564     methods_iter         = VTABLE_get_iter(interp, methods);
1565
1566     while (VTABLE_get_bool(interp, methods_iter)) {
1567         STRING * const method_name = VTABLE_shift_string(interp, methods_iter);
1568         PMC    * const cur_method  = VTABLE_get_pmc_keyed_str(interp, methods,
1569                                         method_name);
1570
1571         /* Need to find the name we'll check for a conflict on. */
1572         int excluded = 0;
1573
1574         /* Check if it's in the exclude list. */
1575         if (got_exclude) {
1576             const int exclude_count = VTABLE_elements(interp, exclude);
1577
1578             for (i = 0; i < exclude_count; i++) {
1579                 const STRING * const check =
1580                     VTABLE_get_string_keyed_int(interp, exclude, i);
1581
1582                 if (string_equal(interp, check, method_name) == 0) {
1583                     excluded = 1;
1584                     break;
1585                 }
1586             }
1587         }
1588
1589         /* If we weren't excluded... */
1590         if (!excluded) {
1591             /* Is there a method with this name already in the class?
1592              * RT#45999 multi-method handling. */
1593
1594             if (VTABLE_exists_keyed_str(interp, methods_hash, method_name))
1595                 /* Conflicts with something already in the class. */
1596                 real_exception(interp, NULL, ROLE_COMPOSITION_METH_CONFLICT,
1597                     "A conflict occurred during role composition "
1598                     "due to method '%S'.", method_name);
1599
1600             /* What about a conflict with ourslef? */
1601             if (VTABLE_exists_keyed_str(interp, proposed_add_methods,
1602                 method_name))
1603                 /* Something very weird is going on. */
1604                 real_exception(interp, NULL, ROLE_COMPOSITION_METH_CONFLICT,
1605                     "A conflict occurred during role composition;"
1606                     " the method '%S' from the role managed to conflict "
1607                     "with itself somehow.", method_name);
1608
1609             /* If we got here, no conflicts! Add method to the "to compose"
1610              * list. */
1611             VTABLE_set_pmc_keyed_str(interp, proposed_add_methods,
1612                 method_name, cur_method);
1613         }
1614
1615         /* Now see if we've got an alias. */
1616         if (got_alias && VTABLE_exists_keyed_str(interp, alias, method_name)) {
1617             /* Got one. Get name to alias it to. */
1618             STRING * const alias_name = VTABLE_get_string_keyed_str(interp,
1619                 alias, method_name);
1620
1621             /* Is there a method with this name already in the class?
1622              * RT#45999: multi-method handling. */
1623             if (VTABLE_exists_keyed_str(interp, methods_hash, alias_name))
1624                 /* Conflicts with something already in the class. */
1625                 real_exception(interp, NULL, ROLE_COMPOSITION_METH_CONFLICT,
1626                     "A conflict occurred during role composition"
1627                     " due to the aliasing of '%S' to '%S'.",
1628                     method_name, alias_name);
1629
1630             /* What about a conflict with ourslef? */
1631             if (VTABLE_exists_keyed_str(interp, proposed_add_methods,
1632                     alias_name))
1633                 real_exception(interp, NULL, ROLE_COMPOSITION_METH_CONFLICT,
1634                     "A conflict occurred during role composition"
1635                     " due to the aliasing of '%S' to '%S' (role already has"
1636                     " a method '%S').",
1637                     method_name, alias_name, alias_name);
1638
1639             /* If we get here, no conflicts! Add method to the "to compose"
1640              * list with its alias. */
1641             VTABLE_set_pmc_keyed_str(interp, proposed_add_methods,
1642                 alias_name, cur_method);
1643         }
1644     }
1645
1646     /* If we get here, we detected no conflicts. Go ahead and compose the
1647      * methods. */
1648     methods_iter = VTABLE_get_iter(interp, proposed_add_methods);
1649
1650     while (VTABLE_get_bool(interp, methods_iter)) {
1651         /* Get current method and its name. */
1652         STRING * const method_name = VTABLE_shift_string(interp, methods_iter);
1653         PMC *    const cur_method  = VTABLE_get_pmc_keyed_str(interp,
1654                                         proposed_add_methods, method_name);
1655
1656         /* Add it to the methods of the class. */
1657         VTABLE_set_pmc_keyed_str(interp, methods_hash, method_name, cur_method);
1658     }
1659
1660     /* Add this role to the roles list. */
1661     VTABLE_push_pmc(interp, roles_list, role);
1662     roles_count++;
1663
1664     /* As a result of composing this role, we will also now do the roles
1665      * that it did itself. Note that we already have the correct methods
1666      * as roles "flatten" the methods they get from other roles into their
1667      * own method list. */
1668     Parrot_PCCINVOKE(interp, role,
1669         CONST_STRING(interp, "roles"), "->P", &roles_of_role);
1670     roles_of_role_count = VTABLE_elements(interp, roles_of_role);
1671
1672     for (i = 0; i < roles_of_role_count; i++) {
1673         /* Only add if we don't already have it in the list. */
1674         PMC * const cur_role = VTABLE_get_pmc_keyed_int(interp,
1675                                     roles_of_role, i);
1676         int j;
1677
1678         for (j = 0; j < roles_count; j++) {
1679             if (VTABLE_get_pmc_keyed_int(interp, roles_list, j) == cur_role) {
1680                 /* We ain't be havin' it. */
1681                 VTABLE_push_pmc(interp, roles_list, cur_role);
1682             }
1683         }
1684     }
1685 }
1686
1687
1688 /*
1689
1690 =back
1691
1692 =head1 SEE ALSO
1693
1694 F<include/parrot/oo.h>, F<include/parrot/oo_private.h>,
1695 F<docs/pdds/pdd15_objects.pod>.
1696
1697 =cut
1698
1699 */
1700
1701 /*
1702  * Local variables:
1703  *   c-file-style: "parrot"
1704  * End:
1705  * vim: expandtab shiftwidth=4:
1706  */