From 1d317eeab3508fd5c52624ed199f2c61a1bde6c6 Mon Sep 17 00:00:00 2001 From: Leeland Heins Date: Fri, 11 Jan 2019 13:30:14 -0600 Subject: [PATCH] Added zap, split out DSK functions --- DOS33.pm | 111 +------------------------------------- DSK.pm | 159 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ ProDOS.pm | 106 ++++++++++++++++++++++++++++++++++++ README | 2 +- zap.pl | 108 +++++++++++++++++++++++++++++++++++++ 5 files changed, 376 insertions(+), 110 deletions(-) create mode 100644 DSK.pm create mode 100644 ProDOS.pm create mode 100644 zap.pl diff --git a/DOS33.pm b/DOS33.pm index 5aa7f0c..c5e3787 100644 --- a/DOS33.pm +++ b/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; diff --git a/DSK.pm b/DSK.pm new file mode 100644 index 0000000..be22bea --- /dev/null +++ b/DSK.pm @@ -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; + diff --git a/ProDOS.pm b/ProDOS.pm new file mode 100644 index 0000000..e13c890 --- /dev/null +++ b/ProDOS.pm @@ -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; + diff --git a/README b/README index e0db158..cea7ea2 100644 --- a/README +++ b/README @@ -8,5 +8,5 @@ lock rename delete copy -disk zap/sector editor +disk zap/sector editor -- partially working diff --git a/zap.pl b/zap.pl new file mode 100644 index 0000000..9d351d1 --- /dev/null +++ b/zap.pl @@ -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; +