#!/usr/bin/perl -s # paptap takes kim-1 papertape output on stdin and spews it to file(s) on the # command line, or stdout. warnings are made when memory addresses are # non-contiguous. it does not do checksums -- it assumes that's okay. # # written by cameron kaiser, placed in the public domain. # # http://www.floodgap.com/retrobits/kim-1/ # -debug: copious debug output # -imp: kimplement sa headers on output (i.e., SA + $4000) # first pass: figure out how many files we need while reading it into an array $prev_sa = -1; $line = 0; $files++; while() { $line++; chomp; next if (/^$/ || /^#/); s/^;//; $len = hex(substr($_, 0, 2)); $nadr = hex(substr($_, 2, 4)); warn "line $line, length $len, address $nadr, expected $prev_sa\n" if ($debug); if ($nadr != $prev_sa) { if ($prev_sa == -1) { $prev_sa = $nadr; } else { $files++; warn "line ${line}: address jump, extra file needed\n" if ($debug); $prev_sa = $nadr; } } $prev_sa += $len; push(@lines, $_); } while(scalar(@ARGV)) { push(@files, shift(@ARGV)); } die(<<"EOF") if ($files > scalar(@files) && $files > 1); can't do this, baby: this file has $files discontinuous segments and you're asking me to write them out into one continuous stream! that's uncool. specify more (any?) files on the command line for me to write into. EOF # second pass: actually write out the files for each segment $infile = -1; $prev_sa = -1; $britten = 0; ROOP: while(scalar(@lines)) { $_ = shift @lines; ROOP2: if ($infile == -1) { if (scalar(@files)) { $next = shift @files; open(W, ">$next") || die("unable to write to $next: $!\n"); warn "switching to file $next ...\n"; select(W); $infile = 1; } else { select(STDOUT); $infile = 0; } } $len = hex(substr($_, 0, 2)); $hlen = $len + $len; $nadr = hex(substr($_, 2, 4)); warn "(pass 2) len = $len nadr = $nadr expected = $prev_sa\n" if ($debug); if ($nadr != $prev_sa) { if ($prev_sa == -1) { warn "initial address is $nadr\n"; $prev_sa = $nadr; if (defined($imp)) { $no_sa = $prev_sa + 16384; print pack("C", $no_sa & 255); print pack("C", int($no_sa/256)); } } else { warn "closing file, bytes written = $britten\n"; $britten = 0; close(W) if ($infile); $prev_sa = $infile = -1; goto ROOP2; } } print pack("H$hlen", substr($_, 6)); $britten += $len; $prev_sa += $len; } warn "done.\n";