#!/usr/bin/perl # # Copyright © 2024-2025 by Vincent Slyngstad # # Permission is hereby granted, free of charge, to any person obtaining # a copy of this software and associated documentation files (the # "Software"), to deal in the Software without restriction, including # without limitation the rights to use, copy, modify, merge, publish, # distribute, sublicense, and/or sell copies of the Software, and to # permit persons to whom the Software is furnished to do so, subject to # the following conditions: # # The above copyright notice and this permission notice shall be # included in all copies or substantial portions of the Software. # # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, # EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF # MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND # NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE # FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF # CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION # WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. # # Except as contained in this notice, the names of the authors above # shall not be used in advertising or otherwise to promote the sale, use # or other dealings in this Software without prior written authorization # from those authors. # # Look at a .dsk image and create a report similar to the RES/E command. # # # This routine reads the specified blocks of the disk image into the passed # array reference. The array upon return will contain the successive 12 bit # words of the specified block. # sub ReadBlocks { local($first, $last, *a) = @_; local($offset, $count); $offset = 256 * 2 * $first; seek(INPUT, $offset, 0) || die "seek($image): $!"; $count = read(INPUT, $buf, ($last-$first+1)*256*2); die "read($image): $!" if $count < 0; die "read($image): wrong count $!" if $count != ($last-$first+1)*256*2; @a = unpack("S*", $buf); } die "usage $0 \n" unless ($image = $ARGV[0]); open(INPUT, $image) || die "$image: $!"; binmode(INPUT); print "$image:\n"; # # Read the first directory block to determine if this is really an OS/8 # system volume. # &ReadBlocks(01, 06, *dir); die "$image: no OS/8 directory\n" unless $dir[0] & 04000; die "$image: not a system volume\n" unless $dir[1] == 0070; # # The USR routine can be found in blocks 013-015. # It has tables that can translate device names to # device numbers. # &ReadBlocks(013, 015, *usr); # # To locate devicedriver information below, we'll need the entry points # and location on disk for the various drivers. Load up a handler # description table. # Bit 0: Two page handler # Bits 1-4: Disk block - 15 # Bits 5-11: Version Number/Entry point offset # $htbl = $usr[037]; for ($i = 0; $i < 15; $i++) { $htbl[$i] = $usr[$htbl+$i]; } # # The user assignment table lives at 17741-17757, and are loaded from the # last half of the boot block. It appears user assignments aren't written # back to disk, so it is unclear if they are useful here. # # To disambiguate devices below, we'll also need the device types for the # various drivers. These live at 17760-17776, and are loaded from the # the boot block. Bits in ttbl[]: # Bit 0 File structured device # Bit 1 Read only device # Bit 2 Write only device # Bit 3-8 The device type # Bit 9-11 Current tentative file dirblk, if any # &ReadBlocks(0, 0, *boot); $utbl = 07741 & 0177; $ttbl = 07760 & 0177; for ($i = 0; $i < 15; $i++) { $utbl[$i] = $boot[$utbl+$i]; $ttbl[$i] = $boot[$ttbl+$i]; } # # BUGBUG: ttbl[] is wrong for some images!! #warn "@ntbl"; #warn "@ttbl"; # # Device types, for differentiation, but also for KIND determination. # $tty = 000; $ptr = 001; $ptp = 002; $cr8e = 003; $lptr = 004; $rk8 = 005; $rf08a= 006; $rf08b= 007; $rf08c= 010; $rf08d= 011; $df32a= 012; $df32b= 013; $df32c= 014; $df32d= 015; $tc08 = 016; $linc = 017; $tm8e = 020; $td8e = 021; $bat = 022; $rk8e = 023; $null = 024; $rx8e = 025; $ta8e = 027; $vr12 = 030; $dump = 036; $rl02 = 037; $sdsk = 064; # # Locate and read in the drivers, then fetch the version numbers. # for ($i = 0; $i < 15; $i++) { die "ttbl undef" unless @ttbl; $type = ($ttbl[$i]&0777) >> 3; $ktbl[$i] = ""; # No KIND yet if ($htbl[$i] == 0) { # Reference is to SYS $btbl[$i] = 0; $etbl[$i] = 07; $vtbl[$i] = $boot[0207]; } else { $block = ((($htbl[$i] & 03600) >> 7) & 017) + 015; &ReadBlocks($block, $block, *driver); $btbl[$i] = $block; $entry = $htbl[$i]&0177; $etbl[$i] = $entry; # BUGBUG: Version is only in unit 0 entry point?!?! $vtbl[$i] = $driver[$entry]; # While we have the driver, use arcane knowledge # to determine KIND. (TODO) die "tty undef" unless defined $tty; die "ptr undef" unless defined $ptr; die "ptp undef" unless defined $ptp; die "cr8e undef" unless defined $cr8e; die "lptr undef" unless defined $lptr; die "rk8e undef" unless defined $rk8e; if ($type == $tty) { $ktbl[$i] = "AS33"; # The two page handler is KL8E. $ktbl[$i] = "KL8E" if $htbl[$i] & 04000; } elsif (($type == $ptr) || ($type == $ptp)) { $ktbl[$i] = "KS33"; foreach $word (@driver) { # If there's an RSF, it is PT8E. if ($word == 06021) { $ktbl[$i] = "PT8E"; last; } } } elsif ($type == $cr8e) { # If we recognize the character set, set a type. $ktbl[$i] = "026" if $driver[0104] == 07735; $ktbl[$i] = "029" if $driver[0104] == 03203; } elsif ($type == $lptr) { foreach $word (@driver) { # If there's a 6652, it is L645. if ($word == 06021) { $ktbl[$i] = "L645"; last; } } if ($ktbl[$i] eq "") { # Not found, keep working # $ktbl[$i] = "LP08"; # TODO # $ktbl[$i] = "LS8E"; # TODO $ktbl[$i] = "LPSV" if $driver[0001] == 014; $ktbl[$i] = "LV8E" if $driver[0001] == 004; } } elsif ($type == $rk8e) { $ktbl[$i] = "RK05"; # TODO # TODO: Add cases for QRK8, PLAT[1-4], QTC08, QLINC, QTD8E, QRK8E, and QTA8E!! } } $vtbl[$i] = 0 if $vtbl[$i] > 032; #printf STDERR "Driver $i entry is 0%o\n", $etbl[$i]; #printf STDERR "Driver $i version is 0%o\n", $vtbl[$i]; #printf STDERR "Driver $i kind is %s\n", $ktbl[$i]; } @devicetype = ( # 00, 01, 02, 03, "TTY", "PTR", "PTP", "CR8E", # 04, 05, 06, 07, "LPTR", "RK8", "RF08", "RF08", # 10, 11, 12, 13, "RF08", "RF08", "DF32", "DF32", # 14, 15, 16, 17, "DF32", "DF32", "TC08", "LINC", # 20, 21, 22, 23, "TM8E", "TD8E", "BAT", "RK8E", # 24, 25, 26, 27, "NULL", "RX8E", "RL01", "TA8E", # 30, 31, 32, 33, "VR12", "", "RX02", "", # 34, 35, 36, 37, "", "", "DUMP", "RL02" ); sub TypeName { local($dev) = @_; local($type) = ($ttbl[$dev]&0777) >> 3; return $devicetype[$type] if $devicetype[$type]; return sprintf(" %02o", $type); } @devicesize = ( # "TTY", "PTR", "PTP", "CR8E", /00 00000, 00000, 00000, 00000, # "LPTR", "RK8", "RF08", "RF08", 00000, 01520, 06001, 04002, # "RF08", "RF08", "DF32", "DF32", /10 02003, 00004, 07601, 07402, # "DF32", "DF32", "TC08", "LINC", 07203, 07004, 06437, 06437, # "TM8E", "TD8E", "BAT", "RK8E", /20 00000, 06437, 00000, 01520, # "NULL", "RX8E", "RL01", "TA8E", 00000, 07022, 00017, 00000, # "VR12", "", "RX02", "", 00000, 00000, 06044, 00000, # "", "", "DUMP", "" 00000, 00000, "DUMP", 07017, 00000, 00000, 00000, 00000, 00000, 00000, 00000, 00000, 00000, 00000, 00000, 00000, 00000, 00000, 00000, 00000, 01520, 00000, 00000, 00000, ); # # Unfortunately the names are hashed for lookup, # and the full device name is not recoverable. # Here are the full device names; We'll hash them # for the reverse lookup. # # One and two character names are recoverable, and # need not be in this list. # @devices = ( "026", "029", "AS33", "AS34", "BAT", # "BUFF", "DSDH", # Hash collision "BYTE", "CDP", "CDR", "CLCK", "COM0", "COM1", "COMM", "CR8E", "CRT", "CSA0", "CSA1", # "CSAF", "RX2A", # Hash collision "CUMU", "DB8E", "DBL", "DCTP", "DDCM", # "DEV", "WNB7", # Hash collision "DEX1", "DEX2", "DEX3", "DEX4", "DEX5", "DEX6", "DEX7", "DF32", # "DIAB", "RX23", # Hash collision # "DIR", "RXC1", # Hash collision "DISP", # "DK0", "RXA3", # Hash collision "DKA0", "DKB0", "DSDL", "DSDU", "DSK", "DSK0", "DSK1", "DSK2", "DSK3", "DSK4", "DSK5", "DSK6", "DSK7", # "DTA", "LTY", # Hash collision "DTA0", "DTA1", "DTA2", "DTA3", "DTA4", "DTA5", "DTA6", # "DTA7", "R2SY", # Hash collision "DUMP", "DX0", "DX1", "DX2", "DY0", "DY1", "ETRX", "ETTT", "EXIT", "FD00", "FD01", "FD02", "FD03", "FDSK", # "FL23", "WNA1", # Hash collision "FLP0", "FLP1", "FLPY", # "HDX", "PDP", # Hash collision "HN21", "INP", "IPB", "KL8E", # "KLAD", "TM8C", # Hash collision "KS33", "KS40", "L645", "LA30", "LINC", "LIST", "LNC", "LPSV", "LPT", "LPTS", "LQP", "LQP0", "LQPR", "LST", # "LTA", "TTY", # Hash collision "LTA0", "LTA1", "LTA2", "LTA3", # "LTA4", "VC8E", # Hash collision "LTA5", "LTA6", "LTA7", "LV8E", "MDFL", "MDFS", "MDWN", "MDWS", "MIR1", "MIR2", "MIR3", "MIR4", "MIR5", "MIR6", "MIR7", "MTA", "MTA0", "MTA1", "MTA2", "MTA3", "MTA4", "MTA5", "MTA6", "MTA7", # "LPTR", "N210", # Hash collision "NULL", "NX12", # "OS8F", "RX5A", "TEST", # Hash collisions "OUT", "OUTP", "PDP8", "PDR", "PLTR", "PT8E", "PTP", "PTP4", "PTR", "PTR4", "PWRF", # "R01E", "R21C", # Hash collision # "R0AB", "RBA0", # Hash collision # "R0CD", "SDB0", # Hash collision "R1AB", # "R1CD", "SDB1", # Hash collision "R20A", "R20B", "R20C", "R20D", "R20E", "R21A", "R21B", "R21D", "R21E", "RD50", "RD51", "RD52", "RD53", "RD5A", "RD5B", "RDSY", "RF08", "RFD", "RK01", "RK05", "RK08", "RK8", "RK8E", "RKA0", "RKA1", "RKA2", "RKA3", "RKB0", "RKB1", "RKB2", "RKB3", "RL0", "RL0A", "RL0B", "RL0C", "RL1", "RL1A", "RL1B", "RL1C", "RL2", "RL2A", "RL2B", "RL2C", "RL3", # "RL3A", "WIND", # Hash collision "RL3B", "RL3C", "RLC", "RLSY", "ROM", "RTS8", "RX01", "RX02", "RX03", "RX0B", "RX1S", "RX2", "RX20", "RX21", # "RX22", "SX12", # Hash collision "RX2B", "RX2S", "RX3", "RX3S", "RX50", "RX51", "RX52", "RX53", "RX5B", "RX8", "RX8A", "RX8B", "RX8C", "RX8D", "RX8E", "RXA0", "RXA1", "RXA2", "RXB0", "RXB1", "RXC0", "RXCS", "RXD0", "RXD1", "RXH0", "S210", "SCAN", "SCOP", "SDA0", "SDA1", "SDA2", "SDA3", "SDB2", "SDB3", "SDIS", "SDNS", "SDSK", "SDSY", "SERL", "SIDK", "SLU", "SLU0", "SLU2", "SLU3", "SNAP", "SRV", "SRV1", "SRV2", "SWAP", "SYS", "TA8", # "TA8E", "TD8B", # Hash collision "TC08", "TC12", # "TD8", "VT50", # Hash collision "TD8A", "TD8C", "TD8D", "TD8E", "TIME", "TM8E", "TUA0", "TURI", "TVIN", "VAX", "VK8A", "VLU2", "VLU3", "VR12", "VT8E", "VXA0", "WDS2", "WDSK", "WNA0", "WNA2", "WNA3", "WNA4", "WNA5", "WNA6", "WNA7", "WNB0", "WNB1", "WNB2", "WNB3", "WNB4", "WNB5", "WNB6", "WSYS", "WW8E", "XTRA", ); foreach $dev (@devices) { @dev = unpack("C*", $dev); $hash1 = (077 & shift @dev) << 6; $hash1 += (077 & shift @dev) if @dev; $hash2 = 0; $hash2 = (077 & shift @dev) << 6 if @dev; $hash2 += (077 & shift @dev) if @dev; if ($hash2) { $hash1 += $hash2; $hash1 |= 04000; } $hash1 &= 07777; if (defined $devname{$hash1}) { printf STDERR "Hash value: 0%o\n", $hash1; warn "Hash collision: $dev and $devname{$hash1}"; } $devname{$hash1} = $dev; } # # There are enough special cases to warrant a function here. # (For instance, TDA0: and SDB0: have the same hash.) sub DevName { local($dev, $hash) = @_; local($type); # If the hash is one or two characters, just return them. #printf STDERR "hash = 0%o\n", $hash; if (!($hash & 04000)) { $c1 = $hash >> 6; $c2 = $hash & 077; $c1 += 0100 unless $c1 & 040; $c2 += 0100 unless $c2 & 040; $c2 = 0 if $c2 == 0100; return sprintf("%c%c", $c1, $c2); } # Deal with the unambiguous cases first. return $devname{$hash} if defined $devname{$hash}; # Disambiguation requires the device types to be known. die "Forgot to load ttbl" unless @ttbl; $type = ($ttbl[$dev]&0777) >> 3; # Special cases need disambiguation. # When in doubt, fail through. if ($hash == 04004) { # Hash collision: PDP and HDX return "PDP"; } if ($hash == 04042) { # Hash collision: N210 and LPTR return "LPTR"; } if ($hash == 04365) { # Hash collision: R21C and R01E } if ($hash == 04431) { # Hash collision: RX2A and CSAF } if ($hash == 04512) { # Hash collision: SX12 and RX22 return "RX22"; } if ($hash == 04513) { # Hash collision: RX23 and DIAB return "RX23"; } if ($hash == 04515) { # Hash collision: WIND and RL3A return "RL3A"; } if ($hash == 04524) { # Hash collision: LTY and DTA return "DTA"; } if ($hash == 04613) { # Hash collision: R2SY and DTA7 return "DTA7" if $type == $tc08; return "DTA7" if $type == $td8e; } if ($hash == 04731) { # Hash collision: "OS8F", "RX5A", and "TEST" return "RX5A"; } if ($hash == 05033) { # Hash collision: DSDH and BUFF return "DSDH" if $type == 050; return "BUFF"; } if ($hash == 05404) { # Hash collision: VT50 and TD8 return "TD8" if $type == $td8e; return "VT50"; } if ($hash == 05406) { # Hash collision: TD8B and TA8E return "TD8B" if $type == $td8e; return "TA8E"; } if ($hash == 05420) { # Hash collision: TM8C and KLAD return "TM8C"; } if ($hash == 05524) { # Hash collision: TTY and LTA return "TTY" if $type == $tty; return "LTA" if $type == $linc; return "LPAD" if $type == $lptr; } if ($hash == 05610) { # Hash collision: VC8E and LTA4 return "LTA4" if $type == $linc; return "VC8E"; } if ($hash == 06362) { # Hash collision: RBA0 and R0AB return "RBA0"; } if ($hash == 06413) { # Hash collision: RXA3 and DK0 return "RXA3" if $type == $rx8e; return "DK0"; } if ($hash == 06564) { # Hash collision: SDB0 and R0CD return "TDA0" if $type == $td8e; return "SDB0" if $type == $sdsk; } if ($hash == 06565) { # Hash collision: SDB1 and R1CD return "TDA1" if $type == $td8e; return "SDB1" if $type == $sdsk; } if ($hash == 06611) { # Hash collision: RXC1 and DIR } if ($hash == 07077) { # Hash collision: WNA1 and FL23 return "WNA1"; } if ($hash == 07205) { # Hash collision: WNB7 and DEV return "WNB7"; } # The original, I think, printed the octal hashcode in parenthesis. # We attempt to create some 3 or 4 letter name that would hash # correctly, allowing the user to access the device. $lh = ($hash >> 6) & 037; $lh += 040 unless $lh > 1; $rh = $hash & 077; if ($rh == 0) { $lh -= 1; $rh += 0100; } # Try to make x.A. $c1 = $lh - 1; $c3 = 1; # First must be alhpabetic if ($c1 > 031) { $c3 += $c1 - 031; $c1 = $lh - $c3; } die unless $lh == $c1 + $c3; # Try to make .x.[0-7] $c2 = $rh; # 3 character name, if possible. $c4 = 0; # Is c2 alphanumeric? if ($c2 > 071) { # Make c4 a digit $c4 = 060 + ($c2 & 07); $c2 -= $c4; } elsif (($c2 < 057) && ($c2 > 032)) { # Make c2 alphabetic $c4 = $c2 - 031; $c2 -= $c4; } die unless $rh == $c2 + $c4; die "c1: $c1 < 1" if $c1 < 1; die "c2: $c2 < 1" if $c2 < 1; die "c3: $c3 < 1" if $c3 < 1; die "c4: $c4 < 0" if $c4 < 0; $c1 += 0100 unless $c1 & 040; $c2 += 0100 unless $c2 & 040; $c3 += 0100 unless $c3 & 040; $c4 += 0100 unless $c4 & 040; $c4 = 0 if $c4 == 0100; #printf STDERR "hash = 0%o 0%o 0%o 0%o 0%o \n", $hash, $c1, $c2, $c3, $c4; return sprintf"%c%c%c#", $c1, $c2, $c3 unless $c4; return sprintf"%c%c%c%c#", $c1, $c2, $c3, $c4; } # # Extract the table of hashed names. # $ntbl = $usr[036]; for ($i = 0; $i < 15; $i++) { $ntbl[$i] = $usr[$ntbl+$i]; } # # A system volume has device drivers in blocks 016-025. # Each driver occupies 128 or 256 words of the 8 block region. # # # Print the tables. # print "# NAME TYPE MODE SIZ BLK KIND U V ENT USER\n"; for ($i = 0; $i < 15; $i++) { next unless $ntbl[$i]; printf "%02o ", $i+1; $name = &DevName($i, $ntbl[$i]); printf "%-5s", $name; printf "%-5s", &TypeName($i); print $ttbl[$i]&01000? " " : "R"; print $ttbl[$i]&02000? " " : "W"; print $ttbl[$i]&04000? "F" : " "; $type = ($ttbl[$i]&0777) >> 3; $size = $devicesize[$type]? 4096-$devicesize[$type]: 0; printf " %4s ", $size? $size: " "; printf "%02o%s", $btbl[$i], $htbl[$i]&04000? "+": " " if $btbl[$i]; printf "SYS" unless $btbl[$i]; printf " %-4s ", $ktbl[$i]; $unit = " "; $unit = $1 if $name =~ /[AB](\d)$/; $unit = "0" unless $btbl[$i]; # SYS printf "%s ", $unit; printf "%c ", $vtbl[$i]? 0100 + $vtbl[$i]: 040; printf "%3o ", $etbl[$i]; # BUGBUG: USER names aren't right!! # Apparently they are faithful to the media, but the hash codes there # aren't very useful. printf "%-5s", &DevName($i, $utbl[$i]) if $utbl[$i]; printf "\n"; } #.RES/E # #195 FILES IN 3062 BLOCKS USING 6 SEGMENTS #130 FREE BLOCKS (2 EMPTIES) # ## NAME TYPE MODE SIZ BLK KIND U V ENT USER #01 SYS 64 RWF SYS 0 E 07 #02 DSK 64 RWF SYS 0 E 07 #03 TTY TTY RW 16+ KL8E E 176 #04 RKA0 RK8E RWF 3248 17 RK05 0 A 20 #05 RKB0 RK8E RWF 3248 17 RK05 0 A 21 #06 RKA1 RK8E RWF 3248 17 RK05 1 A 22 #07 RKB1 RK8E RWF 3248 17 RK05 1 A 23 #10 RXA0 RX02 RWF 988 20+ 32 #11 RXA1 RX02 RWF 988 20+ 36 #12 RL0A RL01 RWF 4081 21+ 0 A 44 #13 RL0B RL01 RWF 4081 21+ 0 A 40 #14 T4 64 RWF SYS 0 E 07 #15 TDA0 64 RWF SYS 1 E 60 #16 T5 64 RWF 22 D 126 #17 TDA1 64 RWF 22 D 134 # #FREE DEVICE SLOTS: NONE, FREE BLOCK SLOTS: 03 #OS/8 V3T # # #. # # The actual name reconstruction in RESORC.PA seems to work by trying # DT MT LT TD CS RK RF RX and VX, followed by [AB][0-7]. If that does # not work, the following are tried: TTY PTR PTP CDR SYS DSK CDP DEV # OUT INP BAT NULL LST DUMP SLU LQP RL0A RL0B RL0C RL1A RL1B RL1C # RL2A RL2B RL2C RL3A RL3B RL3C # Everything else is just printed as if 04000 were clear and two characters # were encoded. #