#!/usr/bin/perl -w
# usage
#   to-insn-aliases
#           -A .../insn-aliases.inc
#           [-M <map-file>]
#           [-H <header-file>]
#           [<infile>]
#
#   to-insn-aliases -P .../insn-aliases.inc (for debugging, really)
#
#  eg
#   gpdasm -p18f458 program+entire0.hex \
#    | ../iwjpictest/to-insn-aliases -A ../iwjpictest/insn-aliases.inc \
#      -M program+program.map -H /usr/share/gputils/header/p18f458.inc \
#    | less
#  or
#   ../iwjpictest/to-insn-aliases -A ../iwjpictest/insn-aliases.inc \
#     <nmra-stream.asm >nmra-stream.asm.new

use strict qw(vars);
use IO::File;

our ($doprint);

our (%mapping);
# $mapping{$opcode}[$i]{FormalArgs}[$j] = formal arg letter
# $mapping{$opcode}[$i]{Macro} = macro `opcode'
# $mapping{$opcode}[$i]{ActualArgs}[$j] = '0','1', or formal arg letter or W

our (%syms,%addrs);
# $syms{$loc}{$addr}[$i]= $show
# $addrs{$loc}[$i]= $addr

sub parseoptions () {
    my ($f);
    for (;;) {
	return unless @ARGV;
	return unless $ARGV[0] =~ m/^\-/;
	$_= shift @ARGV;
	return if m/^\-\-$/;
	s/^\-([APHM])// or die;
	if (!length) { @ARGV or die; $_= shift @ARGV; }
	$f= new IO::File $_;
	if ($1 eq 'P') { $doprint= 1; readaliases($f); }
	elsif ($1 eq 'A') { readaliases($f); }
	elsif ($1 eq 'M') { readmap($f); }
	elsif ($1 eq 'H') { readheader($f); }
	else { die; }
	die $! if $f->error();
	close $f;
    }
}

sub readheader ($) {
    my ($f) = @_;
    my ($ss, $name,$addr);
    $ss= $syms{' sfr'}= { };
    while (<$f>) {
#print "1>$_";
	next unless m/^\;\-+\s*register file/i ... /^\;.*\-/;
#print "2>$_";
	next if m/^\;/;
	next unless m/\S/;
	die unless m/^(\w+)\s+equ\s+h\'0?(f[0-9a-f]{2})\'\s*$/i;
	($name,$addr) = ($1,$2);
	$addr = hex($addr);
	next if exists $ss->{$addr};
	$ss->{$addr}= $name;
    }
}

sub readmap ($) {
    my ($f) = @_;
    my ($name,$addr,$loc,$stor,$file);
    my ($scope,$show, $k);
    while (<$f>) {
	next unless m/^\s+Symbols\s+$/ .. !m/\S/;
	next if m/^\s+Symbols\s+$/;
	next if m/^\s+Name\s+Address\s+Location\s+Storage\s+File\s+$/;
	next unless m/[^ \t\n-]/;
	die unless
 m/^\s*(\w+)\s+(0x\w+|0+)\s+(program|data)\s+(static|extern)\s+(\S+)\s*$/;
	($name,$addr,$loc,$stor,$file)=($1,$2,$3,$4,$5);
	$scope= $stor eq 'extern' ? '' : "$file:";
	$scope =~ s/\.asm\:$/:/;
	$show= $scope.$name;
	$addr= hex($addr);
	push @{ $syms{$loc}{$addr} }, $show;
	push @{ $addrs{$loc} }, $addr;
    }
    foreach $k (keys %addrs) {
	$addrs{$k}= [ sort { $a <=> $b } @{ $addrs{$k} } ];
    }
}

sub builtin_opcodes () {
    my ($o);
    foreach $o (qw(bra goto call rcall)) {
	push @{ $mapping{$o} }, {
	    FormalArgs => [qw(n)], Macro => $o, ActualArgs => [qw(n)]
	    };
    }
    push @{ $mapping{'call'} }, {
	FormalArgs => [qw(n)], Macro => 'call', ActualArgs => [qw(n 0)]
	};
    foreach $o (qw(return retfie)) {
	push @{ $mapping{$o} }, {
	    FormalArgs => [], Macro => $o, ActualArgs => [qw(0)]
	    };
    }
}

sub addr2print ($$$) {
    my ($loc, $av, $default) = @_;
    my ($i,$j, $al, $h,$ha);
    $av =~ s/^0x// or return $default;
    $av= hex($av);
    if ($loc eq 'data' && $av >= 0xf00) {
	$al= $syms{' sfr'};
	return $default unless exists $al->{$av};
	return $al->{$av};
    }
    $al= $addrs{$loc};
    return $default unless $al;
    $i= 0; $j= @$al;
    for (;;) {
#print ">$loc|$default|av=$av|i=$i|j=$j\n";
	last if $i >= $j;
	$h= ($i+$j) >> 1;
	$ha= $al->[$h];
#print ">$loc|$default|av=$av|i=$i|j=$j|h=$h|ha=$ha\n";
	if ($av == $ha) { return $syms{$loc}{$ha}[0]; }
	elsif ($av < $ha) { $j=$h; }
	else { $i=$h+1; }
    }
    $i--;
    if ($i < 0) { return $default; }
    $ha= $al->[$i];
    return sprintf "%s+0x%x", $syms{$loc}{$ha}[0], $av - $ha;
}

sub readaliases ($) {
    my ($f) = @_;
    my ($inmacro, @formalargs, $newmapping);
    my ($formarglets) = 'inkfgb';
    while (<$f>) {
	s/0xfe8/W/;
	s/\binsn_aliases_arg_([a-z])\b/$1/g;
	if (m/^\s*\;/) {
	} elsif (m/^(\w+)\s+macro(?:\s+([$formarglets,]+))?\s*$/o) {
	    die if defined $inmacro;
	    $inmacro= $1;
	    @formalargs= defined $2 ? split /\,/, $2 : ();
	} elsif (m/^\s+endm\b/) {
	    die unless defined $inmacro;
	    undef $inmacro;
	} elsif (m/^\s+(?:list|nolist)\b/) {
	} elsif (m/^\s+(\w+)(?:\s+([01W$formarglets,]+))?\s*$/o) {
	    die if $inmacro eq '';
	    $newmapping= {
		FormalArgs => [ @formalargs ],
		Macro => $inmacro
		};
	    push @{ $mapping{$1} }, $newmapping;
	    $newmapping->{ActualArgs}= defined $2 ? [ split /\,/, $2 ] : [];
	    $inmacro= '';
	} else {
	    die;
	}
    }
}

sub printaliases () {
    my ($o, $m);
    foreach $o (keys %mapping) {
	foreach $m (@{ $mapping{$o} }) {
	    printf("%7s  %-20s   -> %13s  %-20s\n",
		   $o, join(',', @{ $m->{ActualArgs} }),
		   $m->{Macro}, join(',', @{ $m->{FormalArgs} }));
	}
	print "\n";
    }
}

sub mapinsn {
    my (@r) = @_;
    my ($org_opcode, @org_args) = @_;
    my ($m,$i,$mismatch,$specified,$pattern,%arg,$fa,$aa);
#print "**$org_opcode\n";
    MAPPING: foreach $m (@{ $mapping{$org_opcode} }) {
	next unless @org_args == @{ $m->{ActualArgs} };
#print "**$m->{Macro}|\n";
	for ($i=0, $mismatch=0; !$mismatch && $i<@org_args; $i++) {
	    $specified= $org_args[$i];
	    $pattern= $m->{ActualArgs}[$i];
	    if ($pattern eq 'W') {
		$pattern= 'WREG|0xfe8|0xe8';
		$pattern= "(?:$pattern)";
	    } elsif ($pattern =~ m/^[01]$/) {
		$pattern= "(?:0x)?$pattern";
	    }
	    if ($pattern =~ m/^[a-z]$/) {
		$arg{$&}= $specified;
	    } elsif ($specified !~ m/^\s*$pattern\s*$/) {
#print "**$m->{Macro}|$pattern|$specified<\n";
		next MAPPING;
	    }
	}
	# yay!
	@r= ($m->{Macro});
	foreach $fa (@{ $m->{FormalArgs} }) {
	    next unless $fa =~ m/^[a-z]$/;
	    $aa= $arg{$fa};
#print ">@r|$fa|$aa<\n";
	    if ($fa =~ m/f/) {
		if ($m->{Macro} =~ m/_[wf]*a/ &&
		    $aa =~ m/^0x([6-9a-f][0-9a-f])$/) {
		    $aa= addr2print('data', "0xf$1", $aa);
		} else {
		    $aa= addr2print('data', $aa, $aa);
		}
	    } elsif ($fa =~ m/n/) {
		$aa= addr2print('program', $aa, $aa);
	    }		
	    push @r, $aa;
	}
	last if @r==1;
    }
    return @r;
}

sub processfiles () {
    my ($comment,$addrshow, $addr,$symshow,$symbols);
    my ($lhs,$opcode,$midspc,$args,$rhs, @args, $lastopcode);
    my ($insertnewline);
    $lastopcode= $insertnewline= '';
    while (<>) {
	chomp;
	$comment= s/\;.*// ? $& : '';
	$symbols= '';
	if (s/^(([0-9a-f]{6})\:)\s+//) {
	    $addrshow= $&;
	    $addr= hex($2);
	    foreach $symshow (@{ $syms{'program'}{$addr} }) {
		$symbols .= "$1 $symshow\n";
	    }
	} else {
	    $addrshow= '';
	}
	if (m/^(\w*\s+)(\w+)(\s+)(.*?)(\s*)$/) {
	    ($lhs,$opcode,$midspc,$args,$rhs) = ($1,$2,$3,$4,$5);
	    $symbols= $insertnewline.$symbols;
	    $insertnewline= '';
	    @args= split /\,/, $args;
	    ($opcode, @args) = mapinsn($opcode, @args);
	    $args= sprintf "%-*s", length($args), join ',', @args;
	    $midspc =~ s/\t$/ / if length($opcode) >= 8;
	    $_= $lhs.$opcode.$midspc.$args.$rhs;
#print ">$opcode|$lastopcode<?\n";
	    if (($opcode =~ m/^(?:return|retfie)(?:_r)?$/ ||
		 $opcode =~ m/^(?:goto|bra)$/) && length($addrshow) &&
		length($lastopcode) && $lastopcode !~ m/_if\w+$/) {
#print ">$opcode|$lastopcode<INL\n";
		$insertnewline= "\n";
	    }
	    $lastopcode= $opcode;
	} elsif (length($addrshow) && m/^\w+\s*$/) {
	} else {
	    $lastopcode= $insertnewline= '';
	}
	print $symbols, $addrshow, $_, $comment, "\n";
    }
}

parseoptions();
builtin_opcodes();
if ($doprint) { printaliases(); exit(0); }
processfiles();