From db2330cfcb7a212d1faf94e88ea1d50dc8a0d417 Mon Sep 17 00:00:00 2001
From: jnthn <jnthn@jnthn.net>
Date: Sun, 18 Aug 2013 16:47:54 +0200
Subject: [PATCH] Parrot implementation of nqp::p6scalarfromdesc.

---
 src/vm/parrot/Perl6/Ops.nqp |  1 +
 src/vm/parrot/ops/perl6.ops | 38 +++++++++++++++++++++++++++++++++++++
 2 files changed, 39 insertions(+)

diff --git a/src/vm/parrot/Perl6/Ops.nqp b/src/vm/parrot/Perl6/Ops.nqp
index 482d77cb139..49d8c07085f 100644
--- a/src/vm/parrot/Perl6/Ops.nqp
+++ b/src/vm/parrot/Perl6/Ops.nqp
@@ -68,6 +68,7 @@ $ops.add_hll_op('perl6', 'p6staticouter', -> $qastcomp, $op {
         $op[0]
     ))
 });
+$ops.add_hll_pirop_mapping('perl6', 'p6scalarfromdesc', 'p6scalarfromdesc', 'PP', :inlinable(1));
 
 # Make some of them also available from NQP land, since we use them in the
 # metamodel and bootstrap.
diff --git a/src/vm/parrot/ops/perl6.ops b/src/vm/parrot/ops/perl6.ops
index 602c735da41..65a3214a6fc 100644
--- a/src/vm/parrot/ops/perl6.ops
+++ b/src/vm/parrot/ops/perl6.ops
@@ -252,6 +252,8 @@ static PMC* sub_find_pad(PARROT_INTERP, ARGIN(STRING *lex_name), ARGIN(PMC *ctx)
     }
 }
 
+static PMC *defaultContainerDescriptor = NULL;
+
 static INTVAL initialized_ops = 0;
 
 PARROT_DYNEXT_EXPORT PMC*
@@ -658,6 +660,20 @@ inline op p6settypes(invar PMC) :base_core {
         Parrot_str_new_constant(interp, "Junction")));
     Rakudo_types_nil_set(VTABLE_get_pmc_keyed_str(interp, $1,
         Parrot_str_new_constant(interp, "Nil")));
+
+    {
+        PMC *CD = VTABLE_get_pmc_keyed_str(interp, $1,
+            Parrot_str_new_constant(interp, "ContainerDescriptor"));
+        PMC *defCD = REPR(CD)->allocate(interp, STABLE(CD));
+        Rakudo_ContainerDescriptor *cd = ((Rakudo_ContainerDescriptor *)PMC_data(defCD));
+        REPR(defCD)->initialize(interp, STABLE(defCD), OBJECT_BODY(defCD));
+        cd->of          = Rakudo_types_mu_get();
+        cd->name        = Parrot_str_new_constant(interp, "<element>");
+        cd->rw          = 1;
+        cd->the_default = Rakudo_types_any_get();
+        defaultContainerDescriptor = defCD;
+        Parrot_pmc_gc_register(interp, defaultContainerDescriptor);
+    }
 }
 
 
@@ -1562,6 +1578,28 @@ inline op perl6_get_outer_ctx(out PMC, in PMC) {
     }
 }
 
+/*
+
+=item p6scalarfromdesc
+
+Creates a Scalar from the specified descriptor.
+
+=cut
+
+*/
+inline op p6scalarfromdesc(out PMC, invar PMC) {
+    PMC *cont;
+    PMC *desc = $2;
+    
+    if (PMC_IS_NULL($2) || !IS_CONCRETE($2))
+        desc = defaultContainerDescriptor;
+
+    cont = Rakudo_cont_scalar_from_descriptor(interp, desc);
+    ((Rakudo_Scalar *)PMC_data(cont))->value = ((Rakudo_ContainerDescriptor *)PMC_data(desc))->the_default;
+    
+    $1 = cont;
+}
+
 /*
  * Local variables:
  *   c-file-style: "parrot"