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