#!/usr/bin/perl
# 
# Copyright © 2015-2020 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.

#
# Print the directory of a DIAL LINCtape image.
#
# (LINC-8 info)
# DIAL tapes come in three standard variants, as created by MARK12:
# 1	532 standard blocks
# P	1568 129 word blocks
# B	896 standard blocks
#
# The standard block is 256 words long.
#
# Mode "B" tapes have a shorter turn-around zone at each end (256
# words at each end instead of 1024/2048).
#
# Mode "P" tapes have final IM and EM zone lengths of 1023 and 1024
# words, instead of 8 words and 2048 (or 256) words.
#
# Rolling that up, and omitting check words, guard words, etc., we
# get these lengths:
# BUGBUG: 136451 words is the common length!!
# 1	4095+532*256+8		= 140295 words (272902)
# P	4095+1568*129+1023	= 207390 words
# 8	4095+916*256+8		= 238599 words
#
# (PDP-12 info)
# Newer versions of MARK12 apparently support:
# 512(01000) blocks of 256(0400) words
# 1474(02702) blocks of 129(0201) words
#
# 2048+512*256+3328+3	= 136451 words
# 2048+1474*129+2048+3	= 194245 words
# where the 3 words are (blocksize, -8, -8).
#
# As a practical matter, the image I'm looking at has 2048 words of
# 05252, followed by what appears to be data in 512 blocks of 256 words.
#
# On the far end, there appear to be another 3328 words of 05252, followed
# by a block of 128 mostly (0400 0177770 0177770) nulls.
# 2048	 16x128   05252
# 131072 1024x128 data
# 3328	 26x128   05252
# 3	 3        (256, -8, -8).
# 136451          total
#
# So, the .linc format appears to decode as follows:
# The last 3 words are the block length in words, the negative prolog
# block count, and the negative epilog block count.  The remainder of the
# file should be a multiple of the given block length.  The prolog and epilog
# block counts indicate the number of unused blocks at the beginning and
# end of the file.  Data blocks are found between the prolog and the epilog.
#
# Within the data blocks, block 0402 is supposedly the DIAL index block, at
# least on the LINC-8 (LAP4).  The index entries are apparently 8 words long:
# 0-3	Sixbit file name, padded with sixbit "?"
# 4	Starting block number (source)
# 5	Size in blocks (source)
# 6	Starting block number (binary)
# 7	Size in blocks (binary)
# Unused values are encoded as 05757.  Deleted files over-write the first
# two characters to "unused".
# The first index entry is always 8 words of 05757(?).
# My exemplar (13.linc) has the index at block 346, though.
#
# The sixbit used is a little odd:
# Numbers, digits and much punctuation is as usual.
# 00	is illegal
# 33	is "["
# 34	is illegal
# 35	is "]"
# 36	is "'"
# 37	is illegal
# 43	encodes newline, not "#"
# 47	encodes tab, not "'"
# GSPL1/GSPG1 lists the oddities that don't self-insert:
# 0212 0215 0377 "$" (if used for EOF) "'" 0334 0300 0337 0224 0225
#

#
# The original date algorithm was 3 bits, added to 1970.
# Later, two more bits were added, so years go thru 1999.
# Dates in the future are interpreted as dates in the
# previous 8 years.
# First, get the right epoch.
($_, $_, $_, $dy, $mo, $i) = localtime(time);
$i = ($i + 1900) & 037;
$cyear = $i & 07;
$epoch = 70 + ($i&030);
$i += 70;
@month = ("0",  "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL",
	 "AUG", "SEP", "OCT", "NOV", "DEC", "13",  "14",  "15");
print " $dy-$month[$mo+1]-$i\n\n";

open(INPUT, $ARGV[0]) || die "$ARGV[0]: $!";
binmode(INPUT);
#
# First, obtain block size and offset info.
seek(INPUT, -6, 2) || die "seek: $!";
read(INPUT, $buf, 6) || die "read: $!";
($bsize, $boff, $eoff) = unpack("sss", $buf);
$boff = -$boff;
$eoff = -$eoff;

#
# Find the start of the Directory.
$dir = 0402; # LINC-8?
$dir = 0346;

#
# Read the specified block, taking into account $boff and $bsize.
sub getblk {
  local($blk) = @_;
  seek(INPUT, ($blk+$boff) * $bsize*2, 0) || die "blk seek: $!";
  read(INPUT, $buf, $bsize*2) || die "blk read: $!";
  return unpack("S$bsize", $buf);
}

#
# Read in the next directory block.
# BUGBUG: How do we determine a directory's length?
$link = 1;
while ($link) {
# BUGBUG: Directories are actually 512 words!!
    @dir = &getblk($dir);
    grep($_ &= 07777, @dir); # redundant
    #
    # Loop over the directory entries.
    while (@dir) {
      #
      # Shift the next directory entry.
      $name1 = shift @dir;
      $name2 = shift @dir;
      $name3 = shift @dir;
      $name4 = shift @dir;
      $stxt = shift @dir;
      $ctxt = shift @dir;
      $sbin = shift @dir;
      $cbin = shift @dir;
      #
      # Pack up the file name.
      @name = ($name1>>6, $name1&077, $name2>>6, $name2&077,
               $name3>>6, $name3&077, $name4>>6, $name4&077);
      grep($_ = $_ >= 040? $_ : $_ + 0100, @name);
      $name = pack("C8", @name);
      $name =~ y/A-Z/a-z/; # Don't shout
      $name =~ s/[?]*$//; # Remove trailing "?"
      next if $name eq '////////'; # Empty
      $name =~ s:^//:..:; # Deleted file, write as hidden
      #
      # Process text and binary versions, as found.
#BUGBUG: TODO
      printf "%-8s\t0%04o\t0%04o\n", "${name}.tx", $stxt, $ctxt
        unless $stxt == 05757;
      printf "%-8s\t0%04o\t0%04o\n", "${name}.bd", $sbin, $cbin
        unless $sbin == 05757;
    }
    last;
}