Dan Sugalski <[EMAIL PROTECTED]> wrote:
> Okay, here's a sketch of where I'm going with the initialization,
> finalization, and fallback method locating.
As the current init scheme isn't really flying (and not in sync with
this proposal) here is a first hack to get it running.
> CONSTRUCT is the method we call when we're building the object from
> scratch. We call it on the object and if the object wants to
> redispatch to parents, it better do so. We'll catch that it's being
> redispatched and call the proper parent class method even if it has a
> different name.
> BUILD is the method we call when we're building the object. We call
> this on *every* class in the object's hierarchy that it exists in. No
> redispatching, it's all automatic.
[ ... ]
> Also, these properties are on *names*, not method PMCs. We get a
> two-step "look up the property, then look up the method the property
> names" thing,
Here is a sample program:
$ cat o.imc
.sub _main
$P0 = newclass "A"
$P1 = new PerlString
$P1 = "_new"
setprop $P0, "BUILD", $P1
$I0 = find_type "A"
$P2 = new PerlString
$P2 = "argument\n"
.local pmc obj
obj = new $I0, $P2
print "done\n"
end
.end
.namespace ["A"]
.sub _new method
.param pmc arg
print "new\n"
print arg
.end
.sub __init method
print "init\n"
.end
The new scheme is currently turned on only, if the environment variable
CALL__BUILD is set so that old code isn't broken immediately:
$ CALL__BUILD=1 parrot o.imc
new
argument
done
$ parrot o.imc
init
done
The "obj = new Iclass" can now take an optional initializer which is
passed as first PMC arument to the BUILD or CONSTRUCT method. It's up to
the class what this is, but we should probably define some scheme for
HLL interoperbility.
Comments welcome,
leo
--- parrot/include/parrot/objects.h Sat Apr 3 18:00:20 2004
+++ parrot-leo/include/parrot/objects.h Tue Apr 6 10:10:56 2004
@@ -44,6 +44,7 @@
PMC *Parrot_remove_parent(Parrot_Interp, PMC *, PMC *);
PMC *Parrot_multi_subclass(Parrot_Interp, PMC *, STRING *);
void Parrot_instantiate_object(Parrot_Interp, PMC *);
+void Parrot_instantiate_object_init(Parrot_Interp, PMC *, PMC *);
INTVAL Parrot_object_isa(Parrot_Interp interpreter, PMC *, PMC *);
PMC *Parrot_new_method_cache(Parrot_Interp);
PMC *Parrot_find_method_with_cache(Parrot_Interp, PMC *, STRING *);
--- parrot/src/objects.c Mon Apr 5 11:24:49 2004
+++ parrot-leo/src/objects.c Tue Apr 6 10:21:56 2004
@@ -440,6 +440,7 @@
/* Reset the init method to our instantiation method */
new_vtable->init = Parrot_instantiate_object;
+ new_vtable->init_pmc = Parrot_instantiate_object_init;
new_class->vtable = new_vtable;
/* Put our new vtable in the global table */
@@ -458,16 +459,32 @@
return new_type;
}
+static PMC*
+get_init_meth(Parrot_Interp interpreter, PMC *class, const char * init_name)
+{
+ PMC *prop;
+ STRING *prop_s, *meth;
+ prop_s = const_string(interpreter, init_name);
+ prop = VTABLE_getprop(interpreter, class, prop_s);
+ if (!VTABLE_defined(interpreter, prop))
+ return NULL;
+ meth = VTABLE_get_string(interpreter, prop);
+ return Parrot_find_method_with_cache(interpreter, class, meth);
+}
static void
-do_initcall(Parrot_Interp interpreter, PMC* class, PMC *object)
+do_initcall(Parrot_Interp interpreter, PMC* class, PMC *object, PMC *init)
{
-
SLOTTYPE *class_data = PMC_data(class);
PMC *classsearch_array = get_attrib_num(class_data, PCD_ALL_PARENTS);
PMC *parent_class;
INTVAL i, nparents;
+ int free_it;
+ /*
+ * XXX compat mode
+ */
+ if (!Parrot_getenv("CALL__BUILD", &free_it)) {
nparents = VTABLE_elements(interpreter, classsearch_array);
for (i = nparents - 1; i >= 0; --i) {
parent_class = VTABLE_get_pmc_keyed_int(interpreter,
@@ -476,12 +493,60 @@
object, parent_class);
}
Parrot_base_vtables[enum_class_delegate]->init(interpreter, object);
+ }
+ else {
+ /*
+ * 1) if class has a CONSTRUCT property run it on the object
+ * no redispatch
+ */
+ PMC *meth = get_init_meth(interpreter, class, "CONSTRUCT");
+ if (meth) {
+ /* XXX S0 isn't set - create runops_method */
+ PMC *p2 = REG_PMC(2); /* preserve current self */
+ REG_PMC(2) = object;
+ if (init)
+ Parrot_runops_fromc_args_save(interpreter, meth, "vP", init);
+ else
+ Parrot_runops_fromc_save(interpreter, meth);
+ REG_PMC(2) = p2;
+ }
+ /*
+ * 2. if class has a BUILD property call it for all classes
+ * in reverse search order - this class last.
+ */
+ nparents = VTABLE_elements(interpreter, classsearch_array);
+ for (i = nparents - 1; i >= 0; --i) {
+ parent_class = VTABLE_get_pmc_keyed_int(interpreter,
+ classsearch_array, i);
+ meth = get_init_meth(interpreter, parent_class, "BUILD");
+ if (meth) {
+ PMC *p2 = REG_PMC(2); /* preserve current self */
+ REG_PMC(2) = object;
+ if (init)
+ Parrot_runops_fromc_args_save(interpreter, meth, "vP",
+ init);
+ else
+ Parrot_runops_fromc_save(interpreter, meth);
+ REG_PMC(2) = p2;
+ }
+ }
+ meth = get_init_meth(interpreter, class, "BUILD");
+ if (meth) {
+ PMC *p2 = REG_PMC(2); /* preserve current self */
+ REG_PMC(2) = object;
+ if (init)
+ Parrot_runops_fromc_args_save(interpreter, meth, "vP", init);
+ else
+ Parrot_runops_fromc_save(interpreter, meth);
+ REG_PMC(2) = p2;
+ }
+ }
}
/*
=item C<void
-Parrot_instantiate_object(Parrot_Interp interpreter, PMC *object)>
+Parrot_instantiate_object(Parrot_Interp interpreter, PMC *object, PMC *init)>
Creates a Parrot object. Takes a passed-in class PMC that has sufficient
information to describe the layout of the object and, well, makes the
@@ -491,9 +556,24 @@
*/
+static void instantiate_object(Parrot_Interp, PMC *object, PMC *init);
+
+void
+Parrot_instantiate_object_init(Parrot_Interp interpreter,
+ PMC *object, PMC *init)
+{
+ instantiate_object(interpreter, object, init);
+}
+
void
Parrot_instantiate_object(Parrot_Interp interpreter, PMC *object)
{
+ instantiate_object(interpreter, object, NULL);
+}
+
+static void
+instantiate_object(Parrot_Interp interpreter, PMC *object, PMC *init)
+{
SLOTTYPE *new_object_array;
INTVAL attrib_count;
SLOTTYPE *class_array;
@@ -536,7 +616,7 @@
/* We really ought to call the class init routines here...
* this assumes that an object isa delegate
*/
- do_initcall(interpreter, class, object);
+ do_initcall(interpreter, class, object, init);
}
/*
