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 = ( '80' => 'SUBA',
  52                         '81' => 'CMPA',
  53                         '82' => 'SBCA',
  54                         '84' => 'ANDA',
  55                         '85' => 'BITA',
  56                         '86' => 'LDAA',
  57                         '88' => 'EORA',
  58                         '8A' => 'ORA',
  59                         'C0' => 'SUBB',
  60                         'C1' => 'CMPB',
  61                         'C2' => 'SBCB',
  62                         'C4' => 'ANDB',
  63                         'C5' => 'BITB',
  64                         'C6' => 'LDAB',
  65                         'C8' => 'EORB',
  66                         'CA' => 'ORB' );
  67
  68
  69 LINE: while (<>) {
  70
  71 # if blank line, print blank line
  72   if (/^\s*$/) { print "\n"; next LINE; }
  73
  74 # if comment line, pass straight through
  75   if (/^\s*;/) { print; next LINE; }
  76
  77 # if duplicate label - rename uniquely
  78   if (/^\s*((loop|jump82|goto91):)/) { print "${1}_$.\n"; next LINE; }
  79
  80 # if it's a label, print label
  81   if (/^\s*(\w*:)/) { print "$1\n"; next LINE; }
  82
  83 # if it's a vector table, print words
  84   if (/^\t\.word\t([a-f0-9]{4})$/) { print "\tFDB\t\$\U$1\n"; next LINE; }
  85
  86 # otherwise, catch all, print bytes
  87   if (/^([A-F0-9]{4}) ((([A-F0-9]{2}) )*[A-F0-9]{2})/) {
  88     instruction($_);
  89     next LINE;
  90   }
  91
  92 # if control Z, remove it
  93   if (/^\cZ$/) { next LINE; }
  94
  95 # FINAL print commented out
  96   print ";$_";
  97 }
  98
  99 # Process one instruction
 100 # Usage: instruction line
 101 sub instruction {
 102     my ($line) = @_;
 103     print ";$line";
 104
 105     $instruction = substr($line,5,2);
 106
 107     if (defined $transtable{$instruction}) {
 108         print "\t$transtable{$instruction}";
 109         $line =~ /$transtable{$instruction}(.*)$/i;
 110         print "$1\n";
 111         return;
 112     }
 113
 114     if (defined $twobytefirst{$instruction}) {
 115         $thing = substr($line,5,5);
 116         if (defined $twobytesecond{$thing}) {
 117                 print "\t" . $twobytesecond{$thing};
 118                 $line =~ /$twobytesecond{$thing}(.*)$/i;
 119                 print "$1\n";
 120                 return;
 121         }
 122     }
 123
 124     if (defined $onewitharg{$instruction}) {
 125         $thing = substr($line,8,2);
 126         print "\t$onewitharg{$instruction}\t#\$$thing";
 127         $line =~ /$onewitharg{$instruction} [0-9A-F][0-9A-F](.*)$/i;
 128         print "\t;$1\n";
 129         return;
 130     }
 131
 132     if ($line =~ /^([A-F0-9]{4}) ((([A-F0-9]{2}) )*[A-F0-9]{2})/) {
 133         @_=split(' ',$2);
 134         print "\tFCB\t\$".join(', $',@_)."\n";
 135     }
 136 }