cvsuser 04/09/03 02:27:23
Modified: classes default.pmc
imcc pcc.c
ops pmc.ops
t/pmc objects.t pmc.t
. vtable.tbl
Log:
new_extended object constructor
* new_extended vtable
* new_extended opcode
* adapt imcc/pcc to convert a methodcall class.new_extended()
to the opcode
* fallback to construct objects w/o initializers
* tests
Revision Changes Path
1.100 +19 -1 parrot/classes/default.pmc
Index: default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.99
retrieving revision 1.100
diff -u -w -r1.99 -r1.100
--- default.pmc 20 Aug 2004 08:41:35 -0000 1.99
+++ default.pmc 3 Sep 2004 09:27:20 -0000 1.100
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: default.pmc,v 1.99 2004/08/20 08:41:35 leo Exp $
+$Id: default.pmc,v 1.100 2004/09/03 09:27:20 leo Exp $
=head1 NAME
@@ -200,6 +200,24 @@
/*
+=item C<PMC* new_extended()>
+
+Default fallback. Creates a new PMC of the type of the class SELF and
+calls init().
+
+=cut
+
+*/
+
+ PMC* new_extended() {
+ INTVAL type = SELF->vtable->base_type;
+ PMC* ret = pmc_new_noinit(INTERP, type);
+ VTABLE_init(INTERP, ret);
+ return ret;
+ }
+
+/*
+
=item C<void mark()>
Panics with a "no custom mark routine defined" error message.
1.70 +60 -45 parrot/imcc/pcc.c
Index: pcc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pcc.c,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -w -r1.69 -r1.70
--- pcc.c 20 Jul 2004 09:34:54 -0000 1.69
+++ pcc.c 3 Sep 2004 09:27:21 -0000 1.70
@@ -955,6 +955,20 @@
/* meth hash value: I4 */
ins = set_I_const(interp, unit, ins, 4, 0);
#endif
+
+ /*
+ * special case - new_extended looks like a method call
+ * but is actually the new_extended object constructor opcode that
+ * takes method-like arguments according to pdd03
+ *
+ * so convert to opcode and await the returned PMC as P5
+ */
+ if (meth_call && strcmp(s0->name, "\"new_extended\"") == 0) {
+ SymReg *p5 = get_pasm_reg("P5");
+ regs[0] = p5;
+ ins = insINS(interp, unit, ins, "new_extended", regs, 1);
+ }
+ else {
/*
* emit a savetop for now
*/
@@ -1004,6 +1018,7 @@
regs[1] = p2;
ins = insINS(interp, unit, ins, "set", regs, 2);
}
+ }
/*
* handle return results
*/
1.27 +15 -0 parrot/ops/pmc.ops
Index: pmc.ops
===================================================================
RCS file: /cvs/public/parrot/ops/pmc.ops,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -w -r1.26 -r1.27
--- pmc.ops 25 Aug 2004 19:45:24 -0000 1.26
+++ pmc.ops 3 Sep 2004 09:27:21 -0000 1.27
@@ -93,6 +93,21 @@
goto NEXT();
}
+=item B<new_extended>(out PMC)
+
+Create a new PMC of the type of class REG_PMC(2). This is a classmethod.
+Arguments are passed according to the calling conventions in
+F<docs/pdds/pdd03_calling_conventions.pod>. See also the I<getclass> opcode
+to get a class PMC.
+
+=cut
+
+inline op new_extended(out PMC) {
+ PMC* class = REG_PMC(2);
+ $1 = VTABLE_new_extended(interpreter, class);
+ goto NEXT();
+}
+
########################################
=item B<morph>(in PMC, in INT)
1.53 +54 -2 parrot/t/pmc/objects.t
Index: objects.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/objects.t,v
retrieving revision 1.52
retrieving revision 1.53
diff -u -w -r1.52 -r1.53
--- objects.t 3 Aug 2004 18:47:32 -0000 1.52
+++ objects.t 3 Sep 2004 09:27:22 -0000 1.53
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: objects.t,v 1.52 2004/08/03 18:47:32 scog Exp $
+# $Id: objects.t,v 1.53 2004/09/03 09:27:22 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 49;
+use Parrot::Test tests => 51;
use Test::More;
output_is(<<'CODE', <<'OUTPUT', "findclass (base class)");
@@ -1556,3 +1556,55 @@
ok 2
Foo
OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "new_extended");
+ subclass P2, "Integer", "Foo"
+ set I0, 0
+ set I3, 1
+ new P5, .Integer
+ set P5, 42
+ new_extended P1
+ print P1
+ print "\n"
+ end
+.namespace [ "Foo" ]
+.pcc_sub __new_extended: # create object the hard way
+ find_type I0, "Foo"
+ new P10, I0 # should inspect passed arguments
+ classoffset I0, P10, "Foo" # better should clone the argument
+ setattribute P10, I0, P5 # the first attribute is the internal __value
+ set P5, P10 # set return value
+ invoke P1
+CODE
+42
+OUTPUT
+
+output_is(<<'CODE', <<'OUTPUT', "new_extended - PIR");
+##PIR##
+.sub main @MAIN
+ .local pmc cl
+ cl = subclass "Integer", "Foo"
+ .local pmc i
+ i = cl."new_extended"(42)
+ print i
+ print "\n"
+.end
+
+.namespace ["Foo"]
+.sub __new_extended method
+ .param int val # in realiter check what is passed
+ $I0 = find_type "Foo"
+ .local pmc obj
+ obj = new $I0
+ $I1 = classoffset obj, "Foo"
+ $P0 = new Integer
+ $P0 = val
+ setattribute obj, $I1, $P0
+ .pcc_begin_return
+ .return obj
+ .pcc_end_return
+.end
+CODE
+42
+OUTPUT
+
1.93 +19 -2 parrot/t/pmc/pmc.t
Index: pmc.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/pmc.t,v
retrieving revision 1.92
retrieving revision 1.93
diff -u -w -r1.92 -r1.93
--- pmc.t 5 Aug 2004 06:57:28 -0000 1.92
+++ pmc.t 3 Sep 2004 09:27:22 -0000 1.93
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: pmc.t,v 1.92 2004/08/05 06:57:28 leo Exp $
+# $Id: pmc.t,v 1.93 2004/09/03 09:27:22 leo Exp $
=head1 NAME
@@ -16,7 +16,7 @@
=cut
-use Parrot::Test tests => 94;
+use Parrot::Test tests => 95;
use Test::More;
use Parrot::PMC qw(%pmc_types);
my $max_pmc = scalar(keys(%pmc_types)) + 1;
@@ -2605,4 +2605,21 @@
1001
OUTPUT
+output_is(<<'CODE', <<'OUTPUT', "new_extended - no args");
+ getclass P2, "Integer"
+ set I0, 0 # unproto
+ set I3, 0 # no P args
+ new_extended P3
+ typeof S0, P3
+ print S0
+ print "\n"
+ set I0, P3
+ print I0
+ print "\n"
+ end
+CODE
+Integer
+0
+OUTPUT
+
1;
1.69 +2 -1 parrot/vtable.tbl
Index: vtable.tbl
===================================================================
RCS file: /cvs/public/parrot/vtable.tbl,v
retrieving revision 1.68
retrieving revision 1.69
diff -u -w -r1.68 -r1.69
--- vtable.tbl 17 Jul 2004 16:01:30 -0000 1.68
+++ vtable.tbl 3 Sep 2004 09:27:23 -0000 1.69
@@ -1,10 +1,11 @@
-# $Id: vtable.tbl,v 1.68 2004/07/17 16:01:30 leo Exp $
+# $Id: vtable.tbl,v 1.69 2004/09/03 09:27:23 leo Exp $
# [MAIN] #default section name
void init()
# init must be first for JITed vtable meths
void init_pmc(PMC* initializer)
void init_pmc_props(PMC* initializer, PMC* properties)
+PMC* new_extended()
void morph(INTVAL type)
void mark()
void destroy()
