[svn:parrot] r44880 - trunk/src/ops

tewk at svn.parrot.org tewk at svn.parrot.org
Thu Mar 11 17:53:38 UTC 2010


Author: tewk
Date: Thu Mar 11 17:53:36 2010
New Revision: 44880
URL: https://trac.parrot.org/parrot/changeset/44880

Log:
root_new_p_p_i

Modified:
   trunk/src/ops/experimental.ops

Modified: trunk/src/ops/experimental.ops
==============================================================================
--- trunk/src/ops/experimental.ops	Thu Mar 11 14:55:29 2010	(r44879)
+++ trunk/src/ops/experimental.ops	Thu Mar 11 17:53:36 2010	(r44880)
@@ -300,6 +300,38 @@
     }
 }
 
+op root_new(out PMC, in PMC, in INT) {
+    PMC * const  name_key = $2;
+
+    /* get_class() returns a PMCProxy for core types, so check for core PMCs */
+    const INTVAL type = Parrot_pmc_get_type(interp, name_key);
+
+    /* if it's clearly a PIR-level PMC */
+    if (type > enum_class_core_max) {
+        PMC * const root_ns  = interp->root_namespace;
+        PMC * const ns       = Parrot_get_namespace_keyed(interp, root_ns, name_key);
+        PMC * const _class   = Parrot_oo_get_class(interp, ns);
+        if (!PMC_IS_NULL(_class)) {
+            PMC *initial = Parrot_pmc_new(interp,
+                Parrot_get_ctx_HLL_type(interp, enum_class_Integer));
+            VTABLE_set_integer_native(interp, initial, $3);
+            $1 = VTABLE_instantiate(interp, _class, initial);
+        }
+    }
+
+    /* if it's a core PMC */
+    else if (type > enum_class_default)
+        $1 = Parrot_pmc_new_init_int(interp, type, $3);
+
+    /* it's a typo */
+    else {
+        opcode_t *dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(),
+            EXCEPTION_NO_CLASS,
+            "Class '%Ss' not found", VTABLE_get_repr(interp, name_key));
+        goto ADDRESS(dest);
+    }
+}
+
 =head1 COPYRIGHT
 
 Copyright (C) 2001-2010, Parrot Foundation.


More information about the parrot-commits mailing list