#!/usr/bin/perl
#
# Copyright (C) 2001 Mark Bush
# <Mark.Bush@bushnet.demon.co.uk>
#
# This is a BBC disassembler.
#
# Options:
# -------
#
#  -f <BBC file>       Specify the BBC micro machine code file
#                      to try to disassemble.
#
#  -s <skip file>      Specify a "skip" file (see below).
#
#  -o <start offset>   Specify the address to start disassembly from.
#                      The default is the first byte (or the service
#                      routine if the file is a ROM).
#
#  -a <code address>   Specify the address of the first byte in the file.
#                      The first address will be assumed to be 0x0000
#                      (or 0x8000 if this is a ROM) without this option.
#
#  -r                  The file to disassemble is a ROM and has a
#                      ROM header which will be decoded.  By default,
#                      the disassembly will then start from the address
#
#  -l                  Disassemble from the language routine if this
#                      is a ROM rather than the service routine.
#
# The script will disassemble until the end of file is reached by trying
# to decode op-codes (all 65C02 including undocumented op-codes are
# supported, though BBS0-7 instructions are not recognised properly as
# I don't know yet what form the argument bytes take - if someone knows,
# let me know and I'll add them).
#
# Obviously, because data bytes are often interspersed with operational
# bytes, this method may produce errors.  You will have to inspect the
# output and use a "skip" file to identify data bytes and bytes not to
# be decoded.  A complete decode may, therefore, involve many cycles of
# disassembly, scanning output, re-writing the "skip" file, and repeating.
#
# Skip File
# ---------
# A "skip" file can be used to help the disassembler locate valid
# sections of code.  Lines must be one of (with all addresses in hex):
#
# l:<address>:<label>  Specify a label to use for an address to make
#                      the purpose of sections of the code more obvious.
#                      The script knows about the standard OS calls and
#                      will use appropriate labels for those.  Labels
#                      will be used for JMP, JSR and branch instructions.
#
# i:<addr range>       The address range must be either a single address
#                      or a hyphenated pair.  All bytes in the range
#                      will be ignored and a placeholder will be output
#                      to show where the missing bytes are and their
#                      address range.
#
# d:<addr range>       The bytes are data bytes.  If they are printable,
#                      then the character will be displayed, otherwise
#                      the hex code is displayed.
#
# D:<addr range>       Like "d" above, but the bytes are raw data and
#                      printable characters are printed as thier code.
#
# Any other line is ignored.
#
# The script will produce a list on STDERR of undocumented op-codes
# encountered and also jump/branch destinations which the disassembler
# did not see (and, hence, are possible locations to search next for code).
#

use POSIX;
use Getopt::Std;

@mode = qw(_ A # zp zp,X zp,Y (zp) (zp,X) (zp),Y
	   ab ab,X ab,Y (ab) (ab,X) rel zp,rel);
@display = ('', 'A', '  #&%02x', '   &%02x', '   &%02x,X', '   &%02x,Y',
	    '  (&%02x)', '  (&%02x,X)', '  (&%02x),Y', ' &%04x', ' &%04x,X',
	    ' &%04x,Y', '(&%04x)', '(&%04x,X)', 'rl &%02x',
	    '&%02x, rl &%02x');
%label = (ffe3=>'OSASCI', ffe7=>'OSNEWL', fff4=>'OSBYTE',
	  fff1=>'OSWORD', fff7=>'OSCLI', ffe0=>'OSRDCH',
	  ffee=>'OSWRCH', ffce=>'OSFIND', ffd1=>'OSGPBP',
	  ffd4=>'OSBPUT', ffd7=>'OSBGET', ffda=>'OSARGS',
	  ffdd=>'OSFILE', ffce=>'OSFIND', ffc2=>'GSINIT',
	  ffb9=>'OSRDRM', ffbc=>'VDUCHR', ffbf=>'OSEVEN',
	  ffc5=>'GSREAD', ffc8=>'NVRDCH', ffcb=>'NVWRCH',
	  fffa=>'NMI', fffc=>'RESET', fffe=>'IRQ',
	  fe30=>'ROMSEL', fe34=>'ACCCON',
	  '020a'=>'BYTEV', '020c'=>'WORDV', '0208'=>'CLIV',
	  '0210'=>'RDCHV', '020e'=>'WRCHV', '0220'=>'EVENTV',
	  '0202'=>'BRKV', '0200'=>'USERV', '0228'=>'KEYV',
	  '0226'=>'VDUV', '0222'=>'UPTV', '022a'=>'INSV',
	  '022c'=>'REMV', '022e'=>'CNPV', '021c'=>'FINDV',
	  '021a'=>'GPBPV', '0218'=>'BPUTV', '0216'=>'BGETV',
	  '0214'=>'ARGSV', '0212'=>'FILEV', '021e'=>'FSCV',
	  '0224'=>'NETV', '0230'=>'IND1V', '0232'=>'IND2V',
	  '0234'=>'IND3V', '0204'=>=>'IRQ1V', '0206'=>'IRQ2V',
	  '0100'=>'STACK');
%data = (fffa=>1, fffb=>1, fffc=>1, fffd=>1, fffe=>1, ffff=>1);
%dend = (fffb=>1, fffd=>1, ffff=>1);

@code_type = ("65C12/6502 BASIC",
	      "unknown",
	      "65C12/6502 code other than BASIC",
	      "68000 code");
@code_type[8..13] = ("Z80 code",
		     "32016 code",
		     "unknown",
		     "80186 code",
		     "80286 code",
		     "unknown");
foreach $i (4..7, 14..15)
{
  $code_type[$i] = "unused type code";
}

foreach $system (values %label)
{
  $system{$system} = 1;
}
@bytes = (0, 0, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 1, 2);

$OPS = "$ENV{HOME}/lib/6502.ops";
$OPS = "/usr/local/lib/6502.ops" unless (-f $OPS);
$addr = 0;
$baddr = 0;
$oaddr = 0;
$arg = 0;
$dnum = 0;
$rom = 0;
$skip = 0;
$nobytes = 0;
getopts("ls:a:f:ro:b");
$language = 1 if ($opt_l);
$rom = 1 if ($opt_r);
$addr = 0x8000 if ($rom);
$oaddr = $opt_o if ($opt_o);
$addr = $opt_a if ($opt_a);
$nobytes = $opt_b if ($opt_b);
if ($oaddr =~ s/^(0x|&)//)
{
  $oaddr = hex($oaddr);
}
if ($addr =~ s/^(0x|&)//)
{
  $addr = hex($addr);
}
$baddr = $addr;
if ($opt_s)
{
  $SKIP = $opt_s;
  if (open(SKIP, $SKIP))
  {
    while (<SKIP>)
    {
      chomp;
      ($type, $range, $args) = split /:/;
      ($start, $end) = split /-/, $range;
      $start = lc($start);
      $end = lc($end);
      $end = $start unless ($end);
      $startv = hex($start);
      $endv = hex($end);
      if ($type =~ /d|D|m|M|I/)
      {
	$d = ($type eq lc($type))? 1: 0;
	$tstart = $relocate{$start}? $relocate{$start}: $start;
	if (! defined $label{$tstart})
	{
	  $label{$tstart} = sprintf("%s%03d",
				    $type,
				    $dnum++);
	}
	$dend{$end} = 1;
	foreach $kaddr ($startv .. $endv)
	{
	  $ignore = sprintf "%04x", $kaddr;
	  $data{$ignore} = $type;
	  $d{$ignore} = 1 if ($d);
	}
      }
      elsif ($type eq "i")
      {
	$ignoring{$start} = $end;
	foreach $kaddr ($startv .. $endv)
	{
	  $ignore = sprintf "%04x", $kaddr;
	  $ignore{$ignore} = 1;
	}
      }
      elsif ($type eq "r")
      {
	$target = hex($args);
	foreach $kaddr ($startv .. $endv)
	{
	  $ignore = sprintf "%04x", $kaddr;
	  $h_target = sprintf "%04x", $target++;
	  $relocate{$ignore} = $h_target;
	}
	$relocated{$start} = "$args - $h_target";
	$relend{$start} = $end;
      }
      elsif ($type eq "l")
      {
	$label{$range} = $args;
	$system{$args} = 1;
      }
    }
    close(SKIP);
  }
  else
  {
    printf STDERR "Can't open $SKIP: $!\n";
  }
}
if ($opt_f)
{
  open(FILE, $opt_f) || die "Can't open $opt_f: $!\n";
  $size = -s $opt_f;
}
else
{
  *FILE = *STDIN;
  $size = 0;
  $filesize = 0;
}

open(OPS, $OPS) || die "Can't read $OPS: $!\n";
while (<OPS>)
{
  chomp;
  ($op, @codes) = split /:/;
  $op = toupper($op);
  $mode = 0;
  foreach $codeset (@codes)
  {
    @codeset = split(/,/, $codeset);
    foreach $code (@codeset)
    {
      $code = tolower($code);
      if (defined $op{$code})
      {
	printf "Duplicate code %s as %s (was %s)\n",
	  $code, $op, $op{$code};
      }
      $op{$code} = $op;
      $mode{$code} = $mode;
    }
    $mode++;
  }
}
close(OPS);

$pos = 0;
if ($rom)
{
  foreach $i (0..2)
  {
    sysread(FILE, $c, 1);
    $lang[$i] = ord($c);
    $size || $filesize++;
  }
  foreach $i (0..2)
  {
    sysread(FILE, $c, 1);
    $serv[$i] = ord($c);
    $size || $filesize++;
  }
  sysread(FILE, $type, 1); $type = ord($type);
  $size || $filesize++;
  sysread(FILE, $offset, 1); $offset = ord($offset);
  $size || $filesize++;
  sysread(FILE, $ivers, 1); $ivers = ord($ivers);
  $size || $filesize++;
  $title = "";
  $pos = 9;
  if ($offset > $pos) # read title
  {
    while (sysread(FILE, $c, 1),
	   ($size || $filesize++),
	   $pos++, $char = ord($c))
    {
      $title .= $c;
    }
  }
  $version = "";
  if ($offset > $pos)
  {
    while (sysread(FILE, $c, 1),
	   ($size || $filesize++),
	   $pos++, $char = ord($c))
    {
      $version .= $c;
    }
  }
  $copyright = "";
  while (sysread(FILE, $c, 1),
	 ($size || $filesize++),
	 $pos++, ord($c))
  {
    $copyright .= $c;
  }
  if ($type & 0x20) # read Tube address
  {
    $tube = 1;
    foreach $i (0..3)
    {
      sysread(FILE, $c, 1);
      $tube[$i] = ord($c);
      $size || $filesize++;
      $pos++;
    }
  }
  printf "ROM: %s, V: %s (%d)\n", $title, $version, $ivers;
  printf "     %s\n", $copyright;
  $servstr = ""; $langstr = "";
  if ($type & 0x80)
  {
    push(@decode, "service ROM");
    $servaddr = sprintf "%02x%02x", $serv[2], $serv[1];
    $label{$servaddr} = "SERV";
    $servoff = hex($servaddr) - $addr;
    $servstr = sprintf("     service entry point at &%s\n", $servaddr);
  }
  if ($type & 0x40)
  {
    push(@decode, "language ROM");
    $langaddr = sprintf "%02x%02x", $lang[2], $lang[1];
    $label{$langaddr} = "LANG";
    $langoff = hex($langaddr) - $addr;
    $langstr = sprintf("     language entry point at &%s\n", $langaddr);
  }
  push(@decode, "valid Tube addr") if ($type & 0x20);
  push(@decode, "supports softkey expansions") if ($type & 0x10);
  printf "     type &%02x (%s)\n", $type, join(", ", @decode,
					       $code_type[$type & 0x0f]);
  $lang = sprintf("%02x", $lang[0]);
  $serv = sprintf("%02x", $serv[0]);
  print $langstr, $servstr;
  printf "     Tube address: &%02x &%02x &%02x &%02x\n", @tube
      if ($tube);
  $addr += $pos;

  printf "     code start addr: &%04x\n", $addr;

  if ($opt_o)
  {
    printf "     Disassembling from addr &%04x\n", $oaddr;
    $skip = $oaddr - $addr;
  }
  elsif ($language)
  {
    print "     Disassembling language.\n";
    $skip = $langoff - $pos;
  }
  else
  {
    print "     Disassembling service routine.\n";
    $skip = $servoff - $pos;
  }
}
else
{
  if ($opt_o)
  {
    $skip = $oaddr - $addr;
  }
}
if ($skip > 0)
{
  printf "     Skipping %d bytes\n", $skip;
  sysread(FILE, $c, $skip);
  $addr += $skip;
  $size || ($filesize+=$skip);
}
$instr = ""; $outline = ""; $saddr = "";
$label = ""; $lnum = 0; $bnum = 0; $mnum = 0;
while (sysread(FILE, $c, 1))
{
  $size || $filesize++;
  $saddr = sprintf("%04x", $addr);
  $taddr = $relocate{$saddr}? $relocate{$saddr}: $saddr;
  $adiff = hex($taddr)-hex($saddr);
  $code = sprintf("%02x", ord($c));
  $addr++;
  if (defined $ignoring{$saddr})
  {
    push(@addr, $saddr);
  }
  next if (defined $ignore{$saddr});
  if (defined $data{$saddr})
  {
    push(@addr, $saddr);
    $instr{$saddr} = sprintf("$code (%s)", $data{$saddr});
    if ($d{$saddr} && (ord($c) > 32) && (ord($c) < 127))
    {
      $code{$saddr} = $c;
    }
    elsif ($d{$saddr} && (ord($c) == 0x0d))
    {
      $code{$saddr} = "<0d>\n";
    }
    else
    {
      $code{$saddr} = "<$code>";
    }
    next;
  }
  $op = $op{$code};
  printf STDERR "unexpected op $op at $saddr\n" if (length($op) > 3);
  $mode = $mode{$code};
  $outline = sprintf "%3s", $op;
  $instr = sprintf("%2s", $code);
  $bytes = $bytes[$mode];
  if ($bytes)
  {
    sysread(FILE, $c, 1);
    $size || $filesize++;
    $byte1 = ord($c);
    $byte = $byte1;
    $instr .= sprintf " %02x", $byte1;
    $bytes--; $addr++;
    if ($bytes)
    {
      sysread(FILE, $c, 1);
      $size || $filesize++;
      $byte2 = ord($c);
      $byte += $byte2*256;
      $instr .= sprintf " %02x", $byte2;
      $addr++;
    }
    if ($op =~ /BB[SR]/)
    {
      $outline .= sprintf(" $display[$mode]", $byte1, $byte2);
      $byte = $byte2;
    }
    else
    {
      $outline .= sprintf(" $display[$mode]", $byte);
    }
    if ($op =~ /JMP|JSR/)
    {
      $target = sprintf "%04x", $byte;
      if (defined $label{$target} &&
	  ($system{$label{$target}} || ($label{$target} =~ /^L/)))
      {
	$label = $label{$target};
      }
      else
      {
	$label = sprintf "L%03d", $lnum++;
	$label{$target} = $label;
      }
      $target{$saddr} = $target;
    }
    elsif ($op =~ /BCC|BCS|BEQ|BMI|BNE|BPL|BRA|BVC|BVS|BB[RS]/)
    {
      $target = $addr + $byte + $adiff; # translate if relocated
      $target -= 256 if ($byte > 127);
      $target = sprintf "%04x", $target;
      if (defined $label{$target} &&
	  ($system{$label{$target}} ||
	   ($label{$target} =~ /^L/) ||
	   ($label{$target} =~ /^B/)))
      {
	$label = $label{$target};
      }
      else
      {
	$label = sprintf "B%03d", $bnum++;
	$label{$target} = $label;
      }
      $target{$saddr} = $target;
    }
    elsif ($mode > 2) # some sort of addressing going on so label address
    {
      $target = sprintf "%04x", $byte;
      if (defined $label{$target})
      {
	$label = $label{$target};
      }
      else
      {
	$label = sprintf "%s%03d", ($target =~ /^00/)? "Z": "M", $mnum++;
	$label{$target} = $label;
      }
      $target{$saddr} = $target;
    }
  }
  push(@addr, $saddr);
  $instr{$saddr} = $instr;
  $code{$saddr} = $outline;
  $instr = ""; $outline = ""; $label = "";
  $saddr = "";
}
close(FILE) if ($opt_f);
$size = $filesize unless ($size);

$startLine = 1;

foreach $addr (@addr)
{
  if (defined $ignoring{$addr})
  {
    print "\n" unless ($startLine);
    if ($ignoring{$addr} eq $addr)
    {
      printf "%s\n", $addr;
    }
    else
    {
      printf "%s\n:\n%s\n", $addr, $ignoring{$addr};
    }
    $startLine = 1;
    next;
  }
  if ($relocated{$addr})
  {
    print "\n" unless ($startLine);
    printf "%s - %s relocated to %s:\n", $addr, $relend{$addr},
        $relocated{$addr};
    $startLine = 1;
  }
  if ($relocate{$addr})
  {
    $taddr = $relocate{$addr};
  }
  else
  {
    $taddr = $addr;
  }
  $label = (defined $label{$taddr})? ".$label{$taddr}": "";
  $instr = $nobytes? "": sprintf("%-8s ", $instr{$addr});
  if ($instr{$addr} =~ /\([DdImM]\)/)
  {
    if ($label)
    {
      print "\n" unless ($startLine);
      printf "%s %s%-9s %s", $taddr, $instr, $label, $code{$addr};
    }
    else
    {
      printf "%s", $code{$addr};
    }
    $startLine = 0;
    if ($dend{$addr})
    {
      print "\n";
      $startLine = 1;
    }
  }
  else
  {
    $target = "";
    $target = sprintf(" (%s)", $label{$target{$addr}}) if ($target{$addr});
    print "\n" unless ($startLine);
    printf "%s %s%-9s %s%s\n", $taddr, $instr,
      $label, $code{$addr}, $target;
    print "\n" if ($code{$addr} =~ /RTS|RTI|JMP|BRA/);
    $startLine = 1;
  }
  $seen{$taddr} = 1 if (defined $label{$taddr});
}
print "\n";
foreach $addr (sort keys %label)
{
  next if ((hex($addr) < $baddr) || (hex($addr) >= ($baddr+$size)));
  printf STDERR "unseen label %s for %s\n", $label{$addr}, $addr
    unless (defined $seen{$addr} || $system{$label{$addr}});
}