src/pmc/object.pmc

   1 /*
   2 Copyright (C) 2001-2010, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc/object.pmc - An instance of a class
   8
   9 =head1 DESCRIPTION
  10
  11 Implements an instance of a class.
  12
  13 =head2 Functions
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/oo_private.h"
  22 #include "pmc/pmc_class.h"
  23
  24 /* HEADERIZER HFILE: none */
  25 /* HEADERIZER BEGIN: static */
  26 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  27
  28 static void cache_method(PARROT_INTERP,
  29     ARGIN(PMC *_class),
  30     ARGIN(STRING *name),
  31     ARGIN(PMC *method))
  32         __attribute__nonnull__(1)
  33         __attribute__nonnull__(2)
  34         __attribute__nonnull__(3)
  35         __attribute__nonnull__(4);
  36
  37 PARROT_WARN_UNUSED_RESULT
  38 PARROT_CAN_RETURN_NULL
  39 static PMC * find_cached(PARROT_INTERP,
  40     ARGIN(PMC *_class),
  41     ARGIN(STRING *name))
  42         __attribute__nonnull__(1)
  43         __attribute__nonnull__(2)
  44         __attribute__nonnull__(3);
  45
  46 PARROT_WARN_UNUSED_RESULT
  47 static INTVAL get_attrib_index(PARROT_INTERP,
  48     ARGIN(PMC *self),
  49     ARGIN(STRING *name))
  50         __attribute__nonnull__(1)
  51         __attribute__nonnull__(2)
  52         __attribute__nonnull__(3);
  53
  54 PARROT_WARN_UNUSED_RESULT
  55 static INTVAL get_attrib_index_keyed(PARROT_INTERP,
  56     ARGIN(PMC *self),
  57     ARGIN(PMC *key),
  58     ARGIN(STRING *name))
  59         __attribute__nonnull__(1)
  60         __attribute__nonnull__(2)
  61         __attribute__nonnull__(3)
  62         __attribute__nonnull__(4);
  63
  64 #define ASSERT_ARGS_cache_method __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  65        PARROT_ASSERT_ARG(interp) \
  66     , PARROT_ASSERT_ARG(_class) \
  67     , PARROT_ASSERT_ARG(name) \
  68     , PARROT_ASSERT_ARG(method))
  69 #define ASSERT_ARGS_find_cached __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  70        PARROT_ASSERT_ARG(interp) \
  71     , PARROT_ASSERT_ARG(_class) \
  72     , PARROT_ASSERT_ARG(name))
  73 #define ASSERT_ARGS_get_attrib_index __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  74        PARROT_ASSERT_ARG(interp) \
  75     , PARROT_ASSERT_ARG(self) \
  76     , PARROT_ASSERT_ARG(name))
  77 #define ASSERT_ARGS_get_attrib_index_keyed __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  78        PARROT_ASSERT_ARG(interp) \
  79     , PARROT_ASSERT_ARG(self) \
  80     , PARROT_ASSERT_ARG(key) \
  81     , PARROT_ASSERT_ARG(name))
  82 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  83 /* HEADERIZER END: static */
  84
  85 /* This finds the index of an attribute in an object's attribute store and
  86  * returns it. Returns -1 if the attribute does not exist. */
  87
  88 /*
  89
  90 =item C<static INTVAL get_attrib_index(PARROT_INTERP, PMC *self, STRING *name)>
  91
  92 =cut
  93
  94 */
  95
  96 PARROT_WARN_UNUSED_RESULT
  97 static INTVAL
  98 get_attrib_index(PARROT_INTERP, ARGIN(PMC *self), ARGIN(STRING *name))
  99 {
 100     ASSERT_ARGS(get_attrib_index)
 101     Parrot_Class_attributes * const _class  = PARROT_CLASS(self);
 102     const INTVAL                    cur_hll = Parrot_pcc_get_HLL(interp, CURRENT_CONTEXT(interp));
 103     int                             num_classes, i;
 104     INTVAL                          retval;
 105
 106     Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), 0);
 107
 108     /* First see if we can find it in the cache. */
 109     retval                       = VTABLE_get_integer_keyed_str(interp,
 110                                          _class->attrib_cache, name);
 111
 112     /* there's a semi-predicate problem with a retval of 0 */
 113     if (retval
 114     ||  VTABLE_exists_keyed_str(interp, _class->attrib_cache, name)) {
 115         Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_hll);
 116         return retval;
 117     }
 118
 119     /* No hit. We need to walk up the list of parents to try and find the
 120      * attribute. */
 121     num_classes = VTABLE_elements(interp, _class->all_parents);
 122
 123     for (i = 0; i < num_classes; i++) {
 124         /* Get the class and its attribute metadata hash. */
 125         PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp,
 126             _class->all_parents, i);
 127
 128         /* Build a string representing the fully qualified attribute name. */
 129         STRING *fq_name = VTABLE_get_string(interp, cur_class);
 130         fq_name         = Parrot_str_concat(interp, fq_name, name);
 131
 132         /* Look up. */
 133         if (VTABLE_exists_keyed_str(interp, _class->attrib_index, fq_name)) {
 134             /* Found it. Get value, cache it and we're done. */
 135             const INTVAL index = VTABLE_get_integer_keyed_str(interp,
 136                 _class->attrib_index, fq_name);
 137             VTABLE_set_integer_keyed_str(interp, _class->attrib_cache, name,
 138                 index);
 139
 140             Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_hll);
 141             return index;
 142         }
 143     }
 144
 145     Parrot_pcc_set_HLL(interp, CURRENT_CONTEXT(interp), cur_hll);
 146     return -1;
 147 }
 148
 149 /*
 150
 151 =item C<static INTVAL get_attrib_index_keyed(PARROT_INTERP, PMC *self, PMC *key,
 152 STRING *name)>
 153
 154 This variation bypasses the cache and finds the index of a particular
 155 parent's attribute in an object's attribute store and returns it.
 156 Returns C<-1> if the attribute does not exist.
 157
 158 =cut
 159
 160 */
 161
 162 PARROT_WARN_UNUSED_RESULT
 163 static INTVAL
 164 get_attrib_index_keyed(PARROT_INTERP, ARGIN(PMC *self), ARGIN(PMC *key), ARGIN(STRING *name))
 165 {
 166     ASSERT_ARGS(get_attrib_index_keyed)
 167     Parrot_Class_attributes * const _class       = PARROT_CLASS(self);
 168     PMC                     * const class_cache  =
 169         VTABLE_get_pmc_keyed_str(interp, _class->attrib_cache,
 170                                  VTABLE_get_string(interp, key));
 171
 172     PMC                 *parent_class;
 173     STRING              *fq_name;
 174
 175     if (!PMC_IS_NULL(class_cache))
 176         if (VTABLE_exists_keyed_str(interp, class_cache, name))
 177             return VTABLE_get_integer_keyed_str(interp, class_cache, name);
 178
 179     /* Build a string representing the fully qualified attribute name. */
 180     parent_class = Parrot_oo_get_class(interp, key);
 181     fq_name      = VTABLE_get_string(interp, parent_class);
 182     fq_name      = Parrot_str_concat(interp, fq_name, name);
 183
 184     /* Look up. */
 185     if (VTABLE_exists_keyed_str(interp, _class->attrib_index, fq_name)) {
 186         /* Found it. Get value and we're done. */
 187         const INTVAL index = VTABLE_get_integer_keyed_str(interp,
 188             _class->attrib_index, fq_name);
 189         return index;
 190     }
 191
 192     return -1;
 193 }
 194
 195 /*
 196
 197 =item C<static PMC * find_cached(PARROT_INTERP, PMC *_class, STRING *name)>
 198
 199 =cut
 200
 201 */
 202
 203 PARROT_WARN_UNUSED_RESULT
 204 PARROT_CAN_RETURN_NULL
 205 static PMC *
 206 find_cached(PARROT_INTERP, ARGIN(PMC *_class), ARGIN(STRING *name))
 207 {
 208     ASSERT_ARGS(find_cached)
 209     PMC *cache;
 210     GETATTR_Class_meth_cache(interp, _class, cache);
 211
 212     if (PMC_IS_NULL(cache))
 213         return PMCNULL;
 214
 215     return VTABLE_get_pmc_keyed_str(interp, cache, name);
 216 }
 217
 218 /*
 219
 220 =item C<static void cache_method(PARROT_INTERP, PMC *_class, STRING *name, PMC
 221 *method)>
 222
 223 =cut
 224
 225 */
 226
 227 static void
 228 cache_method(PARROT_INTERP, ARGIN(PMC *_class), ARGIN(STRING *name),
 229 ARGIN(PMC *method))
 230 {
 231     ASSERT_ARGS(cache_method)
 232     PMC *cache;
 233     GETATTR_Class_meth_cache(interp, _class, cache);
 234
 235     if (PMC_IS_NULL(cache)) {
 236         cache = Parrot_pmc_new(interp, enum_class_Hash);
 237         SETATTR_Class_meth_cache(interp, _class, cache);
 238     }
 239
 240     VTABLE_set_pmc_keyed_str(interp, cache, name, method);
 241 }
 242
 243 pmclass Object auto_attrs {
 244     ATTR PMC *_class;       /* The class this is an instance of. */
 245     ATTR PMC *attrib_store; /* The attributes store - a resizable PMC array. */
 246
 247
 248 /*
 249
 250 =item C<void init()>
 251
 252 Raises an exception; you can only instantiate objects from a class.
 253
 254 =cut
 255
 256 */
 257
 258     VTABLE void init() {
 259         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
 260             "Object must be created by a class.");
 261     }
 262
 263 /*
 264
 265
 266 =item C<void init_pmc(PMC *class)>
 267
 268 Raises an exception; you can only instantiate objects from a class.
 269
 270 =cut
 271
 272 */
 273
 274     VTABLE void init_pmc(PMC *worreva) {
 275         Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
 276                 "Object must be created by a class.");
 277     }
 278
 279
 280 /*
 281
 282 =item C<void destroy()>
 283
 284 Just to avoid the automatic generation of one.
 285
 286 =cut
 287
 288 */
 289     VTABLE void destroy() {
 290     }
 291
 292
 293 /*
 294
 295 =item C<STRING *name()>
 296
 297 Returns the fully qualified name of the object's class.
 298
 299 =cut
 300
 301 */
 302
 303     VTABLE STRING *name() {
 304         PMC    * const _class     = VTABLE_get_class(INTERP, SELF);
 305         STRING * const name       = CONST_STRING(INTERP, "name");
 306
 307         /* If there's a vtable override for 'name' run that instead. */
 308         PMC * const method = Parrot_oo_find_vtable_override(INTERP,
 309                                  _class, name);
 310
 311         if (!PMC_IS_NULL(method)) {
 312             STRING *result = NULL;
 313             Parrot_ext_call(INTERP, method, "Pi->S", SELF, &result);
 314             return result;
 315         }
 316         else
 317             return VTABLE_get_string(INTERP, _class);
 318     }
 319
 320
 321 /*
 322
 323 =item C<void mark()>
 324
 325 Mark any referenced strings and PMCs.
 326
 327 =cut
 328
 329 */
 330     VTABLE void mark() {
 331         if (PARROT_OBJECT(SELF)) {
 332             Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
 333
 334             Parrot_gc_mark_PMC_alive(INTERP, obj->_class);
 335             Parrot_gc_mark_PMC_alive(INTERP, obj->attrib_store);
 336         }
 337     }
 338
 339
 340 /*
 341
 342 =item C<PMC *get_attr_str(STRING *name)>
 343
 344 Gets the value of an attribute for this object. Will find the first attribute
 345 of the given name walking up the inheritance tree.
 346
 347 =cut
 348
 349 */
 350     VTABLE PMC *get_attr_str(STRING *name) {
 351         Parrot_Object_attributes * const obj      = PARROT_OBJECT(SELF);
 352         STRING                   * const get_attr = CONST_STRING(INTERP, "get_attr_str");
 353
 354         INTVAL index;
 355
 356         /* If there's a vtable override for 'get_attr_str' run that first. */
 357         PMC * const method = Parrot_oo_find_vtable_override(INTERP,
 358                 obj->_class, get_attr);
 359
 360         if (!PMC_IS_NULL(method)) {
 361             PMC *result = PMCNULL;
 362             Parrot_ext_call(INTERP, method, "PiS->P", SELF, name, &result);
 363             return result;
 364         }
 365
 366         /* Look up the index. */
 367         index = get_attrib_index(INTERP, obj->_class, name);
 368
 369         /* If lookup failed, exception. */
 370         if (index == -1)
 371             Parrot_ex_throw_from_c_args(INTERP, NULL,
 372                 EXCEPTION_ATTRIB_NOT_FOUND, "No such attribute '%S'", name);
 373
 374         return VTABLE_get_pmc_keyed_int(INTERP, obj->attrib_store, index);
 375     }
 376
 377
 378 /*
 379
 380 =item C<PMC *get_attr_keyed(PMC *key, STRING *name)>
 381
 382 Gets the value of an attribute for this object. Will only look for attributes
 383 defined in the parent identified by the given key.
 384
 385 =cut
 386
 387 */
 388     VTABLE PMC *get_attr_keyed(PMC *key, STRING *name) {
 389         Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
 390
 391         /* Look up the index. */
 392         const INTVAL index = get_attrib_index_keyed(INTERP, obj->_class,
 393                                                     key, name);
 394
 395         /* If lookup failed, exception. */
 396         if (index == -1)
 397             Parrot_ex_throw_from_c_args(INTERP, NULL,
 398                 EXCEPTION_ATTRIB_NOT_FOUND,
 399                 "No such attribute '%S' in class '%S'", name,
 400                 VTABLE_get_string(INTERP, key));
 401
 402         return VTABLE_get_pmc_keyed_int(INTERP, obj->attrib_store, index);
 403     }
 404
 405
 406 /*
 407
 408 =item C<void set_attr_str(STRING *name, PMC *value)>
 409
 410 Sets the value of an attribute for this object. Will set the first attribute
 411 of the given name walking up the inheritance tree.
 412
 413 =cut
 414
 415 */
 416     VTABLE void set_attr_str(STRING *name, PMC *value) {
 417         Parrot_Object_attributes * const obj              = PARROT_OBJECT(SELF);
 418         STRING                   * const vtable_meth_name = CONST_STRING(INTERP, "set_attr_str");
 419         INTVAL         index;
 420
 421         /* If there's a vtable override for 'set_attr_str' run that first. */
 422         PMC * const method = Parrot_oo_find_vtable_override(INTERP,
 423                 obj->_class, vtable_meth_name);
 424
 425         if (!PMC_IS_NULL(method)) {
 426             Parrot_ext_call(INTERP, method, "PiSP->", SELF, name, value);
 427             return;
 428         }
 429
 430         index = get_attrib_index(INTERP, obj->_class, name);
 431
 432         /* If lookup failed, exception. */
 433         if (index == -1)
 434             Parrot_ex_throw_from_c_args(INTERP, NULL,
 435                 EXCEPTION_ATTRIB_NOT_FOUND, "No such attribute '%S'", name);
 436
 437         VTABLE_set_pmc_keyed_int(INTERP, obj->attrib_store, index, value);
 438     }
 439
 440
 441 /*
 442
 443 =item C<void set_attr_keyed(PMC *key, STRING *name, PMC *value)>
 444
 445 Sets the value of an attribute for this object. Will only set attributes
 446 defined in the parent identified by the given key.
 447
 448 =cut
 449
 450 */
 451     VTABLE void set_attr_keyed(PMC *key, STRING *name, PMC *value) {
 452         Parrot_Object_attributes * const obj  = PARROT_OBJECT(SELF);
 453         const INTVAL                    index =
 454              get_attrib_index_keyed(INTERP, obj->_class, key, name);
 455
 456         /* If lookup failed, exception. */
 457         if (index == -1)
 458             Parrot_ex_throw_from_c_args(INTERP, NULL,
 459                  EXCEPTION_ATTRIB_NOT_FOUND,
 460                 "No such attribute '%S' in class '%S'", name,
 461                 VTABLE_get_string(INTERP, key));
 462
 463         VTABLE_set_pmc_keyed_int(INTERP, obj->attrib_store, index, value);
 464     }
 465
 466
 467 /*
 468
 469 =item C<PMC *find_method(STRING *name)>
 470
 471 Queries this object's class to find the method with the given name.
 472
 473 =cut
 474
 475 */
 476     VTABLE PMC *find_method(STRING *name) {
 477         Parrot_Object_attributes * const obj    = PARROT_OBJECT(SELF);
 478         Parrot_Class_attributes  * const _class = PARROT_CLASS(obj->_class);
 479         PMC                             *method =
 480                  find_cached(INTERP, obj->_class, name);
 481
 482         if (!PMC_IS_NULL(method))
 483             return method;
 484         else {
 485             STRING * const find_method = CONST_STRING(INTERP, "find_method");
 486             const int      num_classes = VTABLE_elements(INTERP,
 487                                                       _class->all_parents);
 488
 489             const int all_in_universe  =
 490                             !CLASS_has_alien_parents_TEST(obj->_class);
 491             int i;
 492
 493             for (i = 0; i < num_classes; i++) {
 494                 /* Get the class. */
 495                 PMC * const cur_class =
 496                     VTABLE_get_pmc_keyed_int(INTERP, _class->all_parents, i);
 497
 498                 const Parrot_Class_attributes * const class_info =
 499                         PARROT_CLASS(cur_class);
 500
 501                 /* If there's a vtable override for 'find_method' in the
 502                  * current class, run that first. */
 503
 504                 method = Parrot_oo_find_vtable_override_for_class(INTERP,
 505                             cur_class, find_method);
 506
 507                 if (!PMC_IS_NULL(method)) {
 508                     PMC *result = PMCNULL;
 509                     Parrot_ext_call(INTERP, method, "PiS->P", SELF, name, &result);
 510
 511                     /* break out to the CACHE IF FOUND code */
 512                     method = result;
 513                     break;
 514                 }
 515
 516                 /* If it's from this universe or the class doesn't inherit from
 517                  * anything outside of it... */
 518                 if (all_in_universe || VTABLE_isa(INTERP, cur_class, CONST_STRING(INTERP, "Class"))) {
 519                     method = VTABLE_get_pmc_keyed_str(INTERP,
 520                                     class_info->methods, name);
 521
 522                     /* Found it! */
 523                     if (!PMC_IS_NULL(method))
 524                         break;
 525                 }
 526                 else
 527                     Parrot_ex_throw_from_c_args(INTERP, NULL, -1,
 528                         "Class %Ss inherits from alien parents.",
 529                         class_info->name);
 530             }
 531
 532             if (!PMC_IS_NULL(method))
 533                 cache_method(INTERP, obj->_class, name, method);
 534
 535             return method;
 536         }
 537     }
 538
 539
 540 /*
 541
 542 =item C<INTVAL get_integer()>
 543
 544 Invoke the PIR-defined vtable override, or call the default get_integer.
 545
 546 =cut
 547
 548 */
 549     VTABLE INTVAL get_integer() {
 550         Parrot_Object_attributes * const obj       = PARROT_OBJECT(SELF);
 551         Parrot_Class_attributes  * const _class    = PARROT_CLASS(obj->_class);
 552         STRING                   * const meth_name = CONST_STRING(INTERP, "get_integer");
 553
 554         /* Walk and search for the vtable. */
 555         const int num_classes = VTABLE_elements(INTERP, _class->all_parents);
 556         int       i;
 557
 558         for (i = 0; i < num_classes; i++) {
 559             /* Get the class. */
 560             PMC * const cur_class =
 561                 VTABLE_get_pmc_keyed_int(INTERP, _class->all_parents, i);
 562
 563             PMC * const meth = Parrot_oo_find_vtable_override_for_class(INTERP,
 564                     cur_class, meth_name);
 565
 566             if (!PMC_IS_NULL(meth)) {
 567                 INTVAL result;
 568                 Parrot_ext_call(INTERP, meth, "Pi->I", SELF, &result);
 569                 return result;
 570
 571             }
 572
 573             if (cur_class->vtable->base_type == enum_class_PMCProxy) {
 574                 /* Get the PMC instance and call the vtable function on that. */
 575                 STRING * const proxy      = CONST_STRING(INTERP, "proxy");
 576                 PMC    * const del_object =
 577                      VTABLE_get_attr_str(INTERP, SELF, proxy);
 578
 579                 if (!PMC_IS_NULL(del_object))
 580                     return (INTVAL)VTABLE_get_integer(INTERP, del_object);
 581             }
 582         }
 583         return INTERP->vtables[enum_class_default]->get_integer(INTERP, SELF);
 584     }
 585
 586
 587 /*
 588
 589 =item C<PMC *get_class()>
 590
 591 Get the class PMC representing the class that this object is an instance of.
 592
 593 =cut
 594
 595 */
 596     VTABLE PMC *get_class() {
 597         return PARROT_OBJECT(SELF)->_class;
 598     }
 599
 600
 601 /*
 602
 603 =item C<PMC *get_namespace()>
 604
 605 Get the namespace PMC associated with the class that this object is an instance of.
 606
 607 =cut
 608
 609 */
 610
 611     VTABLE PMC *get_namespace() {
 612         PMC    * const classobj      = VTABLE_get_class(INTERP, SELF);
 613         STRING * const get_namespace = CONST_STRING(INTERP, "get_namespace");
 614
 615         /* If there's a vtable override for 'get_namespace' run that instead */
 616         PMC    * const method = Parrot_oo_find_vtable_override(INTERP,
 617                 classobj, get_namespace);
 618
 619         if (!PMC_IS_NULL(method)) {
 620             PMC *result;
 621             Parrot_ext_call(INTERP, method, "Pi->P", SELF, &result);
 622             return result;
 623         }
 624
 625        return VTABLE_inspect_str(INTERP, classobj, CONST_STRING(INTERP, "namespace"));
 626     }
 627
 628
 629 /*
 630
 631 =item C<INTVAL can(STRING *method_name)>
 632
 633 Returns 0 if the class does not have a method with the given name and a
 634 non-zero value if it does.
 635
 636 =cut
 637
 638 */
 639     VTABLE INTVAL can(STRING *method_name) {
 640         /* Just use find_method and see it if finds anything. */
 641         const PMC * const method =
 642             VTABLE_find_method(INTERP, SELF, method_name);
 643         return !PMC_IS_NULL(method);
 644     }
 645
 646
 647 /*
 648
 649 =item C<INTVAL isa_pmc(PMC *classname)>
 650
 651 Returns whether the object's class is or inherits from C<*classname>.
 652
 653 =cut
 654
 655 */
 656
 657     VTABLE INTVAL isa_pmc(PMC *lookup) {
 658         if (PMC_IS_NULL(lookup))
 659             return 0;
 660
 661         if (SUPER(lookup))
 662             return 1;
 663
 664         /* Dispatch isa to the object's class */
 665         return VTABLE_isa_pmc(INTERP, VTABLE_get_class(INTERP, SELF), lookup);
 666     }
 667
 668
 669 /*
 670
 671 =item C<INTVAL isa(STRING *classname)>
 672
 673 Returns whether the class is or inherits from C<*classname>.
 674
 675 =cut
 676
 677 */
 678
 679     VTABLE INTVAL isa(STRING *classname) {
 680         if (SELF->vtable->whoami == classname
 681         ||  Parrot_str_equal(INTERP, SELF->vtable->whoami, classname))
 682             return 1;
 683         else {
 684             PMC *_class = PARROT_OBJECT(SELF)->_class;
 685             return VTABLE_isa(INTERP, _class, classname);
 686         }
 687     }
 688
 689
 690 /*
 691
 692 =item C<INTVAL does(STRING *role_name)>
 693
 694 Returns whether the object's class does the role with name C<*role_name>.
 695
 696 =cut
 697
 698 */
 699
 700     VTABLE INTVAL does(STRING *role_name) {
 701         /* If it's a null string, return false */
 702         if (!role_name)
 703             return 0;
 704         else {
 705             PMC    * const classobj  = VTABLE_get_class(INTERP, SELF);
 706             STRING * const meth_name = CONST_STRING(INTERP, "does");
 707
 708             PMC * const method = Parrot_oo_find_vtable_override(INTERP,
 709                 classobj, meth_name);
 710
 711             if (!PMC_IS_NULL(method)) {
 712                 INTVAL result;
 713                 Parrot_ext_call(INTERP, method, "PiS->I", SELF, role_name, &result);
 714                 if (result)
 715                     return 1;
 716             }
 717         }
 718
 719         /* Check the superclass's vtable interface, if any. */
 720         if (SUPER(role_name))
 721             return 1;
 722
 723         /* Dispatch to the object's class */
 724         return VTABLE_does(INTERP, VTABLE_get_class(INTERP, SELF), role_name);
 725     }
 726
 727
 728 /*
 729
 730 =item C<INTVAL does_pmc(PMC *role)>
 731
 732 Returns whether the object's class does C<*role>.
 733
 734 =cut
 735
 736 */
 737
 738     VTABLE INTVAL does_pmc(PMC *role) {
 739         if (PMC_IS_NULL(role))
 740             return 0;
 741
 742         if (SUPER(role))
 743             return 1;
 744
 745         /* Dispatch to the object's class */
 746         return VTABLE_does_pmc(INTERP, VTABLE_get_class(INTERP, SELF), role);
 747     }
 748
 749
 750 /*
 751
 752 =item C<opcode_t *invoke(void *next)>
 753
 754 Invokes the object (if this vtable function is overridden).
 755
 756 =cut
 757
 758 */
 759
 760     opcode_t * invoke(void *next) {
 761         Parrot_Object_attributes * const obj    = PARROT_OBJECT(SELF);
 762         Parrot_Class_attributes  * const _class = PARROT_CLASS(obj->_class);
 763
 764         /* Walk and search for the vtable. */
 765         const int num_classes = VTABLE_elements(INTERP, _class->all_parents);
 766         int i;
 767
 768         for (i = 0; i < num_classes; i++) {
 769             /* Get the class. */
 770             STRING * const meth_name = CONST_STRING(INTERP, "invoke");
 771             STRING * const proxy     = CONST_STRING(INTERP, "proxy");
 772             PMC    * const cur_class =
 773                 VTABLE_get_pmc_keyed_int(INTERP, _class->all_parents, i);
 774
 775             PMC    * const meth      =
 776                 Parrot_oo_find_vtable_override_for_class(INTERP, cur_class,
 777                                                          meth_name);
 778             if (!PMC_IS_NULL(meth)) {
 779                 /* Experimental code. See DEPRECATED.pod */
 780                 PMC *call_sig =
 781                     Parrot_pcc_get_signature(INTERP, CURRENT_CONTEXT(INTERP));
 782
 783                 if ((VTABLE_elements(INTERP, call_sig) == 0
 784                 ||   VTABLE_get_pmc_keyed_int(INTERP, call_sig, 0) != SELF))
 785                     VTABLE_unshift_pmc(INTERP, call_sig, SELF);
 786
 787                 return VTABLE_invoke(INTERP, meth, next);
 788             }
 789
 790             if (cur_class->vtable->base_type == enum_class_PMCProxy) {
 791                 /* Get the PMC instance and call the vtable function on that. */
 792                 PMC * const del_object =
 793                     VTABLE_get_attr_keyed(INTERP, SELF, cur_class, proxy);
 794
 795                 if (!PMC_IS_NULL(del_object))
 796                     return VTABLE_invoke(INTERP, del_object, next);
 797             }
 798         }
 799
 800         return (opcode_t *)INTERP->vtables[enum_class_default]->invoke(INTERP, SELF, next);
 801     }
 802
 803
 804 /*
 805
 806 =item C<INTVAL type()>
 807
 808 Returns the integer type of the object's class.
 809
 810 =cut
 811
 812 */
 813
 814     VTABLE INTVAL type() {
 815         PMC * const _class = VTABLE_get_class(INTERP, SELF);
 816         return VTABLE_type(INTERP, _class);
 817     }
 818
 819
 820 /*
 821
 822 =item C<PMC * clone()>
 823
 824 Creates a clone of the object.
 825
 826 =cut
 827
 828 */
 829
 830     VTABLE PMC * clone() {
 831         Parrot_Object_attributes * const obj = PARROT_OBJECT(SELF);
 832         /* If we have a custom override, invoke it.
 833          * If not, use the oo function. */
 834         STRING * const meth_name = CONST_STRING(INTERP, "clone");
 835         PMC    * const meth      =
 836                 Parrot_oo_find_vtable_override(INTERP, obj->_class, meth_name);
 837
 838         if (!PMC_IS_NULL(meth)) {
 839             PMC *result;
 840             Parrot_ext_call(INTERP, meth, "Pi->P", SELF, &result);
 841             return result;
 842         }
 843
 844         return Parrot_oo_clone_object(INTERP, SELF, NULL);
 845     }
 846
 847
 848 /*
 849
 850 =item C<void visit(PMC *info)>
 851
 852 This is used by freeze/thaw to visit the contents of the object.
 853
 854 C<*info> is the visit info, (see F<include/parrot/pmc_freeze.h>).
 855
 856 =cut
 857
 858 */
 859
 860     VTABLE void visit(PMC *info) {
 861         Parrot_Object_attributes * const obj_data = PARROT_OBJECT(SELF);
 862
 863         /* 1) visit class */
 864         VISIT_PMC(INTERP, info, obj_data->_class);
 865
 866         /* 2) visit the attributes */
 867         VISIT_PMC(INTERP, info, obj_data->attrib_store);
 868     }
 869
 870
 871 /*
 872
 873 =item C<void freeze(PMC *info)>
 874
 875 =item C<void thaw(PMC *info)>
 876
 877 Realias magically generated methods so they don't wreak havoc.
 878
 879 =cut
 880
 881 */
 882
 883     VTABLE void freeze(PMC *info) {
 884     }
 885
 886     VTABLE void thaw(PMC *info) {
 887     }
 888
 889
 890 /*
 891
 892 =item C<void thawfinish(PMC *info)>
 893
 894 Called after the object has been thawed.
 895
 896 =cut
 897
 898 */
 899
 900     VTABLE void thawfinish(PMC *info) {
 901         /* Set custom GC mark and destroy on the object. */
 902         PObj_custom_mark_SET(SELF);
 903         PObj_custom_destroy_SET(SELF);
 904
 905         /* Flag that it is an object */
 906         PObj_is_object_SET(SELF);
 907     }
 908
 909
 910 /*
 911
 912 =item C<PMC * share_ro()>
 913
 914 Used to mark a PMC as read-only shared.
 915
 916 =cut
 917
 918 */
 919     VTABLE PMC *share_ro() {
 920         PMC   *ret, *_true, *data;
 921         INTVAL i, n;
 922         PMC *classobj;
 923         Parrot_Interp  master;
 924         INTVAL         type_num;
 925
 926         if (PObj_is_PMC_shared_TEST(SELF))
 927             return SELF;
 928
 929         master = interpreter_array[0];
 930         classobj = VTABLE_get_class(INTERP, SELF);
 931         type_num = SELF->vtable->base_type;
 932
 933         /* make sure metadata doesn't go away unexpectedly */
 934         if (PMC_metadata(SELF))
 935             PMC_metadata(SELF) = pt_shared_fixup(INTERP, PMC_metadata(SELF));
 936
 937         PARROT_ASSERT(master->vtables[type_num]->pmc_class);
 938         /* don't want the referenced class disappearing on us */
 939         LOCK_INTERPRETER(master);
 940         SELF->vtable->pmc_class = master->vtables[type_num]->pmc_class;
 941         UNLOCK_INTERPRETER(master);
 942
 943         ret = SELF;
 944         /* Setting the '_ro' property switches to the read-only vtable */
 945         _true = Parrot_pmc_new_init_int(INTERP, enum_class_Integer, 1);
 946         VTABLE_setprop(INTERP, ret, CONST_STRING(INTERP, "_ro"), _true);
 947
 948         SELF->vtable->pmc_class = master->vtables[type_num]->pmc_class;
 949         PObj_is_PMC_shared_SET(ret);
 950
 951         data = PARROT_CLASS(classobj)->parents;
 952         n    = VTABLE_elements(INTERP, data);
 953
 954         for (i = 0; i < n; ++i) {
 955             PMC * const cur_class = VTABLE_get_pmc_keyed_int(INTERP, data, i);
 956             VTABLE_set_pmc_keyed_int(INTERP, data, i, VTABLE_share_ro(INTERP, cur_class));
 957         }
 958
 959         /* XXX This is perhaps not the best way to fix this up, but we
 960          * need to ensure that the class object won't go away when
 961          * this interpreter dies.
 962          */
 963         PARROT_ASSERT(ret->vtable->pmc_class);
 964         PARROT_ASSERT(ret->vtable->share_ro == Parrot_Object_share_ro);
 965
 966         return ret;
 967     }
 968
 969
 970 /*
 971
 972 =item C<void morph(PMC* type)>
 973
 974 Changes the PMC to a PMC of a new type
 975
 976 =cut
 977
 978 */
 979
 980     VTABLE void morph(PMC* type) {
 981         PMC    * const classobj  = VTABLE_get_class(INTERP, SELF);
 982         STRING * const meth_name = CONST_STRING(INTERP, "morph");
 983         /* If there's a vtable override for 'morph' run that instead. */
 984         PMC    * const method    =
 985              Parrot_oo_find_vtable_override(INTERP, classobj, meth_name);
 986
 987         if (!PMC_IS_NULL(method))
 988             Parrot_ext_call(INTERP, method, "PiP->", SELF, type);
 989         else
 990             SUPER(type);
 991     }
 992 }
 993
 994 /*
 995
 996 =back
 997
 998 =head1 SEE ALSO
 999
1000 F<docs/pdds/pdd15_objects.pod>.
1001
1002 =cut
1003
1004 */
1005
1006 /*
1007  * Local variables:
1008  *   c-file-style: "parrot"
1009  * End:
1010  * vim: expandtab shiftwidth=4:
1011  */