cvsuser 04/07/09 06:17:26
Modified: classes bigint.pmc
languages/python pie-thon.pl
languages/python/t/pie b5.t
src trace.c
Log:
Pie-thon 42 - bigint get_bool; bool() function; test
Revision Changes Path
1.12 +16 -2 parrot/classes/bigint.pmc
Index: bigint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/bigint.pmc,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -w -r1.11 -r1.12
--- bigint.pmc 9 Jul 2004 11:49:20 -0000 1.11
+++ bigint.pmc 9 Jul 2004 13:17:15 -0000 1.12
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: bigint.pmc,v 1.11 2004/07/09 11:49:20 leo Exp $
+$Id: bigint.pmc,v 1.12 2004/07/09 13:17:15 leo Exp $
=head1 NAME
@@ -66,6 +66,7 @@
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)))
@@ -74,6 +75,12 @@
return 0;
}
+static int
+bigint_get_bool(Interp *interpreter, PMC *self) {
+ if (mpz_fits_slong_p(BN(self)))
+ return mpz_get_si(BN(self)) != 0;
+ return 0;
+}
static char *
bigint_get_string(Interp *interpreter, PMC *self) {
return mpz_get_str(NULL, 10, BN(self));
@@ -201,6 +208,11 @@
internal_exception(1, "no bigint lib loaded");
return 0L;
}
+static long
+bigint_get_bool(Interp *interpreter, PMC *self) {
+ internal_exception(1, "no bigint lib loaded");
+ return 0L;
+}
static double
bigint_get_double(Interp *interpreter, PMC *self) {
internal_exception(1, "no bigint lib loaded");
@@ -407,7 +419,7 @@
*/
INTVAL get_bool() {
- return 0;
+ return bigint_get_bool(INTERP, SELF);
}
/*
@@ -447,6 +459,7 @@
*/
void increment() {
+ internal_exception(1, "unimp inc");
}
/*
@@ -460,6 +473,7 @@
*/
void decrement() {
+ internal_exception(1, "unimp dec");
}
void add(PMC* value, PMC* dest) {
1.26 +24 -1 parrot/languages/python/pie-thon.pl
Index: pie-thon.pl
===================================================================
RCS file: /cvs/public/parrot/languages/python/pie-thon.pl,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -w -r1.25 -r1.26
--- pie-thon.pl 9 Jul 2004 11:49:24 -0000 1.25
+++ pie-thon.pl 9 Jul 2004 13:17:19 -0000 1.26
@@ -18,6 +18,7 @@
my %builtin_ops = (
abs => 1,
iter =>1,
+ bool => 's', # special
);
my %builtins = (
@@ -490,6 +491,7 @@
# print_stack();
}
+
sub LOAD_NAME() {
my ($n, $c, $cmt) = @_;
if (is_opcode($c)) {
@@ -855,6 +857,20 @@
print "# st $_->[2] : $_->[1]\n";
}
}
+# python func to opcode translations
+sub OPC_bool() {
+ my ($c, $args, $cmt) = @_;
+ my $b = temp('I');
+ my $p = temp('P');
+ print <<EOC;
+ $b = istrue $args $cmt
+ # TODO create true P, false P opcodes
+ $p = new .Boolean
+ $p = $b
+EOC
+ push @stack, [-1, $p, 'I'];
+}
+
sub CALL_FUNCTION
{
my ($n, $c, $cmt) = @_;
@@ -890,7 +906,8 @@
# func $name named arg $j name $arg_name val $val->[1]
EOC
$args[$pushed_args + $j] = promote($val);
- $n = $nfix + $nk/2;}
+ }
+ $n = $nfix + $nk/2;
my $tos = pop @stack;
my $args = join ', ', @args;
my $t;
@@ -910,6 +927,12 @@
$args = $ar;
}
if ($tos->[2] eq 'F') { # builtin opcode
+ if ($builtin_ops{$func} eq 's') {
+ no strict "refs";
+ my $opcode = "OPC_$func";
+ &$opcode($func, $args, $cmt);
+ return;
+ }
$t = temp('P');
print <<EOC;
$t = new $DEFVAR
1.3 +31 -4 parrot/languages/python/t/pie/b5.t
Index: b5.t
===================================================================
RCS file: /cvs/public/parrot/languages/python/t/pie/b5.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- b5.t 9 Jul 2004 11:49:27 -0000 1.2
+++ b5.t 9 Jul 2004 13:17:21 -0000 1.3
@@ -1,9 +1,9 @@
-# $Id: b5.t,v 1.2 2004/07/09 11:49:27 leo Exp $
+# $Id: b5.t,v 1.3 2004/07/09 13:17:21 leo Exp $
use strict;
use lib '../../lib';
-use Parrot::Test tests => 3;
+use Parrot::Test tests => 4;
sub test {
language_output_is('python', $_[0], '', $_[1]);
@@ -31,7 +31,7 @@
main()
CODE
-test(<<'CODE', 'chec_functions abs, long');
+test(<<'CODE', 'check_functions abs, long');
show = True
def check(a, b):
@@ -58,7 +58,7 @@
CODE
-test(<<'CODE', 'chec_functions abs, complex');
+test(<<'CODE', 'check_functions abs, complex');
show = True
def check(a, b):
@@ -84,3 +84,30 @@
CODE
+test(<<'CODE', 'check_functions bool basic types');
+show = True
+
+def check(a, b):
+ if __debug__:
+ if show:
+ print `a`, "==", `b`
+ if not a == b:
+ raise AssertionError("%.30r != %.30r" % (a, b))
+
+def check_functions(i=0, j=0):
+ check(bool(1+i), True)
+ check(bool(100+j), True)
+ check(bool(i-j), False)
+
+def main():
+ check_functions()
+ check_functions(j=10, i=10)
+ for i in range(0,500,249):
+ print "i:", i
+ check_functions(j=long(i*1000000), i=i*1000000)
+
+if __name__ == '__main__':
+ main()
+CODE
+
+
1.61 +5 -1 parrot/src/trace.c
Index: trace.c
===================================================================
RCS file: /cvs/public/parrot/src/trace.c,v
retrieving revision 1.60
retrieving revision 1.61
diff -u -w -r1.60 -r1.61
--- trace.c 7 Jul 2004 03:37:55 -0000 1.60
+++ trace.c 9 Jul 2004 13:17:26 -0000 1.61
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: trace.c,v 1.60 2004/07/07 03:37:55 leo Exp $
+$Id: trace.c,v 1.61 2004/07/09 13:17:26 leo Exp $
=head1 NAME
@@ -56,6 +56,10 @@
mem_sys_free(escaped);
}
}
+ else if (pmc->vtable->base_type == enum_class_Boolean) {
+ PIO_eprintf(interpreter, "Boolean=PMC(%#p: %d",
+ pmc, PMC_int_val(pmc));
+ }
else if (pmc->vtable->base_type == enum_class_BigInt) {
STRING *s = VTABLE_get_string(interpreter, pmc);
PIO_eprintf(interpreter, "BigInt=PMC(%#p: %Ss",
