cvsuser 04/12/07 02:50:42
Modified: classes complex.pmc default.pmc deleg_pmc.pmc delegate.pmc
ref.pmc sharedref.pmc
imcc pcc.c
include/parrot mmd.h
ops math.ops ops.num pmc.ops
t/pmc complex.t objects.t pmc.t
. vtable.tbl
Log:
pow, hash, instantiate
Revision Changes Path
1.14 +3 -3 parrot/classes/complex.pmc
Index: complex.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/complex.pmc,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- complex.pmc 29 Nov 2004 18:07:28 -0000 1.13
+++ complex.pmc 7 Dec 2004 10:50:36 -0000 1.14
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: complex.pmc,v 1.13 2004/11/29 18:07:28 rubys Exp $
+$Id: complex.pmc,v 1.14 2004/12/07 10:50:36 leo Exp $
=head1 NAME
@@ -196,7 +196,7 @@
/*
-=item C<PMC* new_extended()>
+=item C<PMC* instantiate()>
Create a new complex PMC with passed arguments according to pdd03.
@@ -204,7 +204,7 @@
*/
- PMC* new_extended() {
+ PMC* instantiate() {
PMC *res = pmc_new(interpreter, enum_class_Complex);
FLOATVAL re = 0.0, im = 0.0;
int argcI = REG_INT(1);
1.104 +3 -3 parrot/classes/default.pmc
Index: default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.103
retrieving revision 1.104
diff -u -r1.103 -r1.104
--- default.pmc 20 Nov 2004 16:57:24 -0000 1.103
+++ default.pmc 7 Dec 2004 10:50:36 -0000 1.104
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: default.pmc,v 1.103 2004/11/20 16:57:24 rubys Exp $
+$Id: default.pmc,v 1.104 2004/12/07 10:50:36 leo Exp $
=head1 NAME
@@ -198,7 +198,7 @@
/*
-=item C<PMC* new_extended()>
+=item C<PMC* instantiate()>
Default fallback. Creates a new PMC of the type of the class SELF and
calls init().
@@ -207,7 +207,7 @@
*/
- PMC* new_extended() {
+ PMC* instantiate() {
INTVAL type = SELF->vtable->base_type;
PMC* ret = pmc_new_noinit(INTERP, type);
VTABLE_init(INTERP, ret);
1.4 +3 -1 parrot/classes/deleg_pmc.pmc
Index: deleg_pmc.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/deleg_pmc.pmc,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- deleg_pmc.pmc 19 Jul 2004 16:41:39 -0000 1.3
+++ deleg_pmc.pmc 7 Dec 2004 10:50:36 -0000 1.4
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: deleg_pmc.pmc,v 1.3 2004/07/19 16:41:39 leo Exp $
+$Id: deleg_pmc.pmc,v 1.4 2004/12/07 10:50:36 leo Exp $
=head1 NAME
@@ -78,6 +78,8 @@
#define VTABLE_is_equal(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_EQ)
#define VTABLE_is_equal_num(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_NUMEQ)
#define VTABLE_is_equal_str(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STREQ)
+#define VTABLE_pow(i, l, r, d) mmd_dispatch_v_ppp(i, l, r, d, MMD_POW)
+#define VTABLE_pow_float(i, l, r, d) mmd_dispatch_v_pnp(i, l, r, d,
MMD_POW_FLOAT)
pmclass deleg_pmc {
1.34 +5 -5 parrot/classes/delegate.pmc
Index: delegate.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/delegate.pmc,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- delegate.pmc 28 Oct 2004 11:24:32 -0000 1.33
+++ delegate.pmc 7 Dec 2004 10:50:36 -0000 1.34
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: delegate.pmc,v 1.33 2004/10/28 11:24:32 leo Exp $
+$Id: delegate.pmc,v 1.34 2004/12/07 10:50:36 leo Exp $
=head1 NAME
@@ -154,9 +154,9 @@
Calls the delegated C<__init()> method if it exists.
-=item C<PMC* new_extended()>
+=item C<PMC* instantiate()>
-Calls the delegated C<__new_extended> method if it exists.
+Calls the delegated C<__instantiate> method if it exists.
XXX Actually the PMC compiler should emit different code, if a method is
present in classes/default.pmc. Some defaulted methods like this one have
@@ -178,9 +178,9 @@
/* don't delegate destroy */
}
- PMC* new_extended() {
+ PMC* instantiate() {
STRING *meth = const_string(interpreter,
- PARROT_VTABLE_NEW_EXTENDED_METHNAME );
+ PARROT_VTABLE_INSTANTIATE_METHNAME);
PMC *sub = find_meth(interpreter, SELF, meth);
if (PMC_IS_NULL(sub)) {
1.22 +3 -1 parrot/classes/ref.pmc
Index: ref.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/ref.pmc,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- ref.pmc 20 Aug 2004 11:25:36 -0000 1.21
+++ ref.pmc 7 Dec 2004 10:50:36 -0000 1.22
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: ref.pmc,v 1.21 2004/08/20 11:25:36 leo Exp $
+$Id: ref.pmc,v 1.22 2004/12/07 10:50:36 leo Exp $
=head1 NAME
@@ -78,6 +78,8 @@
#define VTABLE_is_equal(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_EQ)
#define VTABLE_is_equal_num(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_NUMEQ)
#define VTABLE_is_equal_str(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STREQ)
+#define VTABLE_pow(i, l, r, d) mmd_dispatch_v_ppp(i, l, r, d, MMD_POW)
+#define VTABLE_pow_float(i, l, r, d) mmd_dispatch_v_pnp(i, l, r, d,
MMD_POW_FLOAT)
pmclass Ref does ref {
1.19 +3 -1 parrot/classes/sharedref.pmc
Index: sharedref.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sharedref.pmc,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- sharedref.pmc 20 Aug 2004 11:25:36 -0000 1.18
+++ sharedref.pmc 7 Dec 2004 10:50:36 -0000 1.19
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: sharedref.pmc,v 1.18 2004/08/20 11:25:36 leo Exp $
+$Id: sharedref.pmc,v 1.19 2004/12/07 10:50:36 leo Exp $
=head1 NAME
@@ -90,6 +90,8 @@
#define VTABLE_is_equal(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_EQ)
#define VTABLE_is_equal_num(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_NUMEQ)
#define VTABLE_is_equal_str(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STREQ)
+#define VTABLE_pow(i, l, r, d) mmd_dispatch_v_ppp(i, l, r, d, MMD_POW)
+#define VTABLE_pow_float(i, l, r, d) mmd_dispatch_v_pnp(i, l, r, d,
MMD_POW_FLOAT)
pmclass SharedRef does ref need_ext is_shared extends Ref {
1.84 +5 -5 parrot/imcc/pcc.c
Index: pcc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pcc.c,v
retrieving revision 1.83
retrieving revision 1.84
diff -u -r1.83 -r1.84
--- pcc.c 30 Nov 2004 09:35:11 -0000 1.83
+++ pcc.c 7 Dec 2004 10:50:38 -0000 1.84
@@ -930,7 +930,7 @@
* insert a tailcall opcode
*/
if (tail_call) {
- if (!(meth_call && strcmp(s0->name, "\"new_extended\"") == 0)) {
+ if (!(meth_call && strcmp(s0->name, "\"instantiate\"") == 0)) {
insert_tail_call(interp, unit, ins, sub, meth_call, s0);
return;
}
@@ -958,16 +958,16 @@
#endif
/*
- * special case - new_extended looks like a method call
- * but is actually the new_extended object constructor opcode that
+ * special case - instantiate looks like a method call
+ * but is actually the instantiate 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) {
+ if (meth_call && strcmp(s0->name, "\"instantiate\"") == 0) {
SymReg *p5 = get_pasm_reg(interp, "P5");
regs[0] = p5;
- ins = insINS(interp, unit, ins, "new_extended", regs, 1);
+ ins = insINS(interp, unit, ins, "instantiate", regs, 1);
}
else {
/*
1.21 +4 -2 parrot/include/parrot/mmd.h
Index: mmd.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/mmd.h,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- mmd.h 17 Jul 2004 16:01:16 -0000 1.20
+++ mmd.h 7 Dec 2004 10:50:39 -0000 1.21
@@ -1,7 +1,7 @@
/* mmd.h
* Copyright: 2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: mmd.h,v 1.20 2004/07/17 16:01:16 leo Exp $
+ * $Id: mmd.h,v 1.21 2004/12/07 10:50:39 leo Exp $
* Overview:
* This is the api header for the mmd subsystem
* Data Structure and Algorithms:
@@ -71,6 +71,8 @@
MMD_CMOD,
MMD_CMOD_INT,
MMD_CMOD_FLOAT,
+ MMD_POW,
+ MMD_POW_FLOAT,
MMD_BAND,
MMD_BAND_INT,
MMD_BOR,
@@ -99,7 +101,7 @@
MMD_SAND,
MMD_SAND_STR,
MMD_SXOR,
- MMD_SXOR_STR,
+ MMD_SXOR_STR, /* must be last due to init sequence */
MMD_USER_FIRST
} parrot_mmd_func_enum;
1.31 +16 -0 parrot/ops/math.ops
Index: math.ops
===================================================================
RCS file: /cvs/public/parrot/ops/math.ops,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- math.ops 27 Nov 2004 11:52:31 -0000 1.30
+++ math.ops 7 Dec 2004 10:50:40 -0000 1.31
@@ -797,6 +797,12 @@
=item B<pow>(out NUM, in NUM, in NUM)
+=item B<pow>(in PMC, in PMC, in PMC)
+
+=item B<pow>(in PMC, in PMC, in NUM)
+
+=item B<pow>(in PMC, in PMC, in INT)
+
Set $1 to $2 raised to the power $3.
=cut
@@ -806,6 +812,16 @@
goto NEXT();
}
+inline op pow(in PMC, in PMC, in NUM) :base_core {
+ mmd_dispatch_v_pnp(interpreter, $2, $3, $1, MMD_POW_FLOAT);
+ goto NEXT();
+}
+
+inline op pow(in PMC, in PMC, in PMC) :base_core {
+ mmd_dispatch_v_ppp(interpreter, $2, $3, $1, MMD_POW);
+ goto NEXT();
+}
+
########################################
=item B<sub>(inout INT, in INT)
1.50 +4 -1 parrot/ops/ops.num
Index: ops.num
===================================================================
RCS file: /cvs/public/parrot/ops/ops.num,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -r1.49 -r1.50
--- ops.num 27 Nov 2004 13:19:22 -0000 1.49
+++ ops.num 7 Dec 2004 10:50:40 -0000 1.50
@@ -746,7 +746,7 @@
neg_p_p 716
new_callback_p_p_p_s 717
new_callback_p_p_p_sc 718
-new_extended_p 719
+instantiate_p 719
new_p_i 720
new_p_i_p 721
new_p_i_p_p 722
@@ -1353,3 +1353,6 @@
xor_i_i_ic 1323
xor_i_ic_i 1324
xor_p_p_p 1325
+pow_p_p_n 1326
+pow_p_p_nc 1327
+pow_p_p_p 1328
1.30 +14 -3 parrot/ops/pmc.ops
Index: pmc.ops
===================================================================
RCS file: /cvs/public/parrot/ops/pmc.ops,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- pmc.ops 27 Nov 2004 09:32:17 -0000 1.29
+++ pmc.ops 7 Dec 2004 10:50:40 -0000 1.30
@@ -85,7 +85,7 @@
goto NEXT();
}
-=item B<new_extended>(out PMC)
+=item B<instantiate>(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
@@ -94,9 +94,9 @@
=cut
-inline op new_extended(out PMC) {
+inline op instantiate(out PMC) {
PMC* class = REG_PMC(2);
- $1 = VTABLE_new_extended(interpreter, class);
+ $1 = VTABLE_instantiate(interpreter, class);
goto NEXT();
}
@@ -639,6 +639,17 @@
goto NEXT();
}
+=item B<hash>(out INT, in PMC)
+
+Set $1 to the hash value of $2.
+
+=cut
+
+op hash(out INT, in PMC) {
+ $1 = VTABLE_hash(interpreter, $2);
+ goto NEXT();
+}
+
=back
1.8 +9 -9 parrot/t/pmc/complex.t
Index: complex.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/complex.t,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- complex.t 15 Oct 2004 07:48:26 -0000 1.7
+++ complex.t 7 Dec 2004 10:50:41 -0000 1.8
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: complex.t,v 1.7 2004/10/15 07:48:26 leo Exp $
+# $Id: complex.t,v 1.8 2004/12/07 10:50:41 leo Exp $
=head1 NAME
@@ -552,7 +552,7 @@
0
OUTPUT
-output_is(<< 'CODE', << 'OUTPUT', "new_extended, PASM, I");
+output_is(<< 'CODE', << 'OUTPUT', "instantiate, PASM, I");
set I0, 1
set I1, 2
set I2, 0
@@ -561,7 +561,7 @@
set I5, 10
set I6, 20
getclass P2, "Complex"
- new_extended P1
+ instantiate P1
print P1
print "\n"
end
@@ -569,11 +569,11 @@
10+20i
OUTPUT
-output_is(<< 'CODE', << 'OUTPUT', "new_extended, PIR, N");
+output_is(<< 'CODE', << 'OUTPUT', "instantiate, PIR, N");
##PIR##
.sub main
$P0 = getclass "Complex"
- $P1 = $P0."new_extended"(2.0, 3.0)
+ $P1 = $P0."instantiate"(2.0, 3.0)
print $P1
print "\n"
end
@@ -582,7 +582,7 @@
2+3i
OUTPUT
-output_is(<< 'CODE', << 'OUTPUT', "new_extended, PIR, P");
+output_is(<< 'CODE', << 'OUTPUT', "instantiate, PIR, P");
##PIR##
.sub main
$P0 = getclass "Complex"
@@ -590,7 +590,7 @@
$P1 = 2.0
$P2 = new Float
$P2 = 3.0
- $P1 = $P0."new_extended"($P1, $P2)
+ $P1 = $P0."instantiate"($P1, $P2)
print $P1
print "\n"
end
@@ -599,11 +599,11 @@
2+3i
OUTPUT
-output_is(<< 'CODE', << 'OUTPUT', "new_extended, PIR, S");
+output_is(<< 'CODE', << 'OUTPUT', "instantiate, PIR, S");
##PIR##
.sub main
$P0 = getclass "Complex"
- $P1 = $P0."new_extended"("2 + 3i")
+ $P1 = $P0."instantiate"("2 + 3i")
print $P1
print "\n"
end
1.58 +7 -7 parrot/t/pmc/objects.t
Index: objects.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/objects.t,v
retrieving revision 1.57
retrieving revision 1.58
diff -u -r1.57 -r1.58
--- objects.t 28 Nov 2004 14:13:33 -0000 1.57
+++ objects.t 7 Dec 2004 10:50:41 -0000 1.58
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: objects.t,v 1.57 2004/11/28 14:13:33 jrieks Exp $
+# $Id: objects.t,v 1.58 2004/12/07 10:50:41 leo Exp $
=head1 NAME
@@ -1655,18 +1655,18 @@
Foo
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "new_extended");
+output_is(<<'CODE', <<'OUTPUT', "instantiate");
subclass P2, "Integer", "Foo"
set I0, 0
set I3, 1
new P5, .Integer
set P5, 42
- new_extended P1
+ instantiate P1
print P1
print "\n"
end
.namespace [ "Foo" ]
-.pcc_sub __new_extended: # create object the hard way
+.pcc_sub __instantiate: # 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
@@ -1679,19 +1679,19 @@
42
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "new_extended - PIR");
+output_is(<<'CODE', <<'OUTPUT', "instantiate - PIR");
##PIR##
.sub main @MAIN
.local pmc cl
cl = subclass "Integer", "Foo"
.local pmc i
- i = cl."new_extended"(42)
+ i = cl."instantiate"(42)
print i
print "\n"
.end
.namespace ["Foo"]
-.sub __new_extended method
+.sub __instantiate method
.param int val # in realiter check what is passed
$I0 = find_type "Foo"
.local pmc obj
1.98 +3 -3 parrot/t/pmc/pmc.t
Index: pmc.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/pmc.t,v
retrieving revision 1.97
retrieving revision 1.98
diff -u -r1.97 -r1.98
--- pmc.t 19 Nov 2004 13:45:32 -0000 1.97
+++ pmc.t 7 Dec 2004 10:50:41 -0000 1.98
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: pmc.t,v 1.97 2004/11/19 13:45:32 leo Exp $
+# $Id: pmc.t,v 1.98 2004/12/07 10:50:41 leo Exp $
=head1 NAME
@@ -2605,11 +2605,11 @@
1001
OUTPUT
-output_is(<<'CODE', <<'OUTPUT', "new_extended - no args");
+output_is(<<'CODE', <<'OUTPUT', "instantiate - no args");
getclass P2, "Integer"
set I0, 0 # unproto
set I3, 0 # no P args
- new_extended P3
+ instantiate P3
typeof S0, P3
print S0
print "\n"
1.71 +7 -2 parrot/vtable.tbl
Index: vtable.tbl
===================================================================
RCS file: /cvs/public/parrot/vtable.tbl,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -r1.70 -r1.71
--- vtable.tbl 20 Nov 2004 16:57:22 -0000 1.70
+++ vtable.tbl 7 Dec 2004 10:50:42 -0000 1.71
@@ -1,11 +1,11 @@
-# $Id: vtable.tbl,v 1.70 2004/11/20 16:57:22 rubys Exp $
+# $Id: vtable.tbl,v 1.71 2004/12/07 10:50:42 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()
+PMC* instantiate()
void morph(INTVAL type)
void mark()
void destroy()
@@ -28,6 +28,8 @@
PMC* find_method(STRING* method_name)
+INTVAL hash()
+
[FETCH]
INTVAL get_integer()
INTVAL get_integer_keyed(PMC* key)
@@ -163,6 +165,9 @@
void cmodulus_int(INTVAL value, PMC* dest) MMD_CMOD_INT
void cmodulus_float(FLOATVAL value, PMC* dest) MMD_CMOD_FLOAT
+void pow(PMC* value, PMC* dest) MMD_POW
+void pow_float(FLOATVAL value, PMC* dest) MMD_POW_FLOAT
+
void neg(PMC* dest)
[BITWISE]
