#!/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.

#
# Examine files, and try to find BIN format segments.
# Convert them to .od format as we find them.
# BUGBUG: Embedded labels (text at the beginning) will be lost.
# BUGBUG: Comments (text between rubouts) are not accepted.

for $f (@ARGV) {
  next unless -f $f;
  next if $f =~ /\.od$/;
  #
  # Open the file in binary mode and scan it.
  open(INPUT, $f) || die "$f: $!";
  binmode(INPUT);
  $done = $segments = 0;
  $lbl = "";
  while (!$done) {
    if (!read(INPUT, $ch, 1)) {
      $done = 1;
      last;
    }
    $lbl .= $ch;
    $byte = unpack("C", $ch);
    if ($byte == 0032) {
      $of = "$f.lbl";
      if (!-f $of) {
        print "Writing $of\n";
        open(OUTPUT, ">$of") || die "$of: $!";
        # Convert each segment to .od format.
        print OUTPUT $lbl;
        close(OUTPUT);
      } else {
        warn "$of: file exists\n";
      }
    }
    # Ignore cruft until leader is found.
    if ($byte == 0200) {
      $lbl = "";
      $segment[$segments] = $ch;
      # Append leader to the segment.
      while ($byte == 0200) {
        if (!read(INPUT, $ch, 1)) {
          $done = 1;
          last;
        }
        $byte = unpack("C", $ch);
        $segment[$segments] .= $ch;
      }
      last if $done;
      # At this point the leader has been scanned.
      # $byte should be an address or field setting,
      # and has been appended already.
      $sum = $add = 0;
      while ($byte != 0200) {
        if ($byte & 0200) {
          if (($byte & 0307) != 0300) {
            warn "$f: Invalid field setting in BIN segment";
            last;
          }
          # Get the next byte
          if (!read(INPUT, $ch, 1)) {
            $done = 1;
            last;
          }
          $byte = unpack("C", $ch);
          $segment[$segments] .= $ch;
          next;
        }
        # $byte is the first of a new pair of bytes.
        # Process the old pair, if any.
        $sum += $add;
        $ck = $add = $byte;
        # Get the second byte of the frame.
        if (!read(INPUT, $ch, 1)) {
          $done = 1;
          last;
        }
        $byte = unpack("C", $ch);
        $segment[$segments] .= $ch;
        if ($byte & 0300) {
          warn "$f: Second byte of BIN frame is invalid";
          last;
        }
        $ck = ($ck << 6) + $byte;
        $add += $byte;
        # Get the next byte
        if (!read(INPUT, $ch, 1)) {
          $done = 1;
          last;
        }
        $byte = unpack("C", $ch);
        $segment[$segments] .= $ch;
      }
      # At this point one trailer byte has been processed.
      while ($byte == 0200) {
        if (!read(INPUT, $ch, 1)) {
          $done = 1;
          last;
        }
        $byte = unpack("C", $ch);
        $segment[$segments] .= $ch if $byte == 0200;
      }
      # Validate the segment, but warn if the checksum was wrong.
      $segments++;
      $sum &= 07777;
      warn "$f: Checksum of BIN segment $segments is invalid"
        unless $sum == $ck;
    }
    # Loop to look for another segment
    # Either $done is set (EOF), or this byte is cruft.
  }
# print "$f: 1 segment found\n" if $segments == 1;
  print "$f: $segments segments found\n" if $segments != 1;
  close(INPUT);
  for ($s = 0; $s < $segments; $s++) {
    $of = "$f.od";
    $of .= $s+1 if $s;
    if (!-f $of) {
      print "Writing $of\n";
      open(OUTPUT, ">$of") || die "$of: $!";
      # Convert each segment to .od format.
      for $byte (unpack("C*", $segment[$s])) {
        printf OUTPUT "%04o\n", $byte;
      }
      close(OUTPUT);
    } else {
      warn "$of: file exists\n";
    }
  }
}
exit 0;