Don't de-reference invocants for Rakudo (non-core-PMC) objects.

rakudo · Jul 5, 2010 · 979a34a · 979a34a
1 parent d9a5ac0
commit 979a34a
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 8 deletions.
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
@@ -2172,7 +2172,7 @@ method EXPR($/, $key?) {
         my $inv := $/[0].ast;
         $past.unshift(
             PAST::Op.ACCEPTS($past) && $past.pasttype eq 'callmethod'
-            ?? PAST::Op.new( :pirop('descalarref PP'), $inv, :returns($inv.returns) )
+            ?? PAST::Op.new( :pirop('deref_unless_object PP'), $inv, :returns($inv.returns) )
             !! $inv
         );
     }

diff --git a/src/builtins/Mu.pir b/src/builtins/Mu.pir
@@ -48,8 +48,8 @@ like this.
 
     # Make a clone.
     .local pmc result
-    self = deobjectref self
-    result = clone self
+    $P0 = descalarref self
+    result = clone $P0
 
     # Set any new attributes.
     .local pmc p6meta, parrotclass, attributes, it

diff --git a/src/ops/perl6.ops b/src/ops/perl6.ops
@@ -22,6 +22,8 @@ BEGIN_OPS_PREAMBLE
 static INTVAL p6s_id = 0;
 static INTVAL or_id  = 0;
 static INTVAL lls_id = 0;
+static INTVAL obj_id = 0;
+static INTVAL p6o_id = 0;
 
 /* Plus a function pointer to the binder. */
 typedef INTVAL (*bind_llsig_func_type) (PARROT_INTERP, PMC *lexpad,
@@ -45,6 +47,8 @@ inline op rakudo_dynop_setup() :base_core {
     p6s_id = pmc_type(interp, string_from_literal(interp, "Perl6Scalar"));
     or_id  = pmc_type(interp, string_from_literal(interp, "ObjectRef"));
     lls_id = pmc_type(interp, string_from_literal(interp, "P6LowLevelSig"));
+    p6o_id = pmc_type(interp, string_from_literal(interp, "P6opaque"));
+    obj_id = enum_class_Object;
 
     /* Create dummy low level sig op and use its get_pointer to get a pointer
      * to the signature binder. */
@@ -66,7 +70,6 @@ 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"));
     PMC * const current_class = VTABLE_get_class(interp, $1);
     PMC * parent_list;
     int num_parents;
@@ -144,9 +147,9 @@ inline op rebless_subclass(in PMC, in PMC) :base_core {
                 i, pmc_new(interp, enum_class_Undef));
 
         /* And make sure the new object is of the right type. */
-        new_ins->vtable = interp->vtables[p6opaque];
+        new_ins->vtable = interp->vtables[p6o_id];
     }
-    else if ((value->vtable->base_type != enum_class_Object && value->vtable->base_type != p6opaque)
+    else if ((value->vtable->base_type != enum_class_Object && value->vtable->base_type != p6o_id)
             || 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.
@@ -348,8 +351,7 @@ kinda direction.)
 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];
+        $1->vtable = interp->vtables[p6o_id];
         goto NEXT();
     }
     else {
@@ -401,6 +403,27 @@ inline op descalarref(out PMC, in PMC) :base_core {
 }
 
 
+/*
+
+=item deref_unless_object(out PMC, in PMC)
+
+If the value underlying $2 is anything but an Object or P6opaque,
+return that value; otherwise return $2.
+
+=cut
+
+*/
+inline op deref_unless_object(out PMC, in PMC) :base_core {
+    PMC * val;
+    val = $2;
+    while (val->vtable->base_type == or_id || val->vtable->base_type == p6s_id)
+        val = VTABLE_get_pmc(interp, val);
+    $1 = (val->vtable->base_type == obj_id || val->vtable->base_type == p6o_id)
+         ? $2 : val;
+    goto NEXT();
+}
+
+
 /*
 
 =item allocate_llsig(out PMC, in INT)