cvsuser 04/07/06 20:37:55
Modified: classes bigint.pmc perlint.pmc perlscalar.pmc
languages/python pie-thon.pl
languages/python/t/pie b2.t
src trace.c
Log:
Pie-thon 30 - more BigInt stuff; pi.py is now exact for 1000 digits
Revision Changes Path
1.7 +60 -6 parrot/classes/bigint.pmc
Index: bigint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/bigint.pmc,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -w -r1.6 -r1.7
--- bigint.pmc 4 Jul 2004 10:41:00 -0000 1.6
+++ bigint.pmc 7 Jul 2004 03:37:43 -0000 1.7
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: bigint.pmc,v 1.6 2004/07/04 10:41:00 leo Exp $
+$Id: bigint.pmc,v 1.7 2004/07/07 03:37:43 leo Exp $
=head1 NAME
@@ -62,6 +62,10 @@
return PMC_struct_val(self);
}
+static void
+bigint_set_self(Interp *interpreter, PMC *self, BIGNUM *value) {
+ mpz_set(BN(self), value);
+}
static long
bigint_get_long(Interp *interpreter, PMC *self) {
if (mpz_fits_slong_p(BN(self)))
@@ -116,6 +120,12 @@
/* this is mpz_fdiv_q */
mpz_div(BN(dest), BN(self), BN(value));
}
+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));
+}
static void
bigint_div_bigint_int(Interp *interpreter, PMC* self, INTVAL value,
@@ -160,6 +170,11 @@
bigint_set_str(Interp *interpreter, PMC *self, char* value) {
internal_exception(1, "no bigint lib loaded");
}
+static void
+bigint_set_self(Interp *interpreter, PMC *self, BIGNUM *value) {
+ internal_exception(1, "no bigint lib loaded");
+ return NULL;
+}
static BIGNUM*
bigint_get_self(Interp *interpreter, PMC *self) {
internal_exception(1, "no bigint lib loaded");
@@ -209,6 +224,11 @@
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");
+}
+static void
bigint_div_bigint_int(Interp *interpreter, PMC* self, INTVAL value,
PMC *dest)
{
@@ -304,7 +324,7 @@
*/
void set_pmc(PMC *value) {
- PMC_struct_val(SELF) = VTABLE_get_bignum(INTERP, value);
+ bigint_set_self(INTERP, SELF, bigint_get_self(INTERP, value));
}
/*
@@ -421,7 +441,7 @@
bigint_add_bigint_int(INTERP, SELF, value, dest);
}
- void mul(PMC* value, PMC* dest) {
+ void multiply(PMC* value, PMC* dest) {
MMD_BigInt: {
bigint_mul_bigint(INTERP, SELF, value, dest);
}
@@ -431,13 +451,46 @@
}
- void mul_int(INTVAL value, PMC* dest) {
+ void multiply_int(INTVAL value, PMC* dest) {
bigint_mul_bigint_int(INTERP, SELF, value, dest);
}
- void div(PMC* value, PMC* dest) {
+ void divide(PMC* value, PMC* dest) {
MMD_BigInt: {
bigint_div_bigint(INTERP, SELF, value, dest);
+ if (mpz_fits_slong_p(BN(dest))) {
+ VTABLE_morph(INTERP, dest, enum_class_PerlInt);
+ VTABLE_set_integer_native(INTERP, dest,
+ mpz_get_si(BN(dest)));
+ }
+ }
+MMD_DEFAULT: {
+ internal_exception(1, "unimp");
+ }
+
+ }
+ void modulus(PMC* value, PMC* dest) {
+MMD_BigInt: {
+ bigint_mod_bigint(INTERP, SELF, value, dest);
+ if (mpz_fits_slong_p(BN(dest))) {
+ VTABLE_morph(INTERP, dest, enum_class_PerlInt);
+ VTABLE_set_integer_native(INTERP, dest,
+ mpz_get_si(BN(dest)));
+ }
+ }
+MMD_DEFAULT: {
+ internal_exception(1, "unimp");
+ }
+
+ }
+ void cmodulus(PMC* value, PMC* dest) {
+MMD_BigInt: {
+ bigint_mod_bigint(INTERP, SELF, value, dest);
+ if (mpz_fits_slong_p(BN(dest))) {
+ VTABLE_morph(INTERP, dest, enum_class_PerlInt);
+ VTABLE_set_integer_native(INTERP, dest,
+ mpz_get_si(BN(dest)));
+ }
}
MMD_DEFAULT: {
internal_exception(1, "unimp");
@@ -445,7 +498,8 @@
}
- void div_int(INTVAL value, PMC* dest) {
+
+ void divide_int(INTVAL value, PMC* dest) {
bigint_div_bigint_int(INTERP, SELF, value, dest);
}
1.69 +42 -4 parrot/classes/perlint.pmc
Index: perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.68
retrieving revision 1.69
diff -u -w -r1.68 -r1.69
--- perlint.pmc 3 Jul 2004 19:50:13 -0000 1.68
+++ perlint.pmc 7 Jul 2004 03:37:43 -0000 1.69
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlint.pmc,v 1.68 2004/07/03 19:50:13 leo Exp $
+$Id: perlint.pmc,v 1.69 2004/07/07 03:37:43 leo Exp $
=head1 NAME
@@ -44,6 +44,28 @@
}
}
+static void
+overflow_p(Interp *interpreter, PMC *self, PMC *val, PMC *dest, int mmd)
+{
+ PMC *temp;
+ INTVAL a = PMC_int_val(self);
+
+ if (PARROT_ERRORS_test(interpreter,PARROT_ERRORS_OVERFLOW_FLAG)) {
+ real_exception(interpreter, NULL, ERR_OVERFLOW,
+ "Integer overflow");
+ }
+ if (self == dest) {
+ VTABLE_morph(interpreter, self, enum_class_BigInt);
+ VTABLE_set_integer_native(interpreter, self, a);
+ mmd_dispatch_v_ppp(interpreter, self, val, dest, mmd);
+ }
+ else {
+ temp = pmc_new(interpreter, enum_class_BigInt);
+ VTABLE_set_integer_native(interpreter, temp, a);
+ mmd_dispatch_v_ppp(interpreter, temp, val, dest, mmd);
+ }
+}
+
pmclass PerlInt extends perlscalar {
/*
@@ -245,6 +267,9 @@
else
overflow(INTERP, SELF, b, dest, MMD_ADD_INT);
}
+MMD_BigInt: {
+ overflow_p(INTERP, SELF, value, dest, MMD_ADD);
+ }
MMD_Integer: {
VTABLE_set_integer_native(INTERP, dest,
PMC_int_val(SELF) + PMC_int_val(value));
@@ -340,6 +365,9 @@
else
overflow(INTERP, SELF, b, dest, MMD_MULTIPLY_INT);
}
+MMD_BigInt: {
+ overflow_p(INTERP, SELF, value, dest, MMD_MULTIPLY);
+ }
MMD_PerlString: {
INTVAL a = PMC_int_val(SELF);
INTVAL b = VTABLE_get_integer(INTERP, value);
@@ -392,15 +420,25 @@
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);
+ INTVAL vali = VTABLE_get_integer(INTERP, value);
+ FLOATVAL d;
+ INTVAL i;
if (valf == 0.0) {
internal_exception(DIV_BY_ZERO, "division by zero!\n");
return;
}
-
- VTABLE_set_number_native(INTERP, dest, PMC_int_val(SELF)/valf);
+ d = PMC_int_val(SELF)/valf;
+ i = PMC_int_val(SELF)/vali;
+ if ((FLOATVAL)(i) == d)
+ VTABLE_set_integer_native(INTERP, dest, i);
+ else
+ VTABLE_set_number_native(INTERP, dest, d);
}
}
1.14 +4 -1 parrot/classes/perlscalar.pmc
Index: perlscalar.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlscalar.pmc,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -w -r1.13 -r1.14
--- perlscalar.pmc 4 Jul 2004 10:41:00 -0000 1.13
+++ perlscalar.pmc 7 Jul 2004 03:37:43 -0000 1.14
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlscalar.pmc,v 1.13 2004/07/04 10:41:00 leo Exp $
+$Id: perlscalar.pmc,v 1.14 2004/07/07 03:37:43 leo Exp $
=head1 NAME
@@ -91,6 +91,9 @@
case enum_class_PerlUndef:
(void) VTABLE_get_pmc(interpreter, value);
break;
+ default:
+ DYNSELF.set_pmc(value);
+ break;
}
}
1.17 +10 -0 parrot/languages/python/pie-thon.pl
Index: pie-thon.pl
===================================================================
RCS file: /cvs/public/parrot/languages/python/pie-thon.pl,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -w -r1.16 -r1.17
--- pie-thon.pl 6 Jul 2004 16:20:05 -0000 1.16
+++ pie-thon.pl 7 Jul 2004 03:37:48 -0000 1.17
@@ -378,6 +378,9 @@
if ($tos->[2] eq 'P' && $tos->[1] =~ /^\$/) {
$pmc = $tos->[1];
}
+ elsif ($builtins{$tos->[1]}) {
+ $pmc = $tos->[1];
+ }
else {
print <<"EOC";
$c = new $DEFVAR \t# case 1
@@ -393,6 +396,13 @@
}
$globals{$c} = 1;
$names{$c} = 1;
+ if ($builtins{$pmc}) {
+ print <<"EOC";
+ global "$c" = $pmc \t# case 2b
+ $c = $pmc
+EOC
+ return;
+ }
# a temp - store it
if ($pmc =~ /^\$/) {
print <<"EOC";
1.3 +26 -2 parrot/languages/python/t/pie/b2.t
Index: b2.t
===================================================================
RCS file: /cvs/public/parrot/languages/python/t/pie/b2.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- b2.t 6 Jul 2004 15:00:44 -0000 1.2
+++ b2.t 7 Jul 2004 03:37:51 -0000 1.3
@@ -1,9 +1,9 @@
-# $Id: b2.t,v 1.2 2004/07/06 15:00:44 leo Exp $
+# $Id: b2.t,v 1.3 2004/07/07 03:37:51 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]);
@@ -33,6 +33,30 @@
main()
CODE
+test(<<'CODE', 'pi() func 1000 digits');
+def pi():
+ k, a, b, a1, b1 = 2, 4, 1, 12, 4
+ n = 0
+ while 1:
+ p, q, k = k*k, 2*k+1, k+1
+ a, b, a1, b1 = a1, b1, p*a+q*a1, p*b+q*b1
+ d, d1 = a//b, a1//b1
+ while d == d1:
+ n += 1
+ if n > 1000:
+ print
+ return
+ print d,
+ a, a1 = 10*(a%b), 10*(a1%b1)
+ d, d1 = a//b, a1//b1
+
+def main():
+ pi()
+
+if __name__ == '__main__':
+ main()
+CODE
+
test(<<'CODE', 'pi() generator');
def pi():
k, a, b, a1, b1 = 2, 4, 1, 12, 4
1.60 +6 -1 parrot/src/trace.c
Index: trace.c
===================================================================
RCS file: /cvs/public/parrot/src/trace.c,v
retrieving revision 1.59
retrieving revision 1.60
diff -u -w -r1.59 -r1.60
--- trace.c 6 Jul 2004 13:00:46 -0000 1.59
+++ trace.c 7 Jul 2004 03:37:55 -0000 1.60
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: trace.c,v 1.59 2004/07/06 13:00:46 leo Exp $
+$Id: trace.c,v 1.60 2004/07/07 03:37:55 leo Exp $
=head1 NAME
@@ -56,6 +56,11 @@
mem_sys_free(escaped);
}
}
+ else if (pmc->vtable->base_type == enum_class_BigInt) {
+ STRING *s = VTABLE_get_string(interpreter, pmc);
+ PIO_eprintf(interpreter, "BigInt=PMC(%#p: %Ss",
+ pmc, s);
+ }
else if (pmc->vtable->base_type == enum_class_Complex) {
STRING *s = VTABLE_get_string(interpreter, pmc);
PIO_eprintf(interpreter, "Complex=PMC(%#p: (%Ss)",
