URL
https://opencores.org/ocsvn/w11/w11/trunk
Subversion Repositories w11
[/] [w11/] [tags/] [w11a_V0.7/] [tools/] [bin/] [file2tap] - Rev 33
Compare with Previous | Blame | View Log
#!/usr/bin/perl -w
# $Id: file2tap 686 2015-06-04 21:08:08Z mueller $
#
# Copyright 2008-2015 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de>
#
# This program is free software; you may redistribute and/or modify it under
# the terms of the GNU General Public License as published by the Free
# Software Foundation, either version 2, or at your option any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY, without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
# for complete details.
#
# Revision History:
# Date Rev Version Comment
# 2015-06-03 686 1.1 fix -a option; support eom at end
# 2008-12-07 175 1.0.1 remove some upperfluous 'my'
# 2008-11-29 174 1.0 Initial version (import from tbird backup)
#
#
# Create a simh tape container file (.tap) from a set of files
#
# Usage: file2tap -c name -b n file1 ... filen
#
# if -c name is omitted, stdout is used
#
use strict;
use Fcntl qw(:seek O_RDWR);
my $arg;
my $cdone;
my $blocksize = 512;
my $nfile = 0;
while ($arg = shift) {
if ($arg eq "-c") {
if (@ARGV) {
$arg = shift;
open(OFILE, ">$arg") || die ("Can't open output file $arg: $!");
$cdone = 1;
}
} elsif ($arg eq "-a") {
if (@ARGV) {
$arg = shift;
sysopen OFILE, $arg, O_RDWR || die ("Can't open output file $arg: $!");
my $buf;
my $len;
# check for EOM mark at end, if found, truncate it away
sysseek OFILE, -4, SEEK_END;
$len = sysread OFILE, $buf, 4;
if ($buf eq "\xff\xff\xff\xff") {
truncate OFILE, sysseek(OFILE, -4, SEEK_END);
}
# check for two EOF marks at end, if found, truncate 2nd away
sysseek OFILE, -8, SEEK_END;
$len = sysread OFILE, $buf, 8;
if ($buf ne "\x00\x00\x00\x00\x00\x00\x00\x00") {
die ("Didn't find double EOF at end of tap file");
}
truncate OFILE, sysseek(OFILE, -4, SEEK_END);
close OFILE;
open(OFILE, ">>$arg") || die ("Can't append to output file $arg: $!");
$cdone = 1;
}
} elsif ($arg eq "-b") {
if (@ARGV) {
$arg = shift;
$blocksize = 512 * int $arg;
}
} else {
if (!$cdone) {
open(OFILE, ">-") || die ("Can't open stdout: $!");
}
my @flist = split(",",$arg);
my $file;
foreach $file (@flist) {
add_file($file, $blocksize);
}
$nfile += 1;
end_file();
}
}
end_file();
# ----------------------------------------------------------------------------
sub end_file {
print OFILE "\x00\x00\x00\x00";
}
# ----------------------------------------------------------------------------
sub add_file {
my($filename, $blocksize) = @_;
my($block, $bytes_read, $length, $nb);
open(FILE, $filename) || die("Can't open $filename: $!");
while($bytes_read = read(FILE, $block, $blocksize)) {
if($bytes_read < $blocksize) {
$block .= "\x00" x ($blocksize - $bytes_read);
}
$length = pack("V", $blocksize);
print OFILE $length, $block, $length;
$nb += 1;
}
close(FILE);
if ($cdone) {
printf "file: %3d records: %5d length: %5d file: $filename\n",
$nfile, $nb, $blocksize;
}
}