src/pmc.c

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