ROM/makeasm.pl

   1 #!/usr/local/bin/perl -w
   2
   3 print "\tORG\t\$8000\n";
   4
   5 my %transtable = ( '02' => 'IDIV' ,
   6                         '03' => 'FDIV' ,
   7                         '08' => 'INX' ,
   8                         '09' => 'DEX',
   9                         '0A' => 'CLV',
  10                         '0D' => 'SEC',
  11                         '0E' => 'CLI',
  12                         '0F' => 'SEI',
  13                         '19' => 'DAA',
  14                         '1B' => 'ABA',
  15                         '30' => 'TSX',
  16                         '31' => 'INS',
  17                         '32' => 'PULA',
  18                         '33' => 'PULB',
  19                         '34' => 'DES',
  20                         '35' => 'TXS',
  21                         '36' => 'PSHA',
  22                         '37' => 'PSHB',
  23                         '3C' => 'PSHX',
  24                         '38' => 'PULX',
  25                         '3A' => 'ABX',
  26                         '3B' => 'RTI',
  27                         '3E' => 'WAI',
  28                         '43' => 'COMA',
  29                         '46' => 'RORA',
  30                         '49' => 'ROLA',
  31                         '4A' => 'DECA',
  32                         '4C' => 'INCA',
  33                         '4F' => 'CLRA',
  34                         '53' => 'COMB',
  35                         '56' => 'RORB',
  36                         '59' => 'ROLB',
  37                         '5A' => 'DECB',
  38                         '5F' => 'CLRB',
  39                         '8F' => 'XGDX',
  40                         '39' => 'RTS' );
  41
  42                 #       '10' => 'SBA',
  43
  44
  45 my %twobytefirst = ( '18' => '1' );
  46
  47 my %twobytesecond = ( '18 38' => 'PULY',
  48                         '18 3A' => 'ABY',
  49                         '18 3C' => 'PSHY');
  50
  51 my %onewitharg = ('63' => "COM\t\$%s,X",
  52                         '6A' => "DEC\t\$%s,X",
  53                         '6C' => "INC\t\$%s,X",
  54                         '6D' => "TST\t\$%s,X",
  55                         '6E' => "JMP\t\$%s,X",
  56                         '6F' => "CLR\t\$%s,X",
  57                         '80' => "SUBA\t#\$%s",
  58                         '81' => "CMPA\t#\$%s",
  59                         '82' => "SBCA\t#\$%s",
  60                         '84' => "ANDA\t#\$%s",
  61                         '85' => "BITA\t#\$%s",
  62                         '86' => "LDAA\t#\$%s",
  63                         '88' => "EORA\t#\$%s",
  64                         '8A' => "ORA\t#\$%s",
  65                         'A3' => "SUBD\t\$%s,X",
  66                         'A7' => "STA\t\$%s,X",
  67                         'C0' => "SUBB\t#\$%s",
  68                         'C1' => "CMPB\t#\$%s",
  69                         'C2' => "SBCB\t#\$%s",
  70                         'C4' => "ANDB\t#\$%s",
  71                         'C5' => "BITB\t#\$%s",
  72                         'C6' => "LDAB\t#\$%s",
  73                         'C8' => "EORB\t#\$%s",
  74                         'CA' => "ORB\t#\$%s",
  75                         'E3' => "ADDD\t\$%s,X",
  76                         'EC' => "LDD\t\$%s,X",
  77                         'ED' => "STAD\t\$%s,X" );
  78
  79
  80 my %onewithword = ('FF' => "STX\t%s");
  81
  82 LINE: while (<>) {
  83
  84 # if blank line, print blank line
  85   if (/^\s*$/) { print "\n"; next LINE; }
  86
  87 # if comment line, pass straight through
  88   if (/^\s*;/) { print; next LINE; }
  89
  90 # if duplicate label - rename uniquely
  91   if (/^\s*((loop|jump82|goto91):)/) { print "${1}_$.\n"; next LINE; }
  92
  93 # if it's a label, print label
  94   if (/^\s*(\w*:)/) { print "$1\n"; next LINE; }
  95
  96 # if it's a vector table, print words
  97   if (/^\t\.word\t([a-f0-9]{4})$/) { print "\tFDB\t\$\U$1\n"; next LINE; }
  98
  99 # otherwise, catch all, print bytes
 100   if (/^([A-F0-9]{4}) ((([A-F0-9]{2}) )*[A-F0-9]{2})/) {
 101     instruction($_);
 102     next LINE;
 103   }
 104
 105 # if control Z, remove it
 106   if (/^\cZ$/) { next LINE; }
 107
 108 # FINAL print commented out
 109   print ";$_";
 110 }
 111
 112 # Process one instruction
 113 # Usage: instruction line
 114 sub instruction {
 115     my ($line) = @_;
 116     print ";$line";
 117
 118     $instruction = substr($line,5,2);
 119
 120     if (defined $transtable{$instruction}) {
 121         print "\t$transtable{$instruction}";
 122         $line =~ /$transtable{$instruction}(.*)$/i;
 123         print "$1\n";
 124         return;
 125     }
 126
 127     if (defined $twobytefirst{$instruction}) {
 128         $thing = substr($line,5,5);
 129         if (defined $twobytesecond{$thing}) {
 130                 print "\t" . $twobytesecond{$thing};
 131                 $line =~ /$twobytesecond{$thing}(.*)$/i;
 132                 print "$1\n";
 133                 return;
 134         }
 135     }
 136
 137     if (defined $onewitharg{$instruction}) {
 138         $thing = substr($line,8,2);
 139
 140         printf "\t$onewitharg{$instruction}", $thing;
 141         $line =~ /$onewitharg{$instruction} [0-9A-F][0-9A-F](.*)$/i;
 142         print "\t;$1\n";
 143         return;
 144     }
 145
 146     if (defined $onewithword{$instruction}) {
 147         $thing = substr($line,8,2);
 148         $thing2 = substr($line,11,2);
 149         if (!($thing2 =~ /\s+/)) {
 150         $curraddr = substr($line,0,4);
 151         printf "FOO%s\tEQU\t\$%s%s\n", $curraddr,$thing,$thing2;
 152         printf "\t$onewithword{$instruction}", ">FOO$curraddr";
 153         $line =~ /$onewithword{$instruction} [0-9A-F][0-9A-F][0-9A-F][0-9A-F](.*)$/i;
 154         print "\t;$1\n";
 155         return;
 156         }
 157     }
 158
 159     if ($line =~ /^([A-F0-9]{4}) ((([A-F0-9]{2}) )*[A-F0-9]{2})/) {
 160         @_=split(' ',$2);
 161         print "\tFCB\t\$".join(', $',@_)."\n";
 162     }
 163 }