cvs commit: parrot/languages/python pie-thon.pl

[Dan Sugalski]

cvsuser     04/10/05 08:00:13

  Modified:    languages/python pie-thon.pl
  Log:
  Add in a few more ops
  
  Revision  Changes    Path
  1.67      +87 -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.66
  retrieving revision 1.67
  diff -u -w -r1.66 -r1.67
  --- pie-thon.pl       29 Jul 2004 06:56:59 -0000      1.66
  +++ pie-thon.pl       5 Oct 2004 15:00:13 -0000       1.67
  @@ -789,6 +789,56 @@
       push @stack, [-1, $n, $t];
   }
   
  +sub binary_word
  +{
  +    my ($op, $cmt) = @_;
  +    my $r = pop @stack;
  +    my $l = pop @stack;
  +    my ($t, $n);
  +    {
  +     my $nl = promote($l);
  +     $n = temp($t = 'P');
  +     my $nr = $r->[1];
  +#    $nr = promote($r) if $r->[2] eq 'S';
  +     $nr = promote($r);
  +     print <<"EOC";
  +     $n = new $DEFVAR $cmt
  +     $op $n, $nl, $nr
  +EOC
  +    }
  +    push @stack, [-1, $n, $t];
  +}
  +
  +sub BINARY_AND
  +{
  +    my ($n, $c, $cmt) = @_;
  +    binary('&', $cmt);
  +}
  +
  +sub BINARY_OR
  +{
  +    my ($n, $c, $cmt) = @_;
  +    binary('|', $cmt);
  +}
  +
  +sub BINARY_XOR
  +{
  +    my ($n, $c, $cmt) = @_;
  +    binary_word('xor', $cmt);
  +}
  +
  +sub BINARY_LSHIFT
  +{
  +    my ($n, $c, $cmt) = @_;
  +    binary_word('shl', $cmt);
  +}
  +
  +sub BINARY_RSHIFT
  +{
  +    my ($n, $c, $cmt) = @_;
  +    binary_word('shr', $cmt);
  +}
  +
   sub BINARY_ADD
   {
       my ($n, $c, $cmt) = @_;
  @@ -855,6 +905,21 @@
   EOC
       push @stack, [-1, $l->[1], $l->[2]];
   }
  +sub inplace_word
  +{
  +    my ($op, $cmt) = @_;
  +    my $r = pop @stack;
  +    my $l = pop @stack;
  +    print <<"EOC";
  +     $op $l->[1], $r->[1] $cmt
  +EOC
  +    push @stack, [-1, $l->[1], $l->[2]];
  +}
  +sub INPLACE_MODULO
  +{
  +    my ($n, $c, $cmt) = @_;
  +    inplace_word('mod', $cmt);
  +}
   sub INPLACE_ADD
   {
       my ($n, $c, $cmt) = @_;
  @@ -1521,6 +1586,18 @@
       push @stack, $tos;
   }
   
  +sub DUP_TOPX
  +{
  +    my ($n, $c, $cmt) = @_;
  +    foreach (1..$n) {
  +     my $thing = $stack[-$n];
  +     push @stack, $thing;
  +    print <<EOC;
  +     $cmt
  +EOC
  +    }
  +}
  +
   sub ROT_THREE
   {
       my ($n, $c, $cmt) = @_;
  @@ -1533,6 +1610,16 @@
       push @stack, $w;
   }
   
  +sub ROT_TWO
  +{
  +    my ($n, $c, $cmt) = @_;
  +    print "\t\t$cmt\n";
  +    my $v = pop @stack;
  +    my $w = pop @stack;
  +    push @stack, $w;
  +    push @stack, $v;
  +}
  +
   sub STORE_SUBSCR
   {
       my ($n, $c, $cmt) = @_;