src/pmc.c

   1 /*
   2 Copyright (C) 2001-2010, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc.c
   8
   9 =head1 DESCRIPTION
  10
  11 The base vtable calling functions
  12
  13 =head1 FUNCTIONS
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/parrot.h"
  22 #include "pmc.str"
  23 #include "pmc/pmc_class.h"
  24 #include "pmc/pmc_callcontext.h"
  25
  26 /* HEADERIZER HFILE: include/parrot/pmc.h */
  27
  28 /* HEADERIZER BEGIN: static */
  29 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  30
  31 static void check_pmc_reuse_flags(PARROT_INTERP,
  32     UINTVAL srcflags,
  33     UINTVAL destflags)
  34         __attribute__nonnull__(1);
  35
  36 PARROT_WARN_UNUSED_RESULT
  37 PARROT_CANNOT_RETURN_NULL
  38 static PMC * create_class_pmc(PARROT_INTERP, INTVAL type)
  39         __attribute__nonnull__(1);
  40
  41 PARROT_WARN_UNUSED_RESULT
  42 PARROT_CANNOT_RETURN_NULL
  43 static PMC * get_new_pmc_header(PARROT_INTERP,
  44     INTVAL base_type,
  45     UINTVAL flags)
  46         __attribute__nonnull__(1);
  47
  48 PARROT_CANNOT_RETURN_NULL
  49 static PMC* Parrot_pmc_reuse_noinit(PARROT_INTERP,
  50     ARGIN(PMC *pmc),
  51     INTVAL new_type)
  52         __attribute__nonnull__(1)
  53         __attribute__nonnull__(2);
  54
  55 #define ASSERT_ARGS_check_pmc_reuse_flags __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  56        PARROT_ASSERT_ARG(interp))
  57 #define ASSERT_ARGS_create_class_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  58        PARROT_ASSERT_ARG(interp))
  59 #define ASSERT_ARGS_get_new_pmc_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  60        PARROT_ASSERT_ARG(interp))
  61 #define ASSERT_ARGS_Parrot_pmc_reuse_noinit __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
  62        PARROT_ASSERT_ARG(interp) \
  63     , PARROT_ASSERT_ARG(pmc))
  64 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  65 /* HEADERIZER END: static */
  66
  67
  68 #if PARROT_CATCH_NULL
  69 PMC * PMCNULL;
  70 #endif
  71
  72 /*
  73
  74 =item C<INTVAL Parrot_pmc_is_null(PARROT_INTERP, const PMC *pmc)>
  75
  76 Tests if the given pmc is null.
  77
  78 =cut
  79
  80 */
  81
  82 PARROT_EXPORT
  83 PARROT_PURE_FUNCTION
  84 PARROT_WARN_UNUSED_RESULT
  85 PARROT_HOT
  86 INTVAL
  87 Parrot_pmc_is_null(SHIM_INTERP, ARGIN_NULLOK(const PMC *pmc))
  88 {
  89     ASSERT_ARGS(Parrot_pmc_is_null)
  90     /* We can't use PMC_IS_NULL() because that calls us here in some cases */
  91 #if PARROT_CATCH_NULL
  92     return pmc == PMCNULL || pmc == NULL;
  93 #else
  94     return pmc == NULL;
  95 #endif
  96 }
  97
  98 /*
  99
 100 =item C<void Parrot_pmc_destroy(PARROT_INTERP, PMC *pmc)>
 101
 102 Destroy a PMC. Call his destroy vtable function if needed, and deallocate
 103 his attributes if they are automatically allocated.
 104
 105 For internal usage of the PMC handling functions and garbage collection
 106 subsystem.
 107
 108 =cut
 109
 110 */
 111
 112 PARROT_EXPORT
 113 void
 114 Parrot_pmc_destroy(PARROT_INTERP, ARGMOD(PMC *pmc))
 115 {
 116     ASSERT_ARGS(Parrot_pmc_destroy)
 117
 118     if (PObj_custom_destroy_TEST(pmc))
 119         VTABLE_destroy(interp, pmc);
 120
 121     PObj_gc_CLEAR(pmc);
 122
 123     if (pmc->vtable->attr_size)
 124         Parrot_gc_free_pmc_attributes(interp, pmc);
 125     else
 126         PMC_data(pmc) = NULL;
 127
 128 #ifndef NDEBUG
 129
 130     pmc->vtable      = (VTABLE  *)0xdeadbeef;
 131
 132 #endif
 133
 134 }
 135
 136 /*
 137
 138 =item C<PMC * Parrot_pmc_new(PARROT_INTERP, INTVAL base_type)>
 139
 140 Creates a new PMC of type C<base_type> (which is an index into the list of PMC
 141 types declared in C<vtables> in F<include/parrot/pmc.h>). Once the PMC has been
 142 successfully created and its vtable pointer initialized, we call its C<init>
 143 method to perform any other necessary initialization.
 144
 145 =cut
 146
 147 */
 148
 149 PARROT_EXPORT
 150 PARROT_CANNOT_RETURN_NULL
 151 PARROT_WARN_UNUSED_RESULT
 152 PMC *
 153 Parrot_pmc_new(PARROT_INTERP, INTVAL base_type)
 154 {
 155     ASSERT_ARGS(Parrot_pmc_new)
 156     PARROT_ASSERT(interp->vtables[base_type]);
 157     {
 158         PMC *const classobj = interp->vtables[base_type]->pmc_class;
 159
 160         if (!PMC_IS_NULL(classobj) && PObj_is_class_TEST(classobj))
 161             return VTABLE_instantiate(interp, classobj, PMCNULL);
 162         else {
 163             PMC * const pmc = get_new_pmc_header(interp, base_type, 0);
 164             VTABLE_init(interp, pmc);
 165             return pmc;
 166         }
 167     }
 168 }
 169
 170 /*
 171
 172 =item C<PMC * Parrot_pmc_reuse(PARROT_INTERP, PMC *pmc, INTVAL new_type, UINTVAL
 173 flags)>
 174
 175 Reuse an existing PMC, turning it into an empty PMC of the new type. Any
 176 required internal structure will be put in place (such as the extension area)
 177 and the PMC will be ready to go.
 178
 179 Cannot currently handle converting a non-Object PMC into an Object. Use
 180 C<pmc_reuse_by_class> for that.
 181
 182
 183 =cut
 184
 185 */
 186
 187 PARROT_EXPORT
 188 PARROT_CANNOT_RETURN_NULL
 189 PARROT_IGNORABLE_RESULT
 190 PMC *
 191 Parrot_pmc_reuse(PARROT_INTERP, ARGIN(PMC *pmc), INTVAL new_type, SHIM(UINTVAL flags))
 192 {
 193     ASSERT_ARGS(Parrot_pmc_reuse)
 194     pmc = Parrot_pmc_reuse_noinit(interp, pmc, new_type);
 195
 196     /* Call the base init for the redone pmc. Warning, this should not
 197        be called on Object PMCs. */
 198     VTABLE_init(interp, pmc);
 199
 200     return pmc;
 201 }
 202
 203 /*
 204
 205 =item C<PMC * Parrot_pmc_reuse_init(PARROT_INTERP, PMC *pmc, INTVAL new_type,
 206 PMC *init, UINTVAL flags)>
 207
 208 Reuse an existing PMC, turning it into an PMC of the new type. Any
 209 required internal structure will be put in place (such as the extension area)
 210 and the PMC will be inited.
 211
 212 Cannot currently handle converting a non-Object PMC into an Object. Use
 213 C<pmc_reuse_by_class> for that.
 214
 215
 216 =cut
 217
 218 */
 219
 220 PARROT_EXPORT
 221 PARROT_CANNOT_RETURN_NULL
 222 PARROT_IGNORABLE_RESULT
 223 PMC *
 224 Parrot_pmc_reuse_init(PARROT_INTERP, ARGIN(PMC *pmc), INTVAL new_type, ARGIN(PMC *init),
 225           SHIM(UINTVAL flags))
 226 {
 227     ASSERT_ARGS(Parrot_pmc_reuse_init)
 228     pmc = Parrot_pmc_reuse_noinit(interp, pmc, new_type);
 229
 230     /* Call the base init for the redone pmc. Warning, this should not
 231        be called on Object PMCs. */
 232     VTABLE_init_pmc(interp, pmc, init);
 233
 234     return pmc;
 235 }
 236
 237 /*
 238
 239 =item C<static PMC* Parrot_pmc_reuse_noinit(PARROT_INTERP, PMC *pmc, INTVAL
 240 new_type)>
 241
 242 Prepare pmc for reuse. Do all scuffolding except initing.
 243
 244 =cut
 245
 246 */
 247
 248 PARROT_CANNOT_RETURN_NULL
 249 static PMC*
 250 Parrot_pmc_reuse_noinit(PARROT_INTERP, ARGIN(PMC *pmc), INTVAL new_type)
 251 {
 252     ASSERT_ARGS(Parrot_pmc_reuse_noinit)
 253
 254     if (pmc->vtable->base_type != new_type) {
 255         VTABLE * const new_vtable = interp->vtables[new_type];
 256
 257         /* Singleton/const PMCs/types are not eligible */
 258         check_pmc_reuse_flags(interp, pmc->vtable->flags, new_vtable->flags);
 259
 260         /* Free the old PMC resources. */
 261         Parrot_pmc_destroy(interp, pmc);
 262
 263         PObj_flags_SETTO(pmc, PObj_is_PMC_FLAG);
 264
 265         /* Set the right vtable */
 266         pmc->vtable = new_vtable;
 267
 268         if (new_vtable->attr_size)
 269             Parrot_gc_allocate_pmc_attributes(interp, pmc);
 270         else
 271             PMC_data(pmc) = NULL;
 272     }
 273
 274     return pmc;
 275 }
 276
 277 /*
 278
 279 =item C<PMC * Parrot_pmc_reuse_by_class(PARROT_INTERP, PMC *pmc, PMC *class_,
 280 UINTVAL flags)>
 281
 282 Reuse an existing PMC. Convert it to the type specified by the given Class
 283 PMC. At the moment, this means we can only use this function to reuse PMCs
 284 into types with Classes (not built-in PMCs). Use C<pmc_reuse> if you need
 285 to convert to a built-in PMC type.
 286
 287 =cut
 288
 289 */
 290
 291 PARROT_EXPORT
 292 PARROT_CANNOT_RETURN_NULL
 293 PARROT_IGNORABLE_RESULT
 294 PMC *
 295 Parrot_pmc_reuse_by_class(PARROT_INTERP, ARGMOD(PMC *pmc), ARGIN(PMC *class_), UINTVAL flags)
 296 {
 297     ASSERT_ARGS(Parrot_pmc_reuse_by_class)
 298     const INTVAL   new_type   = PARROT_CLASS(class_)->id;
 299
 300     if (pmc->vtable->base_type != new_type) {
 301         VTABLE * const new_vtable = interp->vtables[new_type];
 302
 303         /* Singleton/const PMCs/types are not eligible */
 304         check_pmc_reuse_flags(interp, pmc->vtable->flags, new_vtable->flags);
 305
 306         Parrot_pmc_destroy(interp, pmc);
 307
 308         PObj_flags_SETTO(pmc, PObj_is_PMC_FLAG | flags);
 309
 310         /* Set the right vtable */
 311         pmc->vtable = new_vtable;
 312
 313         if (new_vtable->attr_size)
 314             Parrot_gc_allocate_pmc_attributes(interp, pmc);
 315         else
 316             PMC_data(pmc) = NULL;
 317     }
 318
 319     return pmc;
 320 }
 321
 322
 323 /*
 324
 325 =item C<static void check_pmc_reuse_flags(PARROT_INTERP, UINTVAL srcflags,
 326 UINTVAL destflags)>
 327
 328 We're converting one PMC type to another, either in C<pmc_reuse> or
 329 C<pmc_reuse_by_class>. Check to make sure that neither the existing PMC
 330 or the intended target PMC type are singletons or constants. We throw an
 331 exception if we are attempting an illegal operation.
 332
 333 =cut
 334
 335 */
 336
 337 static void
 338 check_pmc_reuse_flags(PARROT_INTERP, UINTVAL srcflags, UINTVAL destflags)
 339 {
 340     ASSERT_ARGS(check_pmc_reuse_flags)
 341     if ((srcflags | destflags) & (VTABLE_PMC_IS_SINGLETON | VTABLE_IS_CONST_FLAG))
 342     {
 343         /* First, is the destination a singleton? No joy for us there */
 344         if (destflags & VTABLE_PMC_IS_SINGLETON)
 345             Parrot_ex_throw_from_c_args(interp, NULL,
 346                 EXCEPTION_ALLOCATION_ERROR,
 347                 "Parrot VM: Can't turn to a singleton type!\n");
 348
 349         /* Is the destination a constant? No joy for us there */
 350         if (destflags & VTABLE_IS_CONST_FLAG)
 351             Parrot_ex_throw_from_c_args(interp, NULL,
 352                 EXCEPTION_ALLOCATION_ERROR,
 353                 "Parrot VM: Can't turn to a constant type!\n");
 354
 355         /* Is the source a singleton? */
 356         if (srcflags & VTABLE_PMC_IS_SINGLETON)
 357             Parrot_ex_throw_from_c_args(interp, NULL,
 358                 EXCEPTION_ALLOCATION_ERROR,
 359                 "Parrot VM: Can't modify a singleton\n");
 360
 361         /* Is the source constant? */
 362         if (srcflags & VTABLE_IS_CONST_FLAG)
 363             Parrot_ex_throw_from_c_args(interp, NULL,
 364                 EXCEPTION_ALLOCATION_ERROR,
 365                 "Parrot VM: Can't modify a constant\n");
 366     }
 367 }
 368
 369 /*
 370
 371 =item C<static PMC * get_new_pmc_header(PARROT_INTERP, INTVAL base_type, UINTVAL
 372 flags)>
 373
 374 Gets a new PMC header of the given integer type. Initialize the pmc if
 375 necessary. In the case of singleton PMC types, get the existing singleton
 376 instead of allocating a new one.
 377
 378 =cut
 379
 380 */
 381
 382 PARROT_WARN_UNUSED_RESULT
 383 PARROT_CANNOT_RETURN_NULL
 384 static PMC *
 385 get_new_pmc_header(PARROT_INTERP, INTVAL base_type, UINTVAL flags)
 386 {
 387     ASSERT_ARGS(get_new_pmc_header)
 388     PMC    *newpmc;
 389     VTABLE *vtable = interp->vtables[base_type];
 390     UINTVAL vtable_flags;
 391
 392     /* This is usually because you either didn't call init_world early enough,
 393      * you added a new PMC class without adding Parrot_(classname)_class_init
 394      * to init_world, or you forgot to run 'make realclean' after adding a new
 395      * PMC class.  */
 396     if (!vtable)
 397         PANIC(interp, "Null vtable used; did you add a new PMC?");
 398
 399     vtable_flags = vtable->flags;
 400
 401     /* we only have one global Env object, living in the interp */
 402     if (vtable_flags & VTABLE_PMC_IS_SINGLETON) {
 403         /*
 404          * singletons (monadic objects) exist only once
 405          * the interface * with the class is:
 406          * - get_pointer: return NULL or a pointer to the single instance
 407          * - set_pointer: set the only instance once
 408          *
 409          * - singletons are created in the constant pmc pool
 410          */
 411         PMC *pmc = (PMC *)(vtable->get_pointer)(interp, NULL);
 412
 413         /* LOCK */
 414         if (!pmc) {
 415             pmc = Parrot_gc_new_pmc_header(interp, PObj_constant_FLAG);
 416             PARROT_ASSERT(pmc);
 417
 418             pmc->vtable    = vtable;
 419             VTABLE_set_pointer(interp, pmc, pmc);
 420         }
 421
 422         return pmc;
 423     }
 424
 425     if (vtable_flags & VTABLE_IS_CONST_PMC_FLAG)
 426         flags |= PObj_constant_FLAG;
 427     else if (vtable_flags & VTABLE_IS_CONST_FLAG) {
 428         /* put the normal vtable in, so that the pmc can be initialized first
 429          * parrot or user code has to set the _ro property then,
 430          * to morph the PMC to the const variant
 431          * This assumes that a constant PMC enum is one bigger then
 432          * the normal one.
 433          */
 434
 435         /*
 436          * XXX not yet we can't assure that all contents in the
 437          * const PMC is const too
 438          * see e.g. t/pmc/sarray_13.pir
 439          */
 440         --base_type;
 441         vtable = interp->vtables[base_type];
 442     }
 443
 444     if (vtable_flags & VTABLE_IS_SHARED_FLAG)
 445         flags |= PObj_is_PMC_shared_FLAG;
 446
 447     newpmc         = Parrot_gc_new_pmc_header(interp, flags);
 448     newpmc->vtable = vtable;
 449
 450     if (vtable->attr_size)
 451         Parrot_gc_allocate_pmc_attributes(interp, newpmc);
 452
 453     return newpmc;
 454 }
 455
 456
 457 /*
 458
 459 =item C<PMC * Parrot_pmc_new_noinit(PARROT_INTERP, INTVAL base_type)>
 460
 461 Creates a new PMC of type C<base_type> (which is an index into the list of PMC
 462 types declared in C<vtables> in F<include/parrot/pmc.h>). Unlike C<Parrot_pmc_new()>,
 463 C<Parrot_pmc_new_noinit()> does not call its C<init> method.  This allows separate
 464 allocation and initialization for continuations.
 465
 466 =cut
 467
 468 */
 469
 470 PARROT_EXPORT
 471 PARROT_CANNOT_RETURN_NULL
 472 PMC *
 473 Parrot_pmc_new_noinit(PARROT_INTERP, INTVAL base_type)
 474 {
 475     ASSERT_ARGS(Parrot_pmc_new_noinit)
 476     PMC *const classobj = interp->vtables[base_type]->pmc_class;
 477
 478     if (!PMC_IS_NULL(classobj) && PObj_is_class_TEST(classobj))
 479         return VTABLE_instantiate(interp, classobj, PMCNULL);
 480
 481     return get_new_pmc_header(interp, base_type, 0);
 482 }
 483
 484
 485 /*
 486
 487 =item C<PMC * Parrot_pmc_new_constant_noinit(PARROT_INTERP, INTVAL base_type)>
 488
 489 Creates a new constant PMC of type C<base_type>.
 490
 491 =cut
 492
 493 */
 494
 495 PARROT_EXPORT
 496 PARROT_CANNOT_RETURN_NULL
 497 PARROT_WARN_UNUSED_RESULT
 498 PMC *
 499 Parrot_pmc_new_constant_noinit(PARROT_INTERP, INTVAL base_type)
 500 {
 501     ASSERT_ARGS(Parrot_pmc_new_constant_noinit)
 502     return get_new_pmc_header(interp, base_type, PObj_constant_FLAG);
 503 }
 504
 505
 506 /*
 507
 508 =item C<PMC * Parrot_pmc_new_constant(PARROT_INTERP, INTVAL base_type)>
 509
 510 Creates a new constant PMC of type C<base_type>, then calls its C<init>.
 511
 512 =cut
 513
 514 */
 515
 516 PARROT_EXPORT
 517 PARROT_CANNOT_RETURN_NULL
 518 PMC *
 519 Parrot_pmc_new_constant(PARROT_INTERP, INTVAL base_type)
 520 {
 521     ASSERT_ARGS(Parrot_pmc_new_constant)
 522     PMC * const pmc = get_new_pmc_header(interp, base_type, PObj_constant_FLAG);
 523     VTABLE_init(interp, pmc);
 524     return pmc;
 525 }
 526
 527
 528 /*
 529
 530 =item C<PMC * Parrot_pmc_new_init(PARROT_INTERP, INTVAL base_type, PMC *init)>
 531
 532 As C<Parrot_pmc_new()>, but passes C<init> to the PMC's C<init_pmc()> vtable entry.
 533
 534 =cut
 535
 536 */
 537
 538 PARROT_EXPORT
 539 PARROT_CANNOT_RETURN_NULL
 540 PMC *
 541 Parrot_pmc_new_init(PARROT_INTERP, INTVAL base_type, ARGOUT(PMC *init))
 542 {
 543     ASSERT_ARGS(Parrot_pmc_new_init)
 544     PMC *const classobj = interp->vtables[base_type]->pmc_class;
 545
 546     if (!PMC_IS_NULL(classobj) && PObj_is_class_TEST(classobj))
 547         return VTABLE_instantiate(interp, classobj, init);
 548     else {
 549         PMC * const pmc = get_new_pmc_header(interp, base_type, 0);
 550         VTABLE_init_pmc(interp, pmc, init);
 551         return pmc;
 552     }
 553 }
 554
 555
 556 /*
 557
 558 =item C<PMC * Parrot_pmc_new_init_int(PARROT_INTERP, INTVAL base_type, INTVAL
 559 init)>
 560
 561 As C<Parrot_pmc_new()>, but passes C<init> to the PMC's C<init_int()> vtable entry.
 562
 563 =cut
 564
 565 */
 566
 567 PARROT_EXPORT
 568 PARROT_CANNOT_RETURN_NULL
 569 PMC *
 570 Parrot_pmc_new_init_int(PARROT_INTERP, INTVAL base_type, INTVAL init)
 571 {
 572     ASSERT_ARGS(Parrot_pmc_new_init_int)
 573     PMC *const classobj = interp->vtables[base_type]->pmc_class;
 574
 575     if (!PMC_IS_NULL(classobj) && PObj_is_class_TEST(classobj)) {
 576         PMC * const initial =
 577           Parrot_pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_Integer));
 578         VTABLE_set_integer_native(interp, initial, init);
 579         return VTABLE_instantiate(interp, classobj, initial);
 580     }
 581     else {
 582         PMC * const pmc = get_new_pmc_header(interp, base_type, 0);
 583         VTABLE_init_int(interp, pmc, init);
 584         return pmc;
 585     }
 586 }
 587
 588
 589
 590 /*
 591
 592 =item C<PMC * Parrot_pmc_new_constant_init(PARROT_INTERP, INTVAL base_type, PMC
 593 *init)>
 594
 595 As C<Parrot_pmc_new_constant>, but passes C<init> to the PMC's C<init_pmc> vtable
 596 entry.
 597
 598 =cut
 599
 600 */
 601
 602 PARROT_EXPORT
 603 PARROT_CANNOT_RETURN_NULL
 604 PMC *
 605 Parrot_pmc_new_constant_init(PARROT_INTERP, INTVAL base_type, ARGIN_NULLOK(PMC *init))
 606 {
 607     ASSERT_ARGS(Parrot_pmc_new_constant_init)
 608     PMC * const pmc = get_new_pmc_header(interp, base_type, PObj_constant_FLAG);
 609     VTABLE_init_pmc(interp, pmc, init);
 610     return pmc;
 611 }
 612
 613
 614 /*
 615
 616 =item C<PMC * Parrot_pmc_new_constant_init_int(PARROT_INTERP, INTVAL base_type,
 617 INTVAL init)>
 618
 619 As C<Parrot_pmc_new_constant>, but passes C<init> to the PMC's C<init_int> vtable
 620 entry.
 621
 622 =cut
 623
 624 */
 625
 626 PARROT_EXPORT
 627 PARROT_CANNOT_RETURN_NULL
 628 PMC *
 629 Parrot_pmc_new_constant_init_int(PARROT_INTERP, INTVAL base_type, INTVAL init)
 630 {
 631     ASSERT_ARGS(Parrot_pmc_new_constant_init_int)
 632     PMC * const pmc = get_new_pmc_header(interp, base_type, PObj_constant_FLAG);
 633     VTABLE_init_int(interp, pmc, init);
 634     return pmc;
 635 }
 636
 637
 638 /*
 639
 640 =item C<PMC * Parrot_pmc_new_temporary(PARROT_INTERP, INTVAL base_type)>
 641
 642 Creates a new temporary PMC of type C<base_type>, then call C<init>. Cannot
 643 be used to create PMC Objects which have been defined from PIR.
 644
 645 B<You> are responsible for freeing this PMC when it goes out of scope with
 646 C<Parrot_pmc_free_temporary()>.  B<Do not> store this PMC in any other PMCs, or
 647 allow it to be stored.  B<Do not> store any regular PMC in this PMC, or
 648 allow the storage of any regular PMC in this PMC. Temporary PMCs do not
 649 participate in garbage collection, and mixing them with PMCs that are
 650 garbage-collected will cause bugs.
 651
 652 If you don't know what this means means, or you can't tell if either case
 653 will happen as the result of any call you make on or with this PMC,
 654 B<DO NOT> use this function, lest you cause weird crashes and memory errors.
 655 Use C<Parrot_pmc_new()> instead.
 656
 657 (Why do these functions even exist?  Used judiciously, they can reduce GC
 658 pressure in hotspots tremendously.  If you haven't audited the code carefully
 659 -- including profiling and benchmarking -- then use C<Parrot_pmc_new()> instead, and
 660 never B<ever> add C<PARROT_EXPORT> to either function.)
 661
 662 =cut
 663
 664 */
 665
 666 PARROT_CANNOT_RETURN_NULL
 667 PMC *
 668 Parrot_pmc_new_temporary(PARROT_INTERP, INTVAL base_type)
 669 {
 670     ASSERT_ARGS(Parrot_pmc_new_temporary)
 671     PMC * const pmc = get_new_pmc_header(interp, base_type, PObj_constant_FLAG);
 672     VTABLE_init(interp, pmc);
 673     return pmc;
 674 }
 675
 676
 677 /*
 678
 679 =item C<void Parrot_pmc_free_temporary(PARROT_INTERP, PMC *pmc)>
 680
 681 Frees a new temporary PMC created by C<temporary_Parrot_pmc_new()>.  Do not call
 682 this with any other type of PMC.  Do not forget to call this (or you'll leak
 683 PMCs). Read and I<understand> the warnings for C<temporary_Parrot_pmc_new()> before
 684 you're tempted to use this.
 685
 686 =cut
 687
 688 */
 689
 690 void
 691 Parrot_pmc_free_temporary(PARROT_INTERP, ARGMOD(PMC *pmc))
 692 {
 693     ASSERT_ARGS(Parrot_pmc_free_temporary)
 694     Parrot_gc_free_pmc_header(interp, pmc);
 695 }
 696
 697
 698 /*
 699
 700 =item C<INTVAL Parrot_pmc_get_new_vtable_index(PARROT_INTERP)>
 701
 702 Get a new unique identifier number and allocate a new vtable structure for a
 703 new PMC type.
 704
 705 =cut
 706
 707 */
 708
 709 INTVAL
 710 Parrot_pmc_get_new_vtable_index(PARROT_INTERP)
 711 {
 712     ASSERT_ARGS(Parrot_pmc_get_new_vtable_index)
 713     const INTVAL type_id = interp->n_vtable_max++;
 714
 715     /* Have we overflowed the table? */
 716     if (type_id >= interp->n_vtable_alloced)
 717         parrot_realloc_vtables(interp);
 718
 719     return type_id;
 720 }
 721
 722 /*
 723
 724 =item C<INTVAL Parrot_pmc_register_new_type(PARROT_INTERP, STRING *name)>
 725
 726 Registers the name of a new PMC type with Parrot, returning the INTVAL
 727 representing that type.
 728
 729 =cut
 730
 731 */
 732
 733 PARROT_EXPORT
 734 INTVAL
 735 Parrot_pmc_register_new_type(PARROT_INTERP, ARGIN(STRING *name))
 736 {
 737     ASSERT_ARGS(Parrot_pmc_register_new_type)
 738     /* If they're looking to register an existing class, return that
 739        class' type number */
 740     INTVAL type = Parrot_pmc_get_type_str(interp, name);
 741
 742     if (type > enum_type_undef)
 743         return type;
 744
 745     if (type < enum_type_undef)
 746         Parrot_ex_throw_from_c_args(interp, NULL, 1,
 747             "undefined type already exists - can't register PMC");
 748
 749     type = Parrot_pmc_get_new_vtable_index(interp);
 750
 751     /* set entry in name->type hash */
 752     VTABLE_set_integer_keyed_str(interp, interp->class_hash, name, type);
 753
 754     return type;
 755 }
 756
 757
 758 /*
 759
 760 =item C<INTVAL Parrot_pmc_get_type_str(PARROT_INTERP, STRING *name)>
 761
 762 Returns the PMC type for C<name>.
 763
 764 =cut
 765
 766 */
 767
 768 PARROT_EXPORT
 769 PARROT_WARN_UNUSED_RESULT
 770 INTVAL
 771 Parrot_pmc_get_type_str(PARROT_INTERP, ARGIN_NULLOK(STRING *name))
 772 {
 773     ASSERT_ARGS(Parrot_pmc_get_type_str)
 774     if (STRING_IS_NULL(name))
 775         return enum_type_undef;
 776     else {
 777         PMC * const classname_hash = interp->class_hash;
 778         PMC * const item           =
 779             (PMC *)VTABLE_get_pointer_keyed_str(interp, classname_hash, name);
 780
 781         if (!PMC_IS_NULL(item)) {
 782             /* nested namespace with same name */
 783             if (PMC_IS_TYPE(item, NameSpace))
 784                 return enum_type_undef;
 785             else
 786                 return VTABLE_get_integer(interp, item);
 787         }
 788         else
 789             return Parrot_get_datatype_enum(interp, name);
 790     }
 791 }
 792
 793
 794 /*
 795
 796 =item C<INTVAL Parrot_pmc_get_type(PARROT_INTERP, PMC *name)>
 797
 798 Returns the PMC type for C<name>.
 799
 800 =cut
 801
 802 */
 803
 804 PARROT_EXPORT
 805 INTVAL
 806 Parrot_pmc_get_type(PARROT_INTERP, ARGIN(PMC *name))
 807 {
 808     ASSERT_ARGS(Parrot_pmc_get_type)
 809     PMC * const classname_hash = interp->class_hash;
 810     PMC * const item = (PMC *)VTABLE_get_pointer_keyed(interp, classname_hash, name);
 811
 812     if (!PMC_IS_NULL(item))
 813         return VTABLE_get_integer(interp, item);
 814
 815     return 0;
 816 }
 817
 818
 819 /*
 820
 821 =item C<static PMC * create_class_pmc(PARROT_INTERP, INTVAL type)>
 822
 823 Create a class object for this interpreter.  Takes an interpreter name and type
 824 as arguments.  Returns a pointer to the class object.
 825
 826 =cut
 827
 828 */
 829
 830 PARROT_WARN_UNUSED_RESULT
 831 PARROT_CANNOT_RETURN_NULL
 832 static PMC *
 833 create_class_pmc(PARROT_INTERP, INTVAL type)
 834 {
 835     ASSERT_ARGS(create_class_pmc)
 836     /*
 837      * class interface - a PMC is its own class
 838      * put an instance of this PMC into class
 839      *
 840      * create a constant PMC
 841      */
 842     PMC * const _class = get_new_pmc_header(interp, type,
 843                                            PObj_constant_FLAG);
 844
 845     /* If we are a second thread, we may get the same object as the
 846      * original because we have a singleton. Just set the singleton to
 847      * be our class object, but don't mess with its vtable.  */
 848     if ((interp->vtables[type]->flags & VTABLE_PMC_IS_SINGLETON)
 849     &&  (_class == _class->vtable->pmc_class))
 850         interp->vtables[type]->pmc_class = _class;
 851     else {
 852         gc_flag_CLEAR(is_special_PMC, _class);
 853         PObj_is_PMC_shared_CLEAR(_class);
 854         interp->vtables[type]->pmc_class = _class;
 855     }
 856
 857     return _class;
 858 }
 859
 860
 861 /*
 862
 863 =item C<void Parrot_pmc_create_mro(PARROT_INTERP, INTVAL type)>
 864
 865 Create the MRO (method resolution order) array for this type.
 866
 867 =cut
 868
 869 */
 870
 871 PARROT_EXPORT
 872 void
 873 Parrot_pmc_create_mro(PARROT_INTERP, INTVAL type)
 874 {
 875     ASSERT_ARGS(Parrot_pmc_create_mro)
 876     PMC    *mro;
 877     VTABLE *vtable   = interp->vtables[type];
 878     PMC    * const mro_list = vtable->mro;
 879     INTVAL  i, count;
 880
 881     /* this should never be PMCNULL */
 882     PARROT_ASSERT(!PMC_IS_NULL(mro_list));
 883
 884     /* multithreaded: has already mro */
 885     if (mro_list->vtable->base_type != enum_class_ResizableStringArray)
 886         return;
 887
 888     mro         = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
 889     vtable->mro = mro;
 890
 891     if (vtable->ro_variant_vtable)
 892         vtable->ro_variant_vtable->mro = mro;
 893
 894     count = VTABLE_elements(interp, mro_list);
 895
 896     for (i = 0; i < count; ++i) {
 897         STRING * const class_name = VTABLE_get_string_keyed_int(interp, mro_list, i);
 898         const INTVAL parent_type  = Parrot_pmc_get_type_str(interp, class_name);
 899         PMC *_class;
 900
 901         /* abstract classes don't have a vtable */
 902         if (!parent_type)
 903             break;
 904
 905         vtable = interp->vtables[parent_type];
 906
 907         if (!vtable->_namespace) {
 908             /* need a namespace Hash, anchor at parent, name it */
 909             PMC * const ns     = Parrot_pmc_new(interp,
 910                     Parrot_get_ctx_HLL_type(interp, enum_class_NameSpace));
 911             vtable->_namespace = ns;
 912
 913             /* anchor at parent, aka current_namespace, that is 'parrot' */
 914             VTABLE_set_pmc_keyed_str(interp,
 915                     Parrot_pcc_get_namespace(interp, CURRENT_CONTEXT(interp)), class_name, ns);
 916         }
 917
 918         _class = vtable->pmc_class;
 919         if (!_class)
 920             _class = create_class_pmc(interp, parent_type);
 921
 922         VTABLE_push_pmc(interp, mro, _class);
 923     }
 924 }
 925
 926
 927 /*
 928
 929 =back
 930
 931 =head2 GC registry interface
 932
 933 =over 4
 934
 935 =item C<void Parrot_pmc_gc_register(PARROT_INTERP, PMC *pmc)>
 936
 937 Registers the PMC with the interpreter's GC registry.
 938
 939 =cut
 940
 941 */
 942
 943 PARROT_EXPORT
 944 void
 945 Parrot_pmc_gc_register(PARROT_INTERP, ARGIN(PMC *pmc))
 946 {
 947     ASSERT_ARGS(Parrot_pmc_gc_register)
 948     /* Better not trigger a GC run with a potentially unanchored PMC */
 949     Parrot_block_GC_mark(interp);
 950
 951     PARROT_ASSERT(interp->gc_registry);
 952
 953     VTABLE_set_pmc_keyed(interp, interp->gc_registry, pmc, PMCNULL);
 954     Parrot_unblock_GC_mark(interp);
 955 }
 956
 957 /*
 958
 959 =item C<void Parrot_pmc_gc_unregister(PARROT_INTERP, PMC *pmc)>
 960
 961 Unregisters the PMC from the interpreter's GC registry.
 962
 963 =cut
 964
 965 */
 966
 967 PARROT_EXPORT
 968 void
 969 Parrot_pmc_gc_unregister(PARROT_INTERP, ARGIN(PMC *pmc))
 970 {
 971     ASSERT_ARGS(Parrot_pmc_gc_unregister)
 972     PARROT_ASSERT(interp->gc_registry);
 973
 974     VTABLE_delete_keyed(interp, interp->gc_registry, pmc);
 975 }
 976
 977 /*
 978
 979 =item C<INTVAL Parrot_pmc_type_does(PARROT_INTERP, STRING *role, INTVAL type)>
 980
 981 Checks to see if PMCs of the given type does the given role. Checks
 982 C<<vtable->provides_str>> to find a match.
 983 Returns true (1) if B<role> is found, false (0) otherwise.
 984
 985 =cut
 986
 987 */
 988
 989 INTVAL
 990 Parrot_pmc_type_does(PARROT_INTERP, ARGIN(STRING *role), INTVAL type)
 991 {
 992     ASSERT_ARGS(Parrot_pmc_type_does)
 993
 994     INTVAL pos = 0;
 995     STRING * const what = interp->vtables[type]->provides_str;
 996     INTVAL length = Parrot_str_byte_length(interp, what);
 997
 998     do {
 999         INTVAL len;
1000         const INTVAL idx = Parrot_str_find_index(interp, what, role, (INTVAL)pos);
1001
1002         if ((idx < 0) || (idx >= length))
1003             return 0;
1004
1005         pos = idx;
1006         len = Parrot_str_byte_length(interp, role);
1007
1008         if (pos && (Parrot_str_indexed(interp, what, pos - 1) != 32)) {
1009             pos += len;
1010             continue;
1011         }
1012
1013         if (pos + len < length) {
1014             pos += len;
1015             if (Parrot_str_indexed(interp, what, pos) != 32)
1016                 continue;
1017         }
1018
1019         return 1;
1020     } while (1);
1021 }
1022
1023 /*
1024
1025 =back
1026
1027 =head1 SEE ALSO
1028
1029 F<include/parrot/vtable.h>.
1030
1031 C<5.1.0.14.2.20011008152120.02158148@pop.sidhe.org>
1032 (http://www.nntp.perl.org/group/perl.perl6.internals/5516).
1033
1034 =cut
1035
1036 */
1037
1038 /*
1039  * Local variables:
1040  *   c-file-style: "parrot"
1041  * End:
1042  * vim: expandtab shiftwidth=4:
1043  */