#!/usr/bin/perl -w

#USAGE:
#
# wiscF05.pl <infile> [ > <outfile> ]

#NOTES:
# -All labels MUST start with L
# -Shift amounts must be in decimal
# -Immediate may be in hex or decimal.  If in hex, precede with "0x"
# -Comments may be specified with either "#" or "//".  
# -No multiline comments
#
# MEM <ADDR> and DATA <VALUE> may be used to specify memory
#


#################################################################


use strict;

if(@ARGV < 1) { print "Usage: wiscF05.pl <input assembly file> [> outputFile]"; exit; }


my %regs = ("R0" => "0000", "R1" => "0001", "R2" => "0010", "R3" => "0011",
	    "R4" => "0100", "R5" => "0101", "R6" => "0110", "R7" => "0111",
	    "R8" => "1000", "R9" => "1001", "R10"=> "1010", "R11"=> "1011",
	    "R12"=> "1100", "R13"=> "1101", "R14"=> "1110", "R15"=> "1111");

my %numArgs = ( qw/AND 3 OR 3 XOR 3 NOT 2 ADD 3 SUB 3 SRA 3 SLL 3 LW 2 SW 2 LHB 2 LLB 2 VADD 3 B 2 CALL 1 RET 0/);

my %opcode = ( qw/AND 0000 OR 0001 XOR 0010 NOT 0011 ADD 0100 SUB 0101 SRA 0110 SLL 0111 LW 1000 SW 1001 LHB 1010 LLB 1011 VADD 1100 B 1101 CALL 1110 RET 1111/);

my %rlookup = ( "1111", "F" , "1110", "E" , "1101", "D" , "1100", "C",
                "1011", "B" , "1010", "A" , "1001", "9" , "1000", "8",
                "0111", "7" , "0110", "6" , "0101", "5" , "0100", "4",
                "0011", "3" , "0010", "2" , "0001", "1" , "0000", "0");


open(IN, "$ARGV[0]") or die("Can't open $ARGV[0]: $!");

my %labels = ( );
my @mem;
my @code;
my $addr = 0;

while(<IN>) {
    my $bits = "";

    s/\#(.*)$//;  #remove  (#) comments
    s#//(.*)$##;  #remove (//) comments
    next if( /^\s*$/ );  #skip blank lines

    if(/MEM\s+(\S*)/) {
	$addr = hex($1);
	next;
    }
    if(/DATA\s+(.*)/) {
	my $data = $1;
	$data =~ s/\s*(\S+)\s*/$1/;
	while(length($data) < 4) { $data = "0" . $data }
	$mem[$addr++] = hexToBin($data, 16);
	next;
    }

    $_ = uc($_);

  if(s/(.*)://) {  #capture labels
    my $label = $1;
    $label =~ s/\s*(\S+)\s*/$1/;   #strip white space
    $labels{$label} = $addr*2;
  }

  if( /^\s*(\S+)\s*(.*)/ ) {
      my $instr = $1;
      my @args = split(",", $2);
      
      if(!exists($numArgs{$instr})) { die("Unknown instruction\n$_") }
      if($numArgs{$instr} != @args) { 
	  die("Error:\n$_\nWrong number of arguments (need $numArgs{$instr} args)\n") 
	  }
      
      $bits = "$opcode{$instr}";

      #strip whitespace from arguments
      for(my $c=0; $c<@args; $c++) { 
	  $args[$c] =~ s/^\s*(\S+)\s*$/$1/ ;
      }
      
      if($instr =~ /^(AND|OR|XOR|ADD|SUB|VADD)$/) {
	  foreach my $reg ($args[0], $args[1], $args[2]) {
	      if(!$regs{$reg}) { die("Bad register ($reg)\n$_") }
	      $bits .= $regs{$reg};
	  }
      }
      elsif($instr =~ /^(NOT)$/) {
	  foreach my $reg ($args[0], $args[1]) {
	      if(!$regs{$reg}) { die("Bad register ($reg)\n$_") }
	      $bits .= $regs{$reg};
	  }
	$bits .= "0000";
      }
      elsif($instr =~ /^(SRA|SLL)$/) {
	  foreach my $reg ($args[0], $args[1]) {
	      if(!$regs{$reg}) { die("Bad register ($reg)\n$_") }
	      $bits .= $regs{$reg};
	  }
	  $bits .= decToBin($args[2], 4);
      }
      elsif($instr =~ /^(LW|SW|LHB|LLB|)$/) {
	  foreach my $reg ($args[0]) {
	      if(!$regs{$reg}) { die("Bad register ($reg)\n$_") }
	      $bits .= $regs{$reg};
	  }
	  $bits .= parseImmediate($args[1], 8);
      }
      elsif($instr =~ /^(B)$/) {
	  if($args[0] =~ /[a-zA-Z]/) {
	      print STDERR "Warning: control letters not yet supported\n";
	  }
	  else { $bits .= "0" . $args[0]; }

	  if($args[1] !~ /[a-zA-Z]/) { print STDERR "Error: Invalid label name: \"$args[1]\""; exit; }
	  $bits .= "|" . $args[1] . "|8|B|";
      }
      elsif($instr =~ /^(CALL)$/) {
	  if($args[0] !~ /[a-zA-Z]/) { print STDERR "Error: Invalid label name: \"$args[0]\""; exit; }
	  $bits .= "|" . $args[0] . "|12|J|";
      }
      elsif($instr =~ /^(RET)$/) {
	  $bits .= "000000000000";
      }

      #print $bits;
      $mem[$addr] = $bits;
      $code[$addr] = $_;
      $addr += 1;
  }    
}
close(IN);

print "* / 00000000;\n\n";

for(my $i=0; $i<scalar(@mem); $i++) {
  $addr = $mem[$i];
  next if(!$addr);
  if($addr =~ /\|(.+)\|(\d+)\|(\w)\|/) { 
    if(!$labels{$1}) { die("Error:\nLabel referenced, but doesnt exist ($1)\n") }
    my $disp = ($3 eq "J") ? $labels{$1} : ($labels{$1} - ($i*2 + 2)) / 2;
    $disp = decToBin($disp, $2);
    $addr =~ s/\|(.+)\|(\d+)\|(\w)\|/$disp/;
  }
  #my $j = $i / 2;  #shift from a byte address to a word address
  print decToHex($i) . "  /  " . binToHex($addr) . "  ;\n";
  #if($code[$i]) { print $code[$i] }
  #else { print "\n" }
}



sub parseImmediate {
    my $imm = $_[0];
    my $hex = ($imm =~ /^0x/i) ? 1 : 0;
    $imm =~ s/^0x//i if($hex);
    return $hex ? hexToBin($imm, $_[1]) : decToBin($imm, $_[1]);
}

sub hexToBin {
  return decToBin(hex($_[0]), $_[1]);
}

sub decToBin {
    my $ret = sprintf("%b", $_[0]);
    while(length($ret) < $_[1]) { $ret = "0" . $ret }
    if(length($ret) > $_[1]) { $ret = substr($ret, length($ret)-$_[1]) }
    return $ret;
}



sub decToHex {
  my $ret = sprintf("%x", $_[0]);
  while(length($ret) < 4) { $ret = "0" . $ret }
  return $ret;
}

sub binToHex {
  $_[0] =~ /(\d{4})(\d{4})(\d{4})(\d{4})/;
  return $rlookup{$1} . $rlookup{$2} . $rlookup{$3} . $rlookup{$4}; 
}