#!/usr/bin/perl

#
#	Verify an HP absolute binary tape
#

use Getopt::Std;

my $debug = 1;
my $self = "HPChkbin.pl";
my $word;

our($opt_d);

sub usage();
sub getWord(*$);

getopts('dv') || usage();
$debug = $opt_d;
$verbose = $opt_v;

if($#ARGV < 0) {
	usage();
	exit(8);
}

open(INFILE,"<$ARGV[0]") || 
	die("Cannot open input file $ARGV[0]\n");
	
binmode(INFILE);

print("$self: Processing file $ARGV[0]\n");

#
#	NOTE:  A tape may containe moer than one absolute file!
#

$skip = 256;
$frame = 0;

while(1) {
	
	#
	#	Loop through the records.  Each record ir preceeded by at MOST
	#	10 empty frames, except the first one.
	#
	
	while(--$skip > 0 && $frame == 0) {
		if(read(INFILE,$ch,1) != 1) {
			print("$self: Error/EOF looking for next record.\n");
			close(INFILE);
			exit(2);
		}
		$frame = ord($ch);
	}
	
	if($skip == 0) {
		print("$self: Reached blank tape.\n");
		close(INFILE);
		exit(2);
	}
	
	#
	#	Found a non zero frame.  Read and check the record.
	#
	
	$count = ord($ch);
	if(read(INFILE,$junk,1) != 1) {
		print("$self: Error/EOF reading byte after record length.\n");
		close(INFILE);
		exit(2);
	}
	
	if(getWord(INFILE,$word) < 0) {
		print("$self: Error/EOF reading address.\n");
		close(INFILE);
		exit(2);
	}
	
	if($verbose) {
		printf("Reading record length: %3d, Address: %07o\n",
			$count, $word);
	}
	
	#
	#	Start up the checksum.
	#
	
	$chksum = $word;
	
	while($count--) {
		if(getWord(INFILE,$word) < 0) {
			close(INFILE);
			exit(2);
		}
		$chksum += $word;
		$chksum = $chksum & 0x0ffff;
		if($debug) {
			printf("$self: Word read: %07o, Checksum: %07o\n",$word,$chksum);	
		}
	}
	
	#
	#	Read the checksum word
	#
	if(getWord(INFILE,$word) < 0) {
		print("$self: Error/EOF reading expected checksum word.");
		close(INFILE);
		exit(2);
	}	
	
	if($chksum != $word) {
		printf("$self: Checksum Error:  Expected %o, Received %o\n",
			$chksum, $word);
	}
	
	#
	#	Next record should be within 10 frames.
	#
	
	$skip = 10;
	$frame = 0;	
}

close(INFILE);

sub usage() {
	print("Usage:  perl $self [-d] inputFile");
}


sub getWord(*$) {
	
	my($fd,$word) = @_;
	# my ($b1, $b2);
	
	if(read($fd,$b1,1) < 1) {
		print("getWord:  Error/EOF assembling 1st byte of expected word.\n");
		return(-1);	
	}
	if(read($fd,$b2,1) < 1) {
		print("getWord: Error/EOF assembling 2nd byte of expected word.\n");
		return(-1);
	}
	
	# print "$b1, $b2\n";
	
	$b1 = ord($b1);
	$b2 = ord($b2);
	
	$word = $b1 << 8 | $b2;
	
	$_[1] = $word;

	return(0);		 
}