diff --git a/build/Makefile.in b/build/Makefile.in index 954e204c17d..fb2eba19795 100644 --- a/build/Makefile.in +++ b/build/Makefile.in @@ -124,10 +124,11 @@ SETTING = \ src/setting/Range.pm \ src/setting/Whatever.pm \ -PMCS = perl6str objectref perl6scalar mutablevar perl6multisub p6invocation +PMCS = perl6str objectref perl6scalar mutablevar perl6multisub p6invocation p6opaque PMC_SOURCES = $(PMC_DIR)/perl6str.pmc $(PMC_DIR)/objectref.pmc $(PMC_DIR)/perl6scalar.pmc \ - $(PMC_DIR)/mutablevar.pmc $(PMC_DIR)/perl6multisub.pmc $(PMC_DIR)/p6invocation.pmc + $(PMC_DIR)/mutablevar.pmc $(PMC_DIR)/perl6multisub.pmc $(PMC_DIR)/p6invocation.pmc \ + $(PMC_DIR)/p6opaque.pmc PERL6_GROUP = $(PMC_DIR)/perl6_group$(LOAD_EXT) diff --git a/src/classes/Object.pir b/src/classes/Object.pir index 0d94d7071e9..a7757822b46 100644 --- a/src/classes/Object.pir +++ b/src/classes/Object.pir @@ -450,6 +450,10 @@ XXX This had probably best really just tailcall .^CREATE; move this stuff later. if $S0 != 'Perl6Object' goto classinit_loop classinit_loop_end: + # Turn the example from a Parrot Object into a p6opaque; we'll ideally be + # able to create it as one in the future. + transform_to_p6opaque example + # Stash the example, clone it and we're done. setprop how, repr_lookup, example $P0 = clone example diff --git a/src/ops/perl6.ops b/src/ops/perl6.ops index b797c23539b..5a88b753414 100644 --- a/src/ops/perl6.ops +++ b/src/ops/perl6.ops @@ -23,6 +23,7 @@ an instance of class $2, where $2 is a subclass of the class of $1. */ inline op rebless_subclass(in PMC, in PMC) :base_core { PMC *value; + INTVAL p6opaque = pmc_type(interp, string_from_literal(interp, "P6opaque")); /* First verify that the object's class is a superclass of the one we're * to re-bless it into. While we're at it, count the number of attributes @@ -96,8 +97,11 @@ inline op rebless_subclass(in PMC, in PMC) :base_core { for (i = 0; i < new_attribs; i++) VTABLE_set_pmc_keyed_int(interp, PARROT_OBJECT(value)->attrib_store, i, pmc_new(interp, enum_class_Undef)); + + /* And make sure the new object is of the right type. */ + new_ins->vtable = interp->vtables[p6opaque]; } - else if (value->vtable->base_type != enum_class_Object + else if ((value->vtable->base_type != enum_class_Object && value->vtable->base_type != p6opaque) || current_class->vtable->base_type != enum_class_Class) { /* If we're here, we found a really odd state - the class claims to be * a standard Parrot one but the object it supposedly created is not. @@ -291,6 +295,31 @@ inline op get_next_candidate_info(out PMC, out PMC, out PMC) :base_core { goto NEXT(); } + +/* + +=item transform_to_p6opaque(inout PMC) + +Takes PMC $1 and swaps out its Object vtable for a P6opaque vtable. (Expect +this op to be temporary, but for now it lets us get things in the right +kinda direction.) + +=cut + +*/ +inline op transform_to_p6opaque(inout PMC) :base_core { + /* Sanity check. */ + if ($1->vtable->base_type == enum_class_Object) { + INTVAL type_id = pmc_type(interp, string_from_literal(interp, "P6opaque")); + $1->vtable = interp->vtables[type_id]; + } + else { + opcode_t *handler = Parrot_ex_throw_from_op_args(interp, NULL, + EXCEPTION_INVALID_OPERATION, "Can only transform an Object to p6opaque"); + goto ADDRESS(handler); + } +} + /* * Local variables: * c-file-style: "parrot" diff --git a/src/pmc/p6opaque.pmc b/src/pmc/p6opaque.pmc new file mode 100644 index 00000000000..65cd624c701 --- /dev/null +++ b/src/pmc/p6opaque.pmc @@ -0,0 +1,60 @@ +/* +$Id$ +Copyright (C) 2009, The Perl Foundation. + +=head1 NAME + +src/pmc/P6opaque.pmc - implements the P6opaque representation + +=head1 DESCRIPTION + +This subclasses Parrot's Object PMC to give us something P6opaque-ish. It will +end up containing various object behaviors that are specific to Perl 6. + +=head2 Methods + +=cut + +*/ + +#include "parrot/parrot.h" +#include "parrot/oo_private.h" + +pmclass P6opaque extends Object need_ext dynpmc group perl6_group { + +/* + +=item C + +Creates a clone of the object. Largely delegates to Parrot's clone, but then +also associates the meta-data of the original with the new, so that typed +attributes don't lose their typedness. Also make sure the new object has the +correct vtable (should maybe fix Parrot's Object to honor sublcassing a bit +more.) + +=cut + +*/ + VTABLE PMC * clone() { + Parrot_Object_attributes * const my_guts = PARROT_OBJECT(SELF); + INTVAL const num_attrs = VTABLE_elements(INTERP, my_guts->attrib_store); + INTVAL i; + + /* First, delegate to our SUPER. */ + PMC *clone = SUPER(); + Parrot_Object_attributes * clone_guts = PARROT_OBJECT(clone); + + /* Set vtable. */ + clone->vtable = SELF->vtable; + + /* Copy over metadata. */ + for (i = 0; i < num_attrs; i++) { + PMC * const original = VTABLE_get_pmc_keyed_int(INTERP, my_guts->attrib_store, i); + PMC * const new = VTABLE_get_pmc_keyed_int(INTERP, clone_guts->attrib_store, i); + if (original->pmc_ext && new->pmc_ext) + PMC_metadata(new) = PMC_metadata(original); + } + + return clone; + } +}