#!/usr/bin/perl # # Copyright (c) 1997-2024 Robert Munafo # License: Creative Commons Attribution-NonCommercial 4.0 International # Source: http://mrob.com/apple2/extract.txt # $bapropos = q` extract-apple-dos(1r) -- catalog and file listings from cap/nib/nyb Apple II disk images `; my($unused_header) = q@ (c) 1999-2019 Robert P. Munafo. _ __ _ ._ _ ._ _ |_ | _| ._ _ ._ _ |_ _ _ ._ _ | | | | ( ) | ) | L/ | | | | ( ) | ) ( ( ) | | | ~ ~ ~ ~ ~ '~ `-- ~ ~ ~ ~ ~ '~ " ~ ~ ~ ~ ~ This work is licensed under a Creative Commons Attribution 2.5 License, as defined here: http://creativecommons.org/licenses/by/2.5/ This means that you are free to copy and reuse any of this work (noncommercially) as long as you tell people where it is from. That is, you don't need my permission to post this material on your website, just mention that (some or all) of the ideas came from here, and include a clear and obvious link back to this page. You're also welcome to use my ideas in not-for-profit publications, curricula for seminars, and other educational activities (all with appropriate attribution). If you want to use them in a commercial activity or event, or if you're not sure whether your use is noncommercial, feel free to contact me (big email address above) and ask. Wording based partly on xkcd's, because xkcd = A(G[64], G[64])! For more perl goodness, go to mrob.com/pub/perl @; $help = q@ NAME extract-apple-dos - catalog and file listings from cap/nib/nyb Apple II disk images This script can read Apple II disk image files whose names end in .cap or .nib/.nyb and also accepts ".cap.gz", ".nib.gz" or ".nyb.gz" (which are GZIP-compressed). It can display catalogs and list contents of textfiles and both types of BASIC; anything else will be shown as a binary listing, 24 bytes per line with hexadecimal and ASCII side by side. CAP files can be converted into the common DSK format using my #makedsk# program in .../proj/makedsk EXAMPLES extract-apple-dos disk.cap Generates a catalog listing of the given disk. extract-apple-dos disk.cap 'FILE NAME' Prints out the contents of the given file from the given disk. FILES ~/1-Museum/1981-Catakig/Disks ~/1-Museum/1981-OSXII/Disks/0-RPM/ - Contains Apple II emulators and disk images. Catakig only works on Macs with Classic mode (to emulate the 68K) ~/1-Museum/1997-SheepShaver - Within this emulator is a Catakig and disk images, so you can run the Apple II emulation inside 68K Mac emulation. ~/shared/proj/makedsk - Contains most of my original disk images @; $unused_header = q@ REVISION HISTORY 20070907 First version. Parses VTOC, catalog, TS lists, and Applesoft data format. 20070908 Add Binary/Hex output formatter and -h option; complete list of Applesoft tokens. 20070909 Add Integer BASIC parser, with partial list of tokens. 20070910 -h option can now be given at end of argument list 20070911 Begin writing &read_nib 20070913 Pretty much get read_nib working. 20090810 Add display of number of free blocks (currently assumes the standard 31 * 16 = 496) 20100923 Clean up formatting, add help, fix "rpmlib.pl" error 20110818 Add a few comments 20200628 Mention DSK files in help; add some comments @; # Set up the %unhex hash that turns the CAP file encoding into normal # hexadecimal. The letters A-P map onto 0-9A-F, so for example at the # beginning of 01FOLLY5.cap is "AB KF CH MJ ...", which is "01 A5 27 C9 ..." sub init_unhex { my($i, $j, $a, $b, $k); for($i=0; $i<16; $i++) { $a = chr(65 + $i); for($j=0; $j<16; $j++) { $b = chr(65 + $j); $k = $a . $b; $unhex{$k} = ($i * 16) + $j; } } } sub tso { my($t, $s, $o) = @_; return($dd[(($t * 16) + $s) * 256 + $o]); } sub ascii1 { my($c, $shownull) = @_; if ($c > 127) { $c = $c - 128; } if ($c == 0) { $c = $shownull ? "." : ""; } elsif (($c > 126) || ($c < 32)) { $c = "."; } else { $c = chr($c); } return $c; } # End of ascii1 sub getname { my($t, $s, $o) = @_; my($i, $c, $n); $n = ""; for($i = 0; $i<30; $i++) { $c = &tso($t, $s, $o+$i); $c = &ascii1($c, 0); $n .= $c; } $n =~ s| +$||; return $n; } sub addsector { my($dt, $ds) = @_; my($i); for($i=0; $i<256; $i++) { $data[$datalen] = &tso($dt, $ds, $i); $datalen++; } } sub output_T { my($i); for($i=0; $i<$datalen; $i++) { print &ascii1($data[$i], 0); } print "\n"; } # Integer BASIC token table # %Itoken = ( 1 => "null", # End of line 3 => ": ", 4 => "LOAD ", 5 => "SAVE ", 6 => "CON ", 8 => "RUN ", 9 => "DEL ", 10 => ",", # after DEL 11 => "NEW ", 12 => "CLR ", 13 => "AUTO ", 14 => ",", 15 => "MAN ", 16 => "HIMEM:", 17 => "LOMEM:", 18 => "+", 19 => "-", 20 => "*", 21 => "/", 22 => "=", 23 => "#", 24 => ">=", 25 => ">", 26 => "<=", 27 => "<>", 28 => "<", 29 => " AND ", 30 => " OR ", 31 => " MOD ", 34 => "(", 35 => ",", 36 => " THEN ", 37 => " THEN ", 38 => ",", 39 => ",", 40 => '"', # Opening quote 41 => '"', # Closing quote 42 => "(", # Substring 45 => "(", # Array aubscript 46 => " PEEK ", 47 => " RND ", 48 => " SGN ", 50 => " PDL ", 52 => "(", 54 => "-", # Unary minus 55 => "NOT ", 56 => "(", 57 => "=", # When comparing strings 58 => "#", # When comparing strings 59 => "LEN(", 63 => "(", 64 => "\$", # String variable 66 => "(", # Assign to substring 67 => ",", 68 => ",", 69 => ";", 70 => ";", 71 => ";", 75 => "TEXT ", 76 => "GR ", 77 => "CALL ", 78 => "DIM ", 79 => "DIM ", 80 => "TAB ", 81 => "END ", 82 => "INPUT ", 83 => "INPUT ", 84 => "INPUT ", 85 => "FOR ", 86 => "=", # Loop variable assignment 87 => " TO ", 88 => " STEP ", 89 => "NEXT ", 90 => ",", 91 => "RETURN ", 92 => "GOSUB ", 93 => "REM ", 95 => "GOTO ", 96 => "IF ", 97 => "PRINT ", 98 => "PRINT ", 99 => "PRINT ", 100 => "POKE ", 101 => ",", 102 => "COLOR=", 103 => "PLOT ", 104 => ",", 105 => "HLIN ", 106 => ",", 107 => " AT ", 108 => "VLIN ", 109 => ",", 110 => " AT ", 111 => "VTAB ", 112 => "=", # String assignment 113 => "=", # Numeric assignment 114 => ")", 119 => " POP ", ); # End of Itoken # Integer BASIC lister, using token table %Itoken above sub output_I { my($i, $j); my($tl, $llen, $num, $c, $line_end); $i = 0; # Get total length $tl = $data[$i] + 256 * ($data[$i+1]); $i += 2; while($i < ($tl + 2)) { # Get length of next line $llen = $data[$i]; $line_end = $i + $llen; $i += 1; # for($j=$i; $j<$line_end; $j++) { printf("%02X ", $data[$j]); } print"\n"; if ($llen < 0) { # %%% There will be a test here for prematurely ending programs # or other early exit conditions. $i = $tl + 3; } else { # Get line number $num = $data[$i] + 256 * ($data[$i+1]); $i += 2; printf(" %5d ", $num); # Get tokens $can_integer = 1; while($i < $line_end) { $c = $data[$i]; $i++; if (0) { } elsif ($c == 40) { $quotemode = 1; print '"'; $can_integer = 0; } elsif ($c == 41) { $quotemode = 0; print '"'; $can_integer = 1; } elsif ($c == 93) { $quotemode = 1; print "REM "; $can_integer = 0; } elsif ($Itoken{$c} ne "") { $c = $Itoken{$c}; $c =~ s|null||; print $c; $can_integer = 1; } elsif ($c < 128) { print " token{$c} "; $can_integer = 1; } elsif (($quotemode == 0) && $can_integer && ($c >= 176) && ($c <= 185)) { # An integer constant $c = $data[$i]; $i++; $c += 256 * $data[$i]; $i++; printf("%d",$c); } else { $c -= 128; if ($c == 0) { # Just skip the nulls } elsif ($c == 127) { print ("^?"); } elsif ($c < 32) { print ("^" . chr(64 + $c)); } else { print(chr($c)); } $can_integer = (($c < ord("A")) || ($c > ord("Z"))); # print "[$c|$can_integer]"; } } print "\n"; $quotemode = 0; } } } # End of output.I # AppleSoft BASIC token table # %Atoken = ( 128 => " END ", 129 => " FOR ", 130 => " NEXT ", 131 => " DATA ", 132 => " INPUT ", 133 => " DEL ", 134 => " DIM ", 135 => " READ ", 136 => " GR ", 137 => " TEXT ", 138 => " PR# ", 139 => " IN# ", 140 => " CALL ", 141 => " PLOT ", 142 => " HLIN ", 143 => " VLIN ", 144 => " HGR2 ", 145 => " HGR ", 146 => " HCOLOR= ", 147 => " HPLOT ", 148 => " DRAW ", 149 => " XDRAW ", 150 => " HTAB ", 151 => " HOME ", 152 => " ROT= ", 153 => " SCALE= ", 154 => " SHLOAD ", 155 => " TRACE ", 156 => " NOTRACE ", 157 => " NORMAL ", 158 => " INVERSE ", 159 => " FLASH ", 160 => " COLOR= ", 161 => " POP ", 162 => " VTAB ", 163 => " HIMEM: ", 164 => " LOMEM: ", 165 => " ONERR ", 166 => " RESUME ", 167 => " RECALL ", 168 => " STORE ", 169 => " SPEED= ", 170 => " LET ", 171 => " GOTO ", 172 => " RUN ", 173 => " IF ", 174 => " RESTORE ", 175 => " & ", 176 => " GOSUB ", 177 => " RETURN ", 178 => " REM ", 179 => " STOP ", 180 => " ON ", 181 => " WAIT ", 182 => " LOAD ", 183 => " SAVE ", 184 => " DEF ", 185 => " POKE ", 186 => " PRINT ", 187 => " CONT ", 188 => " LIST ", 189 => " CLEAR ", 190 => " GET ", 191 => " NEW ", 192 => " TAB( ", 193 => " TO ", 194 => " FN ", 195 => " SPC( ", 196 => " THEN ", 197 => " AT ", 198 => " NOT ", 199 => " STEP ", 200 => " + ", 201 => " - ", 202 => " * ", 203 => " / ", 204 => " ^ ", 205 => " AND ", 206 => " OR ", 207 => " > ", 208 => " = ", 209 => " < ", 210 => " SGN ", 211 => " INT ", 212 => " ABS ", 213 => " USR ", 214 => " FRE ", 215 => " SCRN( ", 216 => " PDL ", 217 => " POS ", 218 => " SQR ", 219 => " RND ", 220 => " LOG ", 221 => " EXP ", 222 => " COS ", 223 => " SIN ", 224 => " TAN ", 225 => " ATN ", 226 => " PEEK ", 227 => " LEN ", 228 => " STR\$ ", 229 => " VAL ", 230 => " ASC ", 231 => " CHR\$ ", 232 => " LEFT\$ ", 233 => " RIGHT\$ ", 234 => " MID\$ ", ); # End of Atoken # AppleSoft BASIC lister, using token table %Atoken above # # Examples: # 13 8 10 0 58 129 73 208 48 193 53 0 20 8 20 0 186 ... # 10 : FOR I = 0 TO 5 # # 12 8 10 0 129 73 208 48 193 53 0 19 8 20 0 186 ... # 10 FOR I = 0 TO 5 sub output_A { my($i); my($tl, $nl, $num, $c); $i = 0; # Get total length $tl = $data[$i] + 256 * ($data[$i+1]); $i += 2; while($i < ($tl + 2)) { # Get pointer to next line $nl = $data[$i] + 256 * ($data[$i+1]); $i += 2; if ($nl == 0) { # Time to exit now. Note: Applesoft programs sometimes have extra data # beyond the last valid program line but within the bytes counted by # the first two bytes. (BACH...AGAIN2 is an example of this). $i = $tl + 3; } else { # Convert it to file offset $nl = ($nl - 2049) + 2; # Get line number $num = $data[$i] + 256 * ($data[$i+1]); $i += 2; printf(" %5d ", $num); # Get tokens while($i < $nl) { $c = $data[$i]; $i++; if ($Atoken{$c} ne "") { print $Atoken{$c}; } elsif ($c >= 128) { print " token{$c} "; } elsif ($c == 0) { # Just skip the nulls } elsif ($c < 32) { print ("^" . chr(64 + $c)); } else { print(chr($c)); } } print "\n"; } } } # End of output.A # Hexdump output. I would eventually like to have options to specify # assembly listing and HGR graphics conversion (to either ASCII graphics # or TIFF). sub output_H { my($B) = @_; my($r, $i, $base, $len, $addr); if ($B) { $addr = $data[0] + (256*$data[1]); $len = $data[2] + (256*$data[3]); # If it is type R, there is a third 16-bit length field giving the # length of the program data alone. If I really care about R files, # I could parse this length and dump the dictionary. printf("Binary file load address %04X (%d decimal)\n", $addr, $addr); printf(" Length %04X (%d decimal)\n", $len, $len); $base = 4; } else { $base = 0; $len = $datalen; } for($r=0; $r<$len; $r+=24) { printf("%4X ", $r); for($i=0; $i<24; $i++) { if ($r+$i < $len) { printf("%02X", $data[$base+$r+$i]); } else { print " "; } } print " "; for($i=0; ($i<24) && ($r+$i < $len); $i++) { $c = $data[$base+$r+$i]; $c = &ascii1($c, 1); print $c; } print "\n"; } } sub get_file { my($at, $as, $type, $name) = @_; my($i, $t, $s, $dt, $ds); $datalen = 0; while($at || $as) { # print "at $at as $as\n"; # Get location of next TS List $t = &tso($at, $as, 1); $s = &tso($at, $as, 2); if (($t > 35) || ($s > 15)) { print "Invalid track/sector $t/$s\n"; exit 1; } $i = &tso($at, $as, 5) + (256 * &tso($at, $as, 6)); if ($i * 256 != $datalen) { print "Sector offset of TS list is out of sequence\n"; exit 1; } $i = 0x0c; $dt = &tso($at, $as, $i); $ds = &tso($at, $as, $i+1); # print "dt $dt ds $ds\n"; while($i > 0) { if ($dt || $ds) { # read a data sector here # print "add $dt $ds\n"; &addsector($dt, $ds); } else { # no more sectors $i = -10; } # Look at next allocated sector $i = $i + 2; if ($i > 0xff) { # Signal that it's time to get another TS List $i = -10; } else { $dt = &tso($at, $as, $i); $ds = &tso($at, $as, $i+1); } } # Go to next TS List $at = $t; $as = $s; } # print "Data length is $datalen\n"; if ($hexdump) { &output_H(0); # raw file hex dump } elsif ($type eq "B") { &output_H(1); # Binary file hex dump } elsif ($type eq "R") { &output_H(1); # Binary file hex dump } elsif ($type eq "T") { &output_T(); } elsif ($type eq "I") { &output_I(); } elsif ($type eq "A") { &output_A(); } else { print "No data output routine for type '$type'\n"; exit 0; } } # read in a .cap format file sub read_cap { my($l, $track, $sector, $base, $col, $byte); print "Reading disk..."; if ($diskname =~ m|\.cap\.gz$|) { $diskname = "cat '$diskname' | gunzip |"; } open(IN, $diskname); while($l = ) { chomp $l; if ($l =~ m|---T([0-9]+)---S([0-9]+)---|) { $track = $1; $sector = $2; # print "t$track" . "s$sector"; $base = (($track * 16) + $sector) * 256; $offset = 0; } elsif ($l =~ m|^[A-P][A-P] [A-P ]+$|) { $col = 0; $l .= " "; while ($col < 16) { if ($l =~ m|^([A-P][A-P]) ([A-P ]*)$|) { $byte = $1; $l = $2; $dd[$base + $offset] = $unhex{$byte}; $col++; $offset++; } else { print "patmatch err |$l|\n"; exit 0; } } if ($l ne " ") { print "extra data |$l|\n"; exit 0; } } } print "\n"; close IN; } %hd1 = ( "0" => 0, "1" => 1, "2" => 2, "3" => 3, "4" => 4, "5" => 5, "6" => 6, "7" => 7, "8" => 8, "9" => 9, "A" => 10, "B" => 11, "C" => 12, "D" => 13, "E" => 14, "F" => 15, ); sub hex_dec { my($h) = @_; my($c1, $c2, $rv); $rv = 0; $h = uc($h); if ($h =~ m/([0-9A-F])([0-9A-F])/) { $c1 = $1; $c2 = $2; $rv = ($hd1{$c1} * 16) + $hd1{$c2}; } return $rv; } # 6+2 nybble decode table # %decode62 = ( "96" => "00", "b4" => "10", "d6" => "20", "ed" => "30", "97" => "01", "b5" => "11", "d7" => "21", "ee" => "31", "9a" => "02", "b6" => "12", "d9" => "22", "ef" => "32", "9b" => "03", "b7" => "13", "da" => "23", "f2" => "33", "9d" => "04", "b9" => "14", "db" => "24", "f3" => "34", "9e" => "05", "ba" => "15", "dc" => "25", "f4" => "35", "9f" => "06", "bb" => "16", "dd" => "26", "f5" => "36", "a6" => "07", "bc" => "17", "de" => "27", "f6" => "37", "a7" => "08", "bd" => "18", "df" => "28", "f7" => "38", "ab" => "09", "be" => "19", "e5" => "29", "f9" => "39", "ac" => "0a", "bf" => "1a", "e6" => "2a", "fa" => "3a", "ad" => "0b", "cb" => "1b", "e7" => "2b", "fb" => "3b", "ae" => "0c", "cd" => "1c", "e9" => "2c", "fc" => "3c", "af" => "0d", "ce" => "1d", "ea" => "2d", "fd" => "3d", "b2" => "0e", "cf" => "1e", "eb" => "2e", "fe" => "3e", "b3" => "0f", "d3" => "1f", "ec" => "2f", "ff" => "3f", ); # Decode and de-nybble-ize a sector. On input, the 343+7 bytes of the # data sector will be in the array $nybbles[] sub denib62 { my($track, $sector) = @_; my($base, $i, $j, $k, $n, $d, $e, $c); # print "-$nybbles[143]"; $base = (($track * 16) + $sector) * 256; # decode for($i=0; $i<343; $i++) { $n = $nybbles[3+$i]; $d = $decode62{$n}; if ($d ne "") { $data62[$i] = $d; } else { print "invalid nybble $n at t$track s$sector d$i\n"; return; } } # convert from hex to numbers for($i=0; $i<343; $i++) { $data62[$i] = &hex_dec($data62[$i]); } # un-XOR and checksum $c = 0; for($i=0; $i<343; $i++) { $c = $c ^ $data62[$i]; $data62[$i] = $c; } if ($c != 0) { print "denib62: nonzero checksum in t$track s$sector\n"; return 0; } # Now the 0 and 1 bits are in bytes 0-85, and bits 2 through 7 are in bytes # 86-341 (byte 342 was the checksum, no longer needed) # 0 0 0 x x Z0 Z1 A0 A1 # 1 0 0 x x x x B0 B1 # 2 . . . # 85 0 0 x x x x Y0 Y1 # 86 0 0 A7 A6 A5 A4 A3 A2 # 87 0 0 B7 B6 B5 B4 B3 B2 # ... # 341 0 0 z7 z6 z5 z4 z3 z2 # Here is the original 6502 code that performs this operation: # (B8C2) # POSTNB16 LDY #0 # POSTNIB1 LDX #$56 ;(decimal #86.) # POSTNIB2 DEX # BMI POSTNIB1 # LDA RWTSBUF1,Y ;Set (a) = 6-encoded byte. # LSR RWTSBUF2,X ;Put lower 2 bits of 2-encoded # ROL ;byte into original 6-encoded byte # LSR RWTSBUF2,X ;to get normal memory byte. # ROL # STA (PTR2BUF),Y ;Put normal memory byte in # INY ;RWTS's buffer (normally DOS # CPY PROSCRTH ;data sector buffer). # BNE POSTNIB2 # (B8D8) RTS for($i=0; $i<256; $i++) { $j = $i % 86; $k = 2*(int($i/86)); $d = $data62[86+$i]; $e = $data62[$j]; $dd[$base + $i] = ($d << 2) | ((($e >> $k) & 1) << 1) | ((($e >> $k) & 2) >> 1); } } #@interleave = (0, 0x0d, 0x0b, 9, 7, 5, 3, 1, # 0x0e, 0x0c, 0x0a, 8, 6, 4, 2, 0x0f); @interleave = (0, 7, 0x0e, 6, 0x0d, 5, 0x0c, 4, 0x0b, 3, 0x0a, 2, 9, 1, 8, 0x0f); # read in a .nib format file sub read_nib { my($l, $track, $sector, $base, $nyb, $gg, $dobyte, $state); my($i, $j); print "Reading nybble format..."; $diskname = "od -v -t x1 '$diskname' |"; open(IN, $diskname); $l = ""; $gg = 1; $state = "sync"; while ($gg) { $dobyte = 0; # Remove initial offset address if any if ($l =~ m/^([0-7][0-7][0-7]+) (.*)$/) { $adr = $1; $l = $2; } if ($l =~ m|^ +([0-9a-f][0-9a-f]) (.*)$|) { $nyb = $1; $l = $2; # $nyb = &hex_dec($nyb); $dobyte = 1; } else { if ($l = ) { # fine, we got a line chomp $l; $l .= " "; } else { # end of file $gg = 0; } } if ($dobyte) { if ($state eq "sync") { # Scanning for prologue if ($nyb eq "d5") { $i = 0; $nybbles[$i++] = $nyb; $state = "adr"; } } elsif ($state eq "adr") { $nybbles[$i++] = $nyb; if ($i == 14) { # Okay, we should have a full address field now. Here is an example # (volume 254, track 3, sector 7): # 0 1 2 3 4 5 6 7 8 9 10 11 12 13 # D5 AA 96 FF FE AB AB AB AF FF FA DE AA EB # %%% verify prologue, epilogue, and checksum. In emulator-generated # disks the epilogue seems to be missing its 3rd byte. $track = ((&hex_dec($nybbles[5]) << 1) | 1) & &hex_dec($nybbles[6]); $sector = ((&hex_dec($nybbles[7]) << 1) | 1) & &hex_dec($nybbles[8]); $sector = $interleave[$sector]; if (0) { printf("\n%s t%02d s%02d ", $adr, $track, $sector); for($j=0; $j<$i; $j++) { printf("%s ", $nybbles[$j]); } } $state = "sync2"; } } elsif ($state eq "sync2") { # Scanning for prologue if ($nyb eq "d5") { $i = 0; $nybbles[$i++] = $nyb; $state = "data"; } } else { $nybbles[$i++] = $nyb; if ($i == (343 + 7)) { # decode, de-nybblize and store in $dd[] array &denib62($track, $sector); $state = "sync"; } } # 8 + 21 + 20 + 5 # 8 + tri(6) + tet(4) + hypertet(2) } } print "\n"; close IN; } $| = 1; # Default options $hexdump = 0; # Read arguments and set options $i = 0; while($a = shift) { if ($a eq "-h") { $hexdump = 1; } else { $args[$i] = $a; $i++; } } if ($i == 0) { # No args given print $help; exit(0); } $diskname = $args[0]; $filename = $args[1]; &init_unhex(); if (!(-e $diskname)) { print "Cannot find disk image '$diskname'\n"; exit 1; } if ($diskname =~ m|\.n[iy]b$|) { &read_nib(); } else { # read_cap handles .cap or .cap.gz &read_cap(); } # Get VTOC info $k122 = &tso(17, 0, 0x27); if ($k122 != 122) { print "VTOC field 0x27 has unexpected value $k122\n"; exit 0; } $ct = &tso(17, 0, 1); $cs = &tso(17, 0, 2); if (($ct > 35) || ($cs > 15)) { print "Invalid track/sector $ct/$cs\n"; exit 1; } if ($filename eq "") { print "Catalog starts at T$ct S$cs\n"; } $total_len = 0; # parse out the catalog entries while ($ct || $cs) { for($fdi = 0x0b; $fdi < 256; $fdi += 35) { $tsl_t = &tso($ct, $cs, $fdi); $tsl_s = &tso($ct, $cs, $fdi+1); if ($tsl_t == 0xff) { # Deleted file. We could try to recover these some day } else { $name = &getname($ct, $cs, $fdi+3); $len = (&tso($ct, $cs, $fdi+0x22) * 256) + &tso($ct, $cs, $fdi+0x21); $total_len += $len; $type = &tso($ct, $cs, $fdi+2); $lock = (($type & 0x80) ? "*" : " "); $type = $type & 0x7f; if ($type == 0) { $type = "T"; } elsif ($type == 1) { $type = "I"; } elsif ($type == 2) { $type = "A"; } elsif ($type == 4) { $type = "B"; } elsif ($type == 16) { $type = "R"; } else { $type = "<$type>"; } if (($filename eq "") && ($name ne "")) { printf("%s%s %03d %s\n", $lock, $type, $len, $name); } elsif (($filename ne "") && ($name eq $filename)) { # print "get_file $name\n"; &get_file($tsl_t, $tsl_s, $type, $name); } } } # Get next catalog sector number $t = &tso($ct, $cs, 1); $s = &tso($ct, $cs, 2); # print "next $t $s\n"; if (($t > 35) || ($s > 15)) { print "Invalid track/sector $t/$s\n"; exit 1; } $ct = $t; $cs = $s; } if ($filename eq "") { $free = ((35-(3+1))*16) - $total_len; print "$free free blocks.\n"; }