cvsuser 04/09/25 03:30:38
Modified: ops object.ops
src dod.c
t/pmc object-meths.t
Log:
more introspective stuff
* implement access to current object
* mark these context items being alive
Revision Changes Path
1.47 +22 -13 parrot/ops/object.ops
Index: object.ops
===================================================================
RCS file: /cvs/public/parrot/ops/object.ops,v
retrieving revision 1.46
retrieving revision 1.47
diff -u -w -r1.46 -r1.47
--- object.ops 25 Aug 2004 19:40:51 -0000 1.46
+++ object.ops 25 Sep 2004 10:30:36 -0000 1.47
@@ -62,66 +62,75 @@
=cut
op callmethod() :object_base {
- PMC *method_pmc;
+ PMC *method_pmc, *object;
opcode_t *dest;
opcode_t *next = expr NEXT();
- method_pmc = VTABLE_find_method(interpreter, REG_PMC(2), REG_STR(0));
+
+ object = REG_PMC(2);
+ method_pmc = VTABLE_find_method(interpreter, object, REG_STR(0));
if (!method_pmc) {
real_exception(interpreter, next, METH_NOT_FOUND,
"Method '%Ss' not found", REG_STR(0));
}
REG_PMC(0) = method_pmc;
- dest = (opcode_t *)VTABLE_invoke(interpreter, REG_PMC(0), next);
+ interpreter->ctx.current_object = object;
+ dest = (opcode_t *)VTABLE_invoke(interpreter, method_pmc, next);
goto ADDRESS(dest);
}
op callmethod(in STR) :object_base {
- PMC *method_pmc;
+ PMC *method_pmc, *object;
opcode_t *dest;
opcode_t *next = expr NEXT();
+
REG_STR(0) = $1;
- method_pmc = VTABLE_find_method(interpreter, REG_PMC(2), REG_STR(0));
+ object = REG_PMC(2);
+ method_pmc = VTABLE_find_method(interpreter, object, REG_STR(0));
if (!method_pmc) {
real_exception(interpreter, next, METH_NOT_FOUND,
"Method '%Ss' not found", REG_STR(0));
}
REG_PMC(0) = method_pmc;
- dest = (opcode_t *)VTABLE_invoke(interpreter, REG_PMC(0), next);
+ interpreter->ctx.current_object = object;
+ dest = (opcode_t *)VTABLE_invoke(interpreter, method_pmc, next);
goto ADDRESS(dest);
}
op callmethodcc() :object_base {
opcode_t *dest;
- PMC *method_pmc;
+ PMC *method_pmc, *object;
opcode_t *next = expr NEXT();
REG_PMC(1) = new_ret_continuation_pmc(interpreter, next);
-
- method_pmc = VTABLE_find_method(interpreter, REG_PMC(2), REG_STR(0));
+ object = REG_PMC(2);
+ method_pmc = VTABLE_find_method(interpreter, object, REG_STR(0));
if (!method_pmc) {
real_exception(interpreter, next, METH_NOT_FOUND,
"Method '%Ss' not found", REG_STR(0));
}
REG_PMC(0) = method_pmc;
- dest = (opcode_t *)REG_PMC(0)->vtable->invoke(interpreter, REG_PMC(0), next);
+ interpreter->ctx.current_object = object;
+ dest = (opcode_t *)REG_PMC(0)->vtable->invoke(interpreter, method_pmc, next);
goto ADDRESS(dest);
}
op callmethodcc(in STR) :object_base {
opcode_t *dest;
- PMC *method_pmc;
+ PMC *method_pmc, *object;
opcode_t *next = expr NEXT();
REG_STR(0) = $1;
REG_PMC(1) = new_ret_continuation_pmc(interpreter, next);
- method_pmc = VTABLE_find_method(interpreter, REG_PMC(2), REG_STR(0));
+ object = REG_PMC(2);
+ method_pmc = VTABLE_find_method(interpreter, object, REG_STR(0));
if (!method_pmc) {
real_exception(interpreter, next, METH_NOT_FOUND,
"Method '%Ss' not found", REG_STR(0));
}
REG_PMC(0) = method_pmc;
- dest = (opcode_t *)REG_PMC(0)->vtable->invoke(interpreter, REG_PMC(0), next);
+ interpreter->ctx.current_object = object;
+ dest = (opcode_t *)REG_PMC(0)->vtable->invoke(interpreter, method_pmc, next);
goto ADDRESS(dest);
}
1.132 +10 -1 parrot/src/dod.c
Index: dod.c
===================================================================
RCS file: /cvs/public/parrot/src/dod.c,v
retrieving revision 1.131
retrieving revision 1.132
diff -u -w -r1.131 -r1.132
--- dod.c 23 Sep 2004 15:25:58 -0000 1.131
+++ dod.c 25 Sep 2004 10:30:37 -0000 1.132
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: dod.c,v 1.131 2004/09/23 15:25:58 leo Exp $
+$Id: dod.c,v 1.132 2004/09/25 10:30:37 leo Exp $
=head1 NAME
@@ -293,6 +293,15 @@
(PObj *)interpreter->pmc_reg.registers[i]);
}
}
+ /*
+ * mark current context stuff
+ */
+ if (interpreter->ctx.current_sub)
+ pobject_lives(interpreter, (PObj*)interpreter->ctx.current_sub);
+ if (interpreter->ctx.current_cont)
+ pobject_lives(interpreter, (PObj*)interpreter->ctx.current_cont);
+ if (interpreter->ctx.current_object)
+ pobject_lives(interpreter, (PObj*)interpreter->ctx.current_object);
/*
* mark vtable->data
1.19 +29 -3 parrot/t/pmc/object-meths.t
Index: object-meths.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/object-meths.t,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- object-meths.t 17 May 2004 21:09:08 -0000 1.18
+++ object-meths.t 25 Sep 2004 10:30:38 -0000 1.19
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: object-meths.t,v 1.18 2004/05/17 21:09:08 jrieks Exp $
+# $Id: object-meths.t,v 1.19 2004/09/25 10:30:38 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 21;
+use Parrot::Test tests => 22;
use Test::More;
output_like(<<'CODE', <<'OUTPUT', "callmethod - unknown method");
@@ -728,3 +728,29 @@
CODE
ok
OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "self - CURRENT_OBJECT");
+##PIR##
+.sub _main
+ .local pmc A
+
+ newclass A, "A"
+ find_type I0, "A"
+
+ new A, I0
+ A."foo"()
+ end
+.end
+
+.namespace ["A"]
+
+.sub foo method
+ .include "interpinfo.pasm"
+ $P0 = interpinfo .INTERPINFO_CURRENT_OBJECT
+ eq_addr self, $P0, ok
+ print "not "
+ok: print "ok\n"
+.end
+CODE
+ok
+OUTPUT
