to-insn-aliases before testing

diff --git a/iwjpictest/to-insn-aliases b/iwjpictest/to-insn-aliases
index 1ed00fb02ddf3d2c713a755f785f0672384d2920..c6c7e0c7596bc23a6e283a31ad4472ba2fb15954 100755 (executable)
--- a/iwjpictest/to-insn-aliases
+++ b/iwjpictest/to-insn-aliases
@@ -1,44 +1,106 @@
-#!/usr/bin/perl -p
-chomp;
-$comment= s/\;.*// ? $& : '';
-if (m/^(\w*\s+)(\w+)(\s+)(.*?)(\s*)$/) {
-    ($lhs,$opcode,$midspc,$args,$rhs) = ($1,$2,$3,$4,$5);
-    if ($opcode =~ m/^(b(c|s|tg)f|btfs[sc])$/ &&
-       $args =~ m/\,.*\,/ &&
-       $args =~ s/\,\s*0$/ ' 'x length($&) /e) {
-       $opcode =~ s/f/_f/;
-       $opcode =~ s/ss$/_if0/;
-       $opcode =~ s/sc$/_if1/;
-    } elsif ($opcode =~ m/^(mul)wf$/ &&
-       $args =~ m/\,/ &&
-       $args =~ s/\,\s*0$/ ' 'x length($&) /e) {
-       $opcode= 'mul_wf';
-    } elsif ($opcode =~ m/^((and|add|xor|ior)wf|addwfc|subwfb)$/ &&
-            $args =~ m/\,.*\,/ &&
-            $args =~ s/\,\s*([01])$/ ' 'x length($&) /e) {
-       $opcode =~ s/wf/ $1 ? 'wff' : 'wfw' /e;
-    } elsif ($opcode =~ m/^(com|dec|inc|neg|r[lr]n?c|neg|swap)f$/ &&
-            $args =~ m/\,.*\,/ &&
-            $args =~ s/\,\s*([01])$/ ' 'x length($&) /e) {
-       $opcode =~ s/f/ $1 ? 'f' : 'fw' /e;
-    } elsif ($opcode =~ m/^(and|add|xor|ior|mul|mov)lw$/) {
-       $opcode =~ s/lw$/_lw/;
-    } elsif ($opcode =~ m/^b(n?(?:c|n|ov|z))$/) {
-       $opcode =~ s/^b/bra_/;
-    } elsif ($opcode =~ m/^movff$/) {
-       $opcode =~ s/ff/_ff/;
-    } elsif ($opcode =~ m/^macro$/) {
-       $macro= $lhs;
-       $macro =~ s/\s.*//;
-       $macro{$macro}= 1;
-    } elsif ($opcode =~ m/^(res|equ|include|udata|udata_acs)$/ ||
-            $opcode =~ m/^(ifn?def)$/ ||
-            $opcode =~ m/^(r?call|bra|goto)$/ ||
-            $opcode =~ m/_/) {
-    } elsif ($macro{$opcode}) {
-    } else {
-       warn "unknown $opcode $args";
+#!/usr/bin/perl -w
+
+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
+
+sub readaliases () {
+    my ($f, $inmacro, @formalargs, $newmapping);
+    my ($formarglets) = 'inkfgb';
+    @ARGV or die;
+    $_= shift @ARGV;
+    s/^\-([AP])// or die;
+    $doprint= $1 eq 'P';
+    if (!length) { @ARGV or die; $_= shift @ARGV; }
+    $f= new IO::File $_;
+    while (<$f>) {
+       s/0xfe8/W/;
+       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;
+       }
     }
-    $_= $lhs.$opcode.$midspc.$args.$rhs;
+    die $! if $f->error();
+    close $f;
 }
-$_.= $comment."\n";
+
+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);
+    MAPPING: foreach $m (@{ $mapping{$org_opcode} }) {
+       next unless @org_args == @{ $m->{ActualArgs} };
+       for ($i=0, $mismatch=0; !$mismatch && $i<@org_args; $i++) {
+           $specified= $org_args[$i];
+           $pattern= $m->{ActualArgs}[$i];
+           $pattern =~ s/W/WREG/;
+           if ($pattern =~ m/^[a-z]$/) {
+               $arg{$&}= $specified;
+           } elsif ($specified !~ m/^\s*$pattern\s*$/) {
+               next MAPPING;
+           }
+       }
+       # yay!
+       @r= ($m->{Macro});
+       map { push @r, $arg{$_} if m/^[a-z]$/; } @{ $m->{FormalArgs} };
+       last;
+    }
+    return @r;
+}
+
+sub processfile () {
+    my ($comment, $lhs,$opcode,$midspc,$args,$rhs, @args);
+    while (<>) {
+       chomp;
+       $comment= s/\;.*// ? $& : '';
+       if (m/^(\w*\s+)(\w+)(\s+)(.*?)(\s*)$/) {
+           ($lhs,$opcode,$midspc,$args,$rhs) = ($1,$2,$3,$4,$5);
+           @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;
+       }
+       $_.= $comment."\n";
+       print $_ or die $!;
+    }
+}
+
+readaliases();
+if ($doprint) { printaliases(); exit(0); }
+processfile();