2 Copyright (C) 2001-2010, Parrot Foundation.
11 The base vtable calling functions
21 #include "parrot/parrot.h"
23 #include "pmc/pmc_class.h"
24 #include "pmc/pmc_callcontext.h"
26 /* HEADERIZER HFILE: include/parrot/pmc.h */
28 /* HEADERIZER BEGIN: static */
29 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
31 static void check_pmc_reuse_flags(PARROT_INTERP
,
34 __attribute__nonnull__(1);
36 PARROT_WARN_UNUSED_RESULT
37 PARROT_CANNOT_RETURN_NULL
38 static PMC
* create_class_pmc(PARROT_INTERP
, INTVAL type
)
39 __attribute__nonnull__(1);
41 PARROT_WARN_UNUSED_RESULT
42 PARROT_CANNOT_RETURN_NULL
43 static PMC
* get_new_pmc_header(PARROT_INTERP
,
46 __attribute__nonnull__(1);
48 PARROT_CANNOT_RETURN_NULL
49 static PMC
* Parrot_pmc_reuse_noinit(PARROT_INTERP
,
52 __attribute__nonnull__(1)
53 __attribute__nonnull__(2);
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 */
74 =item C<INTVAL Parrot_pmc_is_null(PARROT_INTERP, const PMC *pmc)>
76 Tests if the given pmc is null.
84 PARROT_WARN_UNUSED_RESULT
87 Parrot_pmc_is_null(SHIM_INTERP
, ARGIN_NULLOK(const PMC
*pmc
))
89 ASSERT_ARGS(Parrot_pmc_is_null
)
90 /* We can't use PMC_IS_NULL() because that calls us here in some cases */
92 return pmc
== PMCNULL
|| pmc
== NULL
;
100 =item C<void Parrot_pmc_destroy(PARROT_INTERP, PMC *pmc)>
102 Destroy a PMC. Call his destroy vtable function if needed, and deallocate
103 his attributes if they are automatically allocated.
105 For internal usage of the PMC handling functions and garbage collection
114 Parrot_pmc_destroy(PARROT_INTERP
, ARGMOD(PMC
*pmc
))
116 ASSERT_ARGS(Parrot_pmc_destroy
)
118 if (PObj_custom_destroy_TEST(pmc
))
119 VTABLE_destroy(interp
, pmc
);
123 if (pmc
->vtable
->attr_size
)
124 Parrot_gc_free_pmc_attributes(interp
, pmc
);
126 PMC_data(pmc
) = NULL
;
130 pmc
->data
= (DPOINTER
*)0xdeadbeef;
138 =item C<PMC * Parrot_pmc_new(PARROT_INTERP, INTVAL base_type)>
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.
150 PARROT_CANNOT_RETURN_NULL
151 PARROT_WARN_UNUSED_RESULT
153 Parrot_pmc_new(PARROT_INTERP
, INTVAL base_type
)
155 ASSERT_ARGS(Parrot_pmc_new
)
156 PARROT_ASSERT(interp
->vtables
[base_type
]);
158 PMC
*const classobj
= interp
->vtables
[base_type
]->pmc_class
;
160 if (!PMC_IS_NULL(classobj
) && PObj_is_class_TEST(classobj
))
161 return VTABLE_instantiate(interp
, classobj
, PMCNULL
);
163 PMC
* const pmc
= get_new_pmc_header(interp
, base_type
, 0);
164 VTABLE_init(interp
, pmc
);
172 =item C<PMC * Parrot_pmc_reuse(PARROT_INTERP, PMC *pmc, INTVAL new_type, UINTVAL
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.
179 Cannot currently handle converting a non-Object PMC into an Object. Use
180 C<pmc_reuse_by_class> for that.
188 PARROT_CANNOT_RETURN_NULL
189 PARROT_IGNORABLE_RESULT
191 Parrot_pmc_reuse(PARROT_INTERP
, ARGIN(PMC
*pmc
), INTVAL new_type
, SHIM(UINTVAL flags
))
193 ASSERT_ARGS(Parrot_pmc_reuse
)
194 pmc
= Parrot_pmc_reuse_noinit(interp
, pmc
, new_type
);
196 /* Call the base init for the redone pmc. Warning, this should not
197 be called on Object PMCs. */
198 VTABLE_init(interp
, pmc
);
205 =item C<PMC * Parrot_pmc_reuse_init(PARROT_INTERP, PMC *pmc, INTVAL new_type,
206 PMC *init, UINTVAL flags)>
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.
212 Cannot currently handle converting a non-Object PMC into an Object. Use
213 C<pmc_reuse_by_class> for that.
221 PARROT_CANNOT_RETURN_NULL
222 PARROT_IGNORABLE_RESULT
224 Parrot_pmc_reuse_init(PARROT_INTERP
, ARGIN(PMC
*pmc
), INTVAL new_type
, ARGIN(PMC
*init
),
227 ASSERT_ARGS(Parrot_pmc_reuse_init
)
228 pmc
= Parrot_pmc_reuse_noinit(interp
, pmc
, new_type
);
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
);
239 =item C<static PMC* Parrot_pmc_reuse_noinit(PARROT_INTERP, PMC *pmc, INTVAL
242 Prepare pmc for reuse. Do all scuffolding except initing.
248 PARROT_CANNOT_RETURN_NULL
250 Parrot_pmc_reuse_noinit(PARROT_INTERP
, ARGIN(PMC
*pmc
), INTVAL new_type
)
252 ASSERT_ARGS(Parrot_pmc_reuse_noinit
)
254 if (pmc
->vtable
->base_type
!= new_type
) {
255 VTABLE
* const new_vtable
= interp
->vtables
[new_type
];
257 /* Singleton/const PMCs/types are not eligible */
258 check_pmc_reuse_flags(interp
, pmc
->vtable
->flags
, new_vtable
->flags
);
260 /* Free the old PMC resources. */
261 Parrot_pmc_destroy(interp
, pmc
);
263 PObj_flags_SETTO(pmc
, PObj_is_PMC_FLAG
);
265 /* Set the right vtable */
266 pmc
->vtable
= new_vtable
;
268 if (new_vtable
->attr_size
)
269 Parrot_gc_allocate_pmc_attributes(interp
, pmc
);
271 PMC_data(pmc
) = NULL
;
279 =item C<PMC * Parrot_pmc_reuse_by_class(PARROT_INTERP, PMC *pmc, PMC *class_,
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.
292 PARROT_CANNOT_RETURN_NULL
293 PARROT_IGNORABLE_RESULT
295 Parrot_pmc_reuse_by_class(PARROT_INTERP
, ARGMOD(PMC
*pmc
), ARGIN(PMC
*class_
), UINTVAL flags
)
297 ASSERT_ARGS(Parrot_pmc_reuse_by_class
)
298 const INTVAL new_type
= PARROT_CLASS(class_
)->id
;
300 if (pmc
->vtable
->base_type
!= new_type
) {
301 VTABLE
* const new_vtable
= interp
->vtables
[new_type
];
303 /* Singleton/const PMCs/types are not eligible */
304 check_pmc_reuse_flags(interp
, pmc
->vtable
->flags
, new_vtable
->flags
);
306 Parrot_pmc_destroy(interp
, pmc
);
308 PObj_flags_SETTO(pmc
, PObj_is_PMC_FLAG
| flags
);
310 /* Set the right vtable */
311 pmc
->vtable
= new_vtable
;
313 if (new_vtable
->attr_size
)
314 Parrot_gc_allocate_pmc_attributes(interp
, pmc
);
316 PMC_data(pmc
) = NULL
;
325 =item C<static void check_pmc_reuse_flags(PARROT_INTERP, UINTVAL srcflags,
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.
338 check_pmc_reuse_flags(PARROT_INTERP
, UINTVAL srcflags
, UINTVAL destflags
)
340 ASSERT_ARGS(check_pmc_reuse_flags
)
341 if ((srcflags
| destflags
) & (VTABLE_PMC_IS_SINGLETON
| VTABLE_IS_CONST_FLAG
))
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");
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");
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");
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");
371 =item C<static PMC * get_new_pmc_header(PARROT_INTERP, INTVAL base_type, UINTVAL
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.
382 PARROT_WARN_UNUSED_RESULT
383 PARROT_CANNOT_RETURN_NULL
385 get_new_pmc_header(PARROT_INTERP
, INTVAL base_type
, UINTVAL flags
)
387 ASSERT_ARGS(get_new_pmc_header
)
389 VTABLE
*vtable
= interp
->vtables
[base_type
];
390 UINTVAL vtable_flags
;
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
397 PANIC(interp
, "Null vtable used; did you add a new PMC?");
399 vtable_flags
= vtable
->flags
;
401 /* we only have one global Env object, living in the interp */
402 if (vtable_flags
& VTABLE_PMC_IS_SINGLETON
) {
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
409 * - singletons are created in the constant pmc pool
411 PMC
*pmc
= (PMC
*)(vtable
->get_pointer
)(interp
, NULL
);
415 pmc
= Parrot_gc_new_pmc_header(interp
, PObj_constant_FLAG
);
418 pmc
->vtable
= vtable
;
419 VTABLE_set_pointer(interp
, pmc
, pmc
);
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
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
441 vtable
= interp
->vtables
[base_type
];
444 if (vtable_flags
& VTABLE_IS_SHARED_FLAG
)
445 flags
|= PObj_is_PMC_shared_FLAG
;
447 newpmc
= Parrot_gc_new_pmc_header(interp
, flags
);
448 newpmc
->vtable
= vtable
;
450 if (vtable
->attr_size
)
451 Parrot_gc_allocate_pmc_attributes(interp
, newpmc
);
459 =item C<PMC * Parrot_pmc_new_noinit(PARROT_INTERP, INTVAL base_type)>
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.
471 PARROT_CANNOT_RETURN_NULL
473 Parrot_pmc_new_noinit(PARROT_INTERP
, INTVAL base_type
)
475 ASSERT_ARGS(Parrot_pmc_new_noinit
)
476 PMC
*const classobj
= interp
->vtables
[base_type
]->pmc_class
;
478 if (!PMC_IS_NULL(classobj
) && PObj_is_class_TEST(classobj
))
479 return VTABLE_instantiate(interp
, classobj
, PMCNULL
);
481 return get_new_pmc_header(interp
, base_type
, 0);
487 =item C<PMC * Parrot_pmc_new_constant_noinit(PARROT_INTERP, INTVAL base_type)>
489 Creates a new constant PMC of type C<base_type>.
496 PARROT_CANNOT_RETURN_NULL
497 PARROT_WARN_UNUSED_RESULT
499 Parrot_pmc_new_constant_noinit(PARROT_INTERP
, INTVAL base_type
)
501 ASSERT_ARGS(Parrot_pmc_new_constant_noinit
)
502 return get_new_pmc_header(interp
, base_type
, PObj_constant_FLAG
);
508 =item C<PMC * Parrot_pmc_new_constant(PARROT_INTERP, INTVAL base_type)>
510 Creates a new constant PMC of type C<base_type>, then calls its C<init>.
517 PARROT_CANNOT_RETURN_NULL
519 Parrot_pmc_new_constant(PARROT_INTERP
, INTVAL base_type
)
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
);
530 =item C<PMC * Parrot_pmc_new_init(PARROT_INTERP, INTVAL base_type, PMC *init)>
532 As C<Parrot_pmc_new()>, but passes C<init> to the PMC's C<init_pmc()> vtable entry.
539 PARROT_CANNOT_RETURN_NULL
541 Parrot_pmc_new_init(PARROT_INTERP
, INTVAL base_type
, ARGOUT(PMC
*init
))
543 ASSERT_ARGS(Parrot_pmc_new_init
)
544 PMC
*const classobj
= interp
->vtables
[base_type
]->pmc_class
;
546 if (!PMC_IS_NULL(classobj
) && PObj_is_class_TEST(classobj
))
547 return VTABLE_instantiate(interp
, classobj
, init
);
549 PMC
* const pmc
= get_new_pmc_header(interp
, base_type
, 0);
550 VTABLE_init_pmc(interp
, pmc
, init
);
558 =item C<PMC * Parrot_pmc_new_init_int(PARROT_INTERP, INTVAL base_type, INTVAL
561 As C<Parrot_pmc_new()>, but passes C<init> to the PMC's C<init_int()> vtable entry.
568 PARROT_CANNOT_RETURN_NULL
570 Parrot_pmc_new_init_int(PARROT_INTERP
, INTVAL base_type
, INTVAL init
)
572 ASSERT_ARGS(Parrot_pmc_new_init_int
)
573 PMC
*const classobj
= interp
->vtables
[base_type
]->pmc_class
;
575 if (!PMC_IS_NULL(classobj
) && PObj_is_class_TEST(classobj
)) {
576 PMC
* const obj
= VTABLE_instantiate(interp
, classobj
, PMCNULL
);
577 VTABLE_set_integer_native(interp
, obj
, init
);
581 PMC
* const pmc
= get_new_pmc_header(interp
, base_type
, 0);
582 VTABLE_init_int(interp
, pmc
, init
);
591 =item C<PMC * Parrot_pmc_new_constant_init(PARROT_INTERP, INTVAL base_type, PMC
594 As C<Parrot_pmc_new_constant>, but passes C<init> to the PMC's C<init_pmc> vtable
602 PARROT_CANNOT_RETURN_NULL
604 Parrot_pmc_new_constant_init(PARROT_INTERP
, INTVAL base_type
, ARGIN_NULLOK(PMC
*init
))
606 ASSERT_ARGS(Parrot_pmc_new_constant_init
)
607 PMC
* const pmc
= get_new_pmc_header(interp
, base_type
, PObj_constant_FLAG
);
608 VTABLE_init_pmc(interp
, pmc
, init
);
615 =item C<PMC * Parrot_pmc_new_constant_init_int(PARROT_INTERP, INTVAL base_type,
618 As C<Parrot_pmc_new_constant>, but passes C<init> to the PMC's C<init_int> vtable
626 PARROT_CANNOT_RETURN_NULL
628 Parrot_pmc_new_constant_init_int(PARROT_INTERP
, INTVAL base_type
, INTVAL init
)
630 ASSERT_ARGS(Parrot_pmc_new_constant_init_int
)
631 PMC
* const pmc
= get_new_pmc_header(interp
, base_type
, PObj_constant_FLAG
);
632 VTABLE_init_int(interp
, pmc
, init
);
639 =item C<PMC * Parrot_pmc_new_temporary(PARROT_INTERP, INTVAL base_type)>
641 Creates a new temporary PMC of type C<base_type>, then call C<init>. Cannot
642 be used to create PMC Objects which have been defined from PIR.
644 B<You> are responsible for freeing this PMC when it goes out of scope with
645 C<Parrot_pmc_free_temporary()>. B<Do not> store this PMC in any other PMCs, or
646 allow it to be stored. B<Do not> store any regular PMC in this PMC, or
647 allow the storage of any regular PMC in this PMC. Temporary PMCs do not
648 participate in garbage collection, and mixing them with PMCs that are
649 garbage-collected will cause bugs.
651 If you don't know what this means means, or you can't tell if either case
652 will happen as the result of any call you make on or with this PMC,
653 B<DO NOT> use this function, lest you cause weird crashes and memory errors.
654 Use C<Parrot_pmc_new()> instead.
656 (Why do these functions even exist? Used judiciously, they can reduce GC
657 pressure in hotspots tremendously. If you haven't audited the code carefully
658 -- including profiling and benchmarking -- then use C<Parrot_pmc_new()> instead, and
659 never B<ever> add C<PARROT_EXPORT> to either function.)
665 PARROT_CANNOT_RETURN_NULL
667 Parrot_pmc_new_temporary(PARROT_INTERP
, INTVAL base_type
)
669 ASSERT_ARGS(Parrot_pmc_new_temporary
)
670 PMC
* const pmc
= get_new_pmc_header(interp
, base_type
, PObj_constant_FLAG
);
671 VTABLE_init(interp
, pmc
);
678 =item C<void Parrot_pmc_free_temporary(PARROT_INTERP, PMC *pmc)>
680 Frees a new temporary PMC created by C<temporary_Parrot_pmc_new()>. Do not call
681 this with any other type of PMC. Do not forget to call this (or you'll leak
682 PMCs). Read and I<understand> the warnings for C<temporary_Parrot_pmc_new()> before
683 you're tempted to use this.
690 Parrot_pmc_free_temporary(PARROT_INTERP
, ARGMOD(PMC
*pmc
))
692 ASSERT_ARGS(Parrot_pmc_free_temporary
)
693 Parrot_gc_free_pmc_header(interp
, pmc
);
699 =item C<INTVAL Parrot_pmc_get_new_vtable_index(PARROT_INTERP)>
701 Get a new unique identifier number and allocate a new vtable structure for a
709 Parrot_pmc_get_new_vtable_index(PARROT_INTERP
)
711 ASSERT_ARGS(Parrot_pmc_get_new_vtable_index
)
712 const INTVAL type_id
= interp
->n_vtable_max
++;
714 /* Have we overflowed the table? */
715 if (type_id
>= interp
->n_vtable_alloced
)
716 parrot_realloc_vtables(interp
);
723 =item C<INTVAL Parrot_pmc_register_new_type(PARROT_INTERP, STRING *name)>
725 Registers the name of a new PMC type with Parrot, returning the INTVAL
726 representing that type.
734 Parrot_pmc_register_new_type(PARROT_INTERP
, ARGIN(STRING
*name
))
736 ASSERT_ARGS(Parrot_pmc_register_new_type
)
737 /* If they're looking to register an existing class, return that
738 class' type number */
739 INTVAL type
= Parrot_pmc_get_type_str(interp
, name
);
741 if (type
> enum_type_undef
)
744 if (type
< enum_type_undef
)
745 Parrot_ex_throw_from_c_args(interp
, NULL
, 1,
746 "undefined type already exists - can't register PMC");
748 type
= Parrot_pmc_get_new_vtable_index(interp
);
750 /* set entry in name->type hash */
751 VTABLE_set_integer_keyed_str(interp
, interp
->class_hash
, name
, type
);
759 =item C<INTVAL Parrot_pmc_get_type_str(PARROT_INTERP, STRING *name)>
761 Returns the PMC type for C<name>.
768 PARROT_WARN_UNUSED_RESULT
770 Parrot_pmc_get_type_str(PARROT_INTERP
, ARGIN_NULLOK(STRING
*name
))
772 ASSERT_ARGS(Parrot_pmc_get_type_str
)
773 if (STRING_IS_NULL(name
))
774 return enum_type_undef
;
776 PMC
* const classname_hash
= interp
->class_hash
;
778 (PMC
*)VTABLE_get_pointer_keyed_str(interp
, classname_hash
, name
);
780 if (!PMC_IS_NULL(item
)) {
781 /* nested namespace with same name */
782 if (PMC_IS_TYPE(item
, NameSpace
))
783 return enum_type_undef
;
785 return VTABLE_get_integer(interp
, item
);
788 return Parrot_get_datatype_enum(interp
, name
);
795 =item C<INTVAL Parrot_pmc_get_type(PARROT_INTERP, PMC *name)>
797 Returns the PMC type for C<name>.
805 Parrot_pmc_get_type(PARROT_INTERP
, ARGIN(PMC
*name
))
807 ASSERT_ARGS(Parrot_pmc_get_type
)
808 PMC
* const classname_hash
= interp
->class_hash
;
809 PMC
* const item
= (PMC
*)VTABLE_get_pointer_keyed(interp
, classname_hash
, name
);
811 if (!PMC_IS_NULL(item
))
812 return VTABLE_get_integer(interp
, item
);
820 =item C<static PMC * create_class_pmc(PARROT_INTERP, INTVAL type)>
822 Create a class object for this interpreter. Takes an interpreter name and type
823 as arguments. Returns a pointer to the class object.
829 PARROT_WARN_UNUSED_RESULT
830 PARROT_CANNOT_RETURN_NULL
832 create_class_pmc(PARROT_INTERP
, INTVAL type
)
834 ASSERT_ARGS(create_class_pmc
)
836 * class interface - a PMC is its own class
837 * put an instance of this PMC into class
839 * create a constant PMC
841 PMC
* const _class
= get_new_pmc_header(interp
, type
,
844 /* If we are a second thread, we may get the same object as the
845 * original because we have a singleton. Just set the singleton to
846 * be our class object, but don't mess with its vtable. */
847 if ((interp
->vtables
[type
]->flags
& VTABLE_PMC_IS_SINGLETON
)
848 && (_class
== _class
->vtable
->pmc_class
))
849 interp
->vtables
[type
]->pmc_class
= _class
;
851 gc_flag_CLEAR(is_special_PMC
, _class
);
852 PObj_is_PMC_shared_CLEAR(_class
);
853 interp
->vtables
[type
]->pmc_class
= _class
;
862 =item C<void Parrot_pmc_create_mro(PARROT_INTERP, INTVAL type)>
864 Create the MRO (method resolution order) array for this type.
872 Parrot_pmc_create_mro(PARROT_INTERP
, INTVAL type
)
874 ASSERT_ARGS(Parrot_pmc_create_mro
)
876 VTABLE
*vtable
= interp
->vtables
[type
];
877 PMC
* const mro_list
= vtable
->mro
;
880 /* this should never be PMCNULL */
881 PARROT_ASSERT(!PMC_IS_NULL(mro_list
));
883 /* multithreaded: has already mro */
884 if (mro_list
->vtable
->base_type
!= enum_class_ResizableStringArray
)
887 mro
= Parrot_pmc_new(interp
, enum_class_ResizablePMCArray
);
890 if (vtable
->ro_variant_vtable
)
891 vtable
->ro_variant_vtable
->mro
= mro
;
893 count
= VTABLE_elements(interp
, mro_list
);
895 for (i
= 0; i
< count
; ++i
) {
896 STRING
* const class_name
= VTABLE_get_string_keyed_int(interp
, mro_list
, i
);
897 const INTVAL parent_type
= Parrot_pmc_get_type_str(interp
, class_name
);
900 /* abstract classes don't have a vtable */
904 vtable
= interp
->vtables
[parent_type
];
906 if (!vtable
->_namespace
) {
907 /* need a namespace Hash, anchor at parent, name it */
908 PMC
* const ns
= Parrot_pmc_new(interp
,
909 Parrot_get_ctx_HLL_type(interp
, enum_class_NameSpace
));
910 vtable
->_namespace
= ns
;
912 /* anchor at parent, aka current_namespace, that is 'parrot' */
913 VTABLE_set_pmc_keyed_str(interp
,
914 Parrot_pcc_get_namespace(interp
, CURRENT_CONTEXT(interp
)), class_name
, ns
);
917 _class
= vtable
->pmc_class
;
919 _class
= create_class_pmc(interp
, parent_type
);
921 VTABLE_push_pmc(interp
, mro
, _class
);
930 =head2 GC registry interface
934 =item C<void Parrot_pmc_gc_register(PARROT_INTERP, PMC *pmc)>
936 Registers the PMC with the interpreter's GC registry.
944 Parrot_pmc_gc_register(PARROT_INTERP
, ARGIN(PMC
*pmc
))
946 ASSERT_ARGS(Parrot_pmc_gc_register
)
947 /* Better not trigger a GC run with a potentially unanchored PMC */
948 Parrot_block_GC_mark(interp
);
950 PARROT_ASSERT(interp
->gc_registry
);
952 VTABLE_set_pmc_keyed(interp
, interp
->gc_registry
, pmc
, PMCNULL
);
953 Parrot_unblock_GC_mark(interp
);
958 =item C<void Parrot_pmc_gc_unregister(PARROT_INTERP, PMC *pmc)>
960 Unregisters the PMC from the interpreter's GC registry.
968 Parrot_pmc_gc_unregister(PARROT_INTERP
, ARGIN(PMC
*pmc
))
970 ASSERT_ARGS(Parrot_pmc_gc_unregister
)
971 PARROT_ASSERT(interp
->gc_registry
);
973 VTABLE_delete_keyed(interp
, interp
->gc_registry
, pmc
);
978 =item C<INTVAL Parrot_pmc_type_does(PARROT_INTERP, STRING *role, INTVAL type)>
980 Checks to see if PMCs of the given type does the given role. Checks
981 C<<vtable->provides_str>> to find a match.
982 Returns true (1) if B<role> is found, false (0) otherwise.
989 Parrot_pmc_type_does(PARROT_INTERP
, ARGIN(STRING
*role
), INTVAL type
)
991 ASSERT_ARGS(Parrot_pmc_type_does
)
994 STRING
* const what
= interp
->vtables
[type
]->provides_str
;
995 INTVAL length
= Parrot_str_byte_length(interp
, what
);
999 const INTVAL idx
= Parrot_str_find_index(interp
, what
, role
, (INTVAL
)pos
);
1001 if ((idx
< 0) || (idx
>= length
))
1005 len
= Parrot_str_byte_length(interp
, role
);
1007 if (pos
&& (Parrot_str_indexed(interp
, what
, pos
- 1) != 32)) {
1012 if (pos
+ len
< length
) {
1014 if (Parrot_str_indexed(interp
, what
, pos
) != 32)
1028 F<include/parrot/vtable.h>.
1030 C<5.1.0.14.2.20011008152120.02158148@pop.sidhe.org>
1031 (http://www.nntp.perl.org/group/perl.perl6.internals/5516).
1039 * c-file-style: "parrot"
1041 * vim: expandtab shiftwidth=4: