Apple-2-Tools
/
ProDOS-perl
mirror of https://github.com/softwarejanitor/ProDOS.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Worked on lock & unlock

This commit is contained in:
Leeland Heins 2019-03-01 09:34:17 -06:00 committed by GitHub
parent 4a6d852866
commit 4573438df3
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 107 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
PO.pm
View File

@ -133,7 +133,11 @@ sub read_blk {
sub clear_buf {
my ($buf) = @_;
$$buf = pack "C*", 0x00 x 512;
$buf = pack "C*", 0x00 x 512;
$_[0] = $buf;
return $buf;
}
#
@ -153,7 +157,7 @@ sub write_blk {
seek($dfh, $pos, 0);
print $dfh $buf;
print $dfh $$buf;
close $dfh;

101
ProDOS.pm
View File

@ -1378,6 +1378,28 @@ sub get_vol_bit_map {
return @blocks;
}
#
# Count free blocks
#
sub freespace {
my ($pofile, $dbg) = @_;
$debug = 1 if defined $dbg && $dbg;
my (@blocks) = get_vol_bit_map($pofile, $debug);
my $free_blocks = 0;
foreach my $byte (@blocks) {
my $bits = sprintf("%08b", $byte);
$bits =~ s/[0]/\*/g;
$bits =~ s/[1]/ /g;
$free_blocks += $ones_count{($byte >> 4) & 0x0f}; # Blocks 7654
$free_blocks += $ones_count{$byte & 0x0f}; # Blocks 3210
}
return $free_blocks;
}
#
# Display blocks free map
#
@ -1465,6 +1487,43 @@ sub lock_file {
print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used eof=$eof header_pointer=$header_pointer i=$i\n";
return if $storage_type == 0;
my $buf;
if (read_blk($pofile, $header_pointer, \$buf)) {
dump_blk($buf) if $debug;
dump_blk($buf);
my @bytes = unpack "C*", $buf;
my $storage_type = $bytes[4] >> 4;
printf("storage_type=\$%02x\n", $storage_type);
if ($storage_type == 0x0f) {
# Volume Directory Header
#my ($prv_vol_dir_blk, $nxt_vol_dir_blk, @files) = parse_vol_dir_blk($buf, $debug);
#printf("access=\$%02x\n", $files[$i]->{'access'});
print "vol dir hdr\n";
my $access = $bytes[0x2b + (($i - 1) * 0x27) + 0x1e];
printf("access=\$%02x\n", $access);
$access &= 0x21;
printf("access=\$%02x\n", $access);
$bytes[0x2b + (($i - 1) * 0x27) + 0x1e] = $access;
} elsif ($storage_type == 0x0e) {
# Subdirectory Header
print "subdir hdr\n";
}
$buf = pack "C*", @bytes;
if (!write_blk($pofile, $header_pointer, \$buf)) {
return 0;
}
} else {
return 0;
}
return 1;
}
#
@ -1480,6 +1539,48 @@ sub unlock_file {
my ($storage_type, $file_type, $key_pointer, $blocks_used, $eof, $header_pointer, $i) = find_file($pofile, $filename, $debug);
print "storage_type=$storage_type file_type=$file_type key_pointer=$key_pointer blocks_used=$blocks_used eof=$eof header_pointer=$header_pointer i=$i\n";
return if $storage_type == 0;
my $buf;
if (read_blk($pofile, $header_pointer, \$buf)) {
dump_blk($buf) if $debug;
dump_blk($buf);
my @bytes = unpack "C*", $buf;
my $storage_type = $bytes[4] >> 4;
printf("storage_type=\$%02x\n", $storage_type);
if ($storage_type == 0x0f) {
# Volume Directory Header
#my ($prv_vol_dir_blk, $nxt_vol_dir_blk, @files) = parse_vol_dir_blk($buf, $debug);
#printf("access=\$%02x\n", $files[$i]->{'access'});
print "vol dir hdr\n";
my $access = $bytes[0x2b + (($i - 1) * 0x27) + 0x1e];
printf("access=\$%02x\n", $access);
$access |= 0x80;
$access |= 0x40;
$access |= 0x02;
$access |= 0x01;
printf("access=\$%02x\n", $access);
$bytes[0x2b + (($i - 1) * 0x27) + 0x1e] = $access;
} elsif ($storage_type == 0x0e) {
# Subdirectory Header
print "subdir hdr\n";
}
$buf = pack "C*", @bytes;
if (!write_blk($pofile, $header_pointer, \$buf)) {
return 0;
}
} else {
return 0;
}
return 1;
}
1;