Implement p6parcel.

rakudo · Nov 23, 2013 · 3afeb7f · 3afeb7f
1 parent 673c790
commit 3afeb7f
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 1 deletion.
diff --git a/src/vm/moar/Perl6/Ops.nqp b/src/vm/moar/Perl6/Ops.nqp
@@ -79,7 +79,7 @@ $ops.add_hll_moarop_mapping('perl6', 'p6box_i', 'p6box_i');
 $ops.add_hll_moarop_mapping('perl6', 'p6box_n', 'p6box_n');
 $ops.add_hll_moarop_mapping('perl6', 'p6box_s', 'p6box_s');
 #$ops.map_classlib_hll_op('perl6', 'p6bigint', $TYPE_P6OPS, 'p6bigint', [$RT_NUM], $RT_OBJ, :tc);
-#$ops.map_classlib_hll_op('perl6', 'p6parcel', $TYPE_P6OPS, 'p6parcel', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
+$ops.add_hll_moarop_mapping('perl6', 'p6parcel', 'p6parcel');
 #$ops.map_classlib_hll_op('perl6', 'p6listiter', $TYPE_P6OPS, 'p6listiter', [$RT_OBJ, $RT_OBJ], $RT_OBJ, :tc);
 $ops.add_hll_moarop_mapping('perl6', 'p6list', 'p6list');
 #$ops.map_classlib_hll_op('perl6', 'p6listitems', $TYPE_P6OPS, 'p6listitems', [$RT_OBJ], $RT_OBJ, :tc);

diff --git a/src/vm/moar/ops/perl6_ops.c b/src/vm/moar/ops/perl6_ops.c
@@ -12,10 +12,17 @@ static MVMObject *Int      = NULL;
 static MVMObject *Num      = NULL;
 static MVMObject *Str      = NULL;
 static MVMObject *Scalar   = NULL;
+static MVMObject *Parcel   = NULL;
 static MVMObject *ListIter = NULL;
 static MVMObject *True     = NULL;
 static MVMObject *False    = NULL;
 
+/* Parcel, as laid out as a P6opaque. */
+typedef struct {
+    MVMP6opaque  p6o;
+    MVMObject   *storage;
+} Rakudo_Parcel;
+
 /* ListIter, as laid out as a P6opaque. */
 typedef struct {
     MVMP6opaque  p6o;
@@ -56,6 +63,7 @@ static void p6settypes(MVMThreadContext *tc) {
         get_type(tc, conf, "Num", Num);
         get_type(tc, conf, "Str", Str);
         get_type(tc, conf, "Scalar", Scalar);
+        get_type(tc, conf, "Parcel", Parcel);
         get_type(tc, conf, "ListIter", ListIter);
         get_type(tc, conf, "True", True);
         get_type(tc, conf, "False", False);
@@ -85,6 +93,28 @@ static void p6box_s(MVMThreadContext *tc) {
      GET_REG(tc, 0).o = MVM_repr_box_str(tc, Str, GET_REG(tc, 2).s);
 }
 
+static MVMuint8 s_p6parcel[] = {
+    MVM_operand_obj | MVM_operand_write_reg,
+    MVM_operand_obj | MVM_operand_read_reg,
+    MVM_operand_obj | MVM_operand_read_reg
+};
+static void p6parcel(MVMThreadContext *tc) {
+    MVMObject *parcel = MVM_repr_alloc_init(tc, Parcel);
+    MVMObject *vmarr  = GET_REG(tc, 2).o;
+    MVMObject *fill   = GET_REG(tc, 4).o;
+    MVM_ASSIGN_REF(tc, parcel, ((Rakudo_Parcel *)parcel)->storage, vmarr);
+
+    if (fill) {
+        MVMint64 elems = MVM_repr_elems(tc, vmarr);
+        MVMint64 i;
+        for (i = 0; i < elems; i++)
+            if (!MVM_repr_at_pos_o(tc, vmarr, i))
+                MVM_repr_bind_pos_o(tc, vmarr, i, fill);
+    }
+
+    GET_REG(tc, 0).o = parcel;
+}
+
 /* Produces a lazy Perl 6 list of the specified type with the given items. */
 static MVMObject * make_listiter(MVMThreadContext *tc, MVMObject *items, MVMObject *list) {
     MVMObject *result;
@@ -220,6 +250,7 @@ MVM_DLL_EXPORT void Rakudo_ops_init(MVMThreadContext *tc) {
     MVM_ext_register_extop(tc, "p6box_i",  p6box_i, 2, s_p6box_i);
     MVM_ext_register_extop(tc, "p6box_n",  p6box_n, 2, s_p6box_n);
     MVM_ext_register_extop(tc, "p6box_s",  p6box_s, 2, s_p6box_s);
+    MVM_ext_register_extop(tc, "p6parcel",  p6parcel, 3, s_p6parcel);
     MVM_ext_register_extop(tc, "p6list",  p6list, 4, s_p6list);
     MVM_ext_register_extop(tc, "p6settypes",  p6settypes, 1, s_p6settypes);
     MVM_ext_register_extop(tc, "p6bool",  p6bool, 2, s_p6bool);