Author: jonathan
Date: Sat Apr 14 10:13:25 2007
New Revision: 18200
Modified:
trunk/src/ops/object.ops
trunk/src/ops/ops.num
Log:
[PDD15]: Implement get_class ops.
Modified: trunk/src/ops/object.ops
==============================================================================
--- trunk/src/ops/object.ops (original)
+++ trunk/src/ops/object.ops Sat Apr 14 10:13:25 2007
@@ -355,11 +355,14 @@
goto ADDRESS(next);
}
+###############################################################################
+
=item B<getclass>(out PMC, in STR)
=item B<getclass>(out PMC, in PMC)
-Find the PMC for a class, by name.
+Find the PMC for a class, by name. Deprecated - works with the old class
+system.
=cut
@@ -388,6 +391,62 @@
goto ADDRESS(next);
}
+###############################################################################
+
+=item B<get_class>(out PMC, in STR)
+
+=item B<get_class>(out PMC, in PMC)
+
+Find the PMC for a class, by string name or by key.
+
+=cut
+
+inline op get_class(out PMC, in STR) :object_classes {
+ PMC *class = PMCNULL;
+ opcode_t *next = expr NEXT();
+
+ /* Look up a namespace with the given name within the current
+ * namespace and if we find it, get the class associated with it, if any. */
+ PMC *ns = Parrot_get_namespace_keyed_str(interp,
+ CONTEXT(interp->ctx)->current_namespace, $2);
+ if (!PMC_IS_NULL(ns))
+ Parrot_PCCINVOKE(interp, ns,
+ string_from_const_cstring(interp, "get_class", 0), "->P", &class);
+
+ /* If class is not found, throw an exception; otherwise, put it in $1. */
+ if (PMC_IS_NULL(class))
+ real_exception(interp, next, NO_CLASS, "Class '%Ss' doesn't exist", $2);
+ else
+ $1 = class;
+
+ goto ADDRESS(next);
+}
+
+inline op get_class(out PMC, in PMC) :object_classes {
+ PMC *class = PMCNULL;
+ opcode_t *next = expr NEXT();
+
+ /* Look up a namespace and if we find it, get the class associated with it,
+ * if any. */
+ PMC *ns = Parrot_get_namespace_keyed(interp, interp->HLL_namespace, $2);
+ if (!PMC_IS_NULL(ns))
+ Parrot_PCCINVOKE(interp, ns,
+ string_from_const_cstring(interp, "get_class", 0), "->P", &class);
+
+ /* If class is not found, throw an exception; otherwise, put it in $1. */
+ if (PMC_IS_NULL(class)) {
+ STRING *name = readable_name(interp, $2);
+ real_exception(interp, next, NO_CLASS, "Class '%Ss' doesn't exist",
name);
+ }
+ else {
+ $1 = class;
+ }
+
+ goto ADDRESS(next);
+}
+
+###############################################################################
+
=item B<singleton>(invar PMC) B<(unimplemented)>
Take the object in $1 and put it into its own singleton class, which is
Modified: trunk/src/ops/ops.num
==============================================================================
--- trunk/src/ops/ops.num (original)
+++ trunk/src/ops/ops.num Sat Apr 14 10:13:25 2007
@@ -1231,3 +1231,7 @@
inspect_p_pc_s 1201
inspect_p_p_sc 1202
inspect_p_pc_sc 1203
+get_class_p_s 1204
+get_class_p_sc 1205
+get_class_p_p 1206
+get_class_p_pc 1207
