#!/usr/local/bin/perl -w

print "\tORG\t\$8000\n";

my %transtable = ( '02' => 'IDIV' ,
			'03' => 'FDIV' ,
			'08' => 'INX' , 
			'09' => 'DEX',
			'0A' => 'CLV',
			'0D' => 'SEC',
			'0E' => 'CLI',
			'0F' => 'SEI',
			'19' => 'DAA',
			'1B' => 'ABA',
			'30' => 'TSX',
			'31' => 'INS',
			'32' => 'PULA',
			'33' => 'PULB',
			'34' => 'DES',
			'35' => 'TXS',
			'36' => 'PSHA',
			'37' => 'PSHB',
			'3C' => 'PSHX',
			'38' => 'PULX',
			'3A' => 'ABX',
			'3B' => 'RTI',
			'3E' => 'WAI',
			'43' => 'COMA',
			'46' => 'RORA',
			'49' => 'ROLA',
			'4A' => 'DECA',
			'4C' => 'INCA',
			'4F' => 'CLRA',
			'53' => 'COMB',
			'56' => 'RORB',
			'59' => 'ROLB',
			'5A' => 'DECB',
			'5F' => 'CLRB',
			'8F' => 'XGDX',
			'39' => 'RTS' );

		#	'10' => 'SBA',


my %twobytefirst = ( '18' => '1' );

my %twobytesecond = ( '18 38' => 'PULY',
			'18 3A' => 'ABY',
			'18 3C' => 'PSHY');

my %onewitharg = ( '80' => 'SUBA',
			'81' => 'CMPA',
			'82' => 'SBCA',
			'84' => 'ANDA',
			'85' => 'BITA',
			'86' => 'LDAA',
			'88' => 'EORA',
			'8A' => 'ORA',
			'C0' => 'SUBB',
			'C1' => 'CMPB',
			'C2' => 'SBCB',
			'C4' => 'ANDB',
			'C5' => 'BITB',
			'C6' => 'LDAB',
			'C8' => 'EORB',
			'CA' => 'ORB' );


LINE: while (<>) {

# if blank line, print blank line
  if (/^\s*$/) { print "\n"; next LINE; }

# if comment line, pass straight through
  if (/^\s*;/) { print; next LINE; }

# if duplicate label - rename uniquely
  if (/^\s*((loop|jump82|goto91):)/) { print "${1}_$.\n"; next LINE; }

# if it's a label, print label
  if (/^\s*(\w*:)/) { print "$1\n"; next LINE; }

# if it's a vector table, print words
  if (/^\t\.word\t([a-f0-9]{4})$/) { print "\tFDB\t\$\U$1\n"; next LINE; }

# otherwise, catch all, print bytes
  if (/^([A-F0-9]{4}) ((([A-F0-9]{2}) )*[A-F0-9]{2})/) {
    instruction($_);
    next LINE;
  }

# if control Z, remove it
  if (/^\cZ$/) { next LINE; }

# FINAL print commented out
  print ";$_";
}

# Process one instruction
# Usage: instruction line
sub instruction {
    my ($line) = @_;
    print ";$line";

    $instruction = substr($line,5,2);

    if (defined $transtable{$instruction}) {
    	print "\t$transtable{$instruction}";
	$line =~ /$transtable{$instruction}(.*)$/i;
	print "$1\n";
	return;
    }
   
    if (defined $twobytefirst{$instruction}) {
    	$thing = substr($line,5,5);
    	if (defined $twobytesecond{$thing}) {
    		print "\t" . $twobytesecond{$thing};
		$line =~ /$twobytesecond{$thing}(.*)$/i;
		print "$1\n";
		return;
	}
    }
    
    if (defined $onewitharg{$instruction}) {
    	$thing = substr($line,8,2);
    	print "\t$onewitharg{$instruction}\t#\$$thing";
	$line =~ /$onewitharg{$instruction} [0-9A-F][0-9A-F](.*)$/i;
	print "\t;$1\n";
	return;
    }
   
    if ($line =~ /^([A-F0-9]{4}) ((([A-F0-9]{2}) )*[A-F0-9]{2})/) {
        @_=split(' ',$2);
        print "\tFCB\t\$".join(', $',@_)."\n";
    }
}
