#!/usr/bin/perl -s

# kimtape accepts binaries in KIMplement format or raw with starting addresses
# and emits paper tape that can be loaded into the monitor (L command).
#
# written by cameron kaiser, placed in the public domain.
#
# http://www.floodgap.com/retrobits/kim-1/

# -imp : read kimplement starting addresses from input (MUST BE PRESENT)
# -adrs=x,x,x,.. : list of starting addresses for raw binaries
# (starting addresses can be in hex: $xxxx or 0xyyyy)
# -full : add nulls and CR and trailing ^Q (as documented in Appendix F)
# (this doesn't seem necessary, but is here for completeness)
#
# files accepted on command line or one great big one on standard input.
# for format information, see KIM-1 User's Manual Appendix F.

# "use bytes"
BEGIN { $^H |= 0x00000008 unless ($] < 5.006); }

die("usage: $0 [-imp|-adrs=sa1,sa2,...] file1 file2 ...\nstdin also OK, addresses may be hex with \$ or 0x\n")
	if ((!$imp && (!length($adrs) || $adrs eq '1'))
		|| ($imp && length($adrs)));

unless ($imp) {
	@adrs = map {
		$_ = hex($_) if (s/^\$// || s/^0[xX]//);
		die("$0: address out of range: $_\n") if ($_ < 0 || $_ > 65535);
		$_;
	} split(/,/, $adrs);
}

undef $/;
$lines = 0;
select(STDOUT); $|++;

# each turn of the loop gets a file in its entirety, or all of stdin at once
while(<>) {
	unless ($imp) {
		die("$0: fewer addresses specified than discrete files\n")
			unless (scalar(@adrs));
		$adr = shift @adrs;
		$bin = $_;
	} else {
		die("$0: can't get starting address in current file\n")
			unless (length > 1);
		$adr = unpack("v", substr($_, 0, 2)) - 16384;
		die("$0: nonsense starting address $adr in current file\n")
			if ($adr < 0);
		$bin = substr($_, 2);
	}

	if (!length($bin)) {
		warn("$0: null file, skipping\n");
		next;
	}

	for(;;) {
		$checksum = 0;

		if (length($bin) < 24)  {
			$line = $bin;
			$bin = '';
		} else {
			$line = substr($bin, 0, 24);
			$bin = substr($bin, 24);
		}

		map { $checksum += $_ } unpack("C*", $line);		
		$checksum += length($line);
		$checksum += $adr & 0xff;
		$checksum += ($adr >> 8);

		print STDOUT ($full) ? "\0\0\0\0\0\0" : "";
		$w = sprintf(";%02x%04x%s%04x",
			length($line),
			$adr,
			unpack("H*", $line),
			$checksum);
		print STDOUT uc($w);
		print STDOUT ($full) ? "\015\012" : "\012";
		$adr += length($line);
		$lines++;

		last if (!length($bin));
	}
}
die("$0: no lines emitted\n") unless ($lines);
$w = sprintf(";00%04x%04x", $lines, $lines);
print STDOUT ($full) ? "\0\0\0\0\0\0" : "";
print STDOUT uc($w);
print STDOUT ($full) ? "\015\012" : "\012";

unless ($imp) {
	die("$0: more addresses specified than discrete files\n")
		if (scalar(@adrs));
}