#!/usr/bin/perl -w

use strict;
use lib './lib';
use lib './lib/Parrot/blib/lib';
use lib './lib/Parrot/blib/arch/auto/Parrot/PakFile2';
use Parrot::PakFile2;
use Parrot::Assembler::Utils;
use strict;
use Parrot::OpLib::core;
use Parrot::Types;

unless(@ARGV) {
    Usage();
}
Usage() if $ARGV[0] eq '-h';
Usage() if $ARGV[0] eq '--help';

my %args;
my @files;
#
# Process arguments
#
for(my $i=0;$i<@ARGV;$i++) {
    if($ARGV[$i] eq '--output') {
        $args{output} = $ARGV[++$i];
    }
    elsif($ARGV[$i] eq '--checksyntax') {
        $args{checksyntax} = 1;
    }
    else {
        push @files,$ARGV[$i];
    }
}

my $ops;
my $fullops;
for (@$Parrot::OpLib::core::ops) {
    my $argtype = join "_", @{$_->{ARGS}}[1..$#{$_->{ARGS}}];
    ${$ops->{$_->{NAME}}}{$argtype} = $_->{CODE};
    $fullops->{$_->{NAME}.($argtype &&"_$argtype") } = $_->{CODE};
}

#
# Open all of the files in a row and add them to @asm, stripping keys and labels
#
my @asm;
my $pc = 0;
my $labels={};

for my $file (@files) {
    open FILE,"<$file" or
        die "Couldn't open <$file: $!";
    while (<FILE>) {
        next if /^\s*#/;
        chomp;
        $_ = detach_key($_);
        s/,\s*$//; # In case of comments, trailing commas, etc.
        push @asm, $_;
        define_labels($labels,$_);
    }
    close FILE;
}

# Reset variables
$pc = 0;
my $lineno = 0;
my $bc;
my %const_hash;
my @const_array;

# The second pass expands labels and ops, removes constants and emits
# bytecode
for (@asm) {
    $lineno++;
    $_ = replace_labels($lineno,$labels,$_);
    $_ = expand_op($ops,$lineno,$_) if $_;
    $bc .= emit(\%const_hash,\@const_array,$fullops,$_) if $_;
}
my $packfile = {
    bytecode => $bc,
    constants => \@const_array
};

exit if exists $args{checksyntax};
if(exists $args{output}) {
    open FILE,">$args{output}"
      or die "Could not write to $args{output}: $!";
    print FILE Parrot::PakFile2::output_bytecode($packfile);
    close FILE;
}
else {
    print Parrot::PakFile2::output_bytecode($packfile);
}

exit;

#------------------------------------------------------------------------------

sub Usage {
    print <<_EOF_;
usage: $0 [-h] [--help] [--checksyntax] [--output=file] file ...

    checksyntax Check syntax only, do not output
    help        Print this message
    output      Write bytecode to the file <file>
    
_EOF_
    exit;
}

sub detach_key {
    local $_ = shift;
    my $output = "";
    s/^(\s*\w+:)// and $output .= $1; # label
    s/^(\s*)// and $output .= $1;
    return $output unless $_;
    s/(\w+\s*)// and $output .= $1;   # Op

    # Run through the args looking for keys
    my @args;
    Parrot::Assembler::Utils::map_args {
        my ($arg_t, $arg, $extra) = @_;
        push @args, $arg;
        if ($arg_t eq "key") {
            $extra =~ s/\[/[k:/;
            push @args, $extra;
        }
    } $_;
    return $output." ".join ", ",@args;
}

sub define_labels {
    my $labels = shift;
    local $_ = shift;

    # If we find a label, store its PC
    if (s/^(\s*(\w+):)//) {
        die "Redefined label $2 at line $.\n" if exists $labels->{$2};
        $labels->{$2} = $pc;
    }

    s/^(\s*)//;
    return unless $_;

    # Count the op
 
    s/(\w+\s*)//;
    $pc++;

    # Now count the number of args
    Parrot::Assembler::Utils::map_args {
        $pc++;
    } $_;
}

sub replace_labels {
    my $lineno = shift;
    my $labels = shift;
    local $_ = shift;
    my $output;

    s/^(\s*(\w+):)//;
    s/^(\s*)// and $output .= $1;
    return unless $_;

    # Count the op
    s/(\w+\s*)// and $output .= $1;
    my $ops_pc = $pc;
    $pc++;

    my @args;
    Parrot::Assembler::Utils::map_args {
        my ($arg_t, $arg, $extra) = @_;
        $pc++;
        if ($arg_t eq "label") {
            if (defined $labels->{$arg}) {
                push @args, $labels->{$arg} - $ops_pc;
            } else {
                die "Undefined label $arg used at line $lineno\n";
            }
        } else {
            push @args, $arg;
        }
    } $_;
    return $output." ".join ", ",@args;
}

sub expand_op {
    my $ops = shift;
    my $lineno = shift;
    local $_ = shift;
    s/^\s*//;
    return unless $_;

    s/(\w+)\s*//;
    die "Don't know op $1" unless $ops->{$1};
    my $op = $1;

    # Now let's look at the arguments
    my @args;
    my @arg_t;
    Parrot::Assembler::Utils::map_args {
        push @arg_t, $_[0];
        push @args, $_[1];
    } $_;
    my $type_specifier = join "_", @arg_t;
    my $complete = $op;
    $complete .="_$type_specifier" if $type_specifier;
    warn "Can't find op $complete at line $lineno\n" 
        unless exists $ops->{$op}{$type_specifier};
    return $complete." ".join ",",@args;
}

sub emit {
    my $const_href = shift;
    my $const_aref = shift;
    my $fullops = shift;
    local $_ = shift;
    my $rv;
    s/^\s*//;
    return unless $_;

    s/(\w+)\s*//;
    die "Can't find op $1\n" unless exists $fullops->{$1};
    $rv .= pack_op($fullops->{$1}); 
    Parrot::Assembler::Utils::map_args {
        my ($arg_t, $arg) = @_;
        if ($arg_t =~ /^[ispn]$/) {
            $arg =~ /(\d+)/;
            $rv .= pack_op($1);
        } elsif ($arg_t =~ /^([spn])c$/) {
            my $type = $1;
            if ($type eq "s") {
                $arg = eval $arg;
            }
            $rv .= pack_op(constantize($const_href,$const_aref,$arg, $type));
        } elsif ($arg_t eq "ic") {
            $rv .= pack_op($arg);
        } elsif ($arg_t eq "r") {
            my %r_types = ("I" => 0, "N"=>1, "S"=>2, "P"=>3);
            $arg=~/([PSNI])(\d+)/i;
            $rv .= pack_op($r_types{uc $1} >> 6 + $2);
        }
    } $_;
    return $rv;
}

sub constantize {
    my $const_href = shift;
    my $const_aref = shift;
    my ($arg, $type) = @_;
    return $const_href->{$type}{$arg} if exists $const_href->{$type}{$arg};
    push @$const_aref, [uc $type, $arg];
    return $const_href->{$type}{$arg} = $#{$const_aref};
}
