cvsuser 04/07/17 09:01:30
Modified: classes bigint.pmc default.pmc iterator.pmc perlhash.pmc
perlint.pmc perlnum.pmc perlundef.pmc ref.pmc
scalar.pmc sharedref.pmc
imcc imcc.l imcc.y
include/parrot mmd.h
languages/python pie-thon.pl
languages/python/t/pie b6.t
ops math.ops
. vtable.tbl
Log:
Pie-thon 77 - big vtable cleanup; floor_divide
* removed almost all _bigint vtables
* they were unsued
* they were unusable - BigInts are PMCs not native types
* add floor_divide vtable
* add fdiv ops
* probably poor implementation of these and untested
* add lexer/parser suppport
a // b, a //= b
Revision Changes Path
1.15 +82 -11 parrot/classes/bigint.pmc
Index: bigint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/bigint.pmc,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- bigint.pmc 13 Jul 2004 10:10:57 -0000 1.14
+++ bigint.pmc 17 Jul 2004 16:01:05 -0000 1.15
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: bigint.pmc,v 1.14 2004/07/13 10:10:57 leo Exp $
+$Id: bigint.pmc,v 1.15 2004/07/17 16:01:05 leo Exp $
=head1 NAME
@@ -133,24 +133,53 @@
}
}
static void
-bigint_mod_bigint(Interp *interpreter, PMC* self, PMC *value, PMC *dest)
+bigint_div_bigint_int(Interp *interpreter, PMC* self, INTVAL value, PMC *dest)
{
VTABLE_morph(interpreter, dest, enum_class_BigInt);
- mpz_mod(BN(dest), BN(self), BN(value));
+ /* this is mpz_fdiv_q */
+ mpz_div_ui(BN(dest), BN(self), value);
if (mpz_fits_slong_p(BN(dest))) {
VTABLE_morph(interpreter, dest, enum_class_PerlInt);
VTABLE_set_integer_native(interpreter, dest,
mpz_get_si(BN(dest)));
}
}
-
static void
-bigint_div_bigint_int(Interp *interpreter, PMC* self, INTVAL value,
- PMC *dest)
+bigint_fdiv_bigint(Interp *interpreter, PMC* self, PMC *value, PMC *dest)
{
VTABLE_morph(interpreter, dest, enum_class_BigInt);
- mpz_div_ui(BN(dest), BN(self), value);
+ /* this is mpz_fdiv_q */
+ mpz_fdiv_q(BN(dest), BN(self), BN(value));
+ if (mpz_fits_slong_p(BN(dest))) {
+ VTABLE_morph(interpreter, dest, enum_class_PerlInt);
+ VTABLE_set_integer_native(interpreter, dest,
+ mpz_get_si(BN(dest)));
+ }
+}
+static void
+bigint_fdiv_bigint_int(Interp *interpreter, PMC* self, INTVAL value, PMC *dest)
+{
+ VTABLE_morph(interpreter, dest, enum_class_BigInt);
+ /* this is mpz_fdiv_q */
+ mpz_fdiv_q_ui(BN(dest), BN(self), value);
+ if (mpz_fits_slong_p(BN(dest))) {
+ VTABLE_morph(interpreter, dest, enum_class_PerlInt);
+ VTABLE_set_integer_native(interpreter, dest,
+ mpz_get_si(BN(dest)));
+ }
+}
+static void
+bigint_mod_bigint(Interp *interpreter, PMC* self, PMC *value, PMC *dest)
+{
+ VTABLE_morph(interpreter, dest, enum_class_BigInt);
+ mpz_mod(BN(dest), BN(self), BN(value));
+ if (mpz_fits_slong_p(BN(dest))) {
+ VTABLE_morph(interpreter, dest, enum_class_PerlInt);
+ VTABLE_set_integer_native(interpreter, dest,
+ mpz_get_si(BN(dest)));
+ }
}
+
static INTVAL
bigint_cmp(Interp *interpreter, PMC* self, PMC *value)
{
@@ -245,13 +274,22 @@
internal_exception(1, "no bigint lib loaded");
}
static void
-bigint_mod_bigint(Interp *interpreter, PMC* self, PMC *value, PMC *dest)
+bigint_div_bigint_int(Interp *interpreter, PMC* self, INTVAL value, PMC *dest)
{
internal_exception(1, "no bigint lib loaded");
}
static void
-bigint_div_bigint_int(Interp *interpreter, PMC* self, INTVAL value,
- PMC *dest)
+bigint_fdiv_bigint(Interp *interpreter, PMC* self, PMC *value, PMC *dest)
+{
+ internal_exception(1, "no bigint lib loaded");
+}
+static void
+bigint_fdiv_bigint_int(Interp *interpreter, PMC* self, INTVAL value, PMC *dest)
+{
+ internal_exception(1, "no bigint lib loaded");
+}
+static void
+bigint_mod_bigint(Interp *interpreter, PMC* self, PMC *value, PMC *dest)
{
internal_exception(1, "no bigint lib loaded");
}
@@ -521,6 +559,12 @@
MMD_BigInt: {
bigint_add_bigint(INTERP, SELF, value, dest);
}
+MMD_PerlInt: {
+ bigint_add_bigint_int(INTERP, SELF, PMC_int_val(value), dest);
+ }
+MMD_Integer: {
+ bigint_add_bigint_int(INTERP, SELF, PMC_int_val(value), dest);
+ }
MMD_DEFAULT: {
internal_exception(1, "unimp add");
}
@@ -553,9 +597,36 @@
MMD_BigInt: {
bigint_div_bigint(INTERP, SELF, value, dest);
}
+MMD_PerlInt: {
+ bigint_div_bigint_int(INTERP, SELF, PMC_int_val(value), dest);
+ }
+MMD_Integer: {
+ bigint_div_bigint_int(INTERP, SELF, PMC_int_val(value), dest);
+ }
MMD_DEFAULT: {
- internal_exception(1, "unimp div");
+ internal_exception(1, "unimp fdiv");
+ }
+ }
+
+ void divide_int(INTVAL value, PMC* dest) {
+ bigint_div_bigint_int(INTERP, SELF, value, dest);
+ }
+ void floor_divide(PMC* value, PMC* dest) {
+MMD_BigInt: {
+ bigint_fdiv_bigint(INTERP, SELF, value, dest);
+ }
+MMD_PerlInt: {
+ bigint_fdiv_bigint_int(INTERP, SELF, PMC_int_val(value), dest);
+ }
+MMD_Integer: {
+ bigint_fdiv_bigint_int(INTERP, SELF, PMC_int_val(value), dest);
+ }
+MMD_DEFAULT: {
+ internal_exception(1, "unimp fdiv");
+ }
}
+ void floor_divide_int(INTVAL value, PMC* dest) {
+ bigint_fdiv_bigint_int(INTERP, SELF, value, dest);
}
void modulus(PMC* value, PMC* dest) {
1.94 +1 -31 parrot/classes/default.pmc
Index: default.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/default.pmc,v
retrieving revision 1.93
retrieving revision 1.94
diff -u -w -r1.93 -r1.94
--- default.pmc 8 Jul 2004 16:11:33 -0000 1.93
+++ default.pmc 17 Jul 2004 16:01:05 -0000 1.94
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: default.pmc,v 1.93 2004/07/08 16:11:33 leo Exp $
+$Id: default.pmc,v 1.94 2004/07/17 16:01:05 leo Exp $
=head1 NAME
@@ -386,21 +386,6 @@
return DYNSELF.get_number_keyed(r_key);
}
-/*
-
-=item C<BIGNUM *get_bignum_keyed_int(INTVAL key)>
-
-Converts C<key> to a PMC key and returns the result of calling
-C<get_bignum_keyed()> with it.
-
-=cut
-
-*/
-
- BIGNUM* get_bignum_keyed_int (INTVAL key) {
- PMC* r_key = INT2KEY(INTERP, key);
- return DYNSELF.get_bignum_keyed(r_key);
- }
/*
@@ -532,21 +517,6 @@
DYNSELF.set_number_keyed(r_key, value);
}
-/*
-
-=item C<void set_bignum_keyed_int(INTVAL key, BIGNUM *value)>
-
-Converts C<key> to a PMC key and calls C<set_bignum_keyed()> with it
-and C<value>.
-
-=cut
-
-*/
-
- void set_bignum_keyed_int (INTVAL key, BIGNUM* value) {
- PMC* r_key = INT2KEY(INTERP, key);
- DYNSELF.set_bignum_keyed(r_key, value);
- }
/*
1.28 +1 -60 parrot/classes/iterator.pmc
Index: iterator.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/iterator.pmc,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -w -r1.27 -r1.28
--- iterator.pmc 13 Jul 2004 16:28:15 -0000 1.27
+++ iterator.pmc 17 Jul 2004 16:01:05 -0000 1.28
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: iterator.pmc,v 1.27 2004/07/13 16:28:15 leo Exp $
+$Id: iterator.pmc,v 1.28 2004/07/17 16:01:05 leo Exp $
=head1 NAME
@@ -177,33 +177,7 @@
return VTABLE_get_number_keyed_int(INTERP, agg, PMC_int_val(key) + idx );
}
-/*
-
-=item C<BIGNUM *get_bignum_keyed(PMC *key)>
-
-=cut
-
-*/
- BIGNUM* get_bignum_keyed (PMC* key) {
- return VTABLE_get_bignum_keyed(INTERP, (PMC *)PMC_pmc_val(SELF), key);
- }
-
-/*
-
-=item C<BIGNUM *get_bignum_keyed_int(INTVAL idx)>
-
-Get bignum value of current position plus idx.
-
-=cut
-
-*/
-
- BIGNUM* get_bignum_keyed_int (INTVAL idx) {
- PMC *key = PMC_struct_val(SELF);
- PMC *agg = PMC_pmc_val(SELF);
- return VTABLE_get_bignum_keyed_int(INTERP, agg, PMC_int_val(key) + idx );
- }
/*
@@ -367,23 +341,6 @@
/*
-=item C<BIGNUM *pop_bignum()>
-
-=cut
-
-*/
-
- BIGNUM* pop_bignum () {
- PMC *key = PMC_struct_val(SELF);
- PMC *agg = PMC_pmc_val(SELF);
- BIGNUM *ret = VTABLE_get_bignum_keyed(INTERP, agg, key);
- PMC_struct_val(SELF) =
- VTABLE_nextkey_keyed(INTERP, key, agg, ITERATE_GET_PREV);
- return ret;
- }
-
-/*
-
=item C<STRING *pop_string()>
=cut
@@ -501,22 +458,6 @@
return ret;
}
-/*
-
-=item C<BIGNUM *shift_bignum()>
-
-=cut
-
-*/
-
- BIGNUM* shift_bignum () {
- PMC *key = PMC_struct_val(SELF);
- PMC *agg = PMC_pmc_val(SELF);
- BIGNUM *ret = VTABLE_get_bignum_keyed(INTERP, agg, key);
- PMC_struct_val(SELF) =
- VTABLE_nextkey_keyed(INTERP, key, agg, ITERATE_GET_NEXT);
- return ret;
- }
/*
1.85 +1 -71 parrot/classes/perlhash.pmc
Index: perlhash.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlhash.pmc,v
retrieving revision 1.84
retrieving revision 1.85
diff -u -w -r1.84 -r1.85
--- perlhash.pmc 13 Jul 2004 15:21:27 -0000 1.84
+++ perlhash.pmc 17 Jul 2004 16:01:05 -0000 1.85
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlhash.pmc,v 1.84 2004/07/13 15:21:27 leo Exp $
+$Id: perlhash.pmc,v 1.85 2004/07/17 16:01:05 leo Exp $
=head1 NAME
@@ -408,50 +408,6 @@
return VTABLE_get_number_keyed(INTERP, valpmc, nextkey);
}
-/*
-
-=item C<BIGNUM *get_bignum_keyed_str(STRING *key)>
-
-=cut
-
-*/
-
- BIGNUM* get_bignum_keyed_str (STRING* key) {
- HashBucket *b = hash_get_bucket(INTERP, (Hash*) PMC_struct_val(SELF),
- key);
- if (b == NULL) {
- /* XXX Warning: Use of uninitialized value */
- return VTABLE_get_bignum(INTERP, undef);
- }
- return VTABLE_get_bignum(INTERP, (PMC*) b->value);
- }
-
-/*
-
-=item C<BIGNUM *get_bignum_keyed(PMC *key)>
-
-Returns the big number value for the element at C<*key>.
-
-=cut
-
-*/
-
- BIGNUM* get_bignum_keyed (PMC* key) {
- PMC* valpmc;
- STRING* keystr = make_hash_key(INTERP, key);
- HashBucket *b = hash_get_bucket(INTERP, (Hash*) PMC_struct_val(SELF),
- keystr);
- PMC* nextkey;
- if (b == NULL) {
- /* XXX Warning: Use of uninitialized value */
- return VTABLE_get_bignum(INTERP, undef);
- }
- nextkey = key_next(INTERP, key);
- valpmc = b->value;
- if (!nextkey)
- return VTABLE_get_bignum(INTERP, valpmc);
- return VTABLE_get_bignum_keyed(INTERP, valpmc, nextkey);
- }
/*
@@ -796,32 +752,6 @@
/*
-=item C<void set_bignum_keyed(PMC *key, BIGNUM *value)>
-
-=cut
-
-*/
-
- void set_bignum_keyed (PMC* key, BIGNUM* value) {
- /* XXX */
- }
-
-/*
-
-=item C<void set_bignum_keyed_str(STRING *key, BIGNUM *value)>
-
-These two methods are unimplemented.
-
-=cut
-
-*/
-
- void set_bignum_keyed_str (STRING* key, BIGNUM* value) {
- /* XXX */
- }
-
-/*
-
=item C<void set_string_keyed(PMC *key, STRING *value)>
=cut
1.75 +28 -1 parrot/classes/perlint.pmc
Index: perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.74
retrieving revision 1.75
diff -u -w -r1.74 -r1.75
--- perlint.pmc 15 Jul 2004 08:02:19 -0000 1.74
+++ perlint.pmc 17 Jul 2004 16:01:05 -0000 1.75
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlint.pmc,v 1.74 2004/07/15 08:02:19 leo Exp $
+$Id: perlint.pmc,v 1.75 2004/07/17 16:01:05 leo Exp $
=head1 NAME
@@ -497,6 +497,20 @@
VTABLE_set_number_native(INTERP, dest, d);
}
}
+ void floor_divide (PMC* value, PMC* dest) {
+MMD_PerlUndef: {
+ internal_exception(DIV_BY_ZERO, "division by zero!\n");
+ }
+MMD_BigInt: {
+ overflow_p(INTERP, SELF, value, dest, MMD_DIVIDE);
+ }
+MMD_DEFAULT: {
+ FLOATVAL valf = VTABLE_get_number(INTERP, value);
+
+ FLOATVAL d = floor(PMC_int_val(SELF)/valf);
+ VTABLE_set_integer_native(INTERP, dest, (INTVAL)d);
+ }
+ }
/*
@@ -522,6 +536,19 @@
VTABLE_set_number_native(INTERP, dest, divf);
}
}
+/*
+
+=item C<void floor_divide_int(INTVAL value, PMC *dest)>
+
+Divides the integer by C<value> and returns the result in C<*dest>.
+
+=cut
+
+*/
+ void floor_divide_int (INTVAL value, PMC* dest) {
+ FLOATVAL d = floor(PMC_int_val(SELF)/value);
+ VTABLE_set_integer_native(INTERP, dest, (INTVAL) d);
+ }
/*
1.63 +3 -51 parrot/classes/perlnum.pmc
Index: perlnum.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlnum.pmc,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -w -r1.62 -r1.63
--- perlnum.pmc 13 Jul 2004 10:10:58 -0000 1.62
+++ perlnum.pmc 17 Jul 2004 16:01:05 -0000 1.63
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlnum.pmc,v 1.62 2004/07/13 10:10:58 leo Exp $
+$Id: perlnum.pmc,v 1.63 2004/07/17 16:01:05 leo Exp $
=head1 NAME
@@ -90,7 +90,7 @@
*/
BIGNUM* get_bignum () {
- /* XXX */
+ internal_exception(1, "perlnum: unimp get_bignum");
return NULL;
}
@@ -216,20 +216,9 @@
*/
void set_bignum_native (BIGNUM* value) {
+ internal_exception(1, "perlnum: unimp set_bignum");
}
-/*
-
-=item C<void set_bignum_same(PMC *value)>
-
-Unimplemented. Does nothing.
-
-=cut
-
-*/
-
- void set_bignum_same (PMC* value) {
- }
/*
@@ -280,18 +269,6 @@
PMC_num_val(SELF) + value);
}
-/*
-
-=item C<void add_bignum(BIGNUM *value, PMC *dest)>
-
-Unimplemented. Does nothing.
-
-=cut
-
-*/
-
- void add_bignum (BIGNUM* value, PMC* dest) {
- }
/*
@@ -341,18 +318,6 @@
);
}
-/*
-
-=item C<void subtract_bignum(BIGNUM *value, PMC *dest)>
-
-Unimplemented. Does nothing.
-
-=cut
-
-*/
-
- void subtract_bignum (BIGNUM* value, PMC* dest) {
- }
/*
@@ -404,19 +369,6 @@
/*
-=item C<void multiply_bignum(BIGNUM *value, PMC *dest)>
-
-Unimplemented. Does nothing.
-
-=cut
-
-*/
-
- void multiply_bignum (BIGNUM* value, PMC* dest) {
- }
-
-/*
-
=item C<void multiply_float(FLOATVAL value, PMC *dest)>
Multiplies the number by C<value> and returns the result in C<*dest>.
1.42 +1 -86 parrot/classes/perlundef.pmc
Index: perlundef.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlundef.pmc,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -w -r1.41 -r1.42
--- perlundef.pmc 18 May 2004 13:02:54 -0000 1.41
+++ perlundef.pmc 17 Jul 2004 16:01:05 -0000 1.42
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlundef.pmc,v 1.41 2004/05/18 13:02:54 leo Exp $
+$Id: perlundef.pmc,v 1.42 2004/07/17 16:01:05 leo Exp $
=head1 NAME
@@ -58,24 +58,6 @@
/*
-=item C<BIGNUM *get_bignum()>
-
-Warns of the use of an unitialized value, and returns C<NULL>.
-
-TODO - should return big number zero.
-
-=cut
-
-*/
-
- BIGNUM* get_bignum () {
- Parrot_warn(INTERP, PARROT_WARNINGS_UNDEF_FLAG,
- "Use of uninitialized value in numeric context");
- return NULL;
- }
-
-/*
-
=item C<STRING *get_string()>
Warns of the use of an unitialized value, and returns an empty Parrot
@@ -211,19 +193,6 @@
VTABLE_set_integer_native(INTERP, dest, value);
}
-/*
-
-=item C<void add_bignum(BIGNUM *value, PMC *dest)>
-
-=cut
-
-*/
-
- void add_bignum (BIGNUM* value, PMC* dest) {
- Parrot_warn(INTERP, PARROT_WARNINGS_UNDEF_FLAG,
- "Use of uninitialized value in addition");
- SUPER(value, dest);
- }
/*
@@ -267,19 +236,6 @@
VTABLE_set_integer_native(INTERP, dest, 0-value);
}
-/*
-
-=item C<void subtract_bignum(BIGNUM *value, PMC *dest)>
-
-=cut
-
-*/
-
- void subtract_bignum (BIGNUM* value, PMC* dest) {
- Parrot_warn(INTERP, PARROT_WARNINGS_UNDEF_FLAG,
- "Use of uninitialized value in subtraction");
- SUPER(value, dest);
- }
/*
@@ -323,19 +279,6 @@
VTABLE_set_integer_native(INTERP, dest, 0);
}
-/*
-
-=item C<void multiply_bignum(BIGNUM *value, PMC *dest)>
-
-=cut
-
-*/
-
- void multiply_bignum (BIGNUM* value, PMC* dest) {
- Parrot_warn(INTERP, PARROT_WARNINGS_UNDEF_FLAG,
- "Use of uninitialized value in bignum multiplication");
- VTABLE_set_integer_native(INTERP, dest, 0);
- }
/*
@@ -394,20 +337,6 @@
VTABLE_set_integer_native(INTERP, dest, 0);
}
-/*
-
-=item C<void divide_bignum(BIGNUM *value, PMC *dest)>
-
-=cut
-
-*/
-
- void divide_bignum (BIGNUM* value, PMC* dest) {
- Parrot_warn(INTERP, PARROT_WARNINGS_UNDEF_FLAG,
- "Use of uninitialized value in bignum division");
- /* need test for value == 0 */
- VTABLE_set_integer_native(INTERP, dest, 0);
- }
/*
@@ -469,20 +398,6 @@
VTABLE_set_integer_native(INTERP, dest, 0);
}
-/*
-
-=item C<void modulus_bignum(BIGNUM *value, PMC *dest)>
-
-=cut
-
-*/
-
- void modulus_bignum (BIGNUM* value, PMC* dest) {
- Parrot_warn(INTERP, PARROT_WARNINGS_UNDEF_FLAG,
- "Use of uninitialized value in bignum modulus");
- /* need test for value == 0 */
- VTABLE_set_integer_native(INTERP, dest, 0);
- }
/*
1.19 +4 -1 parrot/classes/ref.pmc
Index: ref.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/ref.pmc,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- ref.pmc 18 May 2004 13:02:54 -0000 1.18
+++ ref.pmc 17 Jul 2004 16:01:05 -0000 1.19
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: ref.pmc,v 1.18 2004/05/18 13:02:54 leo Exp $
+$Id: ref.pmc,v 1.19 2004/07/17 16:01:05 leo Exp $
=head1 NAME
@@ -42,6 +42,9 @@
#define VTABLE_divide(i,l,r,d) mmd_dispatch_v_ppp(i,l,r,d,MMD_DIVIDE)
#define VTABLE_divide_int(i,l,r,d) mmd_dispatch_v_pip(i,l,r,d,MMD_DIVIDE_INT)
#define VTABLE_divide_float(i,l,r,d) mmd_dispatch_v_pnp(i,l,r,d,MMD_DIVIDE_FLOAT)
+#define VTABLE_floor_divide(i,l,r,d) mmd_dispatch_v_ppp(i,l,r,d,MMD_FLOOR_DIVIDE)
+#define VTABLE_floor_divide_int(i,l,r,d)
mmd_dispatch_v_pip(i,l,r,d,MMD_FLOOR_DIVIDE_INT)
+#define VTABLE_floor_divide_float(i,l,r,d)
mmd_dispatch_v_pnp(i,l,r,d,MMD_FLOOR_DIVIDE_FLOAT)
#define VTABLE_modulus(i,l,r,d) mmd_dispatch_v_ppp(i,l,r,d,MMD_MOD)
#define VTABLE_modulus_int(i,l,r,d) mmd_dispatch_v_pip(i,l,r,d,MMD_MOD_INT)
#define VTABLE_modulus_float(i,l,r,d) mmd_dispatch_v_pnp(i,l,r,d,MMD_MOD_FLOAT)
1.19 +1 -70 parrot/classes/scalar.pmc
Index: scalar.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/scalar.pmc,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- scalar.pmc 18 May 2004 13:02:54 -0000 1.18
+++ scalar.pmc 17 Jul 2004 16:01:05 -0000 1.19
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: scalar.pmc,v 1.18 2004/05/18 13:02:54 leo Exp $
+$Id: scalar.pmc,v 1.19 2004/07/17 16:01:05 leo Exp $
=head1 NAME
@@ -203,20 +203,6 @@
/*
-=item C<void add_bignum(BIGNUM *value, PMC *dest)>
-
-Unimplemented. Does nothing.
-
-=cut
-
-*/
-
- void add_bignum (BIGNUM* value, PMC* dest) {
- /* XXX: bignum magic */
- }
-
-/*
-
=item C<void add_float(FLOATVAL value, PMC *dest)>
Adds C<value> to the scalar and returns the result in C<*dest>.
@@ -273,19 +259,6 @@
VTABLE_set_number_native(INTERP, dest, result);
}
-/*
-
-=item C<void subtract_bignum(BIGNUM *value, PMC *dest)>
-
-Unimplemented. Does nothing.
-
-=cut
-
-*/
-
- void subtract_bignum (BIGNUM* value, PMC* dest) {
- /* XXX: bignum magic */
- }
/*
@@ -352,20 +325,6 @@
/*
-=item C<void multiply_bignum(BIGNUM *value, PMC *dest)>
-
-Unimplemented. Does nothing.
-
-=cut
-
-*/
-
- void multiply_bignum (BIGNUM* value, PMC* dest) {
- /* XXX: bignum magic */
- }
-
-/*
-
=item C<void multiply_float(FLOATVAL value, PMC *dest)>
Multiplies the scalar by C<value> and returns the result in C<*dest>.
@@ -429,20 +388,6 @@
/*
-=item C<void divide_bignum(BIGNUM *value, PMC *dest)>
-
-Unimplemented. Does nothing.
-
-=cut
-
-*/
-
- void divide_bignum (BIGNUM* value, PMC* dest) {
- /* XXX: bignum magic */
- }
-
-/*
-
=item C<void divide_float(FLOATVAL value, PMC *dest)>
Divides the scalar by C<value> and returns the result in C<*dest>.
@@ -509,20 +454,6 @@
/*
-=item C<void modulus_bignum(BIGNUM *value, PMC *dest)>
-
-Calls the superclass implementation.
-
-=cut
-
-*/
-
- void modulus_bignum (BIGNUM* value, PMC* dest) {
- SUPER(value, dest);
- }
-
-/*
-
=item C<void modulus_float(FLOATVAL value, PMC *dest)>
Calls the superclass implementation.
1.17 +4 -1 parrot/classes/sharedref.pmc
Index: sharedref.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sharedref.pmc,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- sharedref.pmc 18 May 2004 13:02:54 -0000 1.16
+++ sharedref.pmc 17 Jul 2004 16:01:05 -0000 1.17
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: sharedref.pmc,v 1.16 2004/05/18 13:02:54 leo Exp $
+$Id: sharedref.pmc,v 1.17 2004/07/17 16:01:05 leo Exp $
=head1 NAME
@@ -54,6 +54,9 @@
#define VTABLE_divide(i,l,r,d) mmd_dispatch_v_ppp(i,l,r,d,MMD_DIVIDE)
#define VTABLE_divide_int(i,l,r,d) mmd_dispatch_v_pip(i,l,r,d,MMD_DIVIDE_INT)
#define VTABLE_divide_float(i,l,r,d) mmd_dispatch_v_pnp(i,l,r,d,MMD_DIVIDE_FLOAT)
+#define VTABLE_floor_divide(i,l,r,d) mmd_dispatch_v_ppp(i,l,r,d,MMD_FLOOR_DIVIDE)
+#define VTABLE_floor_divide_int(i,l,r,d)
mmd_dispatch_v_pip(i,l,r,d,MMD_FLOOR_DIVIDE_INT)
+#define VTABLE_floor_divide_float(i,l,r,d)
mmd_dispatch_v_pnp(i,l,r,d,MMD_FLOOR_DIVIDE_FLOAT)
#define VTABLE_modulus(i,l,r,d) mmd_dispatch_v_ppp(i,l,r,d,MMD_MOD)
#define VTABLE_modulus_int(i,l,r,d) mmd_dispatch_v_pip(i,l,r,d,MMD_MOD_INT)
#define VTABLE_modulus_float(i,l,r,d) mmd_dispatch_v_pnp(i,l,r,d,MMD_MOD_FLOAT)
1.110 +2 -0 parrot/imcc/imcc.l
Index: imcc.l
===================================================================
RCS file: /cvs/public/parrot/imcc/imcc.l,v
retrieving revision 1.109
retrieving revision 1.110
diff -u -w -r1.109 -r1.110
--- imcc.l 12 Jul 2004 13:10:03 -0000 1.109
+++ imcc.l 17 Jul 2004 16:01:11 -0000 1.110
@@ -258,6 +258,8 @@
"-=" return(MINUS_ASSIGN);
"*=" return(MUL_ASSIGN);
"/=" return(DIV_ASSIGN);
+"//" return(FDIV);
+"//=" return(FDIV_ASSIGN);
"&=" return(BAND_ASSIGN);
"|=" return(BOR_ASSIGN);
"~=" return(BXOR_ASSIGN);
1.143 +4 -1 parrot/imcc/imcc.y
Index: imcc.y
===================================================================
RCS file: /cvs/public/parrot/imcc/imcc.y,v
retrieving revision 1.142
retrieving revision 1.143
diff -u -w -r1.142 -r1.143
--- imcc.y 9 Jul 2004 08:42:53 -0000 1.142
+++ imcc.y 17 Jul 2004 16:01:11 -0000 1.143
@@ -266,7 +266,7 @@
%token <t> SUB SYM LOCAL CONST
%token <t> INC DEC GLOBAL_CONST
%token <t> PLUS_ASSIGN MINUS_ASSIGN MUL_ASSIGN DIV_ASSIGN CONCAT_ASSIGN
-%token <t> BAND_ASSIGN BOR_ASSIGN BXOR_ASSIGN
+%token <t> BAND_ASSIGN BOR_ASSIGN BXOR_ASSIGN FDIV FDIV_ASSIGN
%token <t> SHR_ASSIGN SHL_ASSIGN SHR_U_ASSIGN
%token <t> SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV PMCV OBJECTV LOG_XOR
%token <t> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
@@ -803,6 +803,7 @@
| target '=' var '*' var { $$ = MK_I(interp, cur_unit, "mul", 3, $1, $3, $5); }
| target '=' var POW var { $$ = MK_I(interp, cur_unit, "pow", 3, $1, $3, $5); }
| target '=' var '/' var { $$ = MK_I(interp, cur_unit, "div", 3, $1, $3, $5); }
+ | target '=' var FDIV var { $$ = MK_I(interp, cur_unit, "fdiv", 3, $1, $3, $5); }
| target '=' var '%' var { $$ = MK_I(interp, cur_unit, "mod", 3, $1, $3, $5); }
| target '=' var CONCAT var { $$ = MK_I(interp, cur_unit, "concat", 3,
$1,$3,$5); }
| target '=' var SHIFT_LEFT var
@@ -893,6 +894,8 @@
{ $$ = MK_I(interp, cur_unit, "mul", 2, $1, $3); }
| target DIV_ASSIGN var
{ $$ = MK_I(interp, cur_unit, "div", 2, $1, $3); }
+ | target FDIV_ASSIGN var
+ { $$ = MK_I(interp, cur_unit, "fdiv", 2, $1, $3); }
| target CONCAT_ASSIGN var
{ $$ = MK_I(interp, cur_unit, "concat", 2, $1, $3); }
| target BAND_ASSIGN var
1.20 +4 -7 parrot/include/parrot/mmd.h
Index: mmd.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/mmd.h,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -w -r1.19 -r1.20
--- mmd.h 27 Jun 2004 15:29:47 -0000 1.19
+++ mmd.h 17 Jul 2004 16:01:16 -0000 1.20
@@ -1,7 +1,7 @@
/* mmd.h
* Copyright: 2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: mmd.h,v 1.19 2004/06/27 15:29:47 leo Exp $
+ * $Id: mmd.h,v 1.20 2004/07/17 16:01:16 leo Exp $
* Overview:
* This is the api header for the mmd subsystem
* Data Structure and Algorithms:
@@ -53,27 +53,24 @@
MMD_ADD,
MMD_ADD_INT,
MMD_ADD_FLOAT,
- MMD_ADD_BIGNUM,
MMD_SUBTRACT,
MMD_SUBTRACT_INT,
MMD_SUBTRACT_FLOAT,
- MMD_SUBTRACT_BIGNUM,
MMD_MULTIPLY,
MMD_MULTIPLY_INT,
MMD_MULTIPLY_FLOAT,
- MMD_MULTIPLY_BIGNUM,
MMD_DIVIDE,
MMD_DIVIDE_INT,
MMD_DIVIDE_FLOAT,
- MMD_DIVIDE_BIGNUM,
+ MMD_FLOOR_DIVIDE,
+ MMD_FLOOR_DIVIDE_INT,
+ MMD_FLOOR_DIVIDE_FLOAT,
MMD_MOD,
MMD_MOD_INT,
MMD_MOD_FLOAT,
- MMD_MOD_BIGNUM,
MMD_CMOD,
MMD_CMOD_INT,
MMD_CMOD_FLOAT,
- MMD_CMOD_BLIGNUM,
MMD_BAND,
MMD_BAND_INT,
MMD_BOR,
1.52 +11 -26 parrot/languages/python/pie-thon.pl
Index: pie-thon.pl
===================================================================
RCS file: /cvs/public/parrot/languages/python/pie-thon.pl,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -w -r1.51 -r1.52
--- pie-thon.pl 17 Jul 2004 11:33:16 -0000 1.51
+++ pie-thon.pl 17 Jul 2004 16:01:21 -0000 1.52
@@ -646,14 +646,7 @@
my $r = pop @stack;
my $l = pop @stack;
my ($t, $n);
- if ($r->[2] eq 'I' && $l->[2] eq 'I') {
- $n = temp($t = 'I');
- # TODO only if args are small constants
- print <<"EOC";
- $n = $l->[1] $op $r->[1] $cmt
-EOC
- }
- else {
+ {
my $nl = promote($l);
$n = temp($t = 'P');
print <<"EOC";
@@ -689,14 +682,7 @@
sub BINARY_FLOOR_DIVIDE
{
my ($n, $c, $cmt) = @_;
- binary('/', $cmt); # XXX
- my $l = pop @stack;
- my $i = temp('I');
- print <<EOC;
- $i = $l->[1]
- $l->[1] = $i
-EOC
- push @stack, $l;
+ binary('//', $cmt);
}
sub BINARY_DIVIDE
{
@@ -1169,12 +1155,19 @@
my $tos = pop @stack;
my $p;
if ($p = $lexicals{$c}) {
+ if ($p eq $tos->[1]) {
+ print <<"EOC";
+ \t $cmt
+EOC
+ }
+ else {
print <<"EOC";
# assign $c, $tos->[1] $cmt
set $p, $tos->[1] $cmt
EOC
$lexicals{$c} = $p;
}
+ }
else {
$lexicals{$c} = promote($tos);
print <<"EOC";
@@ -1289,14 +1282,6 @@
}
my $var = temp('P');
my $name = $tos->[0];
- if ($rev_type_map{$name} || $builtins{$name}) {
- $name =~ s/^Py_//;
- print <<EOC;
- .local NCI iter\:\:$name
- iter\:\:$name = $iter
-EOC
- $iter = 'iter::' . $name;
- }
print <<EOC;
unless $iter goto $targ # $tos->[0]
$var = shift $iter $cmt
1.3 +28 -2 parrot/languages/python/t/pie/b6.t
Index: b6.t
===================================================================
RCS file: /cvs/public/parrot/languages/python/t/pie/b6.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- b6.t 17 Jul 2004 06:10:24 -0000 1.2
+++ b6.t 17 Jul 2004 16:01:24 -0000 1.3
@@ -1,9 +1,9 @@
-# $Id: b6.t,v 1.2 2004/07/17 06:10:24 leo Exp $
+# $Id: b6.t,v 1.3 2004/07/17 16:01:24 leo Exp $
use strict;
use lib '../../lib';
-use Parrot::Test tests => 2;
+use Parrot::Test tests => 3;
sub test {
language_output_is('python', $_[0], '', $_[1]);
@@ -53,3 +53,29 @@
if __name__ == '__main__':
main()
CODE
+
+test(<<'CODE', 'b6 - fdiv');
+# from b5 import check
+show = True
+def check(a, b):
+ if __debug__:
+ if show:
+ print `a`, "==", `b`
+ if not a == b:
+ raise AssertionError("%.30r != %.30r" % (a, b))
+def x():
+ n = 2000000000
+ print `n`
+ n += 1000000000
+ print `n`
+
+def main():
+ n = 0
+ for i in xrange(1000000):
+ n += i
+ check(i, 999999)
+ check(n, 999999*1000000//2)
+
+if __name__ == '__main__':
+ main()
+CODE
1.25 +89 -0 parrot/ops/math.ops
Index: math.ops
===================================================================
RCS file: /cvs/public/parrot/ops/math.ops,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -w -r1.24 -r1.25
--- math.ops 3 Jul 2004 19:50:32 -0000 1.24
+++ math.ops 17 Jul 2004 16:01:27 -0000 1.25
@@ -363,6 +363,35 @@
Set $1 to the quotient of $2 divided by $3. In the case of INTVAL division, the
result is truncated (NOT rounded or floored).
+=item B<fdiv>(inout INT, in INT)
+
+=item B<fdiv>(inout NUM, in INT)
+
+=item B<fdiv>(inout NUM, in NUM)
+
+=item B<fdiv>(in PMC, in INT)
+
+=item B<fdiv>(in PMC, in NUM)
+
+=item B<fdiv>(in PMC, in PMC)
+
+Floor divide $1 by $2.
+
+=item B<fdiv>(out INT, in INT, in INT)
+
+=item B<fdiv>(out NUM, in NUM, in INT)
+
+=item B<fdiv>(out NUM, in NUM, in NUM)
+
+=item B<fdiv>(in PMC, in PMC, in INT)
+
+=item B<fdiv>(in PMC, in PMC, in NUM)
+
+=item B<fdiv>(in PMC, in PMC, in PMC)
+
+Set $1 to the quotient of $2 divided by $3. The result is the floor()
+of the division i.e. the next whole integer towards -inf.
+
=cut
inline op div(inout INT, in INT) :base_core {
@@ -425,6 +454,66 @@
goto NEXT();
}
+inline op fdiv(inout INT, in INT) :base_core {
+ $1 = floor($1 / $2);
+ goto NEXT();
+}
+
+inline op fdiv(inout NUM, in INT) :base_core {
+ $1 = floor($1 / $2);
+ goto NEXT();
+}
+
+inline op fdiv(inout NUM, in NUM) :base_core {
+ $1 = floor($1 / $2);
+ goto NEXT();
+}
+
+inline op fdiv (in PMC, in PMC) :base_core {
+ mmd_dispatch_v_ppp(interpreter, $1, $2, $1, MMD_FLOOR_DIVIDE);
+ goto NEXT();
+}
+
+inline op fdiv (in PMC, in INT) :base_core {
+ mmd_dispatch_v_pip(interpreter, $1, $2, $1, MMD_FLOOR_DIVIDE_INT);
+ goto NEXT();
+}
+
+inline op fdiv (in PMC, in NUM) :base_core {
+ mmd_dispatch_v_pnp(interpreter, $1, $2, $1, MMD_FLOOR_DIVIDE_FLOAT);
+ goto NEXT();
+}
+
+inline op fdiv(out INT, in INT, in INT) :base_core {
+ $1 = floor($2 / $3);
+ goto NEXT();
+}
+
+inline op fdiv(out NUM, in NUM, in INT) :base_core {
+ $1 = floor($2 / $3);
+ goto NEXT();
+}
+
+inline op fdiv(out NUM, in NUM, in NUM) :base_core {
+ $1 = floor($2 / $3);
+ goto NEXT();
+}
+
+inline op fdiv (in PMC, in PMC, in INT) :base_core {
+ mmd_dispatch_v_pip(interpreter, $2, $3, $1, MMD_FLOOR_DIVIDE_INT);
+ goto NEXT();
+}
+
+inline op fdiv (in PMC, in PMC, in NUM) :base_core {
+ mmd_dispatch_v_pnp(interpreter, $2, $3, $1, MMD_FLOOR_DIVIDE_FLOAT);
+ goto NEXT();
+}
+
+inline op fdiv (in PMC, in PMC, in PMC) :base_core {
+ mmd_dispatch_v_ppp(interpreter, $2, $3, $1, MMD_FLOOR_DIVIDE);
+ goto NEXT();
+}
+
########################################
=item B<ceil>(inout NUM)
1.68 +5 -17 parrot/vtable.tbl
Index: vtable.tbl
===================================================================
RCS file: /cvs/public/parrot/vtable.tbl,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -w -r1.67 -r1.68
--- vtable.tbl 9 Jul 2004 15:24:35 -0000 1.67
+++ vtable.tbl 17 Jul 2004 16:01:30 -0000 1.68
@@ -1,4 +1,4 @@
-# $Id: vtable.tbl,v 1.67 2004/07/09 15:24:35 leo Exp $
+# $Id: vtable.tbl,v 1.68 2004/07/17 16:01:30 leo Exp $
# [MAIN] #default section name
void init()
@@ -39,9 +39,6 @@
FLOATVAL get_number_keyed_str(STRING* key)
BIGNUM* get_bignum()
-BIGNUM* get_bignum_keyed(PMC* key)
-BIGNUM* get_bignum_keyed_int(INTVAL key)
-BIGNUM* get_bignum_keyed_str(STRING* key)
STRING* get_string()
STRING* get_repr()
@@ -80,9 +77,6 @@
void set_bignum_native(BIGNUM* value)
void set_bignum_same(PMC* value)
-void set_bignum_keyed(PMC* key, BIGNUM* value)
-void set_bignum_keyed_int(INTVAL key, BIGNUM* value)
-void set_bignum_keyed_str(STRING* key, BIGNUM* value)
void set_string_native(STRING* value)
void assign_string_native(STRING* value)
@@ -113,28 +107,24 @@
[POP]
INTVAL pop_integer()
FLOATVAL pop_float()
-BIGNUM* pop_bignum()
STRING* pop_string()
PMC* pop_pmc()
[PUSH]
void push_integer(INTVAL value)
void push_float(FLOATVAL value)
-void push_bignum(BIGNUM* value)
void push_string(STRING* value)
void push_pmc(PMC* value)
[SHIFT]
INTVAL shift_integer()
FLOATVAL shift_float()
-BIGNUM* shift_bignum()
STRING* shift_string()
PMC* shift_pmc()
[UNSHIFT]
void unshift_integer(INTVAL value)
void unshift_float(FLOATVAL value)
-void unshift_bignum(BIGNUM* value)
void unshift_string(STRING* value)
void unshift_pmc(PMC* value)
@@ -146,32 +136,30 @@
[MATH]
void add(PMC* value, PMC* dest) MMD_ADD
void add_int(INTVAL value, PMC* dest) MMD_ADD_INT
-void add_bignum(BIGNUM* value, PMC* dest)
void add_float(FLOATVAL value, PMC* dest) MMD_ADD_FLOAT
void subtract(PMC* value, PMC* dest) MMD_SUBTRACT
void subtract_int(INTVAL value, PMC* dest) MMD_SUBTRACT_INT
-void subtract_bignum(BIGNUM* value, PMC* dest)
void subtract_float(FLOATVAL value, PMC* dest) MMD_SUBTRACT_FLOAT
void multiply(PMC* value, PMC* dest) MMD_MULTIPLY
void multiply_int(INTVAL value, PMC* dest) MMD_MULTIPLY_INT
-void multiply_bignum(BIGNUM* value, PMC* dest)
void multiply_float(FLOATVAL value, PMC* dest) MMD_MULTIPLY_FLOAT
void divide(PMC* value, PMC* dest) MMD_DIVIDE
void divide_int(INTVAL value, PMC* dest) MMD_DIVIDE_INT
-void divide_bignum(BIGNUM* value, PMC* dest)
void divide_float(FLOATVAL value, PMC* dest) MMD_DIVIDE_FLOAT
+void floor_divide(PMC* value, PMC* dest) MMD_FLOOR_DIVIDE
+void floor_divide_int(INTVAL value, PMC* dest) MMD_FLOOR_DIVIDE_INT
+void floor_divide_float(FLOATVAL value, PMC* dest) MMD_FLOOR_DIVIDE_FLOAT
+
void modulus(PMC* value, PMC* dest) MMD_MOD
void modulus_int(INTVAL value, PMC* dest) MMD_MOD_INT
-void modulus_bignum(BIGNUM* value, PMC* dest)
void modulus_float(FLOATVAL value, PMC* dest) MMD_MOD_FLOAT
void cmodulus(PMC* value, PMC* dest) MMD_CMOD
void cmodulus_int(INTVAL value, PMC* dest) MMD_CMOD_INT
-void cmodulus_bignum(BIGNUM* value, PMC* dest)
void cmodulus_float(FLOATVAL value, PMC* dest) MMD_CMOD_FLOAT
void neg(PMC* dest)
