Add a stub p6opaque, and start making objects we create use that inst…

…ead of Object as their repr. Fill out its clone vtable method enough to un-regress the test my last commit had us fail. This also lays the foundations for starting dispatch refactor.

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)
 

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

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"

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<PMC * clone()>
+
+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;
+    }
+}