cvsuser 04/07/10 02:02:35
Modified: classes complex.pmc perlint.pmc
languages/python pie-thon.pl
languages/python/t/basic 03_types.t
src objects.c
Log:
Pie-thon 45 - some more Complex PMC stuff
Revision Changes Path
1.5 +57 -8 parrot/classes/complex.pmc
Index: complex.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/complex.pmc,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -w -r1.4 -r1.5
--- complex.pmc 9 Jul 2004 11:49:20 -0000 1.4
+++ complex.pmc 10 Jul 2004 09:02:26 -0000 1.5
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: complex.pmc,v 1.4 2004/07/09 11:49:20 leo Exp $
+$Id: complex.pmc,v 1.5 2004/07/10 09:02:26 leo Exp $
=head1 NAME
@@ -282,18 +282,28 @@
}
FLOATVAL get_number () {
- /* XXX calculate modulus */
+ internal_exception(1, "Complex: unimp get_number");
return (FLOATVAL)0;
}
STRING* get_string () {
STRING *s;
+ if (Interp_flags_TEST(INTERP, PARROT_PYTHON_MODE)) {
+ if (IM(SELF) >= 0)
+ s = Parrot_sprintf_c(INTERP,
+ "(%vg+%vgj)", RE(SELF), IM(SELF));
+ else
+ s = Parrot_sprintf_c(INTERP,
+ "(%vg-%vgj)", RE(SELF), -IM(SELF));
+ }
+ else {
if(IM(SELF) >= 0)
s = Parrot_sprintf_c(INTERP,
"%vg+%vgi", RE(SELF), IM(SELF));
else
s = Parrot_sprintf_c(INTERP,
"%vg-%vgi", RE(SELF), -IM(SELF));
+ }
return s;
}
@@ -359,6 +369,45 @@
/*
+=item C<FLOATVAL get_number_keyed_int(INTVAL key)>
+
+Quick hack to emulate get_real() and get_imag():
+
+ key = 0 ... get real part
+ key = 1 ... get imag part
+
+=item C<void set_number_keyed_int(INTVAL key, FLOATVAL v)>
+
+Set real or imag dependig on key
+
+*/
+
+ FLOATVAL get_number_keyed_int(INTVAL key) {
+ switch (key) {
+ case 0:
+ return RE(SELF);
+ case 1:
+ return IM(SELF);
+ default:
+ internal_exception(1, "Complex: key must be 0 or 1");
+ }
+ return 0.0;
+ }
+
+ void set_number_keyed_int(INTVAL key, FLOATVAL v) {
+ switch (key) {
+ case 0:
+ RE(SELF) = v;
+ break;
+ case 1:
+ IM(SELF) = v;
+ break;
+ default:
+ internal_exception(1, "Complex: key must be 0 or 1");
+ }
+ }
+/*
+
=item C<void set_string_native (STRING* value)>
Parses the string C<value> into a complex number; raises an exception on failure.
1.71 +15 -1 parrot/classes/perlint.pmc
Index: perlint.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlint.pmc,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -w -r1.70 -r1.71
--- perlint.pmc 9 Jul 2004 11:49:20 -0000 1.70
+++ perlint.pmc 10 Jul 2004 09:02:26 -0000 1.71
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlint.pmc,v 1.70 2004/07/09 11:49:20 leo Exp $
+$Id: perlint.pmc,v 1.71 2004/07/10 09:02:26 leo Exp $
=head1 NAME
@@ -270,6 +270,20 @@
else
overflow(INTERP, SELF, b, dest, MMD_ADD_INT);
}
+MMD_Complex: {
+ if (dest != SELF) {
+ VTABLE_morph(INTERP, dest, enum_class_Complex);
+ VTABLE_set_number_native(INTERP, dest,
+ PMC_int_val(SELF) +
+ VTABLE_get_number_keyed_int(INTERP, value, 0));
+ VTABLE_set_number_keyed_int(INTERP, dest, 1,
+ VTABLE_get_number_keyed_int(INTERP, value, 1));
+
+ }
+ else {
+ internal_exception(1, "Complex: unimp add self");
+ }
+ }
MMD_BigInt: {
overflow_p(INTERP, SELF, value, dest, MMD_ADD);
}
1.28 +65 -18 parrot/languages/python/pie-thon.pl
Index: pie-thon.pl
===================================================================
RCS file: /cvs/public/parrot/languages/python/pie-thon.pl,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -w -r1.27 -r1.28
--- pie-thon.pl 9 Jul 2004 15:24:23 -0000 1.27
+++ pie-thon.pl 10 Jul 2004 09:02:29 -0000 1.28
@@ -16,9 +16,10 @@
$file = $ARGV[0];
my %builtin_ops = (
- abs => 1,
- iter =>1,
+ abs => 'o',
+ iter => 'o',
bool => 's', # special
+ complex => 's', # special
);
my %builtins = (
@@ -495,11 +496,12 @@
sub LOAD_NAME() {
my ($n, $c, $cmt) = @_;
- if (is_opcode($c)) {
+ my ($o);
+ if (($o = is_opcode($c))) {
print <<EOC;
- # builtin $c $cmt
+ # builtin $c $cmt $o
EOC
- push @stack, [-1, $c, 'F'];
+ push @stack, [$c, $c, $o];
return;
}
if ($globals{$c}) {
@@ -858,13 +860,16 @@
print "# st $_->[2] : $_->[1]\n";
}
}
+
# python func to opcode translations
-sub OPC_bool() {
- my ($c, $args, $cmt) = @_;
+sub OPC_bool {
+ my ($n, $c, $cmt) = @_;
my $b = temp('I');
my $p = temp('P');
+ my $arg = promote(pop @stack);
+ my $self = pop @stack;
print <<EOC;
- $b = istrue $args $cmt
+ $b = istrue $arg $cmt
# TODO create true P, false P opcodes
$p = new .Boolean
$p = $b
@@ -872,6 +877,45 @@
push @stack, [-1, $p, 'I'];
}
+sub OPC_complex {
+ my ($n, $c, $cmt) = @_;
+ my $p = temp('P');
+ my $im = pop @stack;
+ my $re = pop @stack; # TODO 1 argument only
+ my $self = pop @stack;
+ print "\t# stack messed $c ne $self->[1]\n" if ($c ne $self->[1]);
+ print <<EOC;
+ # cmplx($re->[1], $im->[1]) $cmt
+ $p = new .Complex
+EOC
+ if ($re->[2] eq 'P') {
+ my $n = temp('N');
+ print <<EOC;
+ $n = $re->[1]
+ $p = $n
+EOC
+ }
+ else {
+ print <<EOC;
+ $p = $re->[1]
+EOC
+ }
+ if ($im->[2] eq 'P') {
+ my $n = temp('N');
+ print <<EOC;
+ $n = $im->[1]
+ $p\["imag"\] = $n
+EOC
+ }
+ else {
+ print <<EOC;
+ $p\["imag"\] = $im->[1]
+EOC
+ }
+ push @stack, [-1, $p, 'I'];
+}
+
+
sub CALL_FUNCTION
{
my ($n, $c, $cmt) = @_;
@@ -884,14 +928,23 @@
pop @stack;
return;
}
+ my $func;
+ my $nfix = ($n & 0xff);
+ my $nk = 2*($n >> 8);
+ $func = $stack[-1 - $nfix-$nk]->[0];
+ print "\t\t $cmt $func\n";
+ if ($builtin_ops{$func} && $builtin_ops{$func} eq 's') {
+ no strict "refs";
+ my $opcode = "OPC_$func";
+ &$opcode($n, $func, $cmt);
+ return;
+ }
# arguments = $n & 0xff
# named args: = ($n >> 8) *2
- my $nfix = ($n & 0xff);
for (my $i = 0; $i < $nfix; $i++) {
my $arg = pop @stack;
unshift @args, promote($arg);
}
- my $nk = 2*($n >> 8);
my ($i, $j, $arg_name);
my $name = $stack[-1 - $nk]->[0];
my $pushed_args = scalar @args;
@@ -912,7 +965,7 @@
my $tos = pop @stack;
my $args = join ', ', @args;
my $t;
- my $func = $tos->[1];
+ $func = $tos->[1];
if ($builtins{$name} && $builtins{$name} eq 'v') {
my $ar = temp('P');
print <<"EOC";
@@ -927,13 +980,7 @@
}
$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;
- }
+ if ($tos->[2] eq 'o') { # builtin opcode
$t = temp('P');
print <<EOC;
$t = new $DEFVAR
1.8 +9 -2 parrot/languages/python/t/basic/03_types.t
Index: 03_types.t
===================================================================
RCS file: /cvs/public/parrot/languages/python/t/basic/03_types.t,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- 03_types.t 9 Jul 2004 15:24:26 -0000 1.7
+++ 03_types.t 10 Jul 2004 09:02:32 -0000 1.8
@@ -1,9 +1,9 @@
-# $Id: 03_types.t,v 1.7 2004/07/09 15:24:26 leo Exp $
+# $Id: 03_types.t,v 1.8 2004/07/10 09:02:32 leo Exp $
use strict;
use lib '../../lib';
-use Parrot::Test tests => 8;
+use Parrot::Test tests => 9;
sub test {
language_output_is('python', $_[0], '', $_[1]);
@@ -32,6 +32,13 @@
print abs(i)
CODE
+test(<<'CODE', 'complex()');
+if __name__ == '__main__':
+ print complex(3, 4), 3+4j
+ print `3+4j`
+
+CODE
+
test(<<'CODE', 'long() function and conversion');
if __name__ == '__main__':
print 20 == long(20), 123456789012L == long(123456789012)
1.101 +2 -2 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.100
retrieving revision 1.101
diff -u -w -r1.100 -r1.101
--- objects.c 8 Jul 2004 16:11:44 -0000 1.100
+++ objects.c 10 Jul 2004 09:02:35 -0000 1.101
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.100 2004/07/08 16:11:44 leo Exp $
+$Id: objects.c,v 1.101 2004/07/10 09:02:35 leo Exp $
=head1 NAME
@@ -1063,7 +1063,7 @@
start = class_name->strlen + 1;
for (isa = class->vtable->isa_str; ;) {
if (isa->strlen <= start)
- return NULL;
+ break;
pos = string_str_index(interpreter, isa,
CONST_STRING(interpreter, " "), start);
if (pos == -1) {
