First cut of pyc2pasm

[Simon Cozens]

I've started on this, but I don't really have much time to work on
it any further. If anyone wants to take over, have fun. It translates
Python bytecode into Parrot assembler.

#!/usr/bin/perl

use Python::Bytecode;
my @p_registers = ("topstack");
my @free_list;

open IN, shift or die "Can't open file\n";
my $bytecode = Python::Bytecode->new(\*IN);

my $topstack = undef;
for ($bytecode->disassemble) {
    my $nameop = Python::Bytecode::opname($_->[1]);
    print "#\t\t\t\t$_->[0]\n";
    &{"emit_$nameop"}($_);
    print "\n";
}

sub emit_SET_LINENO { print "\tset I31, $_[0]->[2]" }
sub emit_LOAD_CONST {
    # OK, what's the constant?
    my $const_index = $_[0]->[2];
    my $constant = $bytecode->constants->[$const_index];
    my $type = ref $constant;
    $constant = $$constant;
    $type =~ s/Python::Bytecode::/Python/;
    $constant = "'$constant'" if $type eq "PythonString";
    my $reg = topstack($type);
    print "\tset P$reg, $constant" unless $type eq "PythonUndef";
}

sub emit_STORE_NAME {
    my $name_index = $_[0]->[2];
    my $name = $bytecode->names->[$name_index];
    my $register = symtab_entry($name);
    print "\tset P$register, P",topstack();
}

sub emit_LOAD_NAME {
    my $name_index = $_[0]->[2];
    my $name = $bytecode->names->[$name_index];
    my $register = symtab_entry($name);
    print "\tset P",topstack(),", P$register";
}

sub emit_PRINT_ITEM { print "\tprint P",topstack() }
sub emit_PRINT_NEWLINE { print "\tprint '\\n'" }
sub emit_RETURN_VALUE { print "\tend"; }

sub topstack {
    my $type = shift;
    if (not defined $topstack or ($type and $topstack->[1] ne $type)) {
        $topstack = [reg_alloc($type), $type];
    }
    return $topstack->[0];
}

sub reg_alloc {
    my $type = shift;
    if (@free_list) {
        return pop @free_list
    }
    my $reg = ++$#p_registers;
    die "Register allocation error\n" if $reg > 32;
    print "\tnew P$reg, $type\n";
    return $reg;
}

sub reg_free {
    push @free_list, shift;
}

my %sym_tab;

sub symtab_entry {
    my $name = shift;
    if (not exists $sym_tab{$name}) {
        my $register = reg_alloc("PythonInteger"); # XXX Wrong
        $sym_tab{$name} = $register;
        $p_registers[$register] = $name;
        return $register;
    }
    return $sym_tab{$name};
}

-- 
teco < /dev/audio
    - Ignatios Souvatzis