mirror of
https://github.com/wfjm/w11.git
synced 2026-01-13 23:47:36 +00:00
5b52e5418d
- tap2file - BUGFIX in rlmax calculation - add -v option - Rw11CntlTM11 - BUGFIX: AddNormalExit(): get tmds logic right - support odd record length
137 lines
3.4 KiB
Perl
Executable File
137 lines
3.4 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
# $Id: tap2file 1180 2019-07-08 15:46:59Z mueller $
|
|
# SPDX-License-Identifier: GPL-3.0-or-later
|
|
# Copyright 2015-2019 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
|
|
#
|
|
# Revision History:
|
|
# Date Rev Version Comment
|
|
# 2019-07-08 1180 1.0.3 BUGFIX in rlmax calculation; add -v option
|
|
# 2018-12-18 1089 1.0.2 add and use bailout
|
|
# 2015-06-03 686 1.0.1 add print_usage; cleanups
|
|
# 2015-05-24 684 1.0 Initial version
|
|
#
|
|
# Expand a simh tape container file (.tap) to a set of files
|
|
#
|
|
# Usage: tap2file [--pref=pref] file
|
|
#
|
|
use 5.14.0; # require Perl 5.14 or higher
|
|
use strict; # require strict checking
|
|
|
|
use Getopt::Long;
|
|
|
|
my %opts = ();
|
|
|
|
GetOptions(\%opts, "pref=s", "v", "help")
|
|
or bailout("bad command options");
|
|
|
|
if (scalar(@ARGV) == 0 || exists $opts{help}) {
|
|
print_usage();
|
|
exit 0;
|
|
}
|
|
|
|
my $ifile = shift @ARGV;
|
|
exit 0 unless defined $ifile;
|
|
|
|
open(IFILE, "<$ifile") or bailout("Can't open '$ifile': $!");
|
|
|
|
my $basename = $ifile;
|
|
$basename = $1 if $ifile =~ m|.*/(.*)|;
|
|
my $fstem = $basename;
|
|
$fstem = $1 if $basename =~ m|(.*)\..*|;
|
|
|
|
my $pref = (exists $opts{pref}) ? $opts{pref} : "${fstem}_";
|
|
|
|
my $nfile = 0;
|
|
my $nrec = 0;
|
|
my $rlmin = 0;
|
|
my $rlmax = 0;
|
|
my $ofile = "";
|
|
|
|
my $block;
|
|
my $nb;
|
|
|
|
while ($nb = read(IFILE, $block, 4)) {
|
|
my $metabeg = unpack("V", $block);
|
|
|
|
if ($metabeg == 0x00000000) {
|
|
printf "%4d,%5d : ---EOF---\n",$nfile,$nrec if $opts{v};
|
|
close_ofile();
|
|
$nfile += 1;
|
|
next;
|
|
}
|
|
if ($metabeg == 0xffffffff) {
|
|
printf "%4d,%5d : ---EOT---\n",$nfile,$nrec if $opts{v};
|
|
last;
|
|
}
|
|
|
|
unless (defined fileno OFILE) {
|
|
$ofile = sprintf("%s%02d.dat", $pref,$nfile);
|
|
open(OFILE, ">$ofile") or bailout("Can't open '$ofile': $!");
|
|
}
|
|
|
|
$nb = read(IFILE, $block, $metabeg);
|
|
print OFILE $block;
|
|
if ($nrec == 0) {
|
|
$rlmin = $metabeg;
|
|
$rlmax = $metabeg;
|
|
} else {
|
|
$rlmin = $metabeg if $metabeg < $rlmin;
|
|
$rlmax = $metabeg if $metabeg > $rlmax;
|
|
}
|
|
if ($opts{v}) {
|
|
printf "%4d,%5d : %6d :",$nfile,$nrec,$metabeg;
|
|
foreach (unpack("C16", $block)) {printf " %2.2x", $_};
|
|
print " ..." if $metabeg > 16;
|
|
print "\n";
|
|
}
|
|
$nrec += 1;
|
|
|
|
$nb = read(IFILE, $block, 4);
|
|
my $metaend = unpack("V", $block);
|
|
if ($nb != 4 || not defined $metaend) {
|
|
printf "bad meta tag: beg=%8.8x\n", $metabeg;
|
|
last;
|
|
}
|
|
if ($metaend != $metabeg) {
|
|
printf "bad meta tags: beg=%8.8x end=%8.8x\n", $metabeg,$metaend;
|
|
last;
|
|
}
|
|
}
|
|
|
|
close_ofile();
|
|
exit 0;
|
|
|
|
# ----------------------------------------------------------------------------
|
|
sub close_ofile {
|
|
return unless (defined fileno OFILE);
|
|
close(OFILE);
|
|
if ($rlmin == $rlmax) {
|
|
printf "%s: %6d records, length %5d\n",
|
|
$ofile, $nrec, $rlmin;
|
|
} else {
|
|
printf "%s: %6d records, length min=%5d, max=%5d\n",
|
|
$ofile, $nrec, $rlmin, $rlmax;
|
|
}
|
|
$nrec = 0;
|
|
$rlmin = 0;
|
|
$rlmax = 0;
|
|
}
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
sub bailout {
|
|
my ($msg) = @_;
|
|
print STDERR "tap2file-F: $msg\n";
|
|
exit 1;
|
|
}
|
|
|
|
# ----------------------------------------------------------------------------
|
|
sub print_usage {
|
|
print "usage: tap2file [options] ifile\n";
|
|
print " ifile input tap file\n";
|
|
print " Options\n";
|
|
print " --pref=p use p as prefix for generated files\n";
|
|
print " --v verbose, trace each record\n";
|
|
print " --help this message\n";
|
|
}
|