Added zap, split out DSK functions
This commit is contained in:
Leeland Heins
GitHub
parent
5f601bd9df
commit
1d317eeab3
111
DOS33.pm
111
DOS33.pm
|
|
@ -4,6 +4,8 @@ package DOS33;
|
|||
|
||||
use strict;
|
||||
|
||||
use DSK;
|
||||
|
||||
use Exporter::Auto;
|
||||
|
||||
my $debug = 0;
|
||||
|
|
@ -122,84 +124,6 @@ my $tslist_fmt_tmpl = 'xCCx2vx5a122';
|
|||
|
||||
my %dsk = (); # Memory for disk image.
|
||||
|
||||
#
|
||||
# Read entire .dsk image.
|
||||
#
|
||||
sub read_dsk {
|
||||
my ($dskfile) = @_;
|
||||
|
||||
my %dsk = ();
|
||||
|
||||
my $dfh;
|
||||
|
||||
if (open($dfh, "<$dskfile")) {
|
||||
for (my $trk = 0; $trk <= $max_trk; $trk++) {
|
||||
for (my $sec = 0; $sec <= $max_sec; $sec++) {
|
||||
my $bytes_read = read($dfh, $dsk{$trk}{$sec}, $sec_size);
|
||||
if (defined $bytes_read && $bytes_read == $sec_size) {
|
||||
print '.';
|
||||
} else {
|
||||
print "\nError reading $trk, $sec\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
print "\n";
|
||||
} else {
|
||||
print "Unable to open $dskfile\n";
|
||||
}
|
||||
|
||||
return %dsk;
|
||||
}
|
||||
|
||||
#
|
||||
# Calculate position in .dsk file based on track/sector.
|
||||
#
|
||||
sub calc_pos {
|
||||
my ($trk, $sec) = @_;
|
||||
|
||||
my $pos = ($trk * ($sec_size * ($max_sec + 1))) + ($sec * $sec_size);
|
||||
|
||||
#print "pos=$pos\n";
|
||||
|
||||
return $pos;
|
||||
}
|
||||
|
||||
#
|
||||
# Hex dump of sector
|
||||
#
|
||||
sub dump_sec {
|
||||
my ($buf) = @_;
|
||||
|
||||
my @bytes = unpack "C$sec_size", $buf;
|
||||
|
||||
print " ";
|
||||
for (my $c = 0; $c < 16; $c++) {
|
||||
print sprintf(" %01x ", $c);
|
||||
}
|
||||
print "\n";
|
||||
|
||||
print " +------------------------------------------------\n";
|
||||
|
||||
for (my $r = 0; $r < 16; $r++) {
|
||||
print sprintf("%01x| ", $r);
|
||||
for (my $c = 0; $c < 16; $c++) {
|
||||
print sprintf("%02x ", $bytes[($r * 16) + $c]);
|
||||
}
|
||||
print "\n";
|
||||
print " |";
|
||||
for (my $c = 0; $c < 16; $c++) {
|
||||
my $a = $bytes[($r * 16) + $c] & 0x7f;
|
||||
if (($a > 32) && ($a < 127)) {
|
||||
print sprintf(" %c ", $a);
|
||||
} else {
|
||||
print " ";
|
||||
}
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
|
||||
#
|
||||
# Display a file entry in DOS 3.3 catalog format.
|
||||
#
|
||||
|
|
@ -558,36 +482,5 @@ sub read_file {
|
|||
}
|
||||
}
|
||||
|
||||
#
|
||||
# Read Track/Sector
|
||||
#
|
||||
sub rts {
|
||||
my ($dskfile, $trk, $sec, $buf) = @_;
|
||||
|
||||
#print "trk=$trk sec=$sec\n";
|
||||
|
||||
my $dfh;
|
||||
|
||||
my $pos = calc_pos($trk, $sec);
|
||||
|
||||
if (open($dfh, "<$dskfile")) {
|
||||
binmode $dfh;
|
||||
|
||||
seek($dfh, $pos, 0);
|
||||
|
||||
my $bytes_read = read($dfh, $$buf, $sec_size);
|
||||
if (defined $bytes_read && $bytes_read == $sec_size) {
|
||||
#print "bytes_read=$bytes_read\n";
|
||||
return 1;
|
||||
} else {
|
||||
print "Error reading $trk, $sec\n";
|
||||
}
|
||||
} else {
|
||||
print "Unable to open $dskfile\n";
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,159 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
package DSK;
|
||||
|
||||
use strict;
|
||||
|
||||
use Exporter::Auto;
|
||||
|
||||
my $debug = 0;
|
||||
|
||||
my $min_trk = 0; # Minimum track number
|
||||
my $max_trk = 34; # Maximum track number
|
||||
my $min_sec = 0; # Minimum sector number
|
||||
my $max_sec = 15; # Maximum sector number
|
||||
my $sec_size = 256; # Sector size
|
||||
|
||||
#
|
||||
# Read entire .dsk image.
|
||||
#
|
||||
sub read_dsk {
|
||||
my ($dskfile) = @_;
|
||||
|
||||
my %dsk = ();
|
||||
|
||||
my $dfh;
|
||||
|
||||
if (open($dfh, "<$dskfile")) {
|
||||
for (my $trk = 0; $trk <= $max_trk; $trk++) {
|
||||
for (my $sec = 0; $sec <= $max_sec; $sec++) {
|
||||
my $bytes_read = read($dfh, $dsk{$trk}{$sec}, $sec_size);
|
||||
if (defined $bytes_read && $bytes_read == $sec_size) {
|
||||
print '.';
|
||||
} else {
|
||||
print "\nError reading $trk, $sec\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
print "\n";
|
||||
} else {
|
||||
print "Unable to open $dskfile\n";
|
||||
}
|
||||
|
||||
return %dsk;
|
||||
}
|
||||
|
||||
#
|
||||
# Calculate position in .dsk file based on track/sector.
|
||||
#
|
||||
sub calc_pos {
|
||||
my ($trk, $sec) = @_;
|
||||
|
||||
my $pos = ($trk * ($sec_size * ($max_sec + 1))) + ($sec * $sec_size);
|
||||
|
||||
#print "pos=$pos\n";
|
||||
|
||||
return $pos;
|
||||
}
|
||||
|
||||
#
|
||||
# Hex dump of sector
|
||||
#
|
||||
sub dump_sec {
|
||||
my ($buf) = @_;
|
||||
|
||||
my @bytes = unpack "C$sec_size", $buf;
|
||||
|
||||
print " ";
|
||||
for (my $c = 0; $c < 16; $c++) {
|
||||
print sprintf(" %01x ", $c);
|
||||
}
|
||||
print "\n";
|
||||
|
||||
print " +------------------------------------------------\n";
|
||||
|
||||
for (my $r = 0; $r < 16; $r++) {
|
||||
print sprintf("%01x| ", $r);
|
||||
for (my $c = 0; $c < 16; $c++) {
|
||||
print sprintf("%02x ", $bytes[($r * 16) + $c]);
|
||||
}
|
||||
print "\n";
|
||||
print " |";
|
||||
for (my $c = 0; $c < 16; $c++) {
|
||||
my $a = $bytes[($r * 16) + $c] & 0x7f;
|
||||
if (($a > 32) && ($a < 127)) {
|
||||
print sprintf(" %c ", $a);
|
||||
} else {
|
||||
print " ";
|
||||
}
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
print "\n";
|
||||
}
|
||||
|
||||
#
|
||||
# Read Track/Sector
|
||||
#
|
||||
sub rts {
|
||||
my ($dskfile, $trk, $sec, $buf) = @_;
|
||||
|
||||
#print "trk=$trk sec=$sec\n";
|
||||
|
||||
my $dfh;
|
||||
|
||||
my $pos = calc_pos($trk, $sec);
|
||||
|
||||
if (open($dfh, "<$dskfile")) {
|
||||
binmode $dfh;
|
||||
|
||||
seek($dfh, $pos, 0);
|
||||
|
||||
my $bytes_read = read($dfh, $$buf, $sec_size);
|
||||
|
||||
close $dfh;
|
||||
|
||||
if (defined $bytes_read && $bytes_read == $sec_size) {
|
||||
#print "bytes_read=$bytes_read\n";
|
||||
return 1;
|
||||
} else {
|
||||
print "Error reading $trk, $sec\n";
|
||||
}
|
||||
} else {
|
||||
print "Unable to open $dskfile\n";
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
#
|
||||
# Write Track/Sector
|
||||
#
|
||||
sub wts {
|
||||
my ($dskfile, $trk, $sec, $buf) = @_;
|
||||
|
||||
#print "trk=$trk sec=$sec\n";
|
||||
|
||||
my $dfh;
|
||||
|
||||
my $pos = calc_pos($trk, $sec);
|
||||
|
||||
if (open($dfh, "+<$dskfile")) {
|
||||
binmode $dfh;
|
||||
|
||||
seek($dfh, $pos, 0);
|
||||
|
||||
print $dfh $buf;
|
||||
|
||||
close $dfh;
|
||||
|
||||
return 1;
|
||||
} else {
|
||||
print "Unable to write $dskfile\n";
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
package PRODOS;
|
||||
|
||||
use strict;
|
||||
|
||||
use DSK;
|
||||
|
||||
use Exporter::Auto;
|
||||
|
||||
my $debug = 0;
|
||||
|
||||
my $key_vol_dir_blk = 2;
|
||||
|
||||
#
|
||||
# Volume Directory Block
|
||||
#
|
||||
# 00-01 Previous Volume Directory Block
|
||||
# 02-03 Next Volume Directory Block
|
||||
#
|
||||
# Volumne Directory Header
|
||||
#
|
||||
# 04 STORAGE_TYPE/NAME_LENGTH
|
||||
# fx where x is length of VOLUME_NAME
|
||||
# 05-13 VOLUME_NAME
|
||||
# 14-1b Not used
|
||||
# 1c-1f CREATION
|
||||
# 0-1 yyyyyyymmmmddddd year/month/day
|
||||
# 2-3 000hhhhh00mmmmmm hours/minues
|
||||
# 20 VERSION
|
||||
# 21 MIN_VERSION
|
||||
# 22 ACCESS
|
||||
# 23 ENTRY_LENGTH
|
||||
# 24 ENTRIES_PER_BLOCK
|
||||
# 25-26 FILE_COUNT
|
||||
# 27-28 BIT_MAP_POINTER
|
||||
# 29-2a TOTAL_BLOCKS
|
||||
#
|
||||
my $vol_dir_blk_tmpl = 'CCCCa252';
|
||||
my $vol_dir_hdr_tmpl = '';
|
||||
|
||||
#
|
||||
# Volume Bit Map
|
||||
#
|
||||
my $vol_bit_map_tmpl = '';
|
||||
|
||||
#
|
||||
# File Descriptive Entries
|
||||
#
|
||||
# 00 STORAGE_TYPE/NAME_LENGTH
|
||||
# 0x Deleted entry. Available for reuse.
|
||||
# 1x File is a seedling file (only one block)
|
||||
# 2x File is a sapling file (2-256 blocks)
|
||||
# 3x File is a tree file (257-32768 blocks)
|
||||
# dx File is a subdirectory
|
||||
# ex Reserved for Subdirectory Header entry
|
||||
# fx Reserved for Volume Directory Header entry
|
||||
# x is the length of FILE_NAME
|
||||
# 01-0f FILE_NAME
|
||||
# 10 FILE_TYPE
|
||||
# 00 Typeless file
|
||||
# 01 BAD Bad block(s) file
|
||||
# 04 TXT Text file (ASCII text, msb off)
|
||||
# 06 BIN Binary file (8-bit binary image)
|
||||
# 0f DIR Directory file
|
||||
# 19 ADB AppleWorks data base file
|
||||
# 1a AWP AppleWorks word processing file
|
||||
# 1b ASP AppleWorks spreadsheet file
|
||||
# ef PAS ProDOS PASCAL file
|
||||
# f0 CMD ProDOS added command file
|
||||
# f1-f8 User defined file types 1 through 8
|
||||
# fc BAS Applesoft BASIC program file
|
||||
# fd VAR Applesoft stored variables file
|
||||
# fe REL Relocatable object module file (EDASM)
|
||||
# ff SYS ProDOS system file
|
||||
# 11-12 KEY_POINTER
|
||||
# 13-14 BLOCKS_USED
|
||||
# 15-17 EOF
|
||||
# 18-1b CREATION
|
||||
# 0-1 yyyyyyymmmmddddd year/month/day
|
||||
# 2-3 000hhhhh00mmmmmm hours/minues
|
||||
# 1c VERSION
|
||||
# 1d MIN_VERSION
|
||||
# 1e ACCESS
|
||||
# 80 File may be destroyed
|
||||
# 40 File may be renamed
|
||||
# 20 File has changed since last backup
|
||||
# 02 File may be written to
|
||||
# 01 File may be read
|
||||
# 1f-20 AUX_TYPE
|
||||
# TXT Random access record length (L from OPEN)
|
||||
# BIN Load address for binary image (A from BSAVE)
|
||||
# BAS Load address for program image (when SAVEd)
|
||||
# VAR Address of compressed variables inmage (when STOREd)
|
||||
# SYS Load address for system program (usually $2000)
|
||||
# 21-24 LAST_MOD
|
||||
# 25-26 HEADER_POINTER
|
||||
#
|
||||
my $file_desc_ent_tmpl = '';
|
||||
|
||||
sub read_blk {
|
||||
my ($dskfile) = @_;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
2
README
2
README
|
|
@ -8,5 +8,5 @@ lock
|
|||
rename
|
||||
delete
|
||||
copy
|
||||
disk zap/sector editor
|
||||
disk zap/sector editor -- partially working
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,108 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
use strict;
|
||||
|
||||
use DSK;
|
||||
|
||||
my $debug = 0;
|
||||
|
||||
my $trk = -1;
|
||||
my $sec = -1;
|
||||
my $dst_trk = -1;
|
||||
my $dst_sec = -1;
|
||||
my $write = 0;
|
||||
|
||||
my @mods = ();
|
||||
|
||||
while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||
if ($ARGV[0] eq '-d') {
|
||||
$debug = 1;
|
||||
shift;
|
||||
} elsif ($ARGV[0] eq '-t' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
|
||||
$trk = $ARGV[1];
|
||||
shift;
|
||||
shift;
|
||||
} elsif ($ARGV[0] eq '-s' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
|
||||
$sec = $ARGV[1];
|
||||
shift;
|
||||
shift;
|
||||
} elsif ($ARGV[0] eq '-dt' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
|
||||
$dst_trk = $ARGV[1];
|
||||
shift;
|
||||
shift;
|
||||
} elsif ($ARGV[0] eq '-ds' && defined $ARGV[1] && $ARGV[1] =~ /^\d+$/) {
|
||||
$dst_sec = $ARGV[1];
|
||||
shift;
|
||||
shift;
|
||||
} elsif ($ARGV[0] =~ /^-m([ahA])/ && defined $ARGV[1] && $ARGV[1] ne '') {
|
||||
my $typ = $1;
|
||||
print "$ARGV[1] typ=$typ\n" if $debug;
|
||||
if ($ARGV[1] =~ /^([0-9a-fA-F]+):\s*(.+)$/) {
|
||||
print "1=$1 2=$2\n" if $debug;
|
||||
push @mods, { 'typ' => $typ, 'addr' => $1, 'vals' => $2 };
|
||||
}
|
||||
shift;
|
||||
shift;
|
||||
} elsif ($ARGV[0] eq "-w") {
|
||||
$write = 1;
|
||||
shift;
|
||||
}
|
||||
}
|
||||
|
||||
my $dskfile = shift or die "Must supply filename\n";
|
||||
die "Must supply track number 0-35\n" unless $trk >= 0 && $trk <= 35;
|
||||
die "Must supply sector number 0-16\n" unless $sec >= 0 && $sec <= 16;
|
||||
|
||||
$dst_trk = $trk unless $dst_trk >= 0;
|
||||
$dst_sec = $sec unless $dst_sec >= 0;
|
||||
|
||||
my $buf;
|
||||
|
||||
if (rts($dskfile, $trk, $sec, \$buf)) {
|
||||
dump_sec($buf);
|
||||
|
||||
if ($write) {
|
||||
print "WRITING $dst_trk $dst_sec\n" if $debug;
|
||||
my @bytes = unpack "C256", $buf;
|
||||
|
||||
foreach my $mod (@mods) {
|
||||
my @mbytes = ();
|
||||
if ($mod->{'typ'} eq 'a') {
|
||||
print "ASCII vals=$mod->{'vals'}\n" if $debug;
|
||||
# Normal ASCII
|
||||
@mbytes = map { pack('C', ord($_)) } ($mod->{'vals'} =~ /(.)/g);
|
||||
} elsif ($mod->{'typ'} eq 'A') {
|
||||
print "HEX vals=$mod->{'vals'}\n" if $debug;
|
||||
# Apple II ASCII
|
||||
@mbytes = map { pack('C', ord($_) | 0x80) } ($mod->{'vals'} =~ /(.)/g);
|
||||
} elsif ($mod->{'typ'} eq 'h') {
|
||||
print "A2 ASCII vals=$mod->{'vals'}\n" if $debug;
|
||||
# HEX
|
||||
@mbytes = map { pack('C', hex(lc($_))) } ($mod->{'vals'} =~ /(..)/g);
|
||||
}
|
||||
my $addr = hex($mod->{'addr'});
|
||||
print "addr=$addr\n" if $debug;
|
||||
foreach my $byte (@mbytes) {
|
||||
print sprintf("byte=%02x\n", ord($byte)) if $debug;
|
||||
$bytes[$addr++] = ord($byte);
|
||||
}
|
||||
}
|
||||
|
||||
my $buf = pack "C*", @bytes;
|
||||
|
||||
if (wts($dskfile, $dst_trk, $dst_sec, $buf)) {
|
||||
if (rts($dskfile, $dst_trk, $dst_sec, \$buf)) {
|
||||
dump_sec($buf);
|
||||
} else {
|
||||
print "Failed final read!\n";
|
||||
}
|
||||
} else {
|
||||
print "Failed write!\n";
|
||||
}
|
||||
}
|
||||
} else {
|
||||
print "Failed initial read!\n";
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
Loading…
Reference in New Issue