#!/usr/bin/perl
# 
# Copyright © 2015-2025 by Vincent Slyngstad
# 
# Permission is hereby granted, free of charge, to any person obtaining
# a copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,
# distribute, sublicense, and/or sell copies of the Software, and to
# permit persons to whom the Software is furnished to do so, subject to
# the following conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE
# FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
# CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
# 
# Except as contained in this notice, the names of the authors above
# shall not be used in advertising or otherwise to promote the sale, use
# or other dealings in this Software without prior written authorization
# from those authors.

#
# CRC routine is basically stolen from Tom Hunter's V1 code.
#
local @crc16Table = (
   0x0000, 0xc0c1, 0xc181, 0x0140, 0xc301, 0x03c0, 0x0280, 0xc241,
   0xc601, 0x06c0, 0x0780, 0xc741, 0x0500, 0xc5c1, 0xc481, 0x0440,
   0xcc01, 0x0cc0, 0x0d80, 0xcd41, 0x0f00, 0xcfc1, 0xce81, 0x0e40,
   0x0a00, 0xcac1, 0xcb81, 0x0b40, 0xc901, 0x09c0, 0x0880, 0xc841,
   0xd801, 0x18c0, 0x1980, 0xd941, 0x1b00, 0xdbc1, 0xda81, 0x1a40,
   0x1e00, 0xdec1, 0xdf81, 0x1f40, 0xdd01, 0x1dc0, 0x1c80, 0xdc41,
   0x1400, 0xd4c1, 0xd581, 0x1540, 0xd701, 0x17c0, 0x1680, 0xd641,
   0xd201, 0x12c0, 0x1380, 0xd341, 0x1100, 0xd1c1, 0xd081, 0x1040,
   0xf001, 0x30c0, 0x3180, 0xf141, 0x3300, 0xf3c1, 0xf281, 0x3240,
   0x3600, 0xf6c1, 0xf781, 0x3740, 0xf501, 0x35c0, 0x3480, 0xf441,
   0x3c00, 0xfcc1, 0xfd81, 0x3d40, 0xff01, 0x3fc0, 0x3e80, 0xfe41,
   0xfa01, 0x3ac0, 0x3b80, 0xfb41, 0x3900, 0xf9c1, 0xf881, 0x3840,
   0x2800, 0xe8c1, 0xe981, 0x2940, 0xeb01, 0x2bc0, 0x2a80, 0xea41,
   0xee01, 0x2ec0, 0x2f80, 0xef41, 0x2d00, 0xedc1, 0xec81, 0x2c40,
   0xe401, 0x24c0, 0x2580, 0xe541, 0x2700, 0xe7c1, 0xe681, 0x2640,
   0x2200, 0xe2c1, 0xe381, 0x2340, 0xe101, 0x21c0, 0x2080, 0xe041,
   0xa001, 0x60c0, 0x6180, 0xa141, 0x6300, 0xa3c1, 0xa281, 0x6240,
   0x6600, 0xa6c1, 0xa781, 0x6740, 0xa501, 0x65c0, 0x6480, 0xa441,
   0x6c00, 0xacc1, 0xad81, 0x6d40, 0xaf01, 0x6fc0, 0x6e80, 0xae41,
   0xaa01, 0x6ac0, 0x6b80, 0xab41, 0x6900, 0xa9c1, 0xa881, 0x6840,
   0x7800, 0xb8c1, 0xb981, 0x7940, 0xbb01, 0x7bc0, 0x7a80, 0xba41,
   0xbe01, 0x7ec0, 0x7f80, 0xbf41, 0x7d00, 0xbdc1, 0xbc81, 0x7c40,
   0xb401, 0x74c0, 0x7580, 0xb541, 0x7700, 0xb7c1, 0xb681, 0x7640,
   0x7200, 0xb2c1, 0xb381, 0x7340, 0xb101, 0x71c0, 0x7080, 0xb041,
   0x5000, 0x90c1, 0x9181, 0x5140, 0x9301, 0x53c0, 0x5280, 0x9241,
   0x9601, 0x56c0, 0x5780, 0x9741, 0x5500, 0x95c1, 0x9481, 0x5440,
   0x9c01, 0x5cc0, 0x5d80, 0x9d41, 0x5f00, 0x9fc1, 0x9e81, 0x5e40,
   0x5a00, 0x9ac1, 0x9b81, 0x5b40, 0x9901, 0x59c0, 0x5880, 0x9841,
   0x8801, 0x48c0, 0x4980, 0x8941, 0x4b00, 0x8bc1, 0x8a81, 0x4a40,
   0x4e00, 0x8ec1, 0x8f81, 0x4f40, 0x8d01, 0x4dc0, 0x4c80, 0x8c41,
   0x4400, 0x84c1, 0x8581, 0x4540, 0x8701, 0x47c0, 0x4680, 0x8641,
   0x8201, 0x42c0, 0x4380, 0x8341, 0x4100, 0x81c1, 0x8081, 0x4040
);
sub crc {
  foreach $b (@_) {
    $crc = $crc16Table[($crc ^ $b) & 0xFF] ^ ($crc >> 8);
  }
}

#
# Compare ".rke" format to ".dsk" format.
#

while (@ARGV) {
  $f = shift @ARGV;
  open(RKE, $f) || die "$f: $!";
  binmode(RKE);

  $o = shift @ARGV;
  open(DSK, $o) || die "$o: $!";
  binmode(DSK);

  #
  # Read in the RKE file header.
  read(RKE, $buf, 0x16D) || die "$f header: $!";
  ($magic, $version, $name, $desc, $date, $cont, $br, $nc, $ns, $nh, $us)
    = unpack("a10a4a11a200a20a100NNNNN", $buf);
#warn "$magic, $version, $name, $desc, $date, $cont, $br, $nc, $ns, $nh, $us\n";
  die "$f: not rke format " unless $magic == "\x89RK05\r\n\x1A";
  die "$f: cyls != 203" unless $nc == 203;
  die "$f: spt != 16" unless $ns == 16;
  die "$f: heads != 2" unless $nh == 2;
  # At this point it looks like PDP-8 RK05 media.

  #
  # Now, iterate over the data sectors, checking that the
  # data encoded is the same.
  #
  $sectors = 0;
  while (read(RKE, $buf, 4) == 4) {
    ($tts, $dbits) = unpack("SS", $buf);
    $sectors++;
    #
    # Read a data bit blob of length $dbits.
    #
    $words = $dbits / 16;
    $words++ if $dbits % 16; # RKE pads to 16 bit multiple
    read(RKE, $buf, 2*$words) || die "$f data read: $!";
    @buf = unpack("C*", $buf);
    #
    # RK8E: Discard 16 bits for header (cyl<<5)
    #
    $b1 = shift @buf;
    $b2 = shift @buf;
    $crc = 0; # CRC begins AFTER header
    die "$#buf" unless @buf > 384;
    #
    # Unpack the words of data for this sector.
    @words = ();
    for ($i = 0; $i < 128; $i++) { # 128 word pairs per sector
      # Unpack a doubleword (3 bytes)
      $b1 = shift @buf;
      $b2 = shift @buf;
      $b3 = shift @buf;
      &crc($b1, $b2, $b3);
      $w1 = ($b3 << 16) + ($b2 << 8) + $b1;
      $w2 = $w1 >> 12;
      $w1 = $w1 & 07777;
      push(@words, $w1, $w2);
    }
    $rkecrc = (shift @buf) + ((shift @buf)<<8);
    warn "RKE CRC sector $sectors: $crc (computed) <> $rkecrc (read)\n"
      unless $crc == $rkecrc;
    #
    # Remaining words must be postamble, and therefore 0000.
    foreach $b1 (@buf) {
      die "postamble sector $sectors: $b1 is nonzero" unless $b1 == 0;
    }
    #
    # At this point, we read a sector from the RKE file.
    # Now read the sector from the DSK file and compare them.
    #
    read(DSK, $buf, 2*256) || die "DSK: $!";
    @buf = unpack("S*", $buf);
    for ($i = 0; $i < 256; $i++) {
      die "mismatch: $words[$i] <> $buf[$i]" unless $words[$i] == $buf[$i];
    }
  }
  #
  # At this point, check we have done exactly the right number of sectors.
  #
  die "sector count incorrect: $sectors" unless $sectors = $nc*$ns*$nh;
}