mirror of
https://github.com/softwarejanitor/DOS33.git
synced 2024-12-30 11:30:41 +00:00
Initial import
This commit is contained in:
Leeland Heins
GitHub
parent
e044f348ac
commit
5f601bd9df
593
DOS33.pm
Normal file
593
DOS33.pm
Normal file
@ -0,0 +1,593 @@
|
|||||||
|
#!/usr/bin/perl -w
|
||||||
|
|
||||||
|
package DOS33;
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
my $vtoc_trk = 0x11; # Default VTOC track
|
||||||
|
my $vtoc_sec = 0x00; # Default VTOC sector
|
||||||
|
|
||||||
|
# DOS 3.3 file types
|
||||||
|
my %file_types = (
|
||||||
|
0x00 => ' T', # Unlocked text file
|
||||||
|
0x01 => ' I', # Unlocked INTBASIC file
|
||||||
|
0x02 => ' A', # Unlocked Applesoft file
|
||||||
|
0x04 => ' B', # Unlocked Binary file
|
||||||
|
0x08 => ' S', # Unlocked Special file
|
||||||
|
0x10 => ' R', # Unlocked Relocatable file
|
||||||
|
0x20 => ' A', # Unlocked A file
|
||||||
|
0x40 => ' B', # Unlocked B file
|
||||||
|
0x80 => '*T', # Locked text file
|
||||||
|
0x81 => '*I', # Locked INTBASIC file
|
||||||
|
0x82 => '*A', # Locked Applesoft file
|
||||||
|
0x84 => '*B', # Locked Binary file
|
||||||
|
0x88 => '*S', # Locked Special file
|
||||||
|
0x90 => '*R', # Locked Relocatable file
|
||||||
|
0xa0 => '*A', # Locked A file
|
||||||
|
0xb0 => '*B', # Locked B file
|
||||||
|
);
|
||||||
|
|
||||||
|
#
|
||||||
|
# Volume Table of Contents (VTOC) Format
|
||||||
|
#
|
||||||
|
# 00 Not used
|
||||||
|
# 01 Track number of first catalog sector
|
||||||
|
# 02 Sector number of first catalog sector
|
||||||
|
# 03 Release number of DOS used to INIT this diskette
|
||||||
|
# 04-05 Not used
|
||||||
|
# 06 Diskette volume number
|
||||||
|
# 07-26 Not used
|
||||||
|
# 27 Maximum number of track/sector list sector (122 for 256 byte sectors)
|
||||||
|
# 28-2f Not used
|
||||||
|
# 30 Last track where sectors were allocated
|
||||||
|
# 31 Direction of track allocation (+1 or -1)
|
||||||
|
# 32-33 Not used
|
||||||
|
# 34 Number of tracks per diskette (normally 35)
|
||||||
|
# 35 Number of sectors per track (13 or 16)
|
||||||
|
# 36-37 Number of bytes per sector (LO/HI format)
|
||||||
|
# 38-3b Bit map of free sectors in track 0
|
||||||
|
# 3c-3f Bit map of free sectors in track 1
|
||||||
|
# 40-43 Bit map of free sectors in track 2
|
||||||
|
# ...
|
||||||
|
# bc-bf Bit map of free sectors in track 33
|
||||||
|
# c0-c3 Bit map of free sectors in track 34
|
||||||
|
# c4-cf Bit maps for additional tracks if there are more than 35 tracks per diskette
|
||||||
|
#
|
||||||
|
my $vtoc_fmt_tmpl = 'xCCCx2Cx32Cx8CCx2CCva140';
|
||||||
|
|
||||||
|
#
|
||||||
|
# Bit maps of free sectors on a given track
|
||||||
|
#
|
||||||
|
# BYTE SECTORS
|
||||||
|
# 0 FDEC BA98
|
||||||
|
# 1 7654 3210
|
||||||
|
# 2 .... .... (not used)
|
||||||
|
# 3 .... .... (not used)
|
||||||
|
#
|
||||||
|
my $bit_map_free_sec_tmpl = 'nx2';
|
||||||
|
|
||||||
|
#
|
||||||
|
#
|
||||||
|
# Catalog Sector Format
|
||||||
|
#
|
||||||
|
# 00 Not used
|
||||||
|
# 01 Track number of next catalog sector (usually 11 hex)
|
||||||
|
# 02 Sector number of next catalog sector
|
||||||
|
# 03-0a Not used
|
||||||
|
# 0b-2d First file descriptive entry
|
||||||
|
# 2e-50 Second file descriptive entry
|
||||||
|
# 51-73 Third file descriptive entry
|
||||||
|
# 74-96 Fourth file descriptive entry
|
||||||
|
# 97-b9 Fifth file descriptive entry
|
||||||
|
# ba-dc Sixth file descriptive entry
|
||||||
|
# dd-ff Seventh file descriptive entry
|
||||||
|
#
|
||||||
|
my $cat_sec_fmt_tmpl = 'xCCx8a35a35a35a35a35a35a35';
|
||||||
|
|
||||||
|
#
|
||||||
|
# File Descriptive Entry Format
|
||||||
|
#
|
||||||
|
# 00 Track of first track/sector list sector.
|
||||||
|
# 01 Sector of first track/sector list sector.
|
||||||
|
# 02 File type and flags:
|
||||||
|
# 03-20 File name (30 characters)
|
||||||
|
# 21-22 Length of file in sectors (LO/HI format).
|
||||||
|
#
|
||||||
|
my $file_desc_ent_dmt_tmpl = 'CCCa30C';
|
||||||
|
|
||||||
|
#
|
||||||
|
# Track/Sector ListFormat
|
||||||
|
#
|
||||||
|
# 00 Not used
|
||||||
|
# 01 Track number of next T/S List sector if one was needed or zero if no more T/S List sectors.
|
||||||
|
# 02 Sector number of next T/S List sector (if present).
|
||||||
|
# 03-04 Not used
|
||||||
|
# 05-06 Sector offset in file of the first sector described by this list.
|
||||||
|
# 07-0b Not used
|
||||||
|
# 0c-0d Track and sector of first data sector or zeros
|
||||||
|
# 0e-0f Track and sector of second data sector or zeros
|
||||||
|
# 10-ff Up to 120 more Track/Sector pairs
|
||||||
|
#
|
||||||
|
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.
|
||||||
|
#
|
||||||
|
sub display_file_entry {
|
||||||
|
my ($file_type, $filename, $file_length) = @_;
|
||||||
|
|
||||||
|
print sprintf("%-2s %03d %s\n", $file_types{$file_type}, $file_length, $filename);
|
||||||
|
}
|
||||||
|
|
||||||
|
# Parse a file entry
|
||||||
|
sub parse_file_entry {
|
||||||
|
my ($file_desc_entry) = @_;
|
||||||
|
|
||||||
|
my ($first_tslist_trk, $first_tslist_sec, $file_type, $filename, $file_length) = unpack $file_desc_ent_dmt_tmpl, $file_desc_entry;
|
||||||
|
|
||||||
|
return if $first_tslist_trk eq '';
|
||||||
|
return if $first_tslist_trk == 0xff; # Deleted
|
||||||
|
return if $first_tslist_trk == 0x00; # Never used
|
||||||
|
|
||||||
|
$file_length = 0 unless defined $file_length;
|
||||||
|
|
||||||
|
if (defined $first_tslist_trk && $first_tslist_trk ne '') {
|
||||||
|
# Convert Apple ASCII to normal (clear the high bit)
|
||||||
|
my $fname = '';
|
||||||
|
my @bytes = unpack "C*", $filename;
|
||||||
|
foreach my $byte (@bytes) {
|
||||||
|
$fname .= sprintf("%c", $byte & 0x7f);
|
||||||
|
}
|
||||||
|
|
||||||
|
return $first_tslist_trk, $first_tslist_sec, $file_type, $fname, $file_length;
|
||||||
|
}
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Parse a catalog sector
|
||||||
|
sub parse_cat_sec {
|
||||||
|
my ($buf) = @_;
|
||||||
|
|
||||||
|
my ($trk_num_nxt_cat_sec, $sec_num_nxt_cat_sec, $first_file_desc_ent, $second_file_desc_ent, $third_file_desc_ent, $fourth_file_desc_ent, $fifth_file_desc_ent, $sixth_file_desc_ent, $seventh_file_desc_ent) = unpack $cat_sec_fmt_tmpl, $buf;
|
||||||
|
|
||||||
|
my @files = ();
|
||||||
|
|
||||||
|
my ($first_tslist_trk, $first_tslist_sec, $file_type, $filename, $file_length);
|
||||||
|
($first_tslist_trk, $first_tslist_sec, $file_type, $filename, $file_length) = parse_file_entry($first_file_desc_ent);
|
||||||
|
if (defined $first_tslist_trk && $first_tslist_trk ne '') {
|
||||||
|
push @files, { 'file_type' => $file_type, 'filename' => $filename, 'file_length' => $file_length, 'trk' => $first_tslist_trk, 'sec' => $first_tslist_sec };
|
||||||
|
}
|
||||||
|
($first_tslist_trk, $first_tslist_sec, $file_type, $filename, $file_length) = parse_file_entry($second_file_desc_ent);
|
||||||
|
if (defined $first_tslist_trk && $first_tslist_trk ne '') {
|
||||||
|
push @files, { 'file_type' => $file_type, 'filename' => $filename, 'file_length' => $file_length, 'trk' => $first_tslist_trk, 'sec' => $first_tslist_sec };
|
||||||
|
}
|
||||||
|
($first_tslist_trk, $first_tslist_sec, $file_type, $filename, $file_length) = parse_file_entry($third_file_desc_ent);
|
||||||
|
if (defined $first_tslist_trk && $first_tslist_trk ne '') {
|
||||||
|
push @files, { 'file_type' => $file_type, 'filename' => $filename, 'file_length' => $file_length, 'trk' => $first_tslist_trk, 'sec' => $first_tslist_sec };
|
||||||
|
}
|
||||||
|
($first_tslist_trk, $first_tslist_sec, $file_type, $filename, $file_length) = parse_file_entry($fourth_file_desc_ent);
|
||||||
|
if (defined $first_tslist_trk && $first_tslist_trk ne '') {
|
||||||
|
push @files, { 'file_type' => $file_type, 'filename' => $filename, 'file_length' => $file_length, 'trk' => $first_tslist_trk, 'sec' => $first_tslist_sec };
|
||||||
|
}
|
||||||
|
($first_tslist_trk, $first_tslist_sec, $file_type, $filename, $file_length) = parse_file_entry($fifth_file_desc_ent);
|
||||||
|
if (defined $first_tslist_trk && $first_tslist_trk ne '') {
|
||||||
|
push @files, { 'file_type' => $file_type, 'filename' => $filename, 'file_length' => $file_length, 'trk' => $first_tslist_trk, 'sec' => $first_tslist_sec };
|
||||||
|
}
|
||||||
|
($first_tslist_trk, $first_tslist_sec, $file_type, $filename, $file_length) = parse_file_entry($sixth_file_desc_ent);
|
||||||
|
if (defined $first_tslist_trk && $first_tslist_trk ne '') {
|
||||||
|
push @files, { 'file_type' => $file_type, 'filename' => $filename, 'file_length' => $file_length, 'trk' => $first_tslist_trk, 'sec' => $first_tslist_sec };
|
||||||
|
}
|
||||||
|
($first_tslist_trk, $first_tslist_sec, $file_type, $filename, $file_length) = parse_file_entry($seventh_file_desc_ent);
|
||||||
|
if (defined $first_tslist_trk && $first_tslist_trk ne '') {
|
||||||
|
push @files, { 'file_type' => $file_type, 'filename' => $filename, 'file_length' => $file_length, 'trk' => $first_tslist_trk, 'sec' => $first_tslist_sec };
|
||||||
|
}
|
||||||
|
|
||||||
|
return $trk_num_nxt_cat_sec, $sec_num_nxt_cat_sec, @files;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Get catalog sector
|
||||||
|
sub get_cat_sec {
|
||||||
|
my ($dskfile, $cat_trk, $cat_sec) = @_;
|
||||||
|
|
||||||
|
my $buf;
|
||||||
|
|
||||||
|
if (rts($dskfile, $cat_trk, $cat_sec, \$buf)) {
|
||||||
|
return parse_cat_sec($buf);
|
||||||
|
}
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
#
|
||||||
|
# Display disk catalog
|
||||||
|
#
|
||||||
|
sub catalog {
|
||||||
|
my ($dskfile, $dbg) = @_;
|
||||||
|
|
||||||
|
if (defined $dbg && $dbg) {
|
||||||
|
$debug = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
my ($trk_num_1st_cat_sec, $sec_num_1st_cat_sec, $rel_num_dos, $dsk_vol_num, $max_tslist_secs, $last_trk_secs_alloc, $dir_trk_alloc, $num_trks_dsk, $bit_map_free_secs) = get_vtoc_sec($dskfile);
|
||||||
|
|
||||||
|
if (defined $trk_num_1st_cat_sec && $trk_num_1st_cat_sec ne '') {
|
||||||
|
print sprintf("DISK VOLUME %d\n\n", $dsk_vol_num);
|
||||||
|
|
||||||
|
my ($next_cat_trk, $next_cat_sec) = ($trk_num_1st_cat_sec, $sec_num_1st_cat_sec);
|
||||||
|
my @files = ();
|
||||||
|
do {
|
||||||
|
($next_cat_trk, $next_cat_sec, @files) = get_cat_sec($dskfile, $next_cat_trk, $next_cat_sec);
|
||||||
|
if (defined $next_cat_trk && $next_cat_trk ne '') {
|
||||||
|
foreach my $file (@files) {
|
||||||
|
display_file_entry($file->{'file_type'}, $file->{'filename'}, $file->{'file_length'});
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} while ($next_cat_trk != 0);
|
||||||
|
} else {
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
#
|
||||||
|
# Display sector free map
|
||||||
|
#
|
||||||
|
sub freemap {
|
||||||
|
my ($dskfile, $dbg) = @_;
|
||||||
|
|
||||||
|
if (defined $dbg && $dbg) {
|
||||||
|
$debug = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
my ($trk_num_1st_cat_sec, $sec_num_1st_cat_sec, $rel_num_dos, $dsk_vol_num, $max_tslist_secs, $last_trk_secs_alloc, $dir_trk_alloc, $num_trks_dsk, $num_secs_dsk, $num_bytes_sec, $bit_map_free_secs) = get_vtoc_sec($dskfile);
|
||||||
|
|
||||||
|
print " 0123456789abcdef\n";
|
||||||
|
print " +----------------\n";
|
||||||
|
my $tmpl = '';
|
||||||
|
for (my $t = $min_trk; $t <= $max_trk; $t++) {
|
||||||
|
$tmpl .= $bit_map_free_sec_tmpl;
|
||||||
|
}
|
||||||
|
print "tmpl=$tmpl\n" if $debug;
|
||||||
|
my @flds = unpack $tmpl, $bit_map_free_secs;
|
||||||
|
for (my $t = $min_trk; $t <= $max_trk; $t++) {
|
||||||
|
print sprintf("%2d %04x\n", $t, $flds[$t]) if $debug;
|
||||||
|
print sprintf("%2d %016b\n", $t, $flds[$t]) if $debug;
|
||||||
|
my $fr = sprintf("%016b", $flds[$t]);
|
||||||
|
print "fr=$fr\n" if $debug;
|
||||||
|
my $fm = reverse $fr;
|
||||||
|
print "fm=$fm\n" if $debug;
|
||||||
|
$fm =~ s/0/ /g;
|
||||||
|
$fm =~ s/1/*/g;
|
||||||
|
print "fm=$fm\n" if $debug;
|
||||||
|
print sprintf("%2d|%s\n", $t, $fm);
|
||||||
|
}
|
||||||
|
#print "bit_map_free_secs=";
|
||||||
|
#my @bytes = unpack "C*", $bit_map_free_secs;
|
||||||
|
#foreach my $byte (@bytes) {
|
||||||
|
# print sprintf("%02x ", $byte);
|
||||||
|
#}
|
||||||
|
#print "\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
# Parse a VTOC sector
|
||||||
|
sub parse_vtoc_sec {
|
||||||
|
my ($buf) = @_;
|
||||||
|
|
||||||
|
my ($trk_num_1st_cat_sec, $sec_num_1st_cat_sec, $rel_num_dos, $dsk_vol_num, $max_tslist_secs, $last_trk_secs_alloc, $dir_trk_alloc, $num_trks_dsk, $num_secs_dsk, $num_bytes_sec, $bit_map_free_secs) = unpack $vtoc_fmt_tmpl, $buf;
|
||||||
|
|
||||||
|
if ($debug) {
|
||||||
|
print sprintf("trk_num_1st_cat_sec=%02x\n", $trk_num_1st_cat_sec);
|
||||||
|
print sprintf("sec_num_1st_cat_sec=%02x\n", $sec_num_1st_cat_sec);
|
||||||
|
print sprintf("rel_num_dos=%02x\n", $rel_num_dos);
|
||||||
|
print sprintf("dsk_vol_num=%02x\n", $dsk_vol_num);
|
||||||
|
print sprintf("max_tslist_secs=%02x\n", $max_tslist_secs);
|
||||||
|
print sprintf("last_trk_secs_alloc=%02x\n", $last_trk_secs_alloc);
|
||||||
|
print sprintf("dir_trk_alloc=%02x\n", $dir_trk_alloc);
|
||||||
|
print sprintf("num_trks_dsk=%02x\n", $num_trks_dsk);
|
||||||
|
print sprintf("num_secs_dsk=%02x\n", $num_secs_dsk);
|
||||||
|
print sprintf("num_bytes_sec=%04x\n", $num_bytes_sec);
|
||||||
|
print "bit_map_free_secs=";
|
||||||
|
my @bytes = unpack "C*", $bit_map_free_secs;
|
||||||
|
foreach my $byte (@bytes) {
|
||||||
|
print sprintf("%02x ", $byte);
|
||||||
|
}
|
||||||
|
print "\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
return $trk_num_1st_cat_sec, $sec_num_1st_cat_sec, $rel_num_dos, $dsk_vol_num, $max_tslist_secs, $last_trk_secs_alloc, $dir_trk_alloc, $num_trks_dsk, $num_secs_dsk, $num_bytes_sec, $bit_map_free_secs;
|
||||||
|
}
|
||||||
|
|
||||||
|
#
|
||||||
|
# Get VTOC Sector
|
||||||
|
#
|
||||||
|
sub get_vtoc_sec {
|
||||||
|
my ($dskfile) = @_;
|
||||||
|
|
||||||
|
my $buf;
|
||||||
|
|
||||||
|
if (rts($dskfile, $vtoc_trk, $vtoc_sec, \$buf)) {
|
||||||
|
dump_sec($buf) if $debug;
|
||||||
|
return parse_vtoc_sec($buf);
|
||||||
|
}
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
#
|
||||||
|
# Parse a sector of a track/sector list
|
||||||
|
#
|
||||||
|
sub parse_tslist_sec {
|
||||||
|
my ($buf) = @_;
|
||||||
|
|
||||||
|
#dump_sec($buf);
|
||||||
|
# Track/Sector ListFormat
|
||||||
|
#
|
||||||
|
# 00 Not used
|
||||||
|
# 01 Track number of next T/S List sector if one was needed or zero if no more T/S List sectors.
|
||||||
|
# 02 Sector number of next T/S List sector (if present).
|
||||||
|
# 03-04 Not used
|
||||||
|
# 05-06 Sector offset in file of the first sector described by this list.
|
||||||
|
# 07-0b Not used
|
||||||
|
# 0c-0d Track and sector of first data sector or zeros
|
||||||
|
# 0e-0f Track and sector of second data sector or zeros
|
||||||
|
# 10-ff Up to 120 more Track/Sector pairs
|
||||||
|
#
|
||||||
|
#$tslist_fmt_tmpl = 'xCCx2vx5a122';
|
||||||
|
my @secs = ();
|
||||||
|
|
||||||
|
my ($next_tslist_trk, $next_tslist_sec, $soffset, $tslist) = unpack $tslist_fmt_tmpl, $buf;
|
||||||
|
|
||||||
|
if ($debug) {
|
||||||
|
print "tslist=";
|
||||||
|
my @bytes = unpack "C*", $tslist;
|
||||||
|
foreach my $byte (@bytes) {
|
||||||
|
print sprintf("%02x ", $byte);
|
||||||
|
}
|
||||||
|
print "\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
my $tmpl = '';
|
||||||
|
for (my $ts = 0; $ts < 122; $ts++) {
|
||||||
|
$tmpl .= 'CC';
|
||||||
|
}
|
||||||
|
my (@tsl) = unpack $tmpl, $tslist;
|
||||||
|
|
||||||
|
for (my $ts = 0; $ts < 122; $ts++) {
|
||||||
|
my $sec = pop @tsl;
|
||||||
|
my $trk = pop @tsl;
|
||||||
|
last unless defined $trk;
|
||||||
|
last if $trk eq '';
|
||||||
|
next if $trk == 0 && $sec == 0;
|
||||||
|
#print "trk=$trk sec=$sec\n";
|
||||||
|
unshift @secs, { 'trk' => $trk, 'sec' => $sec };
|
||||||
|
}
|
||||||
|
|
||||||
|
return $next_tslist_trk, $next_tslist_sec, @secs;
|
||||||
|
}
|
||||||
|
|
||||||
|
#
|
||||||
|
# Get a sector of a track/sector list
|
||||||
|
#
|
||||||
|
sub get_tslist_sec {
|
||||||
|
my ($dskfile, $tslist_trk, $tslist_sec) = @_;
|
||||||
|
|
||||||
|
my $buf;
|
||||||
|
|
||||||
|
if (rts($dskfile, $tslist_trk, $tslist_sec, \$buf)) {
|
||||||
|
dump_sec($buf) if $debug;
|
||||||
|
return parse_tslist_sec($buf);
|
||||||
|
}
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
#
|
||||||
|
# Get a track/sector list
|
||||||
|
#
|
||||||
|
sub get_tslist {
|
||||||
|
my ($dskfile, $tslist_trk, $tslist_sec) = @_;
|
||||||
|
|
||||||
|
my ($next_tslist_trk, $next_tslist_sec) = ($tslist_trk, $tslist_sec);
|
||||||
|
my @secs = ();
|
||||||
|
do {
|
||||||
|
($next_tslist_trk, $next_tslist_sec, @secs) = get_tslist_sec($dskfile, $next_tslist_trk, $next_tslist_sec);
|
||||||
|
if (defined $next_tslist_trk && $next_tslist_trk ne '') {
|
||||||
|
push @secs, { 'trk' => $next_tslist_trk, 'sec', $next_tslist_sec };
|
||||||
|
}
|
||||||
|
} while ($next_tslist_trk != 0);
|
||||||
|
|
||||||
|
return @secs;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub find_file {
|
||||||
|
my ($dskfile, $filename) = @_;
|
||||||
|
|
||||||
|
my ($trk_num_1st_cat_sec, $sec_num_1st_cat_sec, $rel_num_dos, $dsk_vol_num, $max_tslist_secs, $last_trk_secs_alloc, $dir_trk_alloc, $num_trks_dsk, $bit_map_free_secs) = get_vtoc_sec($dskfile);
|
||||||
|
|
||||||
|
if (defined $trk_num_1st_cat_sec && $trk_num_1st_cat_sec ne '') {
|
||||||
|
my ($next_cat_trk, $next_cat_sec) = ($trk_num_1st_cat_sec, $sec_num_1st_cat_sec);
|
||||||
|
my @files = ();
|
||||||
|
do {
|
||||||
|
($next_cat_trk, $next_cat_sec, @files) = get_cat_sec($dskfile, $next_cat_trk, $next_cat_sec);
|
||||||
|
if (defined $next_cat_trk && $next_cat_trk ne '') {
|
||||||
|
foreach my $file (@files) {
|
||||||
|
my $fn = $file->{'filename'};
|
||||||
|
$fn =~ s/\s+$//g;
|
||||||
|
if ($fn eq $filename) {
|
||||||
|
#print "trk=$file->{'trk'} sec=$file->{'sec'}\n";
|
||||||
|
return $file->{'trk'}, $file->{'sec'};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} while ($next_cat_trk != 0);
|
||||||
|
} else {
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
print "File $filename NOT FOUND\n";
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub read_file {
|
||||||
|
my ($dskfile, $filename, $mode, $conv, $dbg) = @_;
|
||||||
|
|
||||||
|
$mode = '' unless defined $mode;
|
||||||
|
$conv = 0 unless defined $conv;
|
||||||
|
|
||||||
|
if (defined $dbg && $dbg) {
|
||||||
|
$debug = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
my ($trk, $sec) = find_file($dskfile, $filename);
|
||||||
|
if ($trk) {
|
||||||
|
my $buf;
|
||||||
|
|
||||||
|
my @secs = get_tslist($dskfile, $trk, $sec);
|
||||||
|
foreach my $sec (@secs) {
|
||||||
|
next if $sec->{'trk'} == 0 && $sec->{'sec'} == 0;
|
||||||
|
#print "**** trk=$sec->{'trk'} sec=$sec->{'sec'}\n";
|
||||||
|
if (rts($dskfile, $sec->{'trk'}, $sec->{'sec'}, \$buf)) {
|
||||||
|
dump_sec($buf) if $debug;
|
||||||
|
#my @bytes = unpack "C$sec_size", $buf;
|
||||||
|
my @bytes = unpack "C*", $buf;
|
||||||
|
foreach my $byte (@bytes) {
|
||||||
|
# For text file translation.
|
||||||
|
last if $byte == 0x00 && $mode eq 'T';
|
||||||
|
# Translate \r to \n
|
||||||
|
$byte = 0x0a if $byte == 0x8d && $conv;
|
||||||
|
# Convert Apple II ASCII to standard ASCII (clear high bit)
|
||||||
|
$byte &= 0x7f if $mode eq 'T';
|
||||||
|
#print sprintf("%c", $byte & 0x7f);
|
||||||
|
print sprintf("%c", $byte);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
#
|
||||||
|
# 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;
|
||||||
|
|
||||||
12
README
Normal file
12
README
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
TODO:
|
||||||
|
|
||||||
|
catalog -- mostly working
|
||||||
|
read -- mostly working for simple text files
|
||||||
|
write
|
||||||
|
umlock
|
||||||
|
lock
|
||||||
|
rename
|
||||||
|
delete
|
||||||
|
copy
|
||||||
|
disk zap/sector editor
|
||||||
|
|
||||||
21
catalog.pl
Normal file
21
catalog.pl
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
#!/usr/bin/perl -w
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
|
||||||
|
use DOS33;
|
||||||
|
|
||||||
|
my $debug = 0;
|
||||||
|
|
||||||
|
while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||||
|
if ($ARGV[0] eq '-d') {
|
||||||
|
$debug = 1;
|
||||||
|
shift;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $dskfile = shift or die "Must supply filename\n";
|
||||||
|
|
||||||
|
catalog($dskfile, $debug);
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
48
dos33read.pl
Normal file
48
dos33read.pl
Normal file
@ -0,0 +1,48 @@
|
|||||||
|
#!/usr/bin/perl -w
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
|
||||||
|
use DOS33;
|
||||||
|
|
||||||
|
my $mode = 'T';
|
||||||
|
my $conv = 1;
|
||||||
|
my $debug = 0;
|
||||||
|
|
||||||
|
while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||||
|
if ($ARGV[0] eq '-m' && defined $ARGV[1] && $ARGV[1] ne '') {
|
||||||
|
if ($ARGV[1] eq 'T') {
|
||||||
|
$mode = 'T';
|
||||||
|
$conv = 1;
|
||||||
|
} elsif ($ARGV[1] eq 'I') {
|
||||||
|
$mode = 'I';
|
||||||
|
$conv = 0;
|
||||||
|
} elsif ($ARGV[1] eq 'A') {
|
||||||
|
$mode = 'A';
|
||||||
|
$conv = 0;
|
||||||
|
} elsif ($ARGV[1] eq 'B') {
|
||||||
|
$mode = 'B';
|
||||||
|
$conv = 0;
|
||||||
|
} elsif ($ARGV[1] eq 'S') {
|
||||||
|
$mode = 'S';
|
||||||
|
$conv = 0;
|
||||||
|
} else {
|
||||||
|
die "Unknown mode for -m, must be T, I, A, B or S\n";
|
||||||
|
}
|
||||||
|
shift;
|
||||||
|
shift;
|
||||||
|
} elsif ($ARGV[0] eq '-c') {
|
||||||
|
$conv = 0;
|
||||||
|
shift;
|
||||||
|
} elsif ($ARGV[0] eq '-d') {
|
||||||
|
$debug = 1;
|
||||||
|
shift;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $dskfile = shift or die "Must supply filename\n";
|
||||||
|
my $filename = shift or die "Must supply filename\n";
|
||||||
|
|
||||||
|
read_file($dskfile, $filename, $mode, $conv, $debug);
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
21
freemap.pl
Normal file
21
freemap.pl
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
#!/usr/bin/perl -w
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
|
||||||
|
use DOS33;
|
||||||
|
|
||||||
|
my $debug = 0;
|
||||||
|
|
||||||
|
while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
|
||||||
|
if ($ARGV[0] eq '-d') {
|
||||||
|
$debug = 1;
|
||||||
|
shift;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $dskfile = shift or die "Must supply filename\n";
|
||||||
|
|
||||||
|
freemap($dskfile, $debug);
|
||||||
|
|
||||||
|
1;
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user