#!/usr/bin/perl

use warnings;
use strict;

use Parrot::PackFile;
my $PARROT_MAGIC = 0x13155a1;


use Parrot::Types;
use Parrot::OpLib::core;
use Parrot::Op;
sub dissassemble {
    my @ops = @$Parrot::OpLib::core::ops; # A lot less of a mouthful
    my $bytecode = shift;
    my($op, $arg, @argtypes, $type);
    my($label, $code, $comment) = ("") x 3;
    
    while (length($bytecode)>0) {
	$op=shift_op($bytecode);
	
	$comment = "\t\t# ". $op;
	$code = $ops[$op]->full_name . "\t";

	@argtypes = $ops[$op]->arg_types;
	# First arg is always the op itself, which we've already delt with.
	shift @argtypes;
	for $type (@argtypes) {
	    $arg = shift_op($bytecode);
	    $code .= " " . format_arg($arg, $type) . ",";
	    $comment .= " " . $arg;
	}
	chop $code;
	print $label, $code, $comment, "\n";
    }
}

sub format_arg {
    my $arg = shift;
    my $type = shift;
    
    # Register types, just [INSP]n
    if ($type eq 'i') {
	return "I$arg";
    } elsif ($type eq 'n') {
	return "N$arg";
    } elsif ($type eq 's') {
	return "S$arg";
    } elsif ($type eq 'p') {
	return "P$arg";
    # Constant types
    } elsif ($type eq 'ic') {
	return $arg;
    } elsif ($type eq 'nc') {
	return "num_const($arg)";
    } elsif ($type eq 'sc') {
	return "str_const($arg)";
    } elsif ($type eq 'pc') {
	return "pmc_const($arg)";
    } else {
	return "$type($arg)";
    }
}

sub dump_string {
    my $str = shift;
    my $prefix = shift || "";
    my $encname;
    my $typename;
    my $data;
    
    $data = $str->data;
    
    # Convert literal newlines.
    $data =~ s/\n/\\n/;
    # FIXME: If we aren't native singlebyte, we should do more.
    
    printf $prefix."Flags:    0x%x\n", $str->flags;
    printf $prefix."Encoding: 0x%x\n", $str->encoding;
    printf $prefix."Chartype: 0x%x\n", $str->type;
    printf $prefix."Size:       %d\n", $str->size;
    printf $prefix."Data:      \"%s\"\n", $data;
}

my $packfile = new Parrot::PackFile;
$/=undef;
$packfile->unpack(<ARGV>);

printf "Magic Number: 0x%x (%s)\n", $packfile->magic,
  $packfile->magic == $PARROT_MAGIC ? "OK": "BAD";

print "\n";
print "Fixup Table:\n";
my $fixups = $packfile->fixup_table;
if ($fixups->packed_size != 0) {
    print "FIXUP TABLE HAS CONTENTS??\n";
} else {
    print "[Fixup table is empty]\n";
}

print "\n";
print "Constant Table:\n";
my $const_table = $packfile->const_table;
print "Number of consts: ", $const_table->const_count, "\n";

my @consts=$const_table->constants;
my $const;
for $const (@consts) {
    print "   Type: ", $const->type, , " (", $const->type_name($const->type), ")", "\n";
    if ($const->type != ord('s')) {
	print "   Value:", $const->value,"\n";
    } else {
	dump_string($const->value, "      ");
    }
}

print "\n";
print "Bytecode:\n";
my $bytecode = $packfile->byte_code;
dissassemble($bytecode);