iwjpictest/to-insn-aliases

   1 #!/usr/bin/perl -w
   2 # usage
   3 #   to-insn-aliases
   4 #           -A .../insn-aliases.inc
   5 #           [-M <map-file>]
   6 #           [-H <header-file>]
   7 #           [<infile>]
   8 #
   9 #   to-insn-aliases -P .../insn-aliases.inc (for debugging, really)
  10 #
  11 #  eg
  12 #   gpdasm -p18f458 program+entire0.hex \
  13 #    | ../iwjpictest/to-insn-aliases -A ../iwjpictest/insn-aliases.inc \
  14 #      -M program+program.map -H /usr/share/gputils/header/p18f458.inc \
  15 #    | less
  16 #  or
  17 #   ../iwjpictest/to-insn-aliases -A ../iwjpictest/insn-aliases.inc \
  18 #     <nmra-stream.asm >nmra-stream.asm.new
  19
  20 use strict qw(vars);
  21 use IO::File;
  22
  23 our ($doprint);
  24
  25 our (%mapping);
  26 # $mapping{$opcode}[$i]{FormalArgs}[$j] = formal arg letter
  27 # $mapping{$opcode}[$i]{Macro} = macro `opcode'
  28 # $mapping{$opcode}[$i]{ActualArgs}[$j] = '0','1', or formal arg letter or W
  29
  30 our (%syms,%addrs);
  31 # $syms{$loc}{$addr}[$i]= $show
  32 # $addrs{$loc}[$i]= $addr
  33
  34 sub parseoptions () {
  35     my ($f);
  36     for (;;) {
  37         return unless @ARGV;
  38         return unless $ARGV[0] =~ m/^\-/;
  39         $_= shift @ARGV;
  40         return if m/^\-\-$/;
  41         s/^\-([APHM])// or die;
  42         if (!length) { @ARGV or die; $_= shift @ARGV; }
  43         $f= new IO::File $_;
  44         if ($1 eq 'P') { $doprint= 1; readaliases($f); }
  45         elsif ($1 eq 'A') { readaliases($f); }
  46         elsif ($1 eq 'M') { readmap($f); }
  47         elsif ($1 eq 'H') { readheader($f); }
  48         else { die; }
  49         die $! if $f->error();
  50         close $f;
  51     }
  52 }
  53
  54 sub readheader ($) {
  55     my ($f) = @_;
  56     my ($ss, $name,$addr);
  57     $ss= $syms{' sfr'}= { };
  58     while (<$f>) {
  59 #print "1>$_";
  60         next unless m/^\;\-+\s*register file/i ... /^\;.*\-/;
  61 #print "2>$_";
  62         next if m/^\;/;
  63         next unless m/\S/;
  64         die unless m/^(\w+)\s+equ\s+h\'0?(f[0-9a-f]{2})\'\s*$/i;
  65         ($name,$addr) = ($1,$2);
  66         $addr = hex($addr);
  67         next if exists $ss->{$addr};
  68         $ss->{$addr}= $name;
  69     }
  70 }
  71
  72 sub readmap ($) {
  73     my ($f) = @_;
  74     my ($name,$addr,$loc,$stor,$file);
  75     my ($scope,$show, $k);
  76     while (<$f>) {
  77         next unless m/^\s+Symbols\s+$/ .. !m/\S/;
  78         next if m/^\s+Symbols\s+$/;
  79         next if m/^\s+Name\s+Address\s+Location\s+Storage\s+File\s+$/;
  80         next unless m/[^ \t\n-]/;
  81         die unless
  82  m/^\s*(\w+)\s+(0x\w+|0+)\s+(program|data)\s+(static|extern)\s+(\S+)\s*$/;
  83         ($name,$addr,$loc,$stor,$file)=($1,$2,$3,$4,$5);
  84         $scope= $stor eq 'extern' ? '' : "$file:";
  85         $scope =~ s/\.asm\:$/:/;
  86         $show= $scope.$name;
  87         $addr= hex($addr);
  88         push @{ $syms{$loc}{$addr} }, $show;
  89         push @{ $addrs{$loc} }, $addr;
  90     }
  91     foreach $k (keys %addrs) {
  92         $addrs{$k}= [ sort { $a <=> $b } @{ $addrs{$k} } ];
  93     }
  94 }
  95
  96 sub builtin_opcodes () {
  97     my ($o);
  98     foreach $o (qw(bra goto call rcall)) {
  99         push @{ $mapping{$o} }, {
 100             FormalArgs => [qw(n)], Macro => $o, ActualArgs => [qw(n)]
 101             };
 102     }
 103     push @{ $mapping{'call'} }, {
 104         FormalArgs => [qw(n)], Macro => 'call', ActualArgs => [qw(n 0)]
 105         };
 106     foreach $o (qw(return retfie)) {
 107         push @{ $mapping{$o} }, {
 108             FormalArgs => [], Macro => $o, ActualArgs => [qw(0)]
 109             };
 110     }
 111 }
 112
 113 sub addr2print ($$$) {
 114     my ($loc, $av, $default) = @_;
 115     my ($i,$j, $al, $h,$ha);
 116     $av =~ s/^0x// or return $default;
 117     $av= hex($av);
 118     if ($loc eq 'data' && $av >= 0xf00) {
 119         $al= $syms{' sfr'};
 120         return $default unless exists $al->{$av};
 121         return $al->{$av};
 122     }
 123     $al= $addrs{$loc};
 124     return $default unless $al;
 125     $i= 0; $j= @$al;
 126     for (;;) {
 127 #print ">$loc|$default|av=$av|i=$i|j=$j\n";
 128         last if $i >= $j;
 129         $h= ($i+$j) >> 1;
 130         $ha= $al->[$h];
 131 #print ">$loc|$default|av=$av|i=$i|j=$j|h=$h|ha=$ha\n";
 132         if ($av == $ha) { return $syms{$loc}{$ha}[0]; }
 133         elsif ($av < $ha) { $j=$h; }
 134         else { $i=$h+1; }
 135     }
 136     $i--;
 137     if ($i < 0) { return $default; }
 138     $ha= $al->[$i];
 139     return sprintf "%s+0x%x", $syms{$loc}{$ha}[0], $av - $ha;
 140 }
 141
 142 sub readaliases ($) {
 143     my ($f) = @_;
 144     my ($inmacro, @formalargs, $newmapping);
 145     my ($formarglets) = 'inkfgb';
 146     while (<$f>) {
 147         s/0xfe8/W/;
 148         s/\binsn_aliases_arg_([a-z])\b/$1/g;
 149         if (m/^\s*\;/) {
 150         } elsif (m/^(\w+)\s+macro(?:\s+([$formarglets,]+))?\s*$/o) {
 151             die if defined $inmacro;
 152             $inmacro= $1;
 153             @formalargs= defined $2 ? split /\,/, $2 : ();
 154         } elsif (m/^\s+endm\b/) {
 155             die unless defined $inmacro;
 156             undef $inmacro;
 157         } elsif (m/^\s+(?:list|nolist)\b/) {
 158         } elsif (m/^\s+(\w+)(?:\s+([01W$formarglets,]+))?\s*$/o) {
 159             die if $inmacro eq '';
 160             $newmapping= {
 161                 FormalArgs => [ @formalargs ],
 162                 Macro => $inmacro
 163                 };
 164             push @{ $mapping{$1} }, $newmapping;
 165             $newmapping->{ActualArgs}= defined $2 ? [ split /\,/, $2 ] : [];
 166             $inmacro= '';
 167         } else {
 168             die;
 169         }
 170     }
 171 }
 172
 173 sub printaliases () {
 174     my ($o, $m);
 175     foreach $o (keys %mapping) {
 176         foreach $m (@{ $mapping{$o} }) {
 177             printf("%7s  %-20s   -> %13s  %-20s\n",
 178                    $o, join(',', @{ $m->{ActualArgs} }),
 179                    $m->{Macro}, join(',', @{ $m->{FormalArgs} }));
 180         }
 181         print "\n";
 182     }
 183 }
 184
 185 sub mapinsn {
 186     my (@r) = @_;
 187     my ($org_opcode, @org_args) = @_;
 188     my ($m,$i,$mismatch,$specified,$pattern,%arg,$fa,$aa);
 189 #print "**$org_opcode\n";
 190     MAPPING: foreach $m (@{ $mapping{$org_opcode} }) {
 191         next unless @org_args == @{ $m->{ActualArgs} };
 192 #print "**$m->{Macro}|\n";
 193         for ($i=0, $mismatch=0; !$mismatch && $i<@org_args; $i++) {
 194             $specified= $org_args[$i];
 195             $pattern= $m->{ActualArgs}[$i];
 196             if ($pattern eq 'W') {
 197                 $pattern= 'WREG|0xfe8|0xe8';
 198                 $pattern= "(?:$pattern)";
 199             } elsif ($pattern =~ m/^[01]$/) {
 200                 $pattern= "(?:0x)?$pattern";
 201             }
 202             if ($pattern =~ m/^[a-z]$/) {
 203                 $arg{$&}= $specified;
 204             } elsif ($specified !~ m/^\s*$pattern\s*$/) {
 205 #print "**$m->{Macro}|$pattern|$specified<\n";
 206                 next MAPPING;
 207             }
 208         }
 209         # yay!
 210         @r= ($m->{Macro});
 211         foreach $fa (@{ $m->{FormalArgs} }) {
 212             next unless $fa =~ m/^[a-z]$/;
 213             $aa= $arg{$fa};
 214 #print ">@r|$fa|$aa<\n";
 215             if ($fa =~ m/f/) {
 216                 if ($m->{Macro} =~ m/_[wf]*a/ &&
 217                     $aa =~ m/^0x([6-9a-f][0-9a-f])$/) {
 218                     $aa= addr2print('data', "0xf$1", $aa);
 219                 } else {
 220                     $aa= addr2print('data', $aa, $aa);
 221                 }
 222             } elsif ($fa =~ m/n/) {
 223                 $aa= addr2print('program', $aa, $aa);
 224             }
 225             push @r, $aa;
 226         }
 227         last if @r==1;
 228     }
 229     return @r;
 230 }
 231
 232 sub processfiles () {
 233     my ($comment,$addrshow, $addr,$symshow,$symbols);
 234     my ($lhs,$opcode,$midspc,$args,$rhs, @args, $lastopcode);
 235     my ($insertnewline);
 236     $lastopcode= $insertnewline= '';
 237     while (<>) {
 238         chomp;
 239         $comment= s/\;.*// ? $& : '';
 240         $symbols= '';
 241         if (s/^(([0-9a-f]{6})\:)\s+//) {
 242             $addrshow= $&;
 243             $addr= hex($2);
 244             foreach $symshow (@{ $syms{'program'}{$addr} }) {
 245                 $symbols .= "$1 $symshow\n";
 246             }
 247         } else {
 248             $addrshow= '';
 249         }
 250         if (m/^(\w*\s+)(\w+)(\s+)(.*?)(\s*)$/) {
 251             ($lhs,$opcode,$midspc,$args,$rhs) = ($1,$2,$3,$4,$5);
 252             $symbols= $insertnewline.$symbols;
 253             $insertnewline= '';
 254             @args= split /\,/, $args;
 255             ($opcode, @args) = mapinsn($opcode, @args);
 256             $args= sprintf "%-*s", length($args), join ',', @args;
 257             $midspc =~ s/\t$/ / if length($opcode) >= 8;
 258             $_= $lhs.$opcode.$midspc.$args.$rhs;
 259 #print ">$opcode|$lastopcode<?\n";
 260             if (($opcode =~ m/^(?:return|retfie)(?:_r)?$/ ||
 261                  $opcode =~ m/^(?:goto|bra)$/) && length($addrshow) &&
 262                 length($lastopcode) && $lastopcode !~ m/_if\w+$/) {
 263 #print ">$opcode|$lastopcode<INL\n";
 264                 $insertnewline= "\n";
 265             }
 266             $lastopcode= $opcode;
 267         } elsif (length($addrshow) && m/^\w+\s*$/) {
 268         } else {
 269             $lastopcode= $insertnewline= '';
 270         }
 271         print $symbols, $addrshow, $_, $comment, "\n";
 272     }
 273 }
 274
 275 parseoptions();
 276 builtin_opcodes();
 277 if ($doprint) { printaliases(); exit(0); }
 278 processfiles();