github.com/AK6DN.dec-utilities-for-pdp
1
0
Fork 0
mirror of https://github.com/AK6DN/dec-utilities-for-pdp.git synced 2026-01-11 23:42:54 +00:00
Code Issues Releases Wiki Activity

Initial commit

Browse Source
This commit is contained in:
AK6DN 2018-02-20 17:08:24 -08:00
parent f9380b6e1e
commit e65490a767
35 changed files with 24860 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
License.pl Normal file
View File

@ -0,0 +1,29 @@
# Copyright (c) 2005 Don North
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# o Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# o Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# o Neither the name of the copyright holder nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

146
README.md Normal file
View File

@ -0,0 +1,146 @@
<B>obj2bin.pl</B> is a PDP-11 object file translator / linker, transforming an .obj file as output from macro11 into an absolute binary load image file (.bin) or other useful formats (.hex).
If run with no options, it prints a usage screen:
```
obj2bin.pl v2.0 by Don North (perl 5.022)
Usage: ./obj2bin.pl [options...] arguments
--help output manpage and exit
--debug enable debug mode
--verbose verbose status reporting
--boot M9312 boot prom
--console M9312 console/diagnostic prom
--binary binary program load image
--ascii ascii m9312 program load image
--bytes=N bytes per block on output
--nocrc inhibit output of CRC-16 in hex format
--logfile=LOGFILE logging message file
--outfile=OUTFILE output .hex/.txt/.bin file
OBJFILE... macro11 object .obj file(s)
Aborted due to command line errors.
```
If run with the --help option it prints a longer manual page:
```
NAME
obj2bin.pl - Convert a Macro-11 program image to PROM/load format
SYNOPSIS
obj2bin.pl [--help] [--debug] [--verbose] [--boot] [--console] [--binary]
[--ascii] [--bytes=N] [--nocrc] [--logfile=LOGFILE] --outfile=BINFILE
OBJFILE...
DESCRIPTION
Converts a Macro-11 object file to various output formats, including M9312
boot and console PROM, straight binary records, ASCII format for M9312
console load commands, and loadable absolute binary program images (.BIN)
files.
Currently the program is limited to a single object input file that can be
output in the selected format. Multiple .psect/.asect ops are supported,
as well as all local (non-global) relocation directory entries. Multiple
object files are (not yet) supported.
OPTIONS
The following options are available:
--help
Output this manpage and exit the program.
--debug
Enable debug mode; print input file records as parsed.
--verbose
Verbose status; output status messages during processing.
--boot
Generate a hex PROM file image suitable for programming into an M9312
boot prom (512x4 geometry, only low half used).
--console
Generate a hex PROM file image suitable for programming into an M9312
console/diagnostic prom (1024x4 geometry).
--binary
Generate binary format load records of the program image (paper tape
format) for loading into SIMH or compatible simulators. These files
can also be copied onto XXDP filesystems to generate runnable program
images (used to write custom diaqnostics).
--ascii
Generate a a sequence of 'L addr' / 'D data' commands for downloading
a program via a terminal emulator thru the M9312 user command
interface. Suitable only for really small test programs.
Exactly ONE of --boot, --console, --binary, or --ascii must be
specified.
--bytes=N
For hex format output files, output N bytes per line (default 16).
--nocrc
For hex format output files, don't automatically stuff the computed
CRC-16 as the last word in the ROM.
--logfile=FILENAME
Generate debug output into this file.
--outfile=FILENAME
Output binary file in format selected by user option.
OBJFILE...
Input object file(s) in .obj format.
ERRORS
The following diagnostic error messages can be produced on STDERR. The
meaning should be fairly self explanatory.
"Aborted due to command line errors" -- bad option or missing file(s)
"Can't open input file '$file'" -- bad filename or unreadable file
"Error: Improper object file format (1)" -- valid record must start with
0x01
"Error: Improper object file format (2)" -- second byte must be 0x00
"Error: Improper object file format (3)" -- third byte is low byte of
record length
"Error: Improper object file format (4)" -- fourth byte is high byte of
record length
"Error: Improper object file format (5)" -- bytes five thru end-1 are data
bytes
"Error: Improper object file format (6)" -- last byte is checksum
"Error: Bad checksum exp=0x%02X rcv=0x%02X" -- compare rcv'ed checksum vs
exp'ed checksum
EXAMPLES
Some examples of common usage:
obj2bin.pl --help
obj2bin.pl --verbose --boot --out 23-751A9.hex 23-751A9.obj
obj2bin.pl --verbose --binary --out memtest.bin memtest.obj
AUTHOR
Don North - donorth <ak6dn _at_ mindspring _dot_ com>
HISTORY
Modification history:
2005-05-05 v1.0 donorth - Initial version.
2016-01-15 v1.1 donorth - Added RLD(IR) processing, moved sub's to end.
2016-01-18 v1.2 donorth - Added GSD processing, improved debug output.
2016-01-20 v1.3 donorth - Initial support for linking multiple PSECTs.
2016-01-22 v1.4 donorth - Added objfile/outfile/logfile switches vs stdio.
2016-01-28 v1.5 donorth - Added RLD processing, especially complex.
2017-04-01 v2.0 donorth - Started to add capability to process multiple
input object files ... still a work in progress.
Renamed from obj2hex.pl to obj2bin.pl
```

388
binchk/binchk.pl Normal file
View File

@ -0,0 +1,388 @@
#!/usr/bin/perl -w
# Copyright (c) 2005 Don North
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# o Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# o Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# o Neither the name of the copyright holder nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
require 5.008;
=head1 NAME
hdr - Standard template for a Perl module
=head1 SYNOPSIS
hdr
S<[--help]>
S<[--debug]>
S<[--verbose]>
S<[random arguments ...]>
=head1 DESCRIPTION
Description of the command ...
=head1 OPTIONS
The following options are available:
=over
=item B<--help>
Output this manpage and exit the program.
=item B<--debug>
Enable debug mode.
=item B<--verbose>
Verbose status reporting (not implemented).
=back
=head1 ERRORS
The following diagnostic error messages can be produced on STDERR.
The meaning should be fairly self explanatory.
C<List all the error messages here...> -- some error
=head1 EXAMPLES
Some examples of common usage:
hdr --help
hdr --verbose --string 'a string' --integer 5 some_other_argument
=head1 SEE ALSO
Related commands cross reference...
=head1 NOTES
Caveat emptor...
=head1 FILES
Any standard files used?
=head1 AUTHOR
Don North
=head1 HISTORY
Modification history:
2005-05-05 v0.0 donorth - Initial version.
=cut
# options
use strict;
# external standard modules
use Getopt::Long;
use Pod::Text;
use FindBin;
use FileHandle;
# external local modules search path
BEGIN { unshift(@INC, $FindBin::Bin);
unshift(@INC, $ENV{PERL5LIB}) if defined($ENV{PERL5LIB}); # cygwin bugfix
unshift(@INC, '.'); }
# external local modules
# generic defaults
my $VERSION = 'v0.1d1'; # version of code
my $HELP = 0; # set to 1 for man page output
my $DEBUG = 0; # set to 1 for debug messages
my $VERBOSE = 0; # set to 1 for verbose messages
# specific defaults
# process command line arguments
my $NOERROR = GetOptions( "help" => \$HELP,
"debug" => \$DEBUG,
"verbose" => \$VERBOSE,
);
# init
$VERBOSE = 1 if $DEBUG; # debug implies verbose messages
# say hello
printf STDERR "binchk.pl %s by Don North (perl %g)\n", $VERSION, $] if $VERBOSE;
# output the documentation
if ($HELP) {
# output a man page if we can
if (ref(Pod::Text->can('new')) eq 'CODE') {
# try the new way if appears to exist
my $parser = Pod::Text->new(sentence=>0, width=>78);
printf STDOUT "\n"; $parser->parse_from_file($0);
} else {
# else must use the old way
printf STDOUT "\n"; Pod::Text::pod2text(-78, $0);
};
exit(1);
}
# check for correct arguments present, print usage if errors
unless ($NOERROR && scalar(@ARGV) == 1) {
print STDERR "Usage: $0 [options...] arguments\n";
print STDERR <<"EOF";
--help output manpage and exit
--debug enable debug mode
--verbose verbose status reporting
OBJFILE macro11 object .obj file
EOF
# exit if errors...
die "Aborted due to command line errors.\n";
}
# setup log file as a file, defaults to STDERR if not supplied
my $LOG = FileHandle->new_from_fd(fileno(STDERR),"w");
#----------------------------------------------------------------------------------------------------
# subroutine prototypes
sub chksum (@);
sub rad2asc (@);
sub crc (%);
sub read_rec ($);
#----------------------------------------------------------------------------------------------------
my @mem = (); # real pdp11 memory data bytes
foreach my $adr (0..65535) { $mem[$adr] = 0; }
my ($minadr,$maxadr,$staadr) = ('','',1);
# open the input .bin file, die if error
my $OBJ = FileHandle->new("< ".$ARGV[0]);
die "Can't open input binary file '$ARGV[0]'\n" unless defined $OBJ;
while (my @rec = &read_rec($OBJ)) {
# first two bytes are the load address
my $adr = shift(@rec); $adr += shift(@rec)<<8;
printf STDERR "record at address %06o\n", $adr if $DEBUG;
if (@rec == 0) { $staadr = $adr; next; }
# rest of the bytes are data (if present)
$minadr = $adr if $minadr eq '' || $adr < $minadr;
while (@rec) { $mem[$adr++] = shift(@rec); }
$maxadr = $adr if $maxadr eq '' || $adr > $maxadr;
}
$OBJ->close;
# print some info
printf "address = (%06o,%06o) start = %06o\n", $minadr, $maxadr, $staadr;
if ($VERBOSE) {
# print the whole program image
for (my $adr = ($minadr&~0xF); $adr <= ($maxadr|0xF); ) {
printf " %06o :", $adr;
for (my $next = $adr+16; $adr < $next; $adr += 2) {
if ($adr < $minadr-1 || $adr > $maxadr+1) {
printf " ......";
} else {
printf " %06o", ($mem[$adr+1]<<8)|$mem[$adr+0];
}
}
sub fix ($) { my ($c) = @_; $c < 0x20 || $c > 0x7E ? '.' : chr($c); }
printf " \"%s\"\n", join('',map(&fix($mem[$adr-16+$_]),(0..15)));
}
}
#----------------------------------------------------------------------------------------------------
# all done
$LOG->close;
exit;
#----------------------------------------------------------------------------------------------------
# compute checksum (twos complement of the sum of bytes)
sub chksum (@) {
my $sum = 0;
map($sum += $_, @_);
return (-$sum) & 0xFF;
}
#----------------------------------------------------------------------------------------------------
# RAD50 to ASCII decode
sub rad2asc (@) {
my @str = split(//, ' ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789'); # RAD50 character subset
my $ascii = "";
foreach my $rad50 (@_) {
$ascii .= $str[int($rad50/1600)%40] . $str[int($rad50/40)%40] . $str[$rad50%40];
}
return $ascii;
}
#----------------------------------------------------------------------------------------------------
# crc computation routine
sub crc (%) {
# pass all args by name
my %args = @_;
# all the crcs we know how to compute
my %crcdat = ( 'CRC-16' => [ 0xA001, 2, 0x0000, 0x0000 ],
'CRC-32' => [ 0xEDB88320, 4, 0xFFFFFFFF, 0xFFFFFFFF ] );
# run next byte thru crc computation, return updated crc
return $args{-table}[($args{-crc}^$args{-byte}) & 0xFF]^($args{-crc}>>8) if exists($args{-byte});
# return initial crc value
return $crcdat{$args{-name}}->[2] if exists($args{-init});
# return final crc value xored with xorout
return $args{-crc} ^ $crcdat{$args{-name}}->[3] if exists($args{-last});
# compute the crc lookup table, return a pointer to it
if (exists($args{-new})) {
my $crctab = [];
my $poly = $crcdat{$args{-name}}->[0];
foreach my $byte (0..255) {
my $data = $byte;
foreach (1..8) { $data = ($data>>1) ^ ($data&1 ? $poly : 0); }
$$crctab[$byte] = $data;
}
return $crctab;
}
}
#----------------------------------------------------------------------------------------------------
# read a record from the binary file
sub read_rec ($) {
my ($fh) = @_;
my ($buf, $cnt, $len, $err) = (0,0,0,0);
my @pre = ();
my @dat = ();
my @suf = ();
# Binary file format consists of blocks, optionally preceded, separated, and
# followed by zeroes. Each block consists of:
#
# 001 ---
# 000 |
# lo(length) |
# hi(length) |
# lo(address) > 'length' bytes
# hi(address) |
# databyte1 |
# : |
# databyteN ---
# checksum
#
# skip over strings of 0x00; exit OK if hit EOF
do { return () unless $cnt = read($fh, $buf, 1); } while (ord($buf) == 0);
# valid record starts with (1)
$err = 1 unless $cnt == 1 && ord($buf) == 1;
push(@pre, ord($buf));
# second byte must be (0)
$cnt = read($fh, $buf, 1);
$err = 2 unless $cnt == 1 && ord($buf) == 0;
push(@pre, ord($buf));
# third byte is low byte of record length
$cnt = read($fh, $buf, 1);
$err = 3 unless $cnt == 1;
$len = ord($buf);
push(@pre, ord($buf));
# fourth byte is high byte of record length
$cnt = read($fh, $buf, 1);
$err = 4 unless $cnt == 1;
$len += ord($buf)<<8;
push(@pre, ord($buf));
# bytes five thru end-1 are two address bytes plus data bytes
$cnt = read($fh, $buf, $len-4);
$err = 5 unless $cnt == $len-4 && $len >= 4;
@dat = unpack("C*", $buf);
# last byte is checksum
$cnt = read($fh, $buf, 1);
$err = 6 unless $cnt == 1;
my $rcv = ord($buf);
push(@suf, ord($buf));
# output the record if debugging
if ($DEBUG) {
my $fmt = "%03o";
my $n = 16;
my $pre = sprintf("RECORD: [%s] ",join(" ",map(sprintf($fmt,$_),@pre)));
printf $LOG "\n\n%s", $pre;
my $k = length($pre);
my @tmp = @dat;
while (@tmp > $n) {
printf $LOG "%s\n%*s", join(" ",map(sprintf($fmt,$_),splice(@tmp,0,$n))), $k, '';
}
printf $LOG "%s", join(" ",map(sprintf($fmt,$_),@tmp)) if @tmp;
printf $LOG " [%s]\n\n", join(" ",map(sprintf($fmt,$_),@suf));
}
# check we have a well formatted record
die sprintf("Error: invalid binary file record format (%d)", $err) if $err;
# compare rcv'ed checksum vs exp'ed checksum
my $exp = &chksum(0x01, $len>>0, $len>>8, @dat);
die sprintf("Error: Bad checksum exp=0x%02X rcv=0x%02X", $exp, $rcv) unless $exp == $rcv;
# all is well, return the record
return @dat;
}
#----------------------------------------------------------------------------------------------------
# the end

332
config11/config11.pl Normal file
View File

@ -0,0 +1,332 @@
#!/usr/bin/perl -w
# Copyright (c) 2005 Don North
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# o Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# o Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# o Neither the name of the copyright holder nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
require 5.008;
=head1 NAME
config11.pl - Configure PDP-11 I/O Space Addresses
=head1 SYNOPSIS
config11.pl
S<[--help]>
S<[--debug]>
S<[--verbose]>
<INPFILE
>OUTFILE
=head1 DESCRIPTION
Configures the CSR and vector addresses for a set of
PDP-11 peripherals using the 'standard' autoconfigure
algorithm used by DEC software for device discovery.
=head1 OPTIONS
The following options are available:
=over
=item B<--help>
Output this manpage and exit the program.
=item B<--debug>
Enable debug mode; print input file records as parsed.
=item B<--verbose>
Verbose status; output status messages during processing.
=back
=head1 ERRORS
The following diagnostic error messages can be produced on STDERR.
The meaning should be fairly self explanatory.
C<Aborted due to command line errors> -- bad option or missing file(s)
=head1 EXAMPLES
Some examples of common usage:
config11.pl --help
config11.pl --verbose < input.txt > output.txt
=head1 AUTHOR
Don North - donorth <ak6dn _at_ mindspring _dot_ com>
=head1 HISTORY
Modification history:
2005-09-21 v1.0 donorth - Initial version.
=cut
# options
use strict;
# external standard modules
use Getopt::Long;
use Pod::Text;
use FindBin;
# external local modules search path
BEGIN { unshift(@INC, $FindBin::Bin);
unshift(@INC, $ENV{PERL5LIB}) if defined($ENV{PERL5LIB}); # cygwin bugfix
unshift(@INC, '.'); }
# external local modules
# generic defaults
my $VERSION = 'v1.0'; # version of code
my $HELP = 0; # set to 1 for man page output
my $DEBUG = 0; # set to 1 for debug messages
my $VERBOSE = 0; # set to 1 for verbose messages
# specific defaults
# process command line arguments
my $NOERROR = GetOptions( "help" => \$HELP,
"debug" => \$DEBUG,
"verbose" => \$VERBOSE,
);
# init
$VERBOSE = 1 if $DEBUG; # debug implies verbose messages
# say hello
printf STDERR "config11.pl %s by Don North (perl %g)\n", $VERSION, $] if $VERBOSE;
# output the documentation
if ($HELP) {
# output a man page if we can
if (ref(Pod::Text->can('new')) eq 'CODE') {
# try the new way if appears to exist
my $parser = Pod::Text->new(sentence=>0, width=>78);
printf STDOUT "\n"; $parser->parse_from_file($0);
} else {
# else must use the old way
printf STDOUT "\n"; Pod::Text::pod2text(-78, $0);
};
exit(1);
}
# check for correct arguments present, print usage if errors
unless ($NOERROR && scalar(@ARGV) == 0) {
print STDERR "Usage: $0 [options...] arguments\n";
print STDERR <<"EOF";
--help output manpage and exit
--debug enable debug mode
--verbose verbose status reporting
< INPFILE input device list
> OUTFILE output device assignment list
EOF
# exit if errors...
die "Aborted due to command line errors.\n";
}
#----------------------------------------------------------------------------------------------------
my %vec = ( # name => [ rank, numvec [,basevec] ]
DC11 => [ 1, 2 ],
TU58 => [ 1, 2 ],
KL11 => [ 2, 2 ], # (1)
DL11A => [ 2, 2 ], # (1)
DL11B => [ 2, 2 ], # (1)
DLV11J => [ 2, 8 ], # (1)
DLV11 => [ 2, 2 ], # (1)
DLV11F => [ 2, 2 ], # (1)
DP11 => [ 3, 2 ],
DM11A => [ 4, 2 ],
DN11 => [ 5, 1 ],
DM11BA => [ 6, 1 ],
DM11BB => [ 6, 1 ],
DH11_modem => [ 7, 1 ],
DR11A => [ 8, 2 ],
DRV11B => [ 8, 2 ],
DR11C => [ 9, 2 ],
DRV11 => [ 9, 2 ],
PA611 => [ 10, 4 ],
LPD11 => [ 11, 2 ],
DT07 => [ 12, 2 ],
DX11 => [ 13, 2 ],
DL11C => [ 14, 2 ],
DL11D => [ 14, 2 ],
DL11E => [ 14, 2 ],
DL11F => [ 14, 2 ],
DLV11C => [ 14, 2 ],
DLV11D => [ 14, 2 ],
DLV11E => [ 14, 2 ],
DLV11F => [ 14, 2 ],
DJ11 => [ 15, 2 ],
DH11 => [ 16, 2 ],
VT40 => [ 17, 4 ],
VSV11 => [ 17, 4 ],
LPS11 => [ 18, 6 ],
DQ11 => [ 19, 2 ],
KW11W => [ 20, 2 ],
KWV11 => [ 20, 2 ],
DU11 => [ 21, 2 ],
DUV11 => [ 21, 2 ],
DUP11 => [ 22, 2 ],
DV11_modem => [ 23, 3 ],
LK11A => [ 24, 2 ],
DWUN => [ 25, 2 ],
DMC11 => [ 26, 2 ],
DMR11 => [ 26, 2 ],
DZ11 => [ 27, 2 ],
DZS11 => [ 27, 2 ],
DZV11 => [ 27, 2 ],
DZ32 => [ 27, 2 ],
KMC11 => [ 28, 2 ],
LPP11 => [ 29, 2 ],
VMV21 => [ 30, 2 ],
VMV31 => [ 31, 2 ],
VTV01 => [ 32, 2 ],
DWR70 => [ 33, 2 ],
RL11 => [ 34, 1 ], # (2)
RLV11 => [ 34, 1 ], # (2)
TS11 => [ 35, 1 ], # (2)
TU80 => [ 35, 1 ], # (2)
LPA11K => [ 36, 2 ],
IP11 => [ 37, 1 ], # (2)
IP300 => [ 37, 1 ], # (2)
KW11C => [ 38, 2 ],
RX11 => [ 39, 1 ], # (2)
RX211 => [ 39, 1 ], # (2)
RXV11 => [ 39, 1 ], # (2)
RXV21 => [ 39, 1 ], # (2)
DR11W => [ 40, 1 ],
DR11B => [ 41, 1 ], # (2)
DMP11 => [ 42, 2 ],
DPV11 => [ 43, 2 ],
ML11 => [ 44, 1 ], # (3)
ISB11 => [ 45, 2 ],
DMV11 => [ 46, 2 ],
DEUNA => [ 47, 1, 0120 ], # (2)
UDA50 => [ 48, 1, 0154 ], # (2)
DMF32 => [ 49, 8 ],
KMS11 => [ 50, 3 ],
PCL11B => [ 51, 2 ],
VS100 => [ 52, 1 ],
TU81 => [ 53, 1 ], # (2)
KMV11 => [ 54, 2 ],
Reserved => [ 55, 2 ],
IEX => [ 56, 2 ],
DHV11 => [ 57, 2 ],
DMZ32 => [ 58, 6 ],
CP132 => [ 59, 6 ],
# (1) A KL11 or DL11 used as a console, has a fixed vector.
# (2) The first device of this type has a fixed vector. Any extra devices have a floating vector.
# (3) ML11 is a Massbus device which can connect to a UNIBUS via a bus adapter.
);
my %csr = ( # name => [ rank, numcsr [,basecsr] ]
DJ11 => [ 1, 4 ],
DH11 => [ 2, 8 ],
DQ11 => [ 3, 4 ],
DU11 => [ 4, 4 ],
DUV11 => [ 4, 4 ],
DUP11 => [ 5, 4 ],
LK11A => [ 6, 4 ],
DMC11 => [ 7, 4 ],
DMR11 => [ 7, 4 ],
DZ11 => [ 8, 4 ],
DZV11 => [ 8, 4 ],
DZS11 => [ 8, 4 ],
DZ32 => [ 8, 4 ],
KMC11 => [ 9, 4 ],
LPP11 => [ 10, 4 ],
VMV21 => [ 11, 4 ],
VMV31 => [ 12, 8 ],
DWR70 => [ 13, 4 ],
RL11 => [ 14, 4, 0774400 ],
RLV11 => [ 14, 4, 0774400 ],
LPA11K => [ 15, 8, 0770460 ],
KW11C => [ 16, 4 ],
rsvd => [ 17, 4 ],
RX11 => [ 18, 4, 0777170 ],
RX211 => [ 18, 4, 0777170 ],
RXV11 => [ 18, 4, 0777170 ],
RXV21 => [ 18, 4, 0777170 ],
DR11W => [ 19, 4 ],
DR11B => [ 20, 4, 0772410 ],
DMP11 => [ 21, 4 ],
DPV11 => [ 22, 4 ],
ISB11 => [ 23, 4 ],
DMV11 => [ 24, 8 ],
DEUNA => [ 25, 4, 0774440 ],
UDA50 => [ 26, 2, 0772150 ],
DMF32 => [ 27, 16 ],
KMS11 => [ 28, 6 ],
VS100 => [ 29, 8 ],
TK50 => [ 30, 2, 0774500 ],
TU81 => [ 30, 2, 0774500 ],
KMV11 => [ 31, 8 ],
DHV11 => [ 32, 8 ],
DMZ32 => [ 33, 16 ],
CP132 => [ 34, 16 ],
);
# printf ("\nRank\tName\tCtrl#\t CSR\n\n");
# csr = 0760010;
# for (i = 0; i < RANK_LNT; i++) {
# if (numctl[i] == 0) {
# printf (" %02d\t%s\tgap\t%06o\n", i+1, namtab[i], csr); }
# else {
# if (fixtab[i])
# printf (" %02d\t%s\t 1\t%06o*\n", i+1, namtab[i], fixtab[i]);
# else {
# printf (" %02d\t%s\t 1\t%06o\n", i+1, namtab[i], csr);
# csr = (csr + modtab[i] + 1) & ~modtab[i]; }
# for (j = 1; j < numctl[i]; j++) {
# printf ("\t\t %d\t%06o\n", j + 1, csr);
# csr = (csr + modtab[i] + 1) & ~modtab[i]; }
# printf (" %\t\tgap\t%06o\n", csr);
# }
# if ((i + 1) < RANK_LNT) csr = (csr + modtab[i+1] + 1) & ~modtab[i+1];
# }
# printf ("\n\n");
# }
#----------------------------------------------------------------------------------------------------
exit;
# the end

56
d8tape/LICENSE Normal file
View File

@ -0,0 +1,56 @@
This software is copyrighted as per the individual source modules.
Where no copyright is given, the following applies:
(C) Copyright 2002 by 1230599 Ontario Inc., dba PARSE Softare Devices
All rights reserved. Use subject to terms in LICENSE file.
This software may be used for non-commercial applications without restriction.
Redistribution must occur without charge, and the distribution must be intact
and include all copyright notices and LICENSE files. A charge may be made
for distribution to cover media and shipping only.
This license is incompatible with the GNU-GPL and therefore GPL source cannot be
combined with this source. Other licenses may or may not be compatible; you
assume full responsibility for license compliance.
To use this software in a commercial product, please contact:
licensing@parse.com
Licensing fees are generally a direct function of the amount of work that went
into a particular product; the advantage to you is that you get the product
immediately, for approximately the same cost as it would cost you to hire someone
to develop it, and you have the ability to evaluate it under the terms of the
non-commercial use (above).
There is no warranty with this software, expressed or implied. Neither the
author, 1230599 Ontario Inc., nor anyone connected in any way with the development
or distribution of this software may be held liable for any losses, not limited
to consequential or direct, however caused.
For any further information, please contact us at:
1230599 Ontario Inc
dba PARSE Software Devices
278 Equestrian Drive
Kanata, ON K2M 1C5
CANADA
+1 613 599 8316 (voice)
+1 877 727 7379 (toll free North America)
+1 613 599 8317 (fax)
In case this address or contact information changes, you can always get the latest
contact information from the following URL:
http://www.parse.com
PARSE Software Devices is an established research and development organization,
specializing in realtime and embedded systems architecture and software
development. We are also the publishers of the "Getting Started with QNX(R) 4"
and "Getting Started with QNX(R) Neutrino(R) 2" (Momentics(R)) books. As well,
we have a video training course available to help you get started with QNX(R)
Neutrino(R) (Momentics(R)). Please see our website for more information.
All trademarks and registered trademarks mentioned belong to their respective
owners.

54
d8tape/Makefile Normal file
View File

@ -0,0 +1,54 @@
#
# makefile for d8tape
#
# (C) Copyright 2001, 2003, 2007, by Robert Krten, all rights reserved.
# Please see the LICENSE file for more information.
#
# I collect PDP systems of almost all shapes and sizes; send me an
# email to "rk@parse.com" if you have one to give away, sell,
# or trade, or visit the museum at http://www.parse.com/~museum/
#
# 2001 01 07 R. Krten created
# 2007 10 25 R. Krten added flow module
#
# The "bm" utility in the "core:" target simply increments
# the version number -- you can comment out that line with
# no ill effects, or simply "ln /bin/true /usr/local/bin/bm"
# (or similar) to nullify its effects.
#
DEBUG = -g2
OBJECTS = main.o dasm.o flow.o
CFLAGS = $(DEBUG) -Wall
LDFLAGS = $(DEBUG)
Common = Makefile
d8tape: $(OBJECTS)
cc $(CFLAGS) -o d8tape $(OBJECTS) version.c $(LDFLAGS)
main.o: main.c $(Common)
install:
make
cp -v d8tape.exe ../../../tools/exe
release:
make clean
tar cvf d8tape.tar Makefile *.c *.h LICENSE
gzip -9v d8tape.tar
test:
macro8x -d -x -m -u test.pal
d8tape test.bin | expand -4 > test.list
cp test.list verify.pal
macro8x -d -x -m -u verify.pal
../dumpbin.pl test.bin > test.dump
../dumpbin.pl verify.bin > verify.dump
-diff -s test.dump verify.dump
d8tape verify.bin | expand -4 > verify.list
-diff -s test.list verify.list
clean:
rm -f *.o d8tape.exe

46
d8tape/d8tape.h Normal file
View File

@ -0,0 +1,46 @@
/*
* d8tape.h
*
* (C) Copyright 2007 by Robert Krten, all rights reserved.
* Please see the LICENSE file for more information.
*
* This module contains the manifest constants and other header
* information.
*
* 2007 10 25 R. Krten created
* 2007 10 28 R. Krten added TAG_INDIRECTFC
*/
// constants
#define CORE_SIZE 4096 // size of core memory
#define TAG_DATA 0x0001 // memory region is tagged as data,
#define TAG_SUB 0x0002 // subroutine target, or,
#define TAG_LABEL 0x0004 // label
#define TAG_RETURN 0x0008 // return from subroutine
#define TAG_TYPE_MASK 0x00FF // mask of above types
#define TAG_WRITABLE 0x0100 // set if anyone writes to this data location (else constant)
#define TAG_KONSTANT 0x0200 // can be changed from Caaaa -> Kvvvv
#define TAG_INDIRECTFC 0x0400 // target of an indirect flow control (JMS I / JMP I) (only meaningful if not writable)
// segment info
typedef struct
{
uint16_t saddr; // starting address
uint16_t nwords; // number of contiguous words
} segment_t;
// prototypes
// flow.c
extern void flow (void);
// dasm.c
extern int ea (int addr, int opcode, int *indirect, int *curpage);
extern void disassemble (void);
extern int is_data (int v);
extern int fetch_iot (int code, char *dis, char *com);

706
d8tape/dasm.c Normal file
View File

@ -0,0 +1,706 @@
#define DNN1 1
#define DNN2 1
/*
* dasm.c
*
* (C) Copyright 2003 by Robert Krten, all rights reserved.
* Please see the LICENSE file for more information.
*
* This module contains the PDP-8 disassembler.
* Note that the 8/I and 8/L are featured at this point; other models
* should be added (particularly the 8/E's EAE instructions, as well
* as new IOT decodings, etc)
*
* 2003 12 16 R. Krten created
* 2007 10 29 R. Krten added better output formatting
* 2007 11 02 R. Krten added xrefs
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <errno.h>
#include <time.h>
#include "d8tape.h"
#include "iot.h" // decode table for IOTs
extern char *progname; // main.c
extern char *version; // version.c
extern int optv; // main.c
extern char *tapename; // main.c, name of tape image
extern short int core []; // main.c, in-core image (-1 means location never used)
extern uint16_t tags []; // main.c, analysis tags
extern segment_t *segments; // main.c, used to accumulate runs of data (from origin for nwords)
extern int nsegments; // main.c, indicates how many segments we have
static void header (void);
static void disassemble_range (int start, int end);
static void pad (char *buf, int off, int pos);
static void xrefs (int addr);
/*
* dasm8
*
* This takes the current address and the instruction value
* and prints the decoded instruction. A static variable
* is used to kludge up 2-word instructions (e.g., MUY <const>).
*
* The IOTs are coded in a table; in some cases, conflicts exist, you'll
* need to select the appropriate #defines to make them go away :-)
* As shipped, the #defines match my preferences.
*
* Formatting rules:
* - the following types of output exist:
* - labels
* - banners
* - code
* - data
*
* For each type, the following format is used (all tabs, as shown by the single backtick
* character, are assumed to be at 4 character tabstops. If you don't like this, pipe
* the output through "expand -4").
*
* Labels:
* 1111111111222222222233333333334444444444555555555566666666667777777777
* 01234567890123456789012345678901234567890123456789012345678901234567890123456789
* t t t t t t t t t t t t t t t t t t t t
* TAAAA,
*
* where "T" is the label type, one of "D" for data, "L" for executable label,
* and "S" for subroutine entry, and "AAAA" is the four digit octal address.
* (See "Data" below for additional details of the "D" type).
*
* Banners:
* 1111111111222222222233333333334444444444555555555566666666667777777777
* 01234567890123456789012345678901234567890123456789012345678901234567890123456789
* t t t t t t t t t t t t t t t t t t t t
* ////////////////////////////////////////////////////////////////////////////////
* /
* /```CONTENT
* /
* ////////////////////////////////////////////////////////////////////////////////
*
* Where "CONTENT" is the content of the banner, e.g., "SUBROUTINE S1234".
*
* Code:
* 1111111111222222222233333333334444444444555555555566666666667777777777
* 01234567890123456789012345678901234567890123456789012345678901234567890123456789
* t t t t t t t t t t t t t t t t t t t t
* op1`````````````````````/ COMMENTS..............................@@=AAAA,OOOO
* opc1````````````````````/ COMMENTS..............................@@=AAAA,OOOO
* op1 TAAAA```````````````/ COMMENTS..............................@@=AAAA,OOOO
* op1 I TAAAA`````````````/ COMMENTS..............................@@=AAAA,OOOO
* op1 op2 op3 op4 op5 op6`/ COMMENTS..............................@@=AAAA,OOOO
* 12345678911234567892123 1234567891123456789212345678931234567 (DISLEN and COMLEN, resp.)
* 01234567891123456789212345678 234567891123456789212345678931234567890 (COMSTART and DATASTART, resp.)
*
* Where "op1", "opc1", "op2" through "op6" are 3 or 4 character mnemonic
* opcodes. "T" is the label type (as above), and "AAAA" is the address.
* Tabs are used to fill whitespace to the "/" comment delimiter, and from the
* end of the comment to the @@. The area at the "@@" indicates the address
* and the contents.
*
* This is where the COMLEN and DISLEN buffer sizes are derived from, and the
* COMSTART position (28, the start of the "/")
*
* Data:
* 1111111111222222222233333333334444444444555555555566666666667777777777
* 01234567890123456789012345678901234567890123456789012345678901234567890123456789
* t t t t t t t t t t t t t t t t t t t t
* CAAAA,``VVVV````````````````/ op1 op2 op3 op4 op5 op6 COMMENTS..................
* DAAAA,``VVVV````````````````/ op1 op2 op3 op4 op5 op6 COMMENTS..................
* KVVVV,``VVVV````````````````/ op1 op2 op3 op4 op5 op6 COMMENTS..................
*
* Where "C" is used for constants whose values are not unique, "D" is used
* for writable data, and "K" is used for constants that can be added in the
* symbol table. The distinction between "C" and "K" is that if two different
* memory locations both define the same constant value, we need to use "C"
* because it's tagged based on the address, whereas "K" is tagged based on
* the value.
*
* Other types to consider are comment blocks imported from a control file.
*/
static const char *codes [6] = {"AND", "TAD", "ISZ", "DCA", "JMS", "JMP"}; // IOT and OPR are decoded elsewhere
static unsigned short int two_word = 0; // set to hold two-word instruction (e.g., EAE ops), else zero (instruction 0, AND, is not a two-word instruction)
#define COMLEN 37 // length of comment, see "Code", above (both the number of bytes and the max number of characters; tabs will only make the number of bytes less)
#define DISLEN 23 // length of disassembly area, see "Code" above (ditto)
#define COMSTART 28 // 0-based column number where the comments start
#define DATASTART 40 // 0-based column number where the data (@@=AAAA,OOOO) starts
static char disbuf [DISLEN + 1];
static char combuf [COMLEN + 1];
void
dasm8 (int addr, unsigned short int buf)
{
int ind, cur;
int eff_addr;
int primary; // is primary disassembly 'c'ode or 'd'ata?
if (optv > 1) {
printf ("dasm8 (addr 0%04o word 0%04o tag 0x%04x)\n", addr, buf, tags [addr]);
}
eff_addr = ea (addr, buf, &ind, &cur);
if (two_word) {
printf ("\t%04o /\t\t\t\t\t / (operand)\n", buf);
two_word = 0;
return;
}
// prepare buffer areas for disassembly and comments.
memset (disbuf, 0, sizeof (disbuf));
memset (combuf, 0, sizeof (combuf));
primary = 'c'; // default to code disassembly
if (tags [addr] & TAG_LABEL) {
printf ("L%04o,\n", addr);
}
if (tags [addr] & TAG_SUB) {
printf ("\n");
printf ("////////////////////////////////////////////////////////////////////////////////\n");
printf ("/\n");
printf ("/\tSUBROUTINE: S%04o\n", addr);
printf ("/\n");
xrefs (addr);
printf ("////////////////////////////////////////////////////////////////////////////////\n");
printf ("S%04o,\n", addr);
printf ("\t0\t\t\t\t\t\t/ return area\n");
// done; can't be SUB and anything else (except label, perhaps)
return;
}
if (tags [addr] & TAG_DATA) {
// if it's data, set primary as data
primary = 'd';
if ((addr & 07770) == 00010) { // addresses 0010 -> 0017 are autoindex
printf ("AI%o,\t%04o\t\t\t\t/ AUTO-INDEX REGISTER", addr & 7, core [addr]);
} else {
if (tags [addr] & TAG_INDIRECTFC) {
printf ("C%04o,\n", addr);
}
printf ("%c%04o,\t", tags [addr] & TAG_KONSTANT ? 'K' : tags [addr] & TAG_WRITABLE ? 'D' : 'C', tags [addr] & TAG_KONSTANT ? core [addr] : addr);
printf ("%04o\t\t\t\t/", core [addr]);
}
}
switch (buf & 07000) {
case 00000: // AND
case 01000: // TAD
case 02000: // ISZ
case 03000: // DCA
case 04000: // JMS
case 05000: // JMP
sprintf (disbuf, "%s ", codes [buf >> 9]);
if (ind) {
strcat (disbuf, "I ");
} else {
strcat (disbuf, " ");
}
if (tags [eff_addr] & TAG_SUB) {
strcat (disbuf, "S");
} else if (tags [eff_addr] & TAG_LABEL) {
strcat (disbuf, "L");
} else {
if ((eff_addr & 07770) == 00010) { // addresses 0010 -> 0017
strcat (disbuf, "AI");
strcat (combuf, "AUTO INDEX REGISTER");
} else {
strcat (disbuf, (tags [eff_addr] & TAG_KONSTANT) ? "K" : tags [eff_addr] & TAG_WRITABLE ? "D" : "C");
}
}
if (tags [addr] & TAG_RETURN) {
strcat (combuf, "return ");
} else {
// comment indirect flow control change to reflect ultimate target
switch (buf & 07400) {
case 04400:
sprintf (combuf + strlen (combuf), "long call to S%04o ", core [eff_addr]);
break;
case 05400:
sprintf (combuf + strlen (combuf), "long jump to L%04o ", core [eff_addr]);
break;
}
}
if ((eff_addr & 07770) == 00010) { // address 0010 -> 0017
sprintf (disbuf + strlen (disbuf), "%o ", eff_addr & 7);
} else {
sprintf (disbuf + strlen (disbuf), "%04o ", (tags [eff_addr] & TAG_KONSTANT) ? core [eff_addr] : eff_addr);
}
break;
case 06000: // IOT
fetch_iot (buf, disbuf, combuf);
break;
case 07000: // OPR
// perform "short form" OPRs here first...
switch (buf) {
case 07000: sprintf (disbuf, "NOP"); break;
#ifdef DNN1
// case 07002: sprintf (disbuf, "BSW"); break;
case 07600: sprintf (disbuf, "7600"); break;
#endif // DNN1
#ifdef DNN2
case 07400: sprintf (disbuf, "7400"); break;
case 07401: sprintf (disbuf, "7401"); break;
case 07601: sprintf (disbuf, "7601"); break;
#endif // DNN2
case 07041: sprintf (disbuf, "CIA"); break;
case 07120: sprintf (disbuf, "STL"); break;
case 07204: sprintf (disbuf, "GLK"); break;
case 07240: sprintf (disbuf, "STA"); strcat (combuf, "AC = 7777 (-0001)"); break;
case 07300: sprintf (disbuf, "CLA CLL"); strcat (combuf, "AC = 0000"); break;
case 07301: sprintf (disbuf, "CLA CLL IAC"); strcat (combuf, "AC = 0001"); break;
case 07303: sprintf (disbuf, "CLA CLL IAC BSW"); strcat (combuf, "AC = 0100 (64)"); break;
case 07305: sprintf (disbuf, "CLA CLL IAC RAL"); strcat (combuf, "AC = 0002"); break;
case 07325: sprintf (disbuf, "CLA CLL CML IAC RAL"); strcat (combuf, "AC = 0003"); break;
case 07326: sprintf (disbuf, "CLA CLL CML RTL"); strcat (combuf, "AC = 0002"); break;
case 07307: sprintf (disbuf, "CLA CLL IAC RTL"); strcat (combuf, "AC = 0004"); break;
case 07327: sprintf (disbuf, "CLA CLL CML IAC RTL"); strcat (combuf, "AC = 0006"); break;
case 07330: sprintf (disbuf, "CLA CLL CML RAR"); strcat (combuf, "AC = 4000 (-4000 = -2048 dec)"); break;
case 07332: sprintf (disbuf, "CLA CLL CML RTR"); strcat (combuf, "AC = 2000 (1024)"); break;
case 07333: sprintf (disbuf, "CLA CLL CML IAC RTL"); strcat (combuf, "AC = 6000 (-2000 = -1024 dec)"); break;
case 07340: sprintf (disbuf, "CLA CLL CMA"); strcat (combuf, "AC = 7777 (-0001)"); break;
case 07344: sprintf (disbuf, "CLA CLL CMA RAL"); strcat (combuf, "AC = 7776 (-0002)"); break;
case 07346: sprintf (disbuf, "CLA CLL CMA RTL"); strcat (combuf, "AC = 7775 (-0003)"); break;
case 07350: sprintf (disbuf, "CLA CLL CMA RAR"); strcat (combuf, "AC = 3777 (2047)"); break;
case 07352: sprintf (disbuf, "CLA CLL CMA RTR"); strcat (combuf, "AC = 5777 (-2001 = -1025 dec)"); break;
#ifndef DNN2
case 07401: sprintf (disbuf, "NOP"); break;
#endif // !DNN1
case 07410: sprintf (disbuf, "SKP"); break;
case 07610: sprintf (disbuf, "SKP CLA"); break;
case 07604: sprintf (disbuf, "LAS"); break;
case 07621: sprintf (disbuf, "CAM"); break;
default:
// determine group (0401 is 0000/0001 for group 1, 0400 for group 2, 0401 for EAE)
switch (buf & 00401) {
case 00000: // group 1
case 00001: // group 1
// sequence 1
if (buf & 00200) {
strcat (disbuf, "CLA ");
}
if (buf & 00100) {
strcat (disbuf, "CLL ");
}
// sequence 2
if (buf & 00040) {
strcat (disbuf, "CMA ");
}
if (buf & 00020) {
strcat (disbuf, "CML ");
}
// sequence 3
if (buf & 00001) {
strcat (disbuf, "IAC ");
}
// sequence 4
if (buf & 00010) {
if (buf & 00002) {
strcat (disbuf, "RTR ");
} else {
strcat (disbuf, "RAR ");
}
}
if (buf & 00004) {
if (buf & 00002) {
strcat (disbuf, "RTL ");
} else {
strcat (disbuf, "RAL ");
}
}
#ifdef DNN2
if ((buf & 00016) == 00002) {
strcat (disbuf, "BSW ");
}
#endif // DNN2
break;
case 00400: // group 2
// sequence 1
if (buf & 00100) {
if (buf & 00010) {
strcat (disbuf, "SPA ");
} else {
strcat (disbuf, "SMA ");
}
}
if (buf & 00040) {
if (buf & 00010) {
strcat (disbuf, "SNA ");
} else {
strcat (disbuf, "SZA ");
}
}
if (buf & 00020) {
if (buf & 00010) {
strcat (disbuf, "SZL ");
} else {
strcat (disbuf, "SNL ");
}
}
#ifdef DNN2
if ((buf & 00170) == 00010) {
strcat (disbuf, "SKP ");
}
#endif // DNN2
// sequence 2
if (buf & 00200) {
strcat (disbuf, "CLA ");
}
// sequence 3
if (buf & 00004) {
strcat (disbuf, "OSR ");
}
if (buf & 00002) {
strcat (disbuf, "HLT ");
}
break;
case 00401: // EAE
// sequence 1
if (buf & 00200) {
strcat (disbuf, "CLA ");
}
// sequence 2
if (buf & 00100) {
strcat (disbuf, "MQA ");
}
if (buf & 00040) {
strcat (disbuf, "SCA ");
}
if (buf & 00020) {
strcat (disbuf, "MQL ");
}
// sequence 3
switch (buf & 00016) {
case 0: // no further ops, done
break;
case 002:
strcat (disbuf, "SCL ");
two_word = buf;
break;
case 004:
strcat (disbuf, "MUY ");
two_word = buf;
break;
case 006:
strcat (disbuf, "DVI ");
two_word = buf;
break;
case 010:
strcat (disbuf, "NMI");
break;
case 012:
strcat (disbuf, "SHL ");
two_word = buf;
break;
case 014:
strcat (disbuf, "ASR ");
two_word = buf;
break;
case 016:
strcat (disbuf, "LSR ");
two_word = buf;
break;
}
break;
}
break;
}
break;
}
if (two_word) {
strcat (disbuf, "+");
}
// trim any trailing spaces
while (*disbuf && disbuf [strlen (disbuf) - 1] == ' ') {
disbuf [strlen (disbuf) - 1] = 0;
}
if (primary == 'c') { // if primary is code, then spill data too
pad (disbuf, 0, COMSTART - 4); // add tabs to get disassembly to comment start (one tab less because we print it next)
printf ("\t%s", disbuf); // print disassembly so far
printf ("/ "); // print comment start
pad (combuf, 2, DATASTART); // pad comment buffer to get to data area
printf ("%s@@%04o=%04o\n", combuf, addr, buf); // print comment, address and opcode
} else { // else we've already spilled both, just terminate the line
pad (disbuf, 2, DATASTART);
printf (" %s", disbuf);
printf ("\n");
two_word = 0; // we don't care that it's a two-word when we're printing it as data
}
}
/*
* ea
*
* Calculate the effective address given the
* address and opcode. Opcodes that don't have
* an effective address (e.g., IOTs), return -1.
*
* The indirect pointer is optional, and, if specified,
* will cause the location to be returned with a zero
* or one indicating indirection. The indirect pointer
* is not modified in case of a non-EA opcode.
*
* Similarly for the curpage pointer.
*/
int
ea (int addr, int opcode, int *indirect, int *curpage)
{
int eff_addr;
int c;
int i;
if (opcode >= 06000) { // IOTs and OPRs don't have an EA
return (-1);
}
i = opcode & 00400;
c = opcode & 00200;
eff_addr = c ? (addr & 07600) + (opcode & 00177) : opcode & 00177;
if (indirect) {
*indirect = i;
}
if (curpage) {
*curpage = c;
}
return (eff_addr);
}
/*
* disassemble
*
* This drives disassembly once the flow analysis has been done.
*
* We disassemle in segment order.
*/
void
disassemble (void)
{
int snum;
header ();
for (snum = 0; snum < nsegments; snum++) {
printf ("\n*%04o\n", segments [snum].saddr);
disassemble_range (segments [snum].saddr, segments [snum].saddr + segments [snum].nwords);
}
}
static void
header (void)
{
struct tm *tm;
time_t now;
int nused, ndata, ncode;
int i;
time (&now);
tm = localtime (&now);
nused = ndata = ncode = 0;
for (i = 0; i < CORE_SIZE; i++) {
if (core [i] >= 0) {
nused++;
if (tags [i] & TAG_DATA) {
ndata++;
} else {
ncode++;
}
}
}
printf ("TITLE \"AUTOMATIC DISASSEMBLY OF %s BY D8TAPE\"\n", tapename);
printf ("////////////////////////////////////////////////////////////////////////////////\n");
printf ("/\n");
printf ("/\tAutomatic Disassembly of %s\n", tapename);
printf ("/\tGenerated %04d %02d %02d %02d:%02d:%02d\n", tm -> tm_year + 1900, tm -> tm_mon + 1, tm -> tm_mday, tm -> tm_hour, tm -> tm_min, tm -> tm_sec);
printf ("/\tGenerated by d8tape version %s\n", version);
printf ("/\tVisit http://www.pdp12.org/pdp8/software/index.html for updates\n");
printf ("/\n");
printf ("/\tSymbol format:\n");
printf ("/\t\tAIx -- Auto-index variables (address range 001x)\n");
printf ("/\t\tCaaaa -- Constants (non-unique)\n");
printf ("/\t\tDaaaa -- Data (read/write variables)\n");
printf ("/\t\tKvvvv -- Program-wide unique constants\n");
printf ("/\t\tLaaaa -- Labels for control flow targets\n");
printf ("/\t\tSaaaa -- Subroutines\n");
printf ("/\n");
printf ("/\tWhere:\n");
printf ("/\t\taaaa is the definition address\n");
printf ("/\t\tvvvv is the value of the constant\n");
printf ("/\t\tx is the last digit of the address 001x for auto-index variables\n");
printf ("/\n");
printf ("/\t%04o locations used, %04o code and %04o data\n", nused, ncode, ndata);
printf ("////////////////////////////////////////////////////////////////////////////////\n");
}
static void
disassemble_range (int start, int end)
{
int addr;
for (addr = start; addr < end; addr++) {
dasm8 (addr, core [addr]);
}
}
/*
* fetch_iot
*
* This function looks up in the iot table (iot.h) to find
* the opcode passed in "code" and updates the disassembled
* output "dis" and the comment "com".
*
* More work needs to be done here for conflicting IOTs.
*
* Current, I assume that there are no conflicts (actually, I
* return the first match, regardless of conflicts). A command
* line / control file option needs to be created to allow
* the selection of devices. Something like "-i vc8i", for example
* to allow the VC8/I IOTs to be enabled.
*/
int
fetch_iot (int code, char *dis, char *com)
{
int i;
for (i = 0; i < sizeof (iots) / sizeof (iots [0]); i++) {
if (code == iots [i].code) {
if (dis) {
strcpy (dis, iots [i].mnemonic);
}
if (com) {
strncpy (com, iots [i].comment, COMLEN - 1);
}
return (1);
}
}
if (dis) {
sprintf (dis, "%04o", code);
}
if (com) {
sprintf (com, "unknown IOT");
}
return (0);
}
/*
* pad
*
* Figures out where the current print position is based on expanding
* the current tabs in "buf" and adds more tabs to get to "pos".
*/
static void
pad (char *buf, int loc, int pos)
{
for (; *buf; buf++) {
if (*buf == '\t') {
if ((loc & 3) == 0) {
loc += 4;
} else {
loc += 4 - (loc & ~3);
}
} else {
loc++;
}
}
loc = pos / 4 - loc / 4;
while (loc--) {
*buf++ = '\t';
}
*buf = 0;
}
int
is_data (int v)
{
return ((v & TAG_TYPE_MASK) == TAG_DATA);
}
static void
xrefs (int addr)
{
int i;
int eff;
int count;
count = 0;
for (i = 0; i < CORE_SIZE; i++) {
if (core [i] < 0) {
continue;
}
if (tags [i] & TAG_DATA) {
//printf ("+XREF ADDR %04o CHECK %04o IS DATA\n", addr, i);
continue;
}
if ((core [i] & 07400) == 04000) { // direct JMS
eff = ea (i, core [i], NULL, NULL);
//printf ("+XREF ADDR %04o CHECK %04o %04o JMS EA %04o\n", addr, i, core [i], eff);
if (eff == addr) {
if (!count) {
printf ("/\tCalled from:\n/\t");
}
printf ("%04o ", i);
count++;
if ((count % 15) == 0) {
printf ("\n/\t");
}
}
} else if ((core [i] & 07400) == 04400) { // indirect JMS
eff = ea (i, core [i], NULL, NULL);
//printf ("+XREF ADDR %04o CHECK %04o %04o JMS I EA %04o\n", addr, i, core [i], eff);
if (tags [eff] & TAG_WRITABLE) {
continue;
}
//printf ("+XREF ADDR %04o CHECK %04o %04o JMS I is not writable\n", addr, i, core [i]);
if (core [eff] < 0) {
continue;
}
//printf ("+XREF ADDR %04o CHECK %04o %04o JMS I has valid indirect value\n", addr, i, core [i]);
if (core [eff] == addr) {
if (!count) {
printf ("/\tCalled from:\n/\t");
}
printf ("%04o ", i);
count++;
if ((count % 15) == 0) {
printf ("\n/\t");
}
}
}
}
if (count) {
printf ("\n");
printf ("/\tTotal %04o (%d) calls\n", count, count);
} else {
printf ("/\tNever called\n");
}
}

472
d8tape/flow.c Normal file
View File

@ -0,0 +1,472 @@
/*
* flow.c
*
* (C) Copyright 2007 by Robert Krten, all rights reserved.
* Please see the LICENSE file for more information.
*
* This module contains the PDP-8 flow analyzer.
*
* 2007 10 25 R. Krten created
* 2007 10 28 R. Krten added TAG_INDIRECTFC
*/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <errno.h>
#include "d8tape.h"
extern char *progname; // main.c
extern char *version; // version.c
extern int optv; // main.c
extern short int core []; // main.c, in-core image (-1 means location never used)
extern uint16_t tags []; // main.c, analysis tags
char konstmap [4096]; // 12 bits gives us 0..4095, so 4096 different constants (0 == not used, 1 == unique, 2 == used but not unique)
static void pass1 (void);
static void pass2 (void);
static void pass3 (void);
#ifdef PASS4_ENABLED
static void pass4 (void);
#endif
static void verify_subroutines (void);
static int valid_opr (int opr);
/*
* Main flow analysis
*
* See individual functions for more details
*
* Basic idea is that there is a shadow array called "tags", which indicates
* information about the given memory location (e.g., tags [0017] gives
* information about core [0017]).
*
* The various passes affect the tags[] array with whatever they can detect.
*/
void
flow (void)
{
pass1 ();
pass2 ();
pass3 ();
#ifdef PASS4_ENABLED
pass4 (); // this pass is fundamentally broken (well, maybe not the pass, but the interpretation of the results in dasm.c)
#endif
verify_subroutines ();
}
/*
* pass1
*
* On pass 1, we can say with certainty only the following statements:
* - if it's an invalid IOT or OPR, then it's data.
* - if the instruction must have a valid EA, and it's invalid,
* then it's data.
* - if the JMS (direct only) target is not zero or the same as the
* address, then it's data
*/
static void
pass1 (void)
{
int addr, eff;
for (addr = 0; addr < CORE_SIZE; addr++) {
// skip unused
if (core [addr] == -1) {
continue;
}
// handle IOTs
if ((core [addr] & 07000) == 06000) {
// if we can't decode it, it's not valid
if (!fetch_iot (core [addr], NULL, NULL)) {
tags [addr] |= TAG_DATA;
}
continue;
}
// check OPRs; if they're invalid, tag as DATA, else skip
if ((core [addr] & 07000) == 07000) {
if (!valid_opr (core [addr])) {
tags [addr] |= TAG_DATA;
if (optv > 1) {
printf ("+FLOW1 %04o %04o has invalid OPR -> DATA\n", addr, core [addr]);
}
}
// done OPRs, skip
continue; // @@@ NOTE: this does not work with EAE OPRs that take the next location as their parameter...
}
// ea() is always valid for opcodes < 06000
eff = ea (addr, core [addr], NULL, NULL);
// if the instruction should have a valid EA and doesn't...
if (core [eff] == -1) {
// then it's not an instruction
tags [addr] |= TAG_DATA;
if (optv > 1) {
printf ("+FLOW1 %04o %04o has EA %04o (invalid or not in core) and OP < 6000 -> DATA\n", addr, core [addr], eff);
}
continue;
}
// if it's a plain JMS
if ((core [addr] & 07400) == 04000) {
// and the target isn't zero or it's not the same as the address
if (core [eff] && core [eff] != eff) {
tags [addr] |= TAG_DATA;
if (optv > 1) {
printf ("+FLOW1 %04o %04o JMS target not 0000 or ADDR (EA %04o is %04o)\n", addr, core [addr], eff, core [eff]);
}
continue;
}
// else, if it's ok, then the target is writable, after all (JMS drops the return address there)
tags [eff] |= TAG_WRITABLE;
if (optv > 1) {
printf ("+FLOW1 %04o %04o JMS target is 0000 or ADDR, marking EA %04o as WRITABLE\n", addr, core [addr], eff);
}
}
}
}
/*
* pass2
*
* In this pass, we operate on the direct targets (no indirection)
* and mark the targets as data, variable, label, or subroutine
* target.
*/
static void
pass2 (void)
{
int addr;
int eff;
for (addr = 0; addr < CORE_SIZE; addr++) {
// skip unused or data locations
if (core [addr] == -1 || (tags [addr] & TAG_DATA)) {
continue;
}
eff = ea (addr, core [addr], NULL, NULL);
switch (core [addr] & 07400) { // check opcode
case 00000: // AND
case 00400: // AND I
case 01000: // TAD
case 01400: // TAD I
case 02000: // ISZ
case 02400: // ISZ I
case 03000: // DCA
case 03400: // DCA I
tags [eff] |= TAG_DATA; // the referenced EA is data
if (optv > 1) {
printf ("+FLOW2 %04o %04o is AND/TAD/ISZ/DCA's EA %04o tagged as DATA\n", addr, core [addr], eff);
}
// mark as writable if someone writes to it directly (ISZ and DCA only)
if ((core [addr] & 07400) == 02000 || (core [addr] & 07400) == 03000) {
tags [eff] |= TAG_WRITABLE;
if (optv > 1) {
printf ("+FLOW2 %04o %04o is ISZ/DCA so EA %04o is WRITABLE\n", addr, core [addr], eff);
}
}
break;
case 04000: // JMS
if (core [eff] == 0 || core [eff] == eff) { // first word of JMS target must be zero or the address itself
tags [eff] |= TAG_SUB; // otherwise, it's a valid subroutine target
if (optv > 1) {
printf ("+FLOW2 %04o %04o is JMS with good target %04o content (%04o) so tagged as SUB\n", addr, core [addr], eff, core [eff]);
}
} else {
tags [addr] |= TAG_DATA; // then invalidate this "instruction", it's bogus
if (optv > 1) {
printf ("+FLOW2 %04o %04o is JMS with bad target %04o content (%04o) so tagged as DATA\n", addr, core [addr], eff, core [eff]);
}
}
break;
case 05000: // JMP
tags [eff] |= TAG_LABEL;
if (optv > 1) {
printf ("+FLOW2 %04o %04o is JMP so EA %04o is LABEL\n", addr, core [addr], eff);
}
break;
break;
// JMS I, JMP I, IOTs, and OPRs are not handled in this pass
}
}
}
/*
* pass3
*
* In this pass, we verify and mark the indirects
*/
static void
pass3 (void)
{
int addr;
int eff;
for (addr = 0; addr < CORE_SIZE; addr++) {
// skip unused, data, or non-indirect opcodes
if (core [addr] == -1 || (tags [addr] & TAG_DATA) || core [addr] >= 06000 || !(core [addr] & 00400)) {
if (optv > 2 && core [addr] != -1) {
printf ("+FLOW3 %04o %04o tags 0x%04x skipped\n", addr, core [addr], tags [addr]);
}
continue;
}
eff = ea (addr, core [addr], NULL, NULL);
switch (core [addr] & 07000) { // check opcode (indirectness assured above)
case 00000: // AND I
case 01000: // TAD I
case 02000: // ISZ I
case 03000: // DCA I
if (core [eff] != -1 && !(tags [eff] & TAG_WRITABLE)) { // if it's valid and constant
tags [core [eff]] |= TAG_DATA; // then the target is data
if (optv > 1) {
printf ("+FLOW3 %04o %04o is AND/TAD/ISZ/DCA I through constant EA %04o so target %04o is DATA\n", addr, core [addr], eff, core [eff]);
}
// mark as writable if someone writes to it (ISZ and DCA only)
if ((core [addr] & 07000) == 02000 || (core [addr] & 07000) == 03000) {
tags [core [eff]] |= TAG_WRITABLE;
if (optv > 1) {
printf ("+FLOW3 %04o %04o is ISZ/DCA I thorugh constant EA %04o so target %04o is WRITABLE\n", addr, core [addr], eff, core [eff]);
}
}
}
break;
case 04000: // JMS I
if (core [eff] != -1 && !(tags [eff] & TAG_WRITABLE)) { // if it's valid and constant
if (core [core [eff]] == 0 || core [core [eff]] == core [eff]) { // valid first word of JMS I target
tags [core [eff]] |= TAG_SUB; // ultimate target is a valid subroutine target
tags [eff] |= TAG_DATA; // and the pointer is a valid data type
tags [eff] |= TAG_INDIRECTFC; // and the pointer is used in an indirect flow control target
if (optv > 1) {
printf ("+FLOW3 %04o %04o is JMS I through constant EA %04o so target %04o (content %04o) is ok, so tagged as SUB\n", addr, core [addr], eff, core [eff], core [core [eff]]);
}
} else {
tags [addr] |= TAG_DATA; // then this isn't a valid instruction
if (optv > 1) {
printf ("+FLOW3 %04o %04o is JMS I through constant EA %04o with target %04o (invalid content %04o), so tagged as DATA\n", addr, core [addr], eff, core [eff], core [core [eff]]);
}
}
}
break;
case 05000: // JMP I
if (core [eff] != -1) { // if it's valid
if (!(tags [eff] & TAG_WRITABLE)) { // and constant
tags [eff] |= TAG_DATA; // pointer is a valid data type
tags [eff] |= TAG_INDIRECTFC; // and the pointer is used in an indirect flow control target
tags [core [eff]] |= TAG_LABEL; // ultimate target is a valid JMP target
if (optv > 1) {
printf ("+FLOW3 %04o %04o is JMP I through constant EA %04o with valid target %04o, so EA tagged as DATA | INDIRECTFC and target data %04o tagged as LABEL\n", addr, core [addr], eff, core [eff], core [core [eff]]);
}
}
} else {
tags [addr] |= TAG_DATA; // else, it's not really a valid constant expression
if (optv > 1) {
printf ("+FLOW3 %04o %04o is JMP I through constant EA %04o with invalid target %04o, so tagged as DATA\n", addr, core [addr], eff, core [eff]);
}
}
break;
}
}
}
#ifdef PASS4_ENABLED
/*
* pass4
*
* In this pass, we update the constant map (konstmap).
*
* This effectively converts Cxxxx to Kxxxx, and results in more human-
* friendly code. So, instead of:
*
* C1234, 0777
*
* you'd see:
*
* K0777, 0777
*
* The only trick to this is that since symbols must be unique in 6
* characters (for PAL compatibility), we need to ensure that the
* items that convert from Cxxxx to Kxxxx are unique. That's why
* konstmap[] has the values 0, 1, and 2:
*
* 0 == constant is not used anywhere in the code
* 1 == constant is defined exactly once (can be converted)
* 2 == constant has been defined more than once (cannot be converted)
*
* Any constant that's used in an indirect flow control manner, however,
* is not a candidate, because technically it's not used as a K-style
* constant.
*/
static void
pass4 (void)
{
int i;
memset (konstmap, 0, sizeof (konstmap));
// populate konstant[] map
for (i = 0; i < CORE_SIZE; i++) {
if (core [i] == -1) {
continue;
}
if (tags [i] & TAG_WRITABLE) {
if (optv > 1) {
printf ("+FLOW4 %04o %04o TAG %02X is writable, therefore, not a constant\n", i, core [i], tags [i]);
}
continue;
}
if (optv > 1) {
printf ("+FLOW4 %04o %04o TAG %02X\n", i, core [i], tags [i]);
}
if ((tags [i] & TAG_DATA) && !(tags [i] & TAG_INDIRECTFC)) {
switch (konstmap [core [i]]) {
case 0:
if (optv > 1) {
printf ("+FLOW4 %04o %04o FRESH KONSTANT\n", i, core [i]);
}
konstmap [core [i]]++; // this is our first one, bump the counter
break;
case 1:
if (optv > 1) {
printf ("+FLOW4 %04o %04o NO LONGER UNIQUE KONSTANT\n", i, core [i]);
}
konstmap [core [i]]++; // this is our second one, go to "2"
break;
case 2:
if (optv > 1) {
printf ("+FLOW4 %04o %04o PROMISCUOUS CONSTANT\n", i, core [i]);
}
// do nothing, we're at "2" indicating "non-unique"
break;
}
}
}
// analyze konstant[] map
for (i = 0; i < CORE_SIZE; i++) {
if (core [i] == -1) {
continue;
}
if (tags [i] & TAG_WRITABLE) {
if (optv > 1) {
printf ("+FLOW4 %04o %04o TAG %02X is writable, therefore, not a constant\n", i, core [i], tags [i]);
}
continue;
}
if (optv > 1) {
printf ("+FLOW4 %04o %04o TESTING (%02X)\n", i, core [i], tags [i]);
}
if (tags [i] & TAG_DATA) {
if (optv > 1) {
printf ("+FLOW4 %04o %04o TESTING...DATA\n", i, core [i]);
}
if (konstmap [core [i]] == 1) { // if it's unique
tags [i] |= TAG_KONSTANT; // then go ahead and tag it
if (optv > 1) {
printf ("+FLOW4 %04o %04o TAGGED AS KONSTANT\n", i, core [i]);
}
}
}
}
}
#endif
/*
* verify_subroutines
*
* This is used to verify that a target really is a subroutine.
* Verification consists of ensuring that somewhere within the
* same page is a JMP I through the return address. If not,
* then the subroutine is bogus, because you can't return from
* it, so we knock down the "TAG_SUB" flag.
*
* BUG: This misses the following case:
*
* *0
* 0 /return area
* *4000
* jmp i 0 / return through zero page
*
* because we only search for returns within the page that the
* subroutine definition is in. I don't think this is a major
* problem, just something to be aware of. Plus, the TAG_RETURN
* is *really* only used as a comment field indicator anyway.
*/
static void
verify_subroutines (void)
{
int addr;
int page;
int found;
for (addr = 0; addr < CORE_SIZE; addr++) {
if (!(tags [addr] & TAG_SUB)) {
continue;
}
// try and find returns within page
found = 0;
for (page = addr; page <= (addr | 00177); page++) {
if ((core [page] & 07400) == 05400) {
if (ea (page, core [page], NULL, NULL) == addr) { // JMP I <start of subroutine> found!
tags [page] |= TAG_RETURN; // mark the returns
found++;
}
}
}
if (!found) {
tags [addr] &= ~TAG_SUB; // not a subroutine, no return
}
}
}
static int
valid_opr (int opr)
{
// a valid OPR must be 07xxx
if ((opr & 07000) != 07000) {
return (0);
}
if ((opr & 07400) == 07000) { // group 1
if ((opr & 00014) == 00014) { // with both L and R rotate bits on
return (0);
}
} else if ((opr & 07401) == 07400) { // group 2
// all ok
} else if ((opr & 07401) == 07401) { // EAE
// if bits 6, 8, 9, or 10 are set...
if (opr & 00056) {
return (0); // @@@ we're disabling EAE for now
}
// otherwise it's an "MQ microinstruction", which is ok
}
return (1);
}

418
d8tape/iot.h Normal file
View File

@ -0,0 +1,418 @@
/*
* iot.h
*
* (C) Copyright 2003 by Robert Krten, all rights reserved.
* Please see the LICENSE file for more information.
*
* This module contains the IOT decode table.
*
* 2003 12 16 R. Krten created
*/
/*
* Conflicting decodes for IOTs
*
* 6050 - 6077 VC8I or KV8I; one only
* 6440 - 6457 PT08 uses some of the data areas from the Data Communications System 680/I -- definition of PT08 is optional
* 6530 - 6547 AF01A or AF04A; one only
* 6551 used by AA01A, AA05, or not used. Define zero or one only.
* 6571 used by AF04A, AC01A, or not used. Define zero or one only.
* 6600 - 6667 used by DP01AA, overrides DF32/RF08 selection. If defining DP01AA, don't bother with DF32/RF08
* 6600 - 6627 used by DF32 and RF08, define one only.
* 6640 - 6647 used by RF08 or not used, define RF08 or not.
* 6700 - 6727 used by TC58, TR02, and TA8A, define one only
*/
// Select one of the following:
#define VC8I
//#define KV8I
// Select PT08 if required; it will override some of the IOTs from the Data Communications System 680/I
//#define PT08
// Select one of the following:
#define AF01A
//#define AF04A
// Select one of the following:
#define AA01A
//#define AA05
// If selecting DP01AA, don't bother with DF32/RF08
//#define DP01AA
#ifndef DP01AA
// Select one of the following:
#define DF32
// #define RF08
#endif // DP01AA
// Select one of the following:
#define TA8A
//#define TC58
//#define TR02
typedef struct
{
int code; // code number, e.g. 06001
char *option; // hardware option, e.g., vc8i
char *mnemonic; // decoded value, e.g., "ION"
char *comment; // code description of IOT, e.g., "clear x coordinate buffer"
} one_iot_t;
#define OP_ALL ""
one_iot_t iots [] =
{
// 6000 Interrupts
{ 06001, OP_ALL, "ION", "Enable Interrupts"},
{ 06002, OP_ALL, "IOF", "Disable Interrupts"},
// 6010 High Speed Perforated Tape Reader and Control
{ 06011, OP_ALL, "RSF", "Skip if reader flag is a 1."},
{ 06012, OP_ALL, "RFB", "Read the content of the reader buffer and clear the reader flag. This instructions does not clear the AC. RB v AC4-11 -> AC4-11"},
{ 06014, OP_ALL, "RFC", "Clear reader flag and reader buffer, fetch one character from tape and load it into the reader buffer, and set the reader flag when done."},
// 6020 High Speed Perforated Tape Punch and Control
{ 06021, OP_ALL, "PSF", "Skip if punch flag is a 1"},
{ 06022, OP_ALL, "PCF", "Clear punch flag and punch buffer."},
{ 06024, OP_ALL, "PPC", "Load the punch buffer from bits 4 through 11 of the AC and punch the character. This instructions does not clear the punch flag or punch buffer. AC4-11 v PB -> PB"},
{ 06026, OP_ALL, "PLS", "Clear the punch flag, clear the bunch buffer, load the punch buffer from the content of bits 4 through 11 of the accumulator, punch the character, and set the punch flag to 1 when done."},
// 6030 Teletype Keyboard / Reader
{ 06031, OP_ALL, "KSF", "Skip if keyboard flag is a 1."},
{ 06032, OP_ALL, "KCC", "Clear AC and clear keyboard flag."},
{ 06034, OP_ALL, "KRS", "Read keyboard buffer static. This is a static command in that neither the AC nor the keyboard flag is cleared. TTI v AC4-11 -> AC4-11"},
{ 06036, OP_ALL, "KRB", "Clear AC, clear keyboard flag, and read the content of the keyboard buffer into the content of AC4-11."},
// 6040 Teletype Teleprinter / Punch
{ 06041, OP_ALL, "TSF", "Skip if teleprinter flag is a 1."},
{ 06042, OP_ALL, "TCF", "Clear teleprinter flag."},
{ 06044, OP_ALL, "TPC", "Load the TTO from the content of AC4-11 and print and/or punch the character."},
{ 06046, OP_ALL, "TLS", "Load the TTO from the content of AC4-11, clear the teleprinter flag, and print and/or punch the character."},
#ifdef VC8I
// 6050 Oscilloscope Display Type VC8/I [VC8/L]
{ 06051, OP_ALL, "DCX", "Clear X coordinate buffer"},
{ 06053, OP_ALL, "DXL", "Clear and load X coordinate buffer. AC2-11 -> YB"},
{ 06054, OP_ALL, "DIX", "Intensify the point defined by the content of the X and Y coordinate buffers."},
{ 06057, OP_ALL, "DXS", "Executes the combined functions of DXL followed by DIX"},
// 6060 (continued)
{ 06061, OP_ALL, "DCY", "Clear Y coordinate buffer"},
{ 06063, OP_ALL, "DYL", "Clear and load Y coordinate buffer. AC2-11 -> YB"},
{ 06064, OP_ALL, "DIY", "Intensify the point defined by the content of the X and Y coordinate buffers."},
{ 06067, OP_ALL, "DYS", "Executes the combined functions of DYL followed by DIY"},
// 6070 (continued)
{ 06071, OP_ALL, "DSF", "(Light Pen Type 370) Skip if display flag is a 1."},
{ 06072, OP_ALL, "DCF", "(Light Pen Type 370) Clear the display flag."},
{ 06074, OP_ALL, "DSB", "Zero brightness"},
{ 06075, OP_ALL, "DSB", "Set minimum brightness"},
{ 06076, OP_ALL, "DSB", "Set medium brightness"},
{ 06077, OP_ALL, "DSB", "Set maximum brightness"},
#endif
#ifdef KV8I
// 6050 Storage Tube Display Control, Type KV8/I [KV8/L]
{ 06051, OP_ALL, "SNC", "Senses the condition of the cursor interrupt flag. The flag produces an interrupt request when set by operation of the interrupt pushbutton on the joystick. The flag is initially cleared when the computer is started. As with all flag-sent instructions, SNC can be used under interrupt conditions to detect the source of the interrupt, or it can be used under interrupt on (ION) when the interrupt request has been caused by the operation of thecursor interrupt button. In a program running with the interrupt off, SNC can be used to ignore the cursor successive approximation subroutine in the program if a request for service has not been made from the joystick controller."},
{ 06052, OP_ALL, "CCF", "This instruction is used to clear the cursor flag after a request for service has been acknowledged by the program."},
// 6060 (continued)
{ 06062, OP_ALL, "SAC", "The analog comparator is set to compare the analog content of any one of six analog sources with the content of the digital-to-analog converter. The analog sources are chosen according to a 3-bit binary code. This code establishes the parameter for choosing the wanted register according to the content of AC2, AC3, and AC6."},
{ 06063, OP_ALL, "LDF", "This instruction is used to establish the mode in which a wanted graphic is to be produced according to a 2-bit binary code. This code determines whether the wanted vector will be linear absolute relative, whether the point plot mode will be used, or whether the cursor will be displayed. This code establishes the paramteres for these formats according to the content of AC2 and AC3. The LDF instruction must precede the LDX and LDY instructions."},
{ 06064, OP_ALL, "LDX", "The X-axis sample and hold register is loaded with the binary equivalent of the X-axis coordinate according to the contents of AC2-11. This data appears at the output of the digital-to-analog converter as the analog equivalent of the X-axis value of the binary word stored in the AC. The LDX instruction clears an existing ready flag and sets the ready flag after 100 +/- 20 us."},
{ 06065, OP_ALL, "LDY", "The Y-axis sample and hold register is loaded with the binary equivalent of the Y-axis coordinate according to the contents of AC2-11. This data appears at the output of the digital-to-analog converter as the analog equivalent of the binary word in the AC. The LDY instruction clears an existing ready flag and sets the ready flag after 100 +/- 20 us."},
{ 06066, OP_ALL, "EXC", "Used to execute the wanted vector according to the contents of AC2-4 and AC6-11. The parameter word establishes long or short formats, circular vectors, display erasure, reset of the integrators, and intensification of the vector. The EXC instruction clears an existing ready flag and sets the ready flag as follows: a) after 20 +/- 5 us for a point or vector continue; b) after 250 us for short vectors; c) after 4.05 ms for long vectors; d) after 500 ms for an erase."},
// 6070 (continued)
{ 06071, OP_ALL, "SRF", "Used to determine when the controller is ready to perform the next execute instruction. The ready flag produces an interrupt condition when set. The flag can be set by pressing the erase pushbutton on the VT01 unit. Normally, however, the state of this flag is determined by the controller. This flag is initially cleared when the computer is started and prior to an LDX, LDY, or EXC instruction."},
{ 06072, OP_ALL, "CRF", "This instruction clears the ready flag after a skip instruction has been acknowledged."},
{ 06073, OP_ALL, "SDA", "Used in the successive approximation subroutine to determine the digital equivalent of the selected analog holding register. This instruction is used with the SAC (6062) instruction."},
{ 06074, OP_ALL, "LDA", "This instruction is used to load the content of AC2-11. This instruction is used with DSA (6073) in the successive approximation subroutine to determine the digital value of the content of the selected analog holding register. Does not change flag states."},
#endif
// 6100 Memory Parity Type MP8/I [MP8/L]
// 6100 Automatic Restart Type KP8/I [KP8/L]
{ 06101, OP_ALL, "SMP", "(MP8/I) Skip if memory parity error flag = 0."},
{ 06102, OP_ALL, "SPL", "(KP8/I) Skip if power low"},
{ 06104, OP_ALL, "CMP", "(MP8/I) Clear memory parity error flag."},
// 6110 Multiple Asynchronous Serial Line Interface Unit, Type DC02D
{ 06111, OP_ALL, "MKSF", "Skip the next instruction if the keyboard flag is set."},
{ 06112, OP_ALL, "MKCC", "Clear the keyboard and reader flags; clear the AC."},
{ 06113, OP_ALL, "MTPF", "(DC02A) Transfer status of teleprinter flags to AC 0-3."},
{ 06114, OP_ALL, "MKRS", "Transfer the shift register contents to AC 4-11."},
{ 06115, OP_ALL, "MINT", "(DC02A) Interrupt on if AC 11 is set (interrupt request, if any flags)."},
{ 06116, OP_ALL, "MKRB", "Clear the keyboard and reader flags, clear the AC, trasnfer the shift register contents to AC 4-11 (MKCC and MKRS combined)."},
{ 06117, OP_ALL, "MTON", "Transfer AC0-3 to selection register (SELF) (select stations when bit is set)."},
// 6120 Multiple Asynchronous Line Unit, Type DC02A
{ 06121, OP_ALL, "MTSF", "Skip the next instruction if the teleprinter flag is set."},
{ 06122, OP_ALL, "MTCF", "Clear the teleprinter flag."},
{ 06123, OP_ALL, "MTKF", "Transfer status of keyboard flags to AC 0-3."},
{ 06124, OP_ALL, "MTPC", "Load AC4-11 into the shift register (begin print/punch)."},
{ 06125, OP_ALL, "MINS", "Skip if the interrupt request is active (if interrupt is on and any flag is raised)."},
{ 06126, OP_ALL, "MTLS", "Clear the teleprinter flag and load AC4-11 into the shift register (MTCF and MTPC combined)"},
{ 06127, OP_ALL, "MTRS", "Trasnfer the status of the selection register to AC 0-3."},
// 6130 Real Time Clock, Type KW8/I [KW8/L]
{ 06132, OP_ALL, "CCFF", "The flag, flag buffer, clock enable, and interrupt enable flip-flops are cleared. This disables the real-time clock."},
{ 06133, OP_ALL, "CSCF", "When the flag flip-flop has been set by a clock pulse, the flag buffer flip-flop is set to a 1. Upon execution of this instruction, an IO BUS IN SKIP is generated if the flag is set. The content of the PC is incremented by 1, so that the next sequential instruction is skipped. The flag flip-flop is then cleared. If the flag flip-flop has not been set, no skip is generated nor is the flag flip-flop cleared."},
{ 06134, OP_ALL, "CRCA", "The output buffer is gated to the I/O BUS during IOP4, and a CLK AC CLR signal generated. This register contains the last count in the count register. The transfer from the count register is synchronized with this instruction so that a transfer that would occur during this instruction is not made."},
{ 06136, OP_ALL, "CCEC", "All clock control flip-flops are first cleared, then the clock enable flip-flop is set. For the variable frequency clock, the frequency source is enabled synchronously with program operation. With all clocks, the data input to the flag is enabled after IOP2 time. This represents an 800-ns mask, after the clock is enabled."},
{ 06137, OP_ALL, "CECI", "All clock control flip-flops are cleared, then the clock enable, and interrupt enable flip-flops are set. The clock enable flip-flop is described with the CCEC instruction. The interrupt enable flip-flop allows an IO BUS IN INT signal when the flag is set."},
// 6140
// 6150
// 6160
// 6170
// 6200 through 6277 Memory Extension Control Type MC8/I [MC8/L]
{ 06201, OP_ALL, "CDF 0^10", "Change to data field 0."},
{ 06202, OP_ALL, "CIF 0^10", "Prepare to change to instruction field 0 at next JMP or JMS instruction."},
{ 06204, OP_ALL, "CINT", "Clear user interrupt."},
// 6210
{ 06211, OP_ALL, "CDF 1^10", "Change to data field 1."},
{ 06212, OP_ALL, "CIF 1^10", "Prepare to change to instruction field 1 at next JMP or JMS instruction."},
{ 06214, OP_ALL, "RDF", "Read data field into AC6-8. Bit 0-5 and 9-11 of the AC are not affected."},
// 6220
{ 06221, OP_ALL, "CDF 2^10", "Change to data field 2."},
{ 06222, OP_ALL, "CIF 2^10", "Prepare to change to instruction field 2 at next JMP or JMS instruction."},
{ 06224, OP_ALL, "RIF", "Read instruction field into AC6-8. Bit 0-5 and 9-11 of the AC are not affected."},
// 6230
{ 06231, OP_ALL, "CDF 3^10", "Change to data field 3."},
{ 06232, OP_ALL, "CIF 3^10", "Prepare to change to instruction field 3 at the next JMP or JMS instruction."},
{ 06234, OP_ALL, "RIB", "Read interrupt buffer. The instruction field and data field stored during an interrupt are read into AC6-8 and AC9-11."},
// 6240
{ 06241, OP_ALL, "CDF 4^10", "Change to data field 4."},
{ 06242, OP_ALL, "CIF 4^10", "Prepare to change to instruction field 4 at the next JMP or JMS instruction."},
{ 06244, OP_ALL, "RMF", "Restore memory field."},
// 6250
{ 06251, OP_ALL, "CDF 5^10", "Change to data field 5."},
{ 06252, OP_ALL, "CIF 5^10", "Prepare to change to instruction field 5 at the next JMP or JMS instruction."},
{ 06254, OP_ALL, "SINT", "Skip on user interrupt."},
// 6260
{ 06261, OP_ALL, "CDF 6^10", "Change to data field 6."},
{ 06262, OP_ALL, "CIF 6^10", "Prepare to change to instruction field 6 at the next JMP or JMS instruction."},
{ 06264, OP_ALL, "CUF", "Clear the user mode flag."},
// 6270
{ 06271, OP_ALL, "CDF 7^10", "Change to data field 7."},
{ 06272, OP_ALL, "CIF 7^10", "Prepare to change to instruction field 7 at the next JMP or JMS instruction."},
{ 06274, OP_ALL, "SUF", "Set the user mode flag at the next JMP or JMS instruction."},
// 6400 Data Communications System 680/I
{ 06401, OP_ALL, "TTINCR", "This instruction causes the contents of the line register to be incremented by 1. This command, when microprogrammed with a TTO command is executed."},
{ 06402, OP_ALL, "TTI", "Causes a JMS to be executed (N+3) if the R register does not equal 0 and either the line hold bit of the selected line (specified by bits 2-8 of the LSW) is in the 1 state, or as a result of jamming the line state into and shifting the CAW; bit 11 of the CAW is a 1."},
{ 06404, OP_ALL, "TTO", "Clears the link and shifts the link and accumulator one bit position to the right. Bit 11 of the accumulator is shifted into the line unit specified by the line register. The previuos contents (1 bit) of the selected line unit is lost."},
// 6410
{ 06411, OP_ALL, "TTCL", "The command sets the contents of the line register to 0."},
{ 06412, OP_ALL, "TTSL", "The contents of AC5-11 are ORed into the line register."},
{ 06413, OP_ALL, "TTLL", "The contents of AC5-11 are trasnferred into the line register. This is a microprogram of TTCL and TTSL."},
{ 06414, OP_ALL, "TTRL", "The contents of the line register are ORed into AC5-11. The AC must be 0 for a true transfer."},
// 6420
{ 06421, OP_ALL, "T1skip", "(Data Communications System 680/I) Clock Control Instruction: Causes the program to skip the next instruction if clock flag 1 is in the 1 state. To clear the flag, either T1on or T1off can be used."},
{ 06422, OP_ALL, "T1off", "(Data Communications System 680/I) Clock Control Instruction: Inhibits clock 1 from setting its flag. This instruction also sets the flag to the 0 state."},
{ 06424, OP_ALL, "T1on", "(Data Communications System 680/I) Clock Control Instruction: Enables clock 1 to set its flag at the predetermined lcock rate. The flag in the 1 state causes a program interrupt when the interrupt is enabled. This instruction also sets the flag to the 0 state."},
// 6430
{ 06431, OP_ALL, "T2skip", "(Data Communications System 680/I) same as T1skip except for clock 2"},
{ 06432, OP_ALL, "T2off", "(Data Communications System 680/I) same as T1off except for clock 2"},
{ 06434, OP_ALL, "T2on", "(Data Communications System 680/I) same as T1on except for clock 2"},
#ifdef PT08
// 6440 Asynchronous Serial Line Interface, Type PT08
{ 06441, OP_ALL, "TSFXXX", "Skip if teleprinter/punch 3 flag is a 1."},
{ 06442, OP_ALL, "TCFXXX", "Clear teleprinter/punch 3 flag."},
{ 06444, OP_ALL, "TPCXXX", "Load teleprinter 3 buffer (TTOX) with AC4-11 and print/punch the character."},
{ 06446, OP_ALL, "TLSXXX", "Load TTOX with AC4-11, 3 flag, print/punch the character and clear teleprinter/punch."},
{ "6450"},
{ 06451, OP_ALL, "KSFXXX", "Skip if keyboard/reader 3 flag is a 1."},
{ 06452, OP_ALL, "KCCXXX", "Clear AC and keyboard/reader 3 flag."},
{ 06454, OP_ALL, "KRSXXX", "Read keyboard/reader 3 buffer (TTI3) static. TTI3 is loaded into AC4-11 by an OR transfer."},
{ 06456, OP_ALL, "KRBXXX", "Clear the AC, read TTI3 into AC4-11, and clear keyboard 3 flag."},
{#else "PT08"},
{ 06441, OP_ALL, "T3skip", "(Data Communications System 680/I) same as T1skip except for clock 3"},
{ 06442, OP_ALL, "T3off", "(Data Communications System 680/I) same as T1off except for clock 3"},
{ 06444, OP_ALL, "T3on", "(Data Communications System 680/I) same as T1on except for clock 3"},
{ 06451, OP_ALL, "T4skip", "(Data Communications System 680/I) same as T1skip except for clock 4"},
{ 06452, OP_ALL, "T4off", "(Data Communications System 680/I) same as T1off except for clock 4"},
{ 06454, OP_ALL, "T4on", "(Data Communications System 680/I) same as T1on except for clock 4"},
#endif
{ 06461, OP_ALL, "TTRINC", "(Data Communications System 680/I) This command causes the contents of the R register to be incremented by 1. Because it is loaded with a 2's complement number, the result is a subtract. This instruction can be microprogrammed with TTRR."},
{ 06464, OP_ALL, "TTRR", "(Data Communications System 680/I) This command reads the contents of the R register into AC7-11. The contents of the AC must be 0s before issuing this instruction. This instruction, when microprogrammed with TTINCR, causes the incremented results to be read into the AC."},
// 6470
{ 06471, OP_ALL, "TTCR", "(Data Communications System 680/I) This command causes the R register to be set to 0"},
{ 06472, OP_ALL, "TTLR", "(Data Communications System 680/I) This command causes the contents of AC7-11 to be trasnferred into the R register."},
// 6500 Incremental Plotter and Control Type VP8/I
{ 06501, OP_ALL, "PLSF", "Skip if plotter flag is a 1."},
{ 06502, OP_ALL, "PLCF", "Clear plotter flag."},
{ 06504, OP_ALL, "PLPU", "Plotter pen up. Raise pen off of paper."},
// 6510
{ 06511, OP_ALL, "PLPR", "Plotter pen right."},
{ 06512, OP_ALL, "PLDU", "Plotter drum (paper) upward"},
{ 06514, OP_ALL, "PLDD", "Plotter drum (paper) downward."},
// 6520
{ 06521, OP_ALL, "PLPL", "Plotter pen left."},
{ 06522, OP_ALL, "PLUD", "Plotter drum (paper) upward. Same as 6512"},
{ 06524, OP_ALL, "PLPD", "Plotter pen down. Lower pen on to paper."},
#ifdef AF01A
// 6530 General Purpose Converter and Multiplexer Control Type AF01A (this option is mutually exclusive with AF04A)
{ 06531, OP_ALL, "ADSE", "Skip if A/D converter flag is a 1."},
{ 06532, OP_ALL, "ADCV", "Clear A/D converter flag and convert input voltage to a digital number, flag will set to 1 at end of conversion. Number of bits in converted number determined by switch setting, 11 bits maximum."},
{ 06534, OP_ALL, "ADRB", "Read A/D converter buffer into AC, left justified, and clear flag."},
// 6540
{ 06541, OP_ALL, "ADCC", "Clear multiplexer channel address register."},
{ 06542, OP_ALL, "ADSC", "Set up multiplexer channel as per AC6-11. Maximum of 64 single ended or 32 differntial input channels."},
{ 06544, OP_ALL, "ADIC", "Index multiplexer channel address (present address + 1). Upon reaching address limit, increment will cause channel 00 to be selected."},
#endif // AF01A
#ifdef AF04A
// 6530 Guarded Scanning Digital Voltmeter Type AF04A (this option is mutually exclusive with AF01A)
{ 06531, OP_ALL, "VSDR", "Skip if data ready flag is a 1."},
{ 06532, OP_ALL, "VRD", "Selected byte of voltmeter is transferred to the accumulator and the data ready flag is cleared."},
{ 06534, OP_ALL, "VBA", "BYTE ADVANCE command requests next twelve bits, data ready flag is set."},
// 6540
{ 06541, OP_ALL, "VCNV", "The contents of the accumulator are transferred to the AF04A channel address register. Analog signal on selected channel is automatically digitized."},
{ 06542, OP_ALL, "VSEL", "The contents of the accumulator are transferred to the AF04A control register."},
{ 06544, OP_ALL, "VINX", "The last channel address is incremented by one and the analog signal on the selected channel is automatically digitized."},
#endif // AF04A
// 6550
#ifdef AA01A
{ 06551, OP_ALL, "DAL1", "(AA01A) The character in the accumulator is loaded into the channel 1 buffer. The DAC then converts the buffered value to the analog equivalent. NOTE: Similar instructions for DAL2 and DAL3 load respective DACs."},
#else // AA01A
#ifdef AA05
{ 06551, OP_ALL, "CLDA", "The address register in the AA05/AA07 is cleared."},
#else // AA05
#endif // AA05
#endif // AA01A
{ 06552, OP_ALL, "LDAD", "(AA05/AA07) The address register in the AA05/AA07 is loaded with the contents of AC0-5."},
// 6560
{ 06562, OP_ALL, "LDAR", "(AA05/AA07) The buffer (input buffer, if the channel is double-buffered) of the DAC is loaded from AC0-9."},
{ 06564, OP_ALL, "UPDT", "(AA05/AA07) The contents of the input buffers of all double-buffered channels are trasnferred to their respective output buffers. The input buffer is not affected by this instruction."},
// 6570
#ifdef AF04A
{ 06571, OP_ALL, "VSCC", "SAMPLE CURRENT CHANNEL when required to digitize analog signal on current channel repeatedly (AF04A)"},
#else // AF04A
#ifdef AC01A
{ 06571, OP_ALL, "HRAN", "The contents of AC3-5 are trasnferred to the channel address register (CHAR). The 3-bit code is decoded to address any of the 8 channels."},
#else // AC01A
#endif // AC01A
#endif // AF04A
#ifdef AC01A
{ 06572, OP_ALL, "HSIM", "Simultaneously places all 8 channels into the hold mode."},
#else // AC01A
#endif // AC01A
{ 06574, OP_ALL, "SAMP", "(AA01A) Places all 8 channels into the sample (or track) mode."},
#ifdef DP01AA
// 6600 Synchronous Modem Interface, Type DP01AA
{ 06601, OP_ALL, "TAC", "Causes the contents of the AC (6, 7, 8, or 9 bits right-justified) to be transferred into the TB."},
{ 06602, OP_ALL, "CTF", "Resets the trasnmit flag. If trasnmit active flag is set, CTF also causes the program to skip the next instruction."},
{ 06604, OP_ALL, "CIM", "Resets the transmit logic idle mode (IM) flip-flop."},
{ 06611, OP_ALL, "STF", "Causes the program to skip the next instruction if the transmit flag is in the 0 state. When the transmit flag is in the 1 state, the trasnmit buffer register (TB) is ready to accept another character."},
{ 06612, OP_ALL, "RRB", "Transfers the contents of the receiver buffer (RB) (6, 7, 8, or 9 bits, right-justified) to the computer AC. RRB also resets the receive flag."},
{ 06614, OP_ALL, "SIM", "Sets the transmit idle mode (IM) flip-flop."},
{ 06621, OP_ALL, "SEF", "Causes the program to skip the next instruction if the receive end flag is 0. The receive end flag slip-flop is set when the receive logic has stopped receiving serial data from the communications equipment due to termination of th SERIAL CLOCK RECEIVE pulse train."},
{ 06622, OP_ALL, "CEF", "Clears the receive end flag"},
{ 06624, OP_ALL, "SRE", "Sets the ring enable (RE) flip-flop to a 1, which permits the ring flag to request a program interrupt."},
{ 06631, OP_ALL, "SRI", "Causes the program to skip the next instruction if the ring flag is 0. The ring flag is set when a ring input is received."},
{ 06632, OP_ALL, "CRF", "Clears the ring flag."},
{ 06634, OP_ALL, "STR", "Sets the terminal read (TR) flip-flop to the 1 state. This causes the terminal ready lead to the modem to be set on the ON state. The state changes to OFF for CTR"},
{ 06641, OP_ALL, "SSR", "Causes the program to skip the next instruction if the data-set-ready lead from the modem is in the ON state."},
{ 06642, OP_ALL, "CTR", "Clears the terminal ready (TR) flip-flop (see STR)"},
{ 06644, OP_ALL, "CRE", "Clears the ring enable (RE) flip-flop."},
{ 06651, OP_ALL, "SRF", "Causes the program to skip the next instruction if the receive flag is 0. The flag is set when a received character is ready for trasnfer to the AC and the flag is cleared when an RRB instruction is issued."},
{ 06652, OP_ALL, "CRA", "Clears the receive active (RA) flip-flop, taking the receive logic out of the active state. This inhibits any more receive flags until a new sync character is received."},
{ 06654, OP_ALL, "XOB", "Causes an exclusive OR of the AC with the buffer register (BR)."},
{ 06661, OP_ALL, "COB", "Clears the XOR buffer."},
{ 06662, OP_ALL, "ROB", "Transfers the buffer register (BR) content to the AC."},
{ 06664, OP_ALL, "IOB", "Transfers 1s from the AC to the buffer register (BR)."},
#else // DP01AA
#ifdef DF32
// 6600 Random Access Disc File (type DF32)
{ 06601, OP_ALL, "DCMA", "Clears memory address register, parity erorr and completion flags. This instruction clears the disk memory request flag and interrupt flags."},
{ 06603, OP_ALL, "DMAR", "The contents of the AC are loaded into the disk memory address register and the AC is cleared. Begin to read information from the disk into the specified core location. Clears parity error and completion flags. Clears interrupt flags."},
{ 06605, OP_ALL, "DMAW", "The contents of the AC are loaded into the disk memory address register and the AC is cleared. Begin to write information into the disk from the specified core location. Clears parity error and completion flags."},
// 6610
{ 06611, OP_ALL, "DCEA", "Clears the disk extended address and memory address extension register."},
{ 06612, OP_ALL, "DSAC", "Skips next instruction if address confirmed flag is a 1. AC is cleared."},
{ 06615, OP_ALL, "DEAL", "The disk extended-address extension registers are cleared and loaded with the track data held in the AC."},
{ 06616, OP_ALL, "DEAC", "Clear the AC then loads the contents of the disk extended-address register into the AC to allow program evaluation. Skip next instruction if address confirmed flag is a 1."},
// 6620
{ 06621, OP_ALL, "DFSE", "Skip next instruction if the completion flag is a 1. Indicates data transfer is complete."},
{ 06626, OP_ALL, "DMAC", "Clear the AC then loads contents of disk memory address register into the AC to allow program evaluation."},
#endif // DF32
#ifdef RF08
// 6600 Disk File and Control, Type RF08/Expander Disk File, Type RS08
// 6610
{ 06611, OP_ALL, "DCIM", "Clear the disk interrupt enable and core memory address extension register."},
{ 06615, OP_ALL, "DIML", "Clear the interrupt enable and memory address extension register, then load the interrupt enable and memory address extension registers with data held in the AC. Then clear the AC. NOTE: Transfers cannot occur across memory fields. Attempts to do so will cause the transfer to "wrap around" within the specified memory field."},
{ 06616, OP_ALL, "DIMA", "Clear the AC. Then load the contents of the status register (STR) into the AC to allow program evaluation."},
// 6620
{ 06621, OP_ALL, "DFSE", "Skip next instruction if there is a parity error, data request late, write lock status, or nonexistent disk flag set."},
{ 06623, OP_ALL, "DISK", "If either the error or data completion flag (or both) is set, the next instruction is skipped."},
#endif // RF08
// 6630 Card Reader and Control Type CR8/I [CR8/L] (see also 6670)
{ 06631, OP_ALL, "RCSF", "Generates an IOP pulse (IOP 1) to test the data-ready flag output. If the data ready flag is 1, the next sequential program instruction is skipped."},
{ 06632, OP_ALL, "RCRA", "Generates an IOP pulse (IOP 2) to read the alphanumeric data at the control-logic buffer register and clear the data ready flag."},
{ 06634, OP_ALL, "RCRB", "Generates an IOP pulse (IOP 4) to read the BCD data at the control logic buffer register and clear the data ready flag."},
#ifdef RF08
// 6640
{ 06641, OP_ALL, "DCXA", "Clear the high order 8-bits of the disk address register (DAR)."},
{ 06643, OP_ALL, "DXAL", "Clear the high order 8 bits of the DAR. Then load the DAR from data stored in the AC. Then clear the AC."},
{ 06645, OP_ALL, "DXAC", "Clear the AC; then load the contents of the high order 8-bit DAR into the AC."},
{ 06646, OP_ALL, "DMMT", "For maintenance purposes only with the appropriate maintenance cable connections and the disk disconnected from the RS08 logic, the (given) standard signals may be generated by IOT 6646 and associated AC bits. The AC is cleared and the maintenance register is initiated by issuing an IOT 6601 command."},
#else // RF08
// 6640
#endif // RF08
// 6650 Automatic Line Printer and Control Type 645
{ 06651, OP_ALL, "LSE", "Skip if line printer error flag is a 1."},
{ 06652, OP_ALL, "LCB", "Clear both sections of the printing buffer."},
{ 06654, OP_ALL, "LLB", "Load printing buffer from the content of AC6-11 and clear the AC"},
// 6660 Automatic Line Printer and Control Type 645 (continued)
{ 06661, OP_ALL, "LSD", "Skip if the printer done flag is a 1."},
{ 06662, OP_ALL, "LCF", "Clear line printer done and error flags."},
{ 06664, OP_ALL, "LPR", "Clear the format register, load the format register from the content of AC9-11, print the line contained in the section of the printer buffer loaded last, clear the AC, and advance the paper in accordance with the selected channel of the format tape if the content of AC8=1. If the content of AC8=0, the line is printed and paper advance is inhibited."},
#endif // DP01AA
// 6670 Card Reader and Control Type CR8/I [CR8/L] (see also 6630)
{ 06671, OP_ALL, "RCSD", "Generates an IOP pulse (IOP 1) to test the card-done flag output. If the card done flag is 1, the next sequential program instruction is skipped."},
{ 06672, OP_ALL, "RCSE", "Generates an IOP pulse (IOP 2) to advance the card, clear the card done flag, and produce a skip flag is reader is ready. If skip flag is generated, the next sequential program instruction is skipped."},
{ 06674, OP_ALL, "RCRD", "Generates an IOP pulse (IOP 4) to clear the card done flag."},
#ifdef TA8A
// 6700 -> 6707 TU60 DECassette Controller TA8A
{ 06700, OP_ALL, "KCLR", "Clear All; clear the status A and B register"},
{ 06701, OP_ALL, "KSDR", "Skip the next instruction if the data flag is set during read or write operations"},
{ 06702, OP_ALL, "KSEN", "Skip the next instruction if any of the following are true: a) tape is at EOT/BOT, b) the TU60 is not ready or the selected drive is empty"},
{ 06703, OP_ALL, "KSBF", "Skip the next instruction if the ready flag is set"},
{ 06704, OP_ALL, "KLSA", "Load status A from AC4-AC11, clear the AC, and load the complement of status A back into the AC"},
{ 06705, OP_ALL, "KSAF", "Skip on any flag or error condition"},
{ 06706, OP_ALL, "KGOA", "Assert the contents of the status A register and transfer data into the AC during a read operation or out of the AC to the Read/Write buffer during a write operation. This instruction has three functions: a) enables the command in the status A register to be executed by the TU60, b) for read operations, the first KGOA instruction causes the tape to start moving, and when the data flag sets, a second KGOA transfers the first byte from the read/write buffer to the AC. The data flag sets after each 8-bit byte is read from the TU60. c) for write operations, the status A register is set up for a write, and the AC contains the first byte to be written on tape. When the KGOA instruction is executed, the tape starts to move and the first byte is transferred to the TU60."},
{ 06707, OP_ALL, "KRSB", "Transfer the contents of the status B register into AC4-AC11."},
#endif
#ifdef TC58
// 6700 Automatic Magnetic Tape Control Type TC58
{ 06701, OP_ALL, "MTSF", "Skip on error flag or magnetic tape flag. The status of the error flag (EF) and the magnetic tape flag (MTF) are sampled. If either or both are set to 1, the content of the PC is incremented by one to skip the next sequential instruction."},
{ 06702, OP_ALL, "6702", "(no mnemonic assigned) Clear the accumulator."},
{ 06704, OP_ALL, "6704", "(no mnemonic assigned) Inclusively OR the contents of the status register into AC0-11"},
{ 06706, OP_ALL, "MTRS", "Read the contents of the status register into AC0-11."},
// 6710
{ 06711, OP_ALL, "MTCR", "Skip on tape control ready (TCR). If the tape control is ready to receive a command, the PC is incremented by one to skip the next sequential instruction."},
{ 06712, OP_ALL, "MTAF", "Clear the status and command registers, and the EF and MTF if tape control ready. If tape control not ready, clears MTF and EF flags only."},
{ 06714, OP_ALL, "MTCM", "Inclusively OR the contents of AC0-5, AC9-11 into the command register; JAM transfer bits 6, 7, 8 (command function)"},
{ 06716, OP_ALL, "MTLC", "Load the contents of AC0-1j1 into the command register."},
// 6720
{ 06721, OP_ALL, "MTTR", "Skip on tape transport ready (TTR). The next sequential instruction is skipped if the tape transport is ready."},
{ 06722, OP_ALL, "MTGO", "Set "go" bit to execute command in the command register if command is legal."},
{ 06724, OP_ALL, "MTRC", "Inclusively OR the contents of the contents of the command register into AC0-11."},
#endif // TC58
#ifdef TR02
// 6700 Incremental Magnetic Tape Controller, Type TR02
{ 06701, OP_ALL, "IRS", "When data is ready to be strobed into the AC from the read buffer (RB), the PC is incremented by one to skip the next sequential instruction. The read done flag is cleared only if the skip occurs."},
{ 06702, OP_ALL, "ISR", "The content of the status register (STR) is read into AC0-8. The AC should be cleared before it is read by this instruction."},
{ 06703, OP_ALL, "IWS", "If the write done flag is set, the next instruction is skipped and the write done flag is cleared."},
{ 06704, OP_ALL, "IMC", "The move command decoded from AC0-2 is generated. This instruction also clears the read done, write done, and gap detect flags. The indicated flag is set when the command has been executed."},
{ 06705, OP_ALL, "IGS", "If the gap detect flag is set, the next instruction is skipped and the gap detect flag is cleared."},
{ 06706, OP_ALL, "IWR", "The contents of the AC are loaded into the tape input data buffer (WB) and a write step command is generated. The write done flag is set when writing is completed."},
{ 06707, OP_ALL, "IRD", "The AC is cleared and the content of the read buffer (RB) is loaded into the AC. Data bits are transferred into AC6-11 (7-track) or AC4-11 (9-track). Parity error is transferred into AC0 which is 0 if there is no parity error."},
// 6710
{ 06711, OP_ALL, "IRSA", "When data is ready to be strobed into the AC from the read buffer (RB), the PC is incremented by one to skip the next sequential instruction. The read done flag is cleared only if the skip occurs."},
{ 06712, OP_ALL, "ISRA", "The content of the status register (STR) is read into AC0-8. The AC should be cleared before it is read by this instruction."},
{ 06713, OP_ALL, "IWSA", "If the write done flag is set, the next instruction is skipped and the write done flag is cleared."},
{ 06714, OP_ALL, "IMCA", "The move command decoded from AC0-2 is generated. This instruction also clears the read done, write done, and gap detect flags. The indicated flag is set when the command has been executed."},
{ 06715, OP_ALL, "IGSA", "If the gap detect flag is set, the next instruction is skipped and the gap detect flag is cleared."},
{ 06716, OP_ALL, "IWRA", "The contents of the AC are loaded into the tape input data buffer (WB) and a write step command is generated. The write done flag is set when writing is completed."},
{ 06717, OP_ALL, "IRDA", "The AC is cleared and the content of the read buffer (RB) is loaded into the AC. Data bits are transferred into AC6-11 (7-track) or AC4-11 (9-track). Parity error is transferred into AC0 which is 0 if there is no parity error."},
// 6720
#endif // TC58
// 6730
// 6740
// 6750
// 6760 DECtape Transport Type TU55 and DECtape Control Type TC01
{ 06761, OP_ALL, "DTRA", "The content of status register A is read into AC0-9 by an OR transfer. The bit assignments are: AC0-2 = Transport unit select numnber; AC3-4 = Motion; AC5 = Mode; AC6-8 = Function; AC9 = Enable/disable DECtape control flag."},
{ 06762, OP_ALL, "DCTA", "Clear status register A. All flags undisturbed."},
{ 06764, OP_ALL, "DTXA", "Status register A is loaded by an exclusive OR transfer from the content of the AC, and AC10 and AC11 are sampled. If AC10 = 0, the error flags are cleared. If AC11 = 0, the DECtape control flag is cleared."},
// 6770
{ 06771, OP_ALL, "DTSF", "Skip if error flag is a 1 or if DECtape control flag is a 1."},
{ 06772, OP_ALL, "DTRB", "The content of status register B is read into the AC by an OR transfer. The bit assignments are: AC0 = Error flag; AC1 = Mark track error; AC2 = End of tape ; AC3 = Select error ; AC4 = Parity error; AC5 = Timing error; AC6-8 = Memory field; AC9-10 = Unused; AC11 = DECtape flag."},
{ 06774, OP_ALL, "DTLB", "The memory field portion of status register B is loaded from the content of AC6-8."},
};

848
d8tape/main.c Normal file
View File

@ -0,0 +1,848 @@
/*
* main.c
*
* (C) Copyright 2000 by Robert Krten, all rights reserved.
* Please see the LICENSE file for more information.
*
* This module represents the main module for the RIM/BIN
* dumper/disassembler/converter/reverse engineering tool.
*
* This program will dump a RIM/BIN-formatted image to stdout, or
* convert a tape from one format to another, or clean up a tape,
* or disassemble a tape with reverse-engineering aids.
*
* 2001 01 07 R. Krten created
* 2003 12 16 R. Krten added disassembler
* 2003 12 17 R. Krten made it RIM/BIN aware.
* 2007 10 25 R. Krten added reverse-engineering features
* 2007 11 04 R. Krten fixed header skip logic (see dumptape())
*/
#ifdef __USAGE
%C [options] papertapefile [papertapefile...]
where [options] are optional parameters chosen from:
-b generate a BIN-formatted output (adds ".bin")
-d suppress disassembly (useful for conversion-only mode)
-r generate a RIM-formatted output (adds ".rim")
-T generate test pattern 0000=0000..7756=7756
-v verbose operation
Dumps the RIM- or BIN-formatted input file(s) specified on
the command line. If the "-r" and/or "-b" options are
present, also creates a RIM and/or BIN version of the output
by adding ".rim" and/or ".bin" (respectively) to the input
filename (can be used to "clean up" BIN and RIM images by
deleting excess data before and after the leader/trailer).
#endif
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <fcntl.h>
#include <errno.h>
#include <limits.h>
#include <sys/types.h>
#include <sys/stat.h>
#include "d8tape.h"
static void seg_add (uint16_t addr, int len);
static void seg_more (int len);
static void optproc (int, char **);
static int dumptape (unsigned char *t, int n);
static int dumprim (unsigned char *t, int n);
static int dumpbin (unsigned char *t, int n);
static int checkrim (unsigned char *t, int n);
static int checkbin (unsigned char *t, int n);
static void writebin (void);
static void writerim (void);
static int blank (short int *core, int size);
const char *progname = "d8tape";
const char *blankname= " ";
extern char *version; // version.c
int optb;
int optd;
int optr;
int optT;
int optv;
unsigned char *tape; // paper tape image
short int core [CORE_SIZE]; // in-core image (-1 means location never used)
uint16_t tags [CORE_SIZE]; // analysis tags
segment_t *segments; // used to accumulate runs of data (from origin for nwords)
int nsegments; // indicates how many segments we have
char *tapename;
/*
* main
*
* Main simply calls the option processor, from which everything happens.
*/
int
main (int argc, char **argv)
{
optproc (argc, argv);
exit (EXIT_SUCCESS);
}
/*
* usageError
*
* This is the usage message
*/
static void
usageError ()
{
fprintf (stderr, "\nUsage: %s [options] papertapefile [papertapefile...]\n\n", progname);
fprintf (stderr, "where [options] are optional parameters chosen from:\n");
fprintf (stderr, " -b generate a BIN-formatted output (adds \".bin\")\n");
fprintf (stderr, " -d suppress disassembly (useful for conversion-only mode)\n");
fprintf (stderr, " -r generate a RIM-formatted output (adds \".rim\")\n");
fprintf (stderr, " -v verbose operation\n");
fprintf (stderr, "\n");
fprintf (stderr, "Dumps the RIM- or BIN-formatted input file(s) specified on\n");
fprintf (stderr, "the command line. If the \"-r\" and/or \"-b\" options are\n");
fprintf (stderr, "present, also creates a RIM and/or BIN version of the output\n");
fprintf (stderr, "by adding \".rim\" and/or \".bin\" (respectively) to the input\n");
fprintf (stderr, "filename (can be used to \"clean up\" BIN and RIM images by\n");
fprintf (stderr, "deleting excess data before and after the leader/trailer).\n");
fprintf (stderr, "\n");
fprintf (stderr, "Disassembly conforms to PAL III input requirements\n");
fprintf (stderr, "\n");
exit (EXIT_FAILURE);
}
/*
* optproc
*
* This is the option processor. It detects the command line options, and
* then processes the individual files.
*/
static void
optproc (int argc, char **argv)
{
int opt;
int got_any;
int fd;
int i;
struct stat statbuf;
int sts;
if (!argc) {
usageError ();
}
// clear out option values to defaults
optb = optr = optT = 0;
// handle command line options
got_any = 0;
while ((opt = getopt (argc, argv, "bdrTv")) != -1) {
switch (opt) {
case 'b':
optb++;
break;
case 'd':
optd++;
break;
case 'r':
optr++;
break;
case 'T':
optT++;
break;
case 'v':
optv++;
if (optv > 1) {
fprintf (stderr, "Verbosity is %d\n", optv);
}
break;
default:
usageError ();
break;
}
}
// handle command line arguments
for (; optind < argc; optind++) {
got_any++;
tapename = argv [optind]; // snap tapename to global
// open the tape
fd = open (tapename, O_RDONLY);
if (fd == -1) {
fprintf (stderr, "%s: couldn't open %s for O_RDONLY, errno %d\n", progname, tapename, errno);
perror (NULL);
exit (EXIT_FAILURE);
}
fstat (fd, &statbuf); // get the size, so we can read it into memory
tape = calloc (1, statbuf.st_size);
if (tape == NULL) {
fprintf (stderr, "%s: can't allocate %ld bytes during processing of %s, errno %d (%s)\n", progname, (unsigned long)statbuf.st_size, tapename, errno, strerror (errno));
exit (EXIT_FAILURE);
}
// initialize data areas
memset (core, 0xff, sizeof (core)); // set to -1 -- since we are only using 12 bits of each 16 bit word, -1 isn't a valid PDP-8 core value
memset (tags, 0, sizeof (tags)); // reset tags
nsegments = 0;
segments = NULL;
read (fd, tape, statbuf.st_size);
close (fd);
// dump the tape (this also reads the tape into "core" and disassembles)
sts = dumptape (tape, statbuf.st_size);
free (tape);
if (!sts) {
continue; // skip tape
}
// convert to RIM/BIN if required (-b and/or -r)
if (optb || optr) {
// see if there is any data there at all..
if (blank (core, CORE_SIZE)) {
fprintf (stderr, "%s: tape image from %s is empty, not creating a BIN version\n", progname, tapename);
return;
}
if (optb) {
writebin ();
}
if (optr) {
writerim ();
}
}
}
// if no arguments given, dump usage message
if (optT) {
memset (core, 0xff, sizeof (core)); // set to -1 (assumption; all 0xff's in an int is -1; pretty safe)
for (i = 0; i < 07600; i++) {
core [i] = ((i & 07700) >> 6) + ((i & 00077) << 6);
}
tapename = "test";
if (optb) {
writebin ();
}
if (optr) {
writerim ();
}
} else {
if (!got_any) {
usageError ();
}
}
}
/*
* dumptape
*
* This function does some basic processing (detecting and skipping the
* header, killing off data past the trailer) and then determines via
* checkrim() and ckeckbin() the format of the tape. Depending on the
* type of tape, dumprim() or dumpbin() is called to read the tape into
* the "core" array and disassemble it.
*
* 20071104: Changed the 'skip header' logic to look for a character
* less than 0x80, not just not equal to, because a tape I received
* had the following:
* 0000000 200 200 200 200 200 200 200 200 200 200 200 200 200 200 200 200
* *
* 0000100 300 100 000 000 000 050 001 000 002 000 003 000 000 000 000 054
*
* Notice the "300" (0xc0) at location 0100.
*
* Returns 0 on error.
*/
static int
dumptape (unsigned char *t, int n)
{
int i;
// basic preprocessing; find header
for (i = 0; i < n; i++) {
if (t [i] == 0x80) { // got a header
break;
}
}
if (i == n) {
fprintf (stderr, "%s: couldn't find a 0x80 leader on tape %s; tape ignored\n", progname, tapename);
return (0);
}
// skip header
for (; i < n; i++) {
if (t [i] < 0x80) { // RK 20071104 was "!= 0x80";
break;
}
}
if (i == n) {
fprintf (stderr, "%s: no data content found after 0x80 leader on tape %s; tape ignored\n", progname, tapename);
return (0);
}
// at this point, we're positioned on the first-non-leader byte of the tape
if (n - i < 4) {
fprintf (stderr, "%s: tape %s is too short; tape ignored\n", progname, tapename);
return (0);
}
// skip leader (t now points to start of tape; n indicates remaining # bytes)
if (optv) {
fprintf (stderr, "%s: tape %s skipped %d (0x%0X, 0%0o) bytes of header, original size %d new size %d\n", progname, tapename, i, i, i, n, n - i);
}
t += i;
n -= i;
// find first 0x80 -- trailer
for (i = 0; i < n; i++) {
if (t [i] == 0x80) {
break;
}
}
if (i == n) {
fprintf (stderr, "%s: warning -- tape %s does not have a trailer\n", progname, tapename);
// find first data >= 0x80, then
for (i = 0; i < n; i++) {
if (t [i] >= 0x80) {
// at least stop on the first invalid character, then
break;
}
}
}
// reset end-of-tape to last character
if (optv > 2) {
printf ("%s: tape %s skipped %d bytes of trailer, new size is %d bytes\n", progname, tapename, n - i, i);
}
n = i;
// determine type of tape and dump it
if (checkrim (t, n)) {
if (!dumprim (t, n)) {
return (0);
}
} else if (checkbin (t, n)) {
if (!dumpbin (t, n)) {
return (0);
}
} else {
fprintf (stderr, "%s: tape %s is neither RIM nor BIN (first four bytes are 0%03o 0%03o 0%03o 0%03o)\n", progname, tapename, t [0], t [1], t [2], t [3]);
return (0);
}
if (!optd) {
flow (); // perform flow analysis
disassemble (); // disassemble
printf ("\n$\n");
}
return (1);
}
/*
* checkrim
* checkbin
*
* These two functions try to determine what format the tape is in.
* A zero return indicates the tape is not in the given format; a one
* indicates it is. The heuristics used here are fairly simple.
*/
static int
checkrim (unsigned char *t, int n)
{
int i;
if (n % 4) {
if (optv > 2) {
printf ("%s: tape %s size (%d bytes) is not divisible by four; not a RIM tape\n", progname, tapename, n);
}
return (0);
}
// see if it's a RIM-formatted tape; we're looking for 01xxxxxx 00xxxxxx 00xxxxxx 00xxxxxx
for (i = 0; i < n; i += 4) {
if ((t [i] & 0xC0) != 0x40 || (t [i + 1] & 0xC0) || (t [i + 2] & 0xC0) || (t [i + 3] & 0xC0)) {
if (optv > 2) {
printf ("%s: tape %s does not have the RIM signature at offset 0%04o; expected 01xxxxxx 00xxxxxx 00xxxxxx 00xxxxxx, got 0%04o 0%04o 0%04o 0%04o\n", progname, tapename, i, t [i], t [i + 1], t [i + 2], t [i + 3]);
}
return (0);
}
}
return (1);
}
static int
checkbin (unsigned char *t, int n)
{
if (n % 2) {
if (optv > 2) {
printf ("%s: tape %s size (%d bytes) is not divisible by two; not a BIN tape\n", progname, tapename, n);
}
return (0);
}
// see if it's a BIN-formatted tape; 01xxxxxx 00xxxxxx (i.e., we at least expect an origin)
if ((t [0] & 0xC0) != 0x40 || (t [1] & 0xC0)) {
if (optv > 2) {
printf ("%s: tape %s does not have the BIN origin signature; expected header of 01xxxxxx 00xxxxxx, got 0%04o 0%04o\n", progname, tapename, t [0], t [1]);
}
return (0);
}
return (1);
}
/*
* From the PDP-8/I & PDP-8/L Small Computer Handbook (099-00272-A1983 / J-09-5)
* Appendix D, "Perforated-Tape Loader Sequences", page 383
*
* READIN MODE LOADER
* The readin mode (RIM) loader is a minimum length, basic perforated-tape
* reader program for the ASR33, it is initially stored in memory by manual use
* of the operator console keys and switches. The loader is permanently stored in
* 18 locations of page 37.
*
* A perforated tape to be read by the RIM loader must be in RIM format:
*
* Tape Channel
* 8 7 6 5 4 3 2 1 OCTAL Format
* --------------- ----- ------------------------
* 1 0 0 0 0 0 0 0 200 Leader-trailer code
* 0 1 -A1- -A2- 1AA Absolute address to
* 0 0 -A3- -A4- 0AA contain next 4 digits
* 0 0 -X1- -X2- 0XX Content of previous
* 0 0 -X3- -X4- 0XX 4-digit address
* 0 1 -A1- -A2- 1AA Address
* 0 0 -A3- -A4- 0AA
* 0 0 -X1- -X2- 0XX Content
* 0 0 -X3- -X4- 0XX
* (etc) (etc)
* 1 0 0 0 0 0 0 0 200 Leader-trailer code
*
* The RIM loader can only be used in conjunction with the ASR33 reader (not
* the high-speed perforated-tape reader). Because a tape in RIM format is, in
* effect, twice as long as it need be, it is suggested that the RIM loader be used
* only to read the binary loader when using the ASR33. (Note that PDP-8 diag-
* nostic program tapes are in RIM format.)
*
* The complete PDP-8/I RIM loader (SA=7756) is as follows:
*
* Absolute Octal
* Address Content Tag Instruction I Z Comments
* 7756, 6032 BEG, KCC /CLEAR AC AND FLAG
* 7757, 6031 KSF /SKIP IF FLAG = 1
* 7760, 5357 JMP .-1 /LOOKING FOR CHARACTER
* 7761, 6036 KRB /READ BUFFER
* 7762, 7106 CLL RTL
* 7763, 7006 RTL /CHANNEL 8 IN AC0
* 7764, 7510 SPA /CHECKING FOR LEADER
* 7765, 5357 JMP BEG+1 /FOUND LEADER
* 7766, 7006 RTL /OK, CHANNEL 7 IN LINK
* 7767, 6031 KSF
* 7770, 5367 JMP .-1
* 7771, 6034 KRS /READ, DO NOT CLEAR
* 7772, 7420 SNL /CHECKING FOR ADDRESS
* 7773, 3776 DCA I TEMP /STORE CONTENT
* 7774, 3376 DCA TEMP /STORE ADDRESS
* 7775, 5356 JMP BEG /NEXT WORD
* 7776, 0 TEMP, 0 /TEMP STORAGE
* 7777, 5XXX JMP X /JMP START OF BIN LOADER
*/
/*
* dumprim
*
* This is a finite-state-machine that runs through the tape reading the address
* and data records, stuffs them into core[], and disassembles the opcodes unless
* "-d" is specified.
*
* Note that disassembly is done after the complete tape has been read in, this
* allows us to do some flow analysis.
*/
#define RIM_Initial 1 // waiting for address
#define RIM_Addr 2 // got top part of address, process bottom part
#define RIM_Data1 3 // got address, process top part of data
#define RIM_Data2 4 // got top part of data, process bottom part
static int
dumprim (unsigned char *t, int n)
{
int state;
int i;
uint16_t addr, data;
uint16_t cur_addr;
state = RIM_Initial;
cur_addr = 0xffff; // impossible address for PDP-8
for (i = 0; i < n; i++) {
if (optv > 2) {
printf ("[%03o] ", t [i]); fflush (stdout);
if ((i % 13) == 12) {
printf ("\n");
}
}
switch (state) {
case RIM_Initial:
if (t [i] & 0100) { // indicates 1st part of address
addr = (t [i] & 0077) << 6; // store top part
state = RIM_Addr;
}
break;
case RIM_Addr:
addr |= (t [i] & 0077);
state = RIM_Data1;
break;
case RIM_Data1:
data = (t [i] & 0077) << 6; // store top part
state = RIM_Data2;
break;
case RIM_Data2: // final decode complete, store data
data |= (t [i] & 0077);
core [addr] = data; // stash data into core image
// segment management -- if it's the next byte, add, else create new
if (addr == cur_addr) {
cur_addr++;
seg_more (1);
} else {
seg_add (addr, 1);
cur_addr = addr + 1;
}
state = RIM_Initial;
break;
}
}
if (optv > 2) {
printf ("\n");
}
return (1);
}
/*
* BIN format, from the same doc as above, page 384:
*
* BINARY LOADER
* The binary loader (BIN) is used to read machine language tapes (in binary
* format) produced by the program assembly language (PAL). A tape in binary
* format is about one-half the length of the comparable RIM format tape. It can,
* therefore, be read about twice as fast as a RIM tape and is, for this reason,
* the more desirable format to use with the 10 cps ASR33 reader or the Type
* PR8/I High-Speed Perforated-Tape Reader.
*
* The format of a binary tape is as follows:
*
* LEADER: about 2 feet of leader-trailer codes.
*
* BODY: characters representing the absolute, machine language program
* in easy-to-read binary (or octal) form. The section of tape may contain
* characters representing instructions (channel 8 and 7 not punched) or
* origin resettings (channel 8 not punched, channel 7 punched) and is
* concluded by 2 characters (channel 8 and 7 not punched) that represent
* a check sum for the entire section.
*
* TRAILER: same as leader.
*
* I.e.,
*
* Tape Channel
* 8 7 6 5 4 3 2 1 OCTAL Format
* --------------- ----- ------------------------
* 1 0 0 0 0 0 0 0 200 Leader
* 0 1 A A A A A A 1AA Address (top)
* 0 1 B B B B B B 1BB Address (bottom)
* 0 0 C C C C C C 0CC Data (top)
* 0 0 D D D D D D 0DD Data (bottom)
* 0 0 C C C C C C 0CC Data (top)
* 0 0 D D D D D D 0DD Data (bottom)
* . . . ... next data (2 bytes)
* 0 1 A A A A A A 1AA New address (top)
* 0 1 B B B B B B 1BB New address (bottom)
* . . . ... next data (2 bytes)
* 0 0 X X X X X X 0XX Checksum (top)
* 0 0 Y Y Y Y Y Y 0YY Checksum (bottom)
*
*/
/*
* dumpbin
*
* This is a finite-state-machine that runs through the tape looking for the
* origin and subsequent data fields, stuffs them into the core[] array, and
* optionally disassembles the opcodes.
*
* Every time we hit an origin change, we create a new segment and accumulate
* bytes into it.
*/
#define BIN_Initial 1 // initial state; we require an origin to get out of it
#define BIN_Origin 2 // we got the top part of the origin, now need to get the bottom part
#define BIN_DataHW 3 // we have an address, so we are looking for another origin or the top part of the data
#define BIN_DataLW 4 // we have the top part of the data, now fetching the low part
static int
dumpbin (unsigned char *t, int n)
{
int tape_checksum; // checksum stored on tape
int calc_checksum; // calculated checksum
int i;
int state;
unsigned short int addr, data;
if (n < 4) {
fprintf (stderr, "%s: tape %s is too short; tape skipped\n", progname, tapename);
return (0);
}
tape_checksum = ((t [n - 2] & 0x3f) << 6) + (t [n - 1] & 0x3f);
if (optv > 1) {
printf ("%s: tape %s expected checksum 0%04o\n", progname, tapename, tape_checksum);
}
n -= 2; // tape is now shorter by the two bytes
// now calculate checksum
calc_checksum = 0;
for (i = 0; i < n; i++) {
calc_checksum += t [i];
}
calc_checksum &= 07777; // mask to 12 bits
if (optv > 1) {
printf ("%s: tape %s calculated checksum 0%04o\n", progname, tapename, calc_checksum);
}
if (tape_checksum != calc_checksum) {
fprintf (stderr, "%s: tape %s calculated checksum [0%04o] != stored checksum [0%04o]; tape skipped\n", progname, tapename, calc_checksum, tape_checksum);
return (0);
}
// now we can dump the binary data via the state machine
state = BIN_Initial;
for (i = 0; i < n; i++) {
if (optv > 2) {
printf ("[%03o] ", t [i]); fflush (stdout);
if ((i % 13) == 12) {
printf ("\n");
}
}
switch (state) {
case BIN_Initial:
if (t [i] & 0100) { // indicates origin setting code
addr = (t [i] & 0077) << 6; // store top part
state = BIN_Origin;
}
break;
case BIN_Origin:
addr += (t [i] & 0077); // store bottom part
state = BIN_DataHW;
seg_add (addr, 0);
break;
case BIN_DataHW:
if (t [i] & 0100) { // another origin; skip loading data and load address instead
addr = (t [i] & 0077) << 6;
state = BIN_Origin;
} else {
data = (t [i] & 0077) << 6; // store top part of data
state = BIN_DataLW;
}
break;
case BIN_DataLW:
data += (t [i] & 0077);
core [addr] = data;
seg_more (1);
addr++; // the magic of BIN-format is the autoincrement of the address
state = BIN_DataHW;
}
}
if (optv > 2) {
printf ("\n");
}
return (1);
}
/*
* writebin
* writerim
*
* These two functions write the BIN and RIM format tapes to a file.
* The filename is constructed by appending ".bin" or ".rim" to the
* input filename.
*
* The header and trailer written are short, LEADER_LENGTH bytes.
*
* The writebin() uses a finit-state-machine to generate the origin.
*/
#define LEADER_LENGTH 16 // 16 chars of leader/trailer should be plenty
#define WBIN_Initial 1 // looking for first/next in-use core[] element
#define WBIN_Writing 2 // origin written, dumping consecutive words
static void
writebin (void)
{
char fname [PATH_MAX];
char leader [LEADER_LENGTH];
FILE *fp;
int i;
int cksum;
int state;
// create filename and open it
sprintf (fname, "%s.bin", tapename);
if ((fp = fopen (fname, "w")) == NULL) {
fprintf (stderr, "%s: unable to open BIN output file %s for w, errno %d (%s); creation of output file skipped\n", progname, fname, errno, strerror (errno));
return;
}
// write leader
memset (leader, 0x80, sizeof (leader));
fwrite (leader, 1, sizeof (leader), fp);
// now scan through "core" and write the data out...
cksum = 0;
state = WBIN_Initial;
for (i = 0; i < CORE_SIZE; i++) {
switch (state) {
case WBIN_Initial: // transit out of WBIN_Initial on a "used" core position
if (core [i] != -1) {
state = WBIN_Writing;
fprintf (fp, "%c%c", 0x40 | ((i & 07700) >> 6), i & 00077); // write origin directive
fprintf (fp, "%c%c", (core [i] & 07700) >> 6, core [i] & 00077); // write data
cksum += (0x40 | ((i & 07700) >> 6)) + (i & 00077) + ((core [i] & 07700) >> 6) + (core [i] & 00077);
}
break;
case WBIN_Writing:
if (core [i] == -1) {
state = WBIN_Initial; // waiting again for a used core position
} else {
fprintf (fp, "%c%c", (core [i] & 07700) >> 6, core [i] & 00077);
cksum += ((core [i] & 07700) >> 6) + (core [i] & 00077);
}
break;
}
}
// now write the checksum
fprintf (fp, "%c%c", (cksum & 07700) >> 6, cksum & 00077);
// write trailer
fwrite (leader, 1, sizeof (leader), fp);
fclose (fp);
}
static void
writerim (void)
{
char fname [PATH_MAX];
char leader [LEADER_LENGTH];
FILE *fp;
int i;
// create the filename and open it
sprintf (fname, "%s.rim", tapename);
if ((fp = fopen (fname, "w")) == NULL) {
fprintf (stderr, "%s: unable to open RIM output file %s for w, errno %d (%s); creation of output file skipped\n", progname, fname, errno, strerror (errno));
return;
}
// write leader
memset (leader, 0x80, sizeof (leader));
fwrite (leader, 1, sizeof (leader), fp);
for (i = 0; i < CORE_SIZE; i++) {
if (core [i] != -1) {
fprintf (fp, "%c%c%c%c", 0x40 + ((i & 07700) >> 6), i & 00077, (core [i] & 07700) >> 6, core [i] & 00077);
}
}
// write trailer
fwrite (leader, 1, sizeof (leader), fp);
fclose (fp);
}
/*
* blank
*
* A utility routine to see if core[] is blank (returns 1).
* Used to avoid writing an empty tape.
*/
static int
blank (short int *c, int size)
{
int i;
for (i = 0; i < size; i++) {
if (c [i] != -1) {
return (0);
}
}
return (1);
}
/*
* seg_add (addr, len)
* seg_more (more)
*
* These functions manipulate the segment data stored
* in "segments[]" and "nsegments".
*
* seg_add creates a new segment with the given address
* and length.
*
* seg_more lengthens the current segment by "more"
* words.
*/
static void
seg_add (uint16_t addr, int len)
{
if (optv > 3) {
printf ("seg_add (0%04o, %d (0%04o))\n", addr, len, len);
}
segments = realloc (segments, (nsegments + 1) * sizeof (segments [0]));
if (segments == NULL) {
fprintf (stderr, "%s: couldn't realloc segments array to be %d elements (%ld bytes) long, errno %d (%s)\n", progname, nsegments + 1, (unsigned long)(nsegments + 1) * sizeof (segments [0]), errno, strerror (errno));
exit (EXIT_FAILURE);
}
segments [nsegments].saddr = addr;
segments [nsegments].nwords = len;
nsegments++;
}
static void
seg_more (int len)
{
if (optv > 3) {
printf ("seg_more (+%d (0%04o))\n", len, len);
}
if (nsegments) {
segments [nsegments - 1].nwords += len;
} else {
fprintf (stderr, "%s: seg_more called with no segments in existence\n", progname);
exit (EXIT_FAILURE);
}
}

BIN
d8tape/test.bin Normal file
View File

Binary file not shown.

806
d8tape/test.dump Normal file
View File

@ -0,0 +1,806 @@
00000/7402 hlt
00001/7402 hlt
00002/7402 hlt
00003/7402 hlt
00040/0001 and 1
00041/0000 and 0
00042/0000 and 0
00043/0000 and 0
00044/0000 and 0
00045/0000 and 0
00046/0000 and 0
00047/0000 and 0
00050/0000 and 0
00051/0000 and 0
00052/0000 and 0
00053/0000 and 0
00054/7777 cla mqa mql
00055/0000 and 0
00056/0000 and 0
00057/6251 iot 25,1
00060/6241 iot 24,1
00061/6251 iot 25,1
00062/5456 jmp i 56
00063/0000 and 0
00064/6252 iot 25,2
00065/6242 iot 24,2
00066/6252 iot 25,2
00067/5463 jmp i 63
00200/7300 cla cll
00201/7303 cla cll iac bsw
00202/3051 dca 51
00203/3052 dca 52
00204/6040 iot 4,0
00205/1177 tad 177
00206/4576 jms i 176
00207/0000 and 0
00210/7600 cla
00211/0000 and 0
00212/1600 tad i 200
00213/7410 skp
00214/7402 hlt
00215/7200 cla
00216/1051 tad 51
00217/0175 and 175
00220/1174 tad 174
00221/3225 dca 225
00222/7215 cla iac
00223/1173 tad 173
00224/7450 sna
00225/7402 hlt
00226/4572 jms i 172
00227/7006 rtl
00230/7004 ral
00231/0171 and 171
00232/1170 tad 170
00233/3057 dca 57
00234/6214 iot 21,4
00235/1170 tad 170
00236/3064 dca 64
00237/3050 dca 50
00240/5567 jmp i 167
00400/4566 jms i 166
00401/7777 cla mqa mql
00402/0435 and i 35
00403/4565 jms i 165
00404/7421 mql
00405/7501 mqa
00406/3441 dca i 41
00407/7501 mqa
00410/7001 iac
00411/4564 jms i 164
00412/2055 isz 55
00413/5204 jmp 404
00414/4565 jms i 165
00415/7421 mql
00416/7501 mqa
00417/7041 cma iac
00420/1441 tad i 41
00421/7450 sna
00422/5227 jmp 427
00423/3047 dca 47
00424/7501 mqa
00425/3046 dca 46
00426/4563 jms i 163
00427/7501 mqa
00430/7001 iac
00431/4564 jms i 164
00432/2055 isz 55
00433/5215 jmp 415
00434/4063 jms 63
00435/4566 jms i 166
00436/7776 spa sna szl cla osr hlt
00437/0472 and i 72
00440/4562 jms i 162
00441/7421 mql
00442/7501 mqa
00443/3441 dca i 41
00444/7501 mqa
00445/7001 iac
00446/4561 jms i 161
00447/2055 isz 55
00450/5241 jmp 441
00451/4562 jms i 162
00452/7421 mql
00453/7501 mqa
00454/7041 cma iac
00455/1441 tad i 41
00456/7450 sna
00457/5264 jmp 464
00460/3047 dca 47
00461/7501 mqa
00462/3046 dca 46
00463/4563 jms i 163
00464/7501 mqa
00465/7001 iac
00466/4561 jms i 161
00467/2055 isz 55
00470/5252 jmp 452
00471/4063 jms 63
00472/4566 jms i 166
00473/7775 cla mqa mql
00474/0532 and i 132
00475/4565 jms i 165
00476/7421 mql
00477/7501 mqa
00500/4560 jms i 160
00501/3441 dca i 41
00502/7501 mqa
00503/7001 iac
00504/4564 jms i 164
00505/2055 isz 55
00506/5276 jmp 476
00507/4565 jms i 165
00510/7421 mql
00511/7501 mqa
00512/4560 jms i 160
00513/7041 cma iac
00514/1441 tad i 41
00515/7450 sna
00516/5324 jmp 524
00517/3047 dca 47
00520/7501 mqa
00521/4560 jms i 160
00522/3046 dca 46
00523/4563 jms i 163
00524/7501 mqa
00525/7001 iac
00526/4564 jms i 164
00527/2055 isz 55
00530/5310 jmp 510
00531/4063 jms 63
00532/4566 jms i 166
00533/7774 spa sna szl cla osr
00534/0572 and i 172
00535/4562 jms i 162
00536/7421 mql
00537/7501 mqa
00540/4560 jms i 160
00541/3441 dca i 41
00542/7501 mqa
00543/7001 iac
00544/4561 jms i 161
00545/2055 isz 55
00546/5336 jmp 536
00547/4562 jms i 162
00550/7421 mql
00551/7501 mqa
00552/4560 jms i 160
00553/7041 cma iac
00554/1441 tad i 41
00555/7450 sna
00556/5364 jmp 564
00557/3047 dca 47
00560/7501 mqa
00561/4560 jms i 160
00562/3046 dca 46
00563/4563 jms i 163
00564/7501 mqa
00565/7001 iac
00566/4561 jms i 161
00567/2055 isz 55
00570/5350 jmp 550
00571/4063 jms 63
00572/4566 jms i 166
00573/7773 cla mqa mql
00574/0634 and i 434
00575/4565 jms i 165
00576/7421 mql
00577/7501 mqa
00600/4560 jms i 160
00601/7040 cma
00602/3441 dca i 41
00603/7501 mqa
00604/7001 iac
00605/4564 jms i 164
00606/2055 isz 55
00607/5777 jmp i 777
00610/4565 jms i 165
00611/7421 mql
00612/7501 mqa
00613/4560 jms i 160
00614/7001 iac
00615/1441 tad i 41
00616/7450 sna
00617/5226 jmp 626
00620/3047 dca 47
00621/7501 mqa
00622/4560 jms i 160
00623/7040 cma
00624/3046 dca 46
00625/4563 jms i 163
00626/7501 mqa
00627/7001 iac
00630/4564 jms i 164
00631/2055 isz 55
00632/5211 jmp 611
00633/4063 jms 63
00634/4566 jms i 166
00635/7772 spa sna szl cla hlt
00636/0676 and i 676
00637/4562 jms i 162
00640/7421 mql
00641/7501 mqa
00642/4560 jms i 160
00643/7040 cma
00644/3441 dca i 41
00645/7501 mqa
00646/7001 iac
00647/4561 jms i 161
00650/2055 isz 55
00651/5240 jmp 640
00652/4562 jms i 162
00653/7421 mql
00654/7501 mqa
00655/4560 jms i 160
00656/7001 iac
00657/1441 tad i 41
00660/7450 sna
00661/5270 jmp 670
00662/3047 dca 47
00663/7501 mqa
00664/4560 jms i 160
00665/7040 cma
00666/3046 dca 46
00667/4563 jms i 163
00670/7501 mqa
00671/7001 iac
00672/4561 jms i 161
00673/2055 isz 55
00674/5253 jmp 653
00675/4063 jms 63
00676/4566 jms i 166
00677/7771 cla mqa mql
00700/0727 and i 727
00701/4565 jms i 165
00702/7421 mql
00703/4557 jms i 157
00704/3441 dca i 41
00705/4564 jms i 164
00706/2055 isz 55
00707/5303 jmp 703
00710/4565 jms i 165
00711/7421 mql
00712/4557 jms i 157
00713/7041 cma iac
00714/1441 tad i 41
00715/7450 sna
00716/5323 jmp 723
00717/3047 dca 47
00720/7501 mqa
00721/3046 dca 46
00722/4563 jms i 163
00723/4564 jms i 164
00724/2055 isz 55
00725/5312 jmp 712
00726/4063 jms 63
00727/4566 jms i 166
00730/7770 spa sna szl cla
00731/1000 tad 0
00732/4562 jms i 162
00733/7421 mql
00734/4557 jms i 157
00735/3441 dca i 41
00736/4561 jms i 161
00737/2055 isz 55
00740/5334 jmp 734
00741/4562 jms i 162
00742/7421 mql
00743/4557 jms i 157
00744/7041 cma iac
00745/1441 tad i 41
00746/7450 sna
00747/5354 jmp 754
00750/3047 dca 47
00751/7501 mqa
00752/3046 dca 46
00753/4563 jms i 163
00754/4561 jms i 161
00755/2055 isz 55
00756/5343 jmp 743
00757/4063 jms 63
00760/5556 jmp i 156
00777/0576 and i 176
01000/2051 isz 51
01001/7410 skp
01002/5200 jmp 1000
01003/7200 cla
01004/1177 tad 177
01005/4576 jms i 176
01006/0000 and 0
01007/1600 tad i 1000
01010/0000 and 0
01011/7600 cla
01012/4572 jms i 172
01013/7500 sma
01014/4555 jms i 155
01015/4554 jms i 154
01016/1044 tad 44
01017/1051 tad 51
01020/4553 jms i 153
01021/4554 jms i 154
01022/1051 tad 51
01023/1057 tad 57
01024/7112 cll rtr
01025/7010 rar
01026/0175 and 175
01027/1152 tad 152
01030/4551 jms i 151
01031/4554 jms i 154
01032/1055 tad 55
01033/1052 tad 52
01034/4553 jms i 153
01035/4550 jms i 150
01036/4572 jms i 172
01037/7006 rtl
01040/7420 snl
01041/5547 jmp i 147
01042/7402 hlt
01043/5547 jmp i 147
01044/0516 and i 116
01045/0440 and i 40
01046/2001 isz 1
01047/2323 isz 1123
01050/4000 jms 0
01051/4006 jms 6
01052/1105 tad 105
01053/1404 tad i 4
01054/4000 jms 0
01055/4005 jms 5
01056/2222 isz 1022
01057/1722 tad i 1122
01060/2340 isz 1140
01061/0000 and 0
01062/0000 and 0
01063/7300 cla cll
01064/2050 isz 50
01065/1050 tad 50
01066/1662 tad i 1062
01067/7440 sza
01070/7402 hlt
01071/4572 jms i 172
01072/0146 and 146
01073/7450 sna
01074/5304 jmp 1104
01075/1662 tad i 1062
01076/7650 sna cla
01077/5304 jmp 1104
01100/2262 isz 1062
01101/1662 tad i 1062
01102/3262 dca 1062
01103/5662 jmp i 1062
01104/2262 isz 1062
01105/2262 isz 1062
01106/5662 jmp i 1062
01107/0000 and 0
01110/3042 dca 42
01111/1051 tad 51
01112/0145 and 145
01113/7040 cma
01114/3043 dca 43
01115/1042 tad 42
01116/7104 cll ral
01117/7430 szl
01120/7001 iac
01121/2043 isz 43
01122/5316 jmp 1116
01123/5707 jmp i 1107
01124/0000 and 0
01125/7200 cla
01126/1144 tad 144
01127/3042 dca 42
01130/7701 cla mqa
01131/3043 dca 43
01132/1043 tad 43
01133/2042 isz 42
01134/5332 jmp 1132
01135/1143 tad 143
01136/7421 mql
01137/7501 mqa
01140/5724 jmp i 1124
01141/0000 and 0
01142/7701 cla mqa
01143/3042 dca 42
01144/1042 tad 42
01145/7104 cll ral
01146/7104 cll ral
01147/1042 tad 42
01150/1042 tad 42
01151/1042 tad 42
01152/7104 cll ral
01153/7104 cll ral
01154/1042 tad 42
01155/1143 tad 143
01156/7421 mql
01157/7501 mqa
01160/5741 jmp i 1141
01200/0000 and 0
01201/7200 cla
01202/1052 tad 52
01203/0145 and 145
01204/7640 sza cla
01205/5212 jmp 1212
01206/4063 jms 63
01207/4554 jms i 154
01210/1246 tad 1246
01211/4056 jms 56
01212/1051 tad 51
01213/4553 jms i 153
01214/4542 jms i 142
01215/1052 tad 52
01216/4553 jms i 153
01217/4542 jms i 142
01220/1050 tad 50
01221/4553 jms i 153
01222/4542 jms i 142
01223/6214 iot 21,4
01224/7112 cll rtr
01225/7010 rar
01226/1152 tad 152
01227/4551 jms i 151
01230/1041 tad 41
01231/4553 jms i 153
01232/4542 jms i 142
01233/1046 tad 46
01234/4553 jms i 153
01235/4542 jms i 142
01236/1047 tad 47
01237/1046 tad 46
01240/4553 jms i 153
01241/4550 jms i 150
01242/2052 isz 52
01243/7410 skp
01244/5242 jmp 1242
01245/5600 jmp i 1200
01246/3720 dca i 1320
01247/0123 and 123
01250/2340 isz 1340
01251/0522 and i 122
01252/2223 isz 1223
01253/4024 jms 24
01254/0523 and i 123
01255/2440 isz i 40
01256/0104 and 104
01257/0422 and i 22
01260/2340 isz 1340
01261/0530 and i 130
01262/2004 isz 4
01263/4022 jms 22
01264/0326 and 1326
01265/0437 and i 37
01266/0000 and 0
01267/0000 and 0
01270/3333 dca 1333
01271/6214 iot 21,4
01272/1170 tad 170
01273/3331 dca 1331
01274/6224 iot 22,4
01275/1170 tad 170
01276/3277 dca 1277
01277/7402 hlt
01300/1667 tad i 1267
01301/1170 tad 170
01302/3316 dca 1316
01303/2267 isz 1267
01304/1667 tad i 1267
01305/3334 dca 1334
01306/2267 isz 1267
01307/1667 tad i 1267
01310/1170 tad 170
01311/3322 dca 1322
01312/2267 isz 1267
01313/1667 tad i 1267
01314/3335 dca 1335
01315/2267 isz 1267
01316/7402 hlt
01317/1734 tad i 1334
01320/2334 isz 1334
01321/7000 nop
01322/7402 hlt
01323/3735 dca i 1335
01324/2335 isz 1335
01325/7000 nop
01326/2333 isz 1333
01327/5316 jmp 1316
01330/7200 cla
01331/7402 hlt
01332/5667 jmp i 1267
01333/0000 and 0
01334/0000 and 0
01335/0000 and 0
01400/0000 and 0
01401/7104 cll ral
01402/3042 dca 42
01403/1141 tad 141
01404/3043 dca 43
01405/1042 tad 42
01406/7006 rtl
01407/7004 ral
01410/3042 dca 42
01411/1042 tad 42
01412/0175 and 175
01413/1152 tad 152
01414/4551 jms i 151
01415/2043 isz 43
01416/5205 jmp 1405
01417/5600 jmp i 1400
01420/0000 and 0
01421/7200 cla
01422/1620 tad i 1420
01423/3042 dca 42
01424/2220 isz 1420
01425/1442 tad i 42
01426/7002 bsw
01427/4234 jms 1434
01430/1442 tad i 42
01431/4234 jms 1434
01432/2042 isz 42
01433/5225 jmp 1425
01434/0000 and 0
01435/0140 and 140
01436/7450 sna
01437/5620 jmp i 1420
01440/1137 tad 137
01441/7440 sza
01442/5245 jmp 1445
01443/4550 jms i 150
01444/5634 jmp i 1434
01445/7510 spa
01446/1136 tad 136
01447/1135 tad 135
01450/4551 jms i 151
01451/5634 jmp i 1434
01452/0000 and 0
01453/7200 cla
01454/1134 tad 134
01455/4551 jms i 151
01456/5652 jmp i 1452
01457/0000 and 0
01460/7200 cla
01461/1133 tad 133
01462/4551 jms i 151
01463/5657 jmp i 1457
01464/0000 and 0
01465/7200 cla
01466/1147 tad 147
01467/4551 jms i 151
01470/1132 tad 132
01471/4551 jms i 151
01472/5664 jmp i 1464
01473/0000 and 0
01474/6041 iot 4,1
01475/5274 jmp 1474
01476/0131 and 131
01477/6046 iot 4,6
01500/7200 cla
01501/5673 jmp i 1473
01502/0000 and 0
01503/7215 cla iac
01504/1173 tad 173
01505/7440 sza
01506/5311 jmp 1511
01507/1040 tad 40
01510/7410 skp
01511/7604 cla osr
01512/5702 jmp i 1502
01513/0000 and 0
01514/3042 dca 42
01515/7001 iac
01516/1041 tad 41
01517/3041 dca 41
01520/1042 tad 42
01521/5713 jmp i 1513
01522/0000 and 0
01523/3042 dca 42
01524/7040 cma
01525/1041 tad 41
01526/3041 dca 41
01527/1042 tad 42
01530/5722 jmp i 1522
01531/0000 and 0
01532/4347 jms 1547
01533/1053 tad 53
01534/3041 dca 41
01535/1051 tad 51
01536/1041 tad 41
01537/5731 jmp i 1531
01540/0000 and 0
01541/4347 jms 1547
01542/1054 tad 54
01543/3041 dca 41
01544/1051 tad 51
01545/1041 tad 41
01546/5740 jmp i 1540
01547/0000 and 0
01550/4056 jms 56
01551/7300 cla cll
01552/1057 tad 57
01553/7041 cma iac
01554/1064 tad 64
01555/7650 sna cla
01556/5362 jmp 1562
01557/3053 dca 53
01560/3055 dca 55
01561/5370 jmp 1570
01562/1130 tad 130
01563/3053 dca 53
01564/1054 tad 54
01565/7040 cma
01566/1053 tad 53
01567/3055 dca 55
01570/5747 jmp i 1547
01600/0000 and 0
01601/0000 and 0
01602/0000 and 0
01603/0000 and 0
01604/0000 and 0
01605/0000 and 0
01606/0000 and 0
01607/0000 and 0
01610/0000 and 0
01611/0000 and 0
01612/0000 and 0
01613/0000 and 0
01614/0000 and 0
01615/0000 and 0
01616/0000 and 0
01617/0000 and 0
01620/0000 and 0
01621/0000 and 0
01622/0000 and 0
01623/0000 and 0
01624/0000 and 0
01625/0000 and 0
01626/0000 and 0
01627/0000 and 0
01630/0000 and 0
01631/0000 and 0
01632/0000 and 0
01633/0000 and 0
01634/0000 and 0
01635/0000 and 0
01636/0000 and 0
01637/0000 and 0
01640/0000 and 0
01641/0000 and 0
01642/0000 and 0
01643/0000 and 0
01644/0000 and 0
01645/0000 and 0
01646/0000 and 0
01647/0000 and 0
01650/0000 and 0
01651/0000 and 0
01652/0000 and 0
01653/0000 and 0
01654/0000 and 0
01655/0000 and 0
01656/0000 and 0
01657/0000 and 0
01660/0000 and 0
01661/0000 and 0
01662/0000 and 0
01663/0000 and 0
01664/0000 and 0
01665/0000 and 0
01666/0000 and 0
01667/0000 and 0
01670/0000 and 0
01671/0000 and 0
01672/0000 and 0
01673/0000 and 0
01674/0000 and 0
01675/0000 and 0
01676/0000 and 0
01677/0000 and 0
01700/0000 and 0
01701/0000 and 0
01702/0000 and 0
01703/0000 and 0
01704/0000 and 0
01705/0000 and 0
01706/0000 and 0
01707/0000 and 0
01710/0000 and 0
01711/0000 and 0
01712/0000 and 0
01713/0000 and 0
01714/0000 and 0
01715/0000 and 0
01716/0000 and 0
01717/0000 and 0
01720/0000 and 0
01721/0000 and 0
01722/0000 and 0
01723/0000 and 0
01724/0000 and 0
01725/0000 and 0
01726/0000 and 0
01727/0000 and 0
01730/0000 and 0
01731/0000 and 0
01732/0000 and 0
01733/0000 and 0
01734/0000 and 0
01735/0000 and 0
01736/0000 and 0
01737/0000 and 0
01740/0000 and 0
01741/0000 and 0
01742/0000 and 0
01743/0000 and 0
01744/0000 and 0
01745/0000 and 0
01746/0000 and 0
01747/0000 and 0
01750/0000 and 0
01751/0000 and 0
01752/0000 and 0
01753/0000 and 0
01754/0000 and 0
01755/0000 and 0
01756/0000 and 0
01757/0000 and 0
01760/0000 and 0
01761/0000 and 0
01762/0000 and 0
01763/0000 and 0
01764/0000 and 0
01765/0000 and 0
01766/0000 and 0
01767/0000 and 0
01770/0000 and 0
01771/0000 and 0
01772/0000 and 0
01773/0000 and 0
01774/0000 and 0
01775/0000 and 0
01776/0000 and 0
01777/0000 and 0
00130/2000 isz 0
00131/0177 and 177
00132/0212 and 12
00133/0207 and 7
00134/0240 and 40
00135/0237 and 37
00136/0100 and 100
00137/7741 cla mqa
00140/0077 and 77
00141/7774 spa sna szl cla osr
00142/1452 tad i 52
00143/1751 tad i 151
00144/7743 cla mqa
00145/0017 and 17
00146/1700 tad i 100
00147/0215 and 15
00150/1464 tad i 64
00151/1473 tad i 73
00152/0260 and 60
00153/1400 tad i 0
00154/1420 tad i 20
00155/1457 tad i 57
00156/1000 tad 0
00157/1141 tad 141
00160/1107 tad 107
00161/1522 tad i 122
00162/1540 tad i 140
00163/1200 tad 0
00164/1513 tad i 113
00165/1531 tad i 131
00166/1062 tad 62
00167/0400 and i 0
00170/6201 iot 20,1
00171/0070 and 70
00172/1502 tad i 102
00173/7770 spa sna szl cla
00174/6440 iot 44,0
00175/0007 and 7
00176/1267 tad 67
00177/7600 cla
07751/0200 and 7600
07752/6032 iot 3,2
07753/1352 tad 7752
07754/3356 dca 7756
07755/5751 jmp i 7751
07756/5353 jmp 7753
CHKSUM: Computed: 3145, input: 3145 -- PASS

1120
d8tape/test.list Normal file
View File

File diff suppressed because it is too large Load Diff

1566
d8tape/test.lst Normal file
View File

File diff suppressed because it is too large Load Diff

921
d8tape/test.pal Normal file
View File

@ -0,0 +1,921 @@
TITLE "simple MEMORY test"
/
/ start at 200
/
/ switch definitions
/
/ <0> 0=BELL at EOP / 1=silent
/ <1> 0=RUN / 1=STOP and restore loaders
/ <2:5> 0=all tests / !0=exec this test only
/ <6:8> unused
/ <9:11> FIELD to test, 0...7
/
/ ------------------------------------------------------------
/ macro definitions
DEFINE SDF N <
N^10+CDF >
DEFINE SIF N <
N^10+CIF >
/ ------------------------------------------------------------
*0
INIT, HLT / should never get here
HLT / should never get here
HLT / should never get here
HLT / should never get here
*40
SSR, 0001 / software switch register
PTR, 0 / memory ptr
TMP1, 0 / for print routines
TMP2, 0 / ditto
TMP3, 0 / ditto
TMP4, 0 / ditto
EXP, 0 / expected data
RCV, 0 / received data
TEST, 0 / test number
PASSES, 0 / pass count
ERRORS, 0 / error count
MEMBEG, 0 / start location (computed)
MEMEND, 7777 / last location to test
MEMCNT, 0 / -count of locations (computed)
R3L=7014 / on HD6120 only
EJECT
/ ------------------------------------------------------------
/
/ set DF to test value
SETTDF, 0 / return address
SDF 5 / (replaced during init)
SDF 4 /
SDF 5 /
JMP I SETTDF / return
/ ------------------------------------------------------------
/
/ set DF to current value
SETCDF, 0 / return address
SIF 5 / (replaced during init)
SIF 4 /
SIF 5 /
JMP I SETCDF / return
PAGE
EJECT
/ ------------------------------------------------------------
*200
START, CLA CLL / zero
CLA CLL IAC BSW / AC=100
DCA PASSES / init passcount
DCA ERRORS / init errorcount
TFL / enable printing
TAD [-200 / this many words in bootstrap
JMS I [CPMEM / copy memory
0^10 / src field
7600 / last page
0^10 / dst field
LOADER / copy to here
SKP / should return here
HLT / should not happen
/ ------------------------------------------------------------
LOOP, CLA / zero
TAD PASSES / get passcount
AND [0007 / low 3 bits
TAD [6440 / make into led IOT
DCA LEDS / store below
CLA IAC R3L / generate 0010 on HD6120 only
TAD [-10 / expected
SNA / skip if matches
LEDS, HLT / SBC6120 cpu, light leds
JMS I [READSR / get switch register
RTL ; RAL / shift left 3
AND [0070 / mask to 3b field
TAD [CDF / make CDF <N> instr
DCA SETTDF+1 / store into setup routine
RDF / get current DF
TAD [CDF / make CDF <N> instr
DCA SETCDF+1 / store into restore routine
DCA TEST / init test number
JMP I [TST1 / start
PAGE
EJECT
/- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
/ TEST 1 - incr count pattern, incr address
/
/ pattern is (0000...7777) + PASSES
TST1, JMS I [CHKTST / check test number
-1 / should be this one
TST2 / return here to skip test
JMS I [SETUPI / setup data field
TST1A, MQL ; MQA / save pattern in MQ
DCA I PTR / store data pattern
MQA ; IAC / restore pattern and bump
JMS I [PTRINC / bump ptr
ISZ MEMCNT / bump count
JMP TST1A / loop if hasn't wrapped
JMS I [SETUPI / setup data field
TST1B, MQL ; MQA / save pattern in MQ
CIA / invert pattern for test
TAD I PTR / get data pattern
SNA / OK if AC is zero
JMP TST1C / jump if OK
DCA RCV / save received
MQA / get pattern
DCA EXP / save expected
JMS I [PRTERR / ***ERROR***
TST1C, MQA ; IAC / restore pattern and bump
JMS I [PTRINC / bump ptr
ISZ MEMCNT / bump count
JMP TST1B / loop if hasn't wrapped
JMS SETCDF / back to normal
EJECT
/- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
/ TEST 2 - incr count pattern, decr address
/
/ pattern is (0000...7777) + PASSES
TST2, JMS I [CHKTST / check test number
-2 / should be this one
TST3 / return here to skip test
JMS I [SETUPD / setup data field
TST2A, MQL ; MQA / save pattern in MQ
DCA I PTR / store data pattern
MQA ; IAC / restore pattern and bump
JMS I [PTRDEC / bump ptr
ISZ MEMCNT / bump count
JMP TST2A / loop if hasn't wrapped
JMS I [SETUPD / setup data field
TST2B, MQL ; MQA / save pattern in MQ
CIA / invert pattern for test
TAD I PTR / get data pattern
SNA / OK if AC is zero
JMP TST2C / jump if OK
DCA RCV / save received
MQA / get pattern
DCA EXP / save expected
JMS I [PRTERR / ***ERROR***
TST2C, MQA ; IAC / restore pattern and bump
JMS I [PTRDEC / bump ptr
ISZ MEMCNT / bump count
JMP TST2B / loop if hasn't wrapped
JMS SETCDF / back to normal
EJECT
/- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
/ TEST 3 - incr/shifted count pattern, incr addr
/
/ pattern is (0000...7777) rotl (PASSES%16) + PASSES
TST3, JMS I [CHKTST / check test number
-3 / should be this one
TST4 / return here to skip test
JMS I [SETUPI / setup data field
TST3A, MQL ; MQA / save pattern in MQ
JMS I [ROTPAT / rotate AC left by PASSES%16
DCA I PTR / store data pattern
MQA ; IAC / restore pattern and bump
JMS I [PTRINC / bump ptr
ISZ MEMCNT / bump count
JMP TST3A / loop if hasn't wrapped
JMS I [SETUPI / setup data field
TST3B, MQL ; MQA / save pattern in MQ
JMS I [ROTPAT / rotate AC left by PASSES%16
CIA / invert pattern for test
TAD I PTR / get data pattern
SNA / OK if AC is zero
JMP TST3C / jump if OK
DCA RCV / save received
MQA / get pattern
JMS I [ROTPAT / rotate AC left by PASSES%16
DCA EXP / save expected
JMS I [PRTERR / ***ERROR***
TST3C, MQA ; IAC / restore pattern and bump
JMS I [PTRINC / bump ptr
ISZ MEMCNT / bump count
JMP TST3B / loop if hasn't wrapped
JMS SETCDF / back to normal
EJECT
/- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
/ TEST 4 - incr/shifted count pattern, decr addr
/
/ pattern is (0000...7777) rotl (PASSES%16) + PASSES
TST4, JMS I [CHKTST / check test number
-4 / should be this one
TST5 / return here to skip test
JMS I [SETUPD / setup data field
TST4A, MQL ; MQA / save pattern in MQ
JMS I [ROTPAT / rotate AC left by PASSES%16
DCA I PTR / store data pattern
MQA ; IAC / restore pattern and bump
JMS I [PTRDEC / bump ptr
ISZ MEMCNT / bump count
JMP TST4A / loop if hasn't wrapped
JMS I [SETUPD / setup data field
TST4B, MQL ; MQA / save pattern in MQ
JMS I [ROTPAT / rotate AC left by PASSES%16
CIA / invert pattern for test
TAD I PTR / get data pattern
SNA / OK if AC is zero
JMP TST4C / jump if OK
DCA RCV / save received
MQA / get pattern
JMS I [ROTPAT / rotate AC left by PASSES%16
DCA EXP / save expected
JMS I [PRTERR / ***ERROR***
TST4C, MQA ; IAC / restore pattern and bump
JMS I [PTRDEC / bump ptr
ISZ MEMCNT / bump count
JMP TST4B / loop if hasn't wrapped
JMS SETCDF / back to normal
EJECT
/- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
/ TEST 5 - decr/shifted count pattern, incr addr
/
/ pattern is (7777...0000) rotl (PASSES%16) + PASSES
TST5, JMS I [CHKTST / check test number
-5 / should be this one
TST6 / return here to skip test
JMS I [SETUPI / setup data field
TST5A, MQL ; MQA / save pattern in MQ
JMS I [ROTPAT / rotate AC left by PASSES%16
CMA / and invert
DCA I PTR / store data pattern
MQA ; IAC / restore pattern and bump
JMS I [PTRINC / bump ptr
ISZ MEMCNT / bump count
JMP TST5A / loop if hasn't wrapped
JMS I [SETUPI / setup data field
TST5B, MQL ; MQA / save pattern in MQ
JMS I [ROTPAT / rotate AC left by PASSES%16
IAC / invert pattern for test
TAD I PTR / get data pattern
SNA / OK if AC is zero
JMP TST5C / jump if OK
DCA RCV / save received
MQA / get pattern
JMS I [ROTPAT / rotate AC left by PASSES%16
CMA / and invert
DCA EXP / save expected
JMS I [PRTERR / ***ERROR***
TST5C, MQA ; IAC / restore pattern and bump
JMS I [PTRINC / bump ptr
ISZ MEMCNT / bump count
JMP TST5B / loop if hasn't wrapped
JMS SETCDF / back to normal
EJECT
/- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
/ TEST 6 - decr/shifted count pattern, decr addr
/
/ pattern is (7777...0000) rotl (PASSES%16) + PASSES
TST6, JMS I [CHKTST / check test number
-6 / should be this one
TST7 / return here to skip test
JMS I [SETUPD / setup data field
TST6A, MQL ; MQA / save pattern in MQ
JMS I [ROTPAT / rotate AC left by PASSES%16
CMA / and invert
DCA I PTR / store data pattern
MQA ; IAC / restore pattern and bump
JMS I [PTRDEC / bump ptr
ISZ MEMCNT / bump count
JMP TST6A / loop if hasn't wrapped
JMS I [SETUPD / setup data field
TST6B, MQL ; MQA / save pattern in MQ
JMS I [ROTPAT / rotate AC left by PASSES%16
IAC / invert pattern for test
TAD I PTR / get data pattern
SNA / OK if AC is zero
JMP TST6C / jump if OK
DCA RCV / save received
MQA / get pattern
JMS I [ROTPAT / rotate AC left by PASSES%16
CMA / and invert
DCA EXP / save expected
JMS I [PRTERR / ***ERROR***
TST6C, MQA ; IAC / restore pattern and bump
JMS I [PTRDEC / bump ptr
ISZ MEMCNT / bump count
JMP TST6B / loop if hasn't wrapped
JMS SETCDF / back to normal
EJECT
/- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
/ TEST 7 - random data pattern, incr addr
/
/ pattern is (AC<-29*AC+1001) + PASSES
TST7, JMS I [CHKTST / check test number
-7 / should be this one
TST10 / return here to skip test
JMS I [SETUPI / setup data field
MQL / save seed in MQ, clear AC
TST7A, JMS I [RAND2 / AC,MQ <- 29*MQ+1001
DCA I PTR / store data pattern
JMS I [PTRINC / bump ptr
ISZ MEMCNT / bump count
JMP TST7A / loop if hasn't wrapped
JMS I [SETUPI / setup data field
MQL / save seed in MQ, clear AC
TST7B, JMS I [RAND2 / AC,MQ <- 29*MQ+1001
CIA / negate pattern for test
TAD I PTR / get data pattern
SNA / OK if AC is zero
JMP TST7C / jump if OK
DCA RCV / save received
MQA / get pattern
DCA EXP / save expected
JMS I [PRTERR / ***ERROR***
TST7C, JMS I [PTRINC / bump ptr
ISZ MEMCNT / bump count
JMP TST7B / loop if hasn't wrapped
JMS SETCDF / back to normal
EJECT
/- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
/ TEST 10 - random data pattern, decr addr
/
/ pattern is (AC<-29*AC+1001) + PASSES
TST10, JMS I [CHKTST / check test number
-10 / should be this one
EOP / return here to skip test
JMS I [SETUPD / setup data field
MQL / save seed in MQ, clear AC
TST10A, JMS I [RAND2 / AC,MQ <- 29*MQ+1001
DCA I PTR / store data pattern
JMS I [PTRDEC / bump ptr
ISZ MEMCNT / bump count
JMP TST10A / loop if hasn't wrapped
JMS I [SETUPD / setup data field
MQL / save seed in MQ, clear AC
TST10B, JMS I [RAND2 / AC,MQ <- 29*MQ+1001
CIA / negate pattern for test
TAD I PTR / get data pattern
SNA / OK if AC is zero
JMP TST10C / jump if OK
DCA RCV / save received
MQA / get pattern
DCA EXP / save expected
JMS I [PRTERR / ***ERROR***
TST10C, JMS I [PTRDEC / bump ptr
ISZ MEMCNT / bump count
JMP TST10B / loop if hasn't wrapped
JMS SETCDF / back to normal
JMP I [EOP / done
PAGE
EJECT
/ ------------------------------------------------------------
/////// END OF PASS ///////
EOP, ISZ PASSES / count passes
SKP / don't let it be zero
JMP .-2 / again
CLA / zero
TAD [-200 / restore bootstrap from saved
JMS I [CPMEM / copy memory
0^10 / src field
LOADER / copy to here
0^10 / dst field
7600 / last page
JMS I [READSR / get switches
SMA / skip on SR<0> set
JMS I [PRBEL / ring BELL if bit0 clear
JMS I [PRAST / print message
EOPM1 / from here
TAD PASSES / get passcount
JMS I [PROCT / print octal
JMS I [PRAST / print message
EOPM2 / from here
TAD SETTDF+1 / field we are testing
CLL RTR ; RAR / shift right three bits
AND [0007 / one digit
TAD [0260 / make ascii
JMS I [PRCHR / print
JMS I [PRAST / print message
EOPM3 / from here
TAD ERRORS / get errorcount
JMS I [PROCT / print octal
JMS I [PREOL / print end of line
JMS I [READSR / get switches again
RTL / isolate SR<1> halt switch
SNL / skip if set
JMP I [LOOP / keep going
HLT / halt
JMP I [LOOP / restart
EOPM1, TEXT "END PASS "
EOPM2, TEXT " FIELD "
EOPM3, TEXT " ERRORS "
EJECT
/ ------------------------------------------------------------
/
/ check test number sequence
/
/ first word is negative of expected test number
/ second word is addr of where to go to if skipping this test
/
/ uses indirect data address mode
CHKTST, 0 / return address
CLA CLL / clear AC LK
ISZ TEST / bump test number
TAD TEST / and get it to AC
TAD I CHKTST / add negative of expected number
SZA / should be zero...
HLT / ***ERROR***
JMS I [READSR / get switches
AND [1700 / mask to bits 2-5 only
SNA / skip if not zero
JMP CHK2 / zero - execute all tests
TAD I CHKTST / compare current:selected
SNA CLA / skip if not equal
JMP CHK2 / jmp if equal; execute test
ISZ CHKTST / point to skip-test address
TAD I CHKTST / get address
DCA CHKTST / store as return
JMP I CHKTST / return
CHK2, ISZ CHKTST / point to skip-test address
ISZ CHKTST / point to normal return
JMP I CHKTST / return
EJECT
/ ------------------------------------------------------------
/
/ circular rotate AC left by PASSES%16
/
/ return with AC updated
/ uses TMP1-2
SAVEAC=TMP1
COUNT=TMP2
ROTPAT, 0 / return address
DCA SAVEAC / save AC
TAD PASSES / get passcount
AND [17 / mask to low 4 bits
CMA / change to 7777..7760 range
DCA COUNT / save counter
TAD SAVEAC / get value
ROT1, CLL RAL / LK|AC<<1
SZL / check bit shifted out
IAC / was 1, insert into bit11
ISZ COUNT / count
JMP ROT1 / loop if more
JMP I ROTPAT / return
EJECT
/ ------------------------------------------------------------
/
/ generate random number
/
/ return with AC,MQ <- 29*MQ + 1001
/ uses TMP1-2
COUNT=TMP1
MULT=TMP2
RAND1, 0 / return address
CLA / zap
TAD [-35 / -29
DCA COUNT / init multiplier
CLA MQA / AC <- MQ
DCA MULT / init multiplicand
RAND1A, TAD MULT / add multiplicand
ISZ COUNT / decr multiplier
JMP RAND1A / loop
TAD [1751 / +1001
MQL ; MQA / MQ <- AC ; AC <- MQ
JMP I RAND1 / return
/ ------------------------------------------------------------
/
/ generate random number
/
/ return with AC,MQ <- 29*MQ + 1001
/ uses TMP1-2
MULT=TMP1
RAND2, 0 / return address
CLA MQA / AC <- MQ
DCA MULT / init multiplicand
TAD MULT / *1
CLL RAL / *2
CLL RAL / *4
TAD MULT / *5
TAD MULT / *6
TAD MULT / *7
CLL RAL / *14
CLL RAL / *28
TAD MULT / *29
TAD [1751 / +1001
MQL ; MQA / MQ <- AC ; AC <- MQ
JMP I RAND2 / return
PAGE
EJECT
/ ------------------------------------------------------------
/
/ print error message
/
/ return with AC=0
PRTERR, 0 / return address
CLA / zero
TAD ERRORS / get error count
AND [17 / get low four bits
SZA CLA / test
JMP PRTER1 / skip print
JMS SETCDF / back to current DF
JMS I [PRAST / print text
PRTER2 / header
JMS SETTDF / back to test DF
PRTER1, TAD PASSES / get passcount
JMS I [PROCT / print octal
JMS I [PRSPA / print a space
TAD ERRORS / get error count
JMS I [PROCT / print octal
JMS I [PRSPA / print space
TAD TEST / get test number
JMS I [PROCT / print octal
JMS I [PRSPA / print a space
RDF / get data field
CLL RTR ; RAR / shift right three bits
TAD [0260 / make ascii
JMS I [PRCHR / print
TAD PTR / get test address
JMS I [PROCT / print octal
JMS I [PRSPA / print a space
TAD EXP / get expected
JMS I [PROCT / print octal
JMS I [PRSPA / print a space
TAD RCV / received data
TAD EXP / add back expected
JMS I [PROCT / print octal
JMS I [PREOL / end of line
ISZ ERRORS / count errors
SKP /
JMP .-2 / don't let go to zero
JMP I PRTERR / return
PRTER2, TEXT "_PASS ERRS TEST ADDRS EXPD RCVD_"
EJECT
/ ------------------------------------------------------------
/
/ copy memory from SRC to DST for COUNT
/
/ call: TAD (-COUNT
/ JMS CPMEM
/ SRCFIELD<6:8>
/ SRCADDRESS<0:11>
/ DSTFIELD<6:8>
/ DSTADDRESS<0:11>
/ return with AC=0
/ uses indirect data address mode
CPMEM, 0 / return address
DCA CPMEMX / save count
RDF / get current DF
TAD [CDF / make into CDF<D>
DCA CPMEM9 / save for return
RIF / get current IF
TAD [CDF / make into CDF<I>
DCA .+1 / store
HLT / replaced with CDF<I>
TAD I CPMEM / get SRCFIELD
TAD [CDF / make into CDF<S>
DCA CPMEM7 / store
ISZ CPMEM / bump
TAD I CPMEM / get SRCADDR
DCA CPMEMS / store
ISZ CPMEM / bump
TAD I CPMEM / get DSTFIELD
TAD [CDF / make into CDF<T>
DCA CPMEM8 / store
ISZ CPMEM / bump
TAD I CPMEM / get DSTADDR
DCA CPMEMD / store
ISZ CPMEM / bump
CPMEM7, HLT / replaced with CDF<S>
TAD I CPMEMS / get src data
ISZ CPMEMS / bump ptr
NOP / allow for zero
CPMEM8, HLT / replaced with CDF<T>
DCA I CPMEMD / store dst data
ISZ CPMEMD / bump ptr
NOP / allow for zero
ISZ CPMEMX / count words
JMP CPMEM7 / loop
CLA / zero
CPMEM9, HLT / replaced with CDF<D>
JMP I CPMEM / return
CPMEMX, 0 / -count of words
CPMEMS, 0 / source address
CPMEMD, 0 / target address
PAGE
EJECT
/ ------------------------------------------------------------
/
/ octal print routine of AC (4 digit)
/
/ return with AC=0
/ uses TMP1-2
VALUE=TMP1
COUNT=TMP2
PROCT, 0 / return address
CLL RAL / rotate into L,AC<0:10>
DCA VALUE / save number
TAD [-4 / digit count
DCA COUNT / save
PROCT1, TAD VALUE / rotate number left 3
RTL ; RAL /
DCA VALUE / save other bits
TAD VALUE /
AND [0007 / mask digit
TAD [0260 / make ascii
JMS I [PRCHR / print one char
ISZ COUNT / count digits
JMP PROCT1 / loop
JMP I PROCT / return
EJECT
/ ------------------------------------------------------------
/
/ text print routine, addr of string in next word
/ string is two 6b characters per word
/ 00(@) to terminate string, 37(_) prints CRLF sequence
/
/ return with AC=0
/ uses TMP1
/ uses indirect data address mode
STPTR=TMP1
PRAST, 0 / return address
CLA / zero
TAD I PRAST / get ptr to string
DCA STPTR / store ptr
ISZ PRAST / bump addr +1
PRAST1, TAD I STPTR / get two chars
BSW / move upper 6b to low
JMS PRAST2 / go print
TAD I STPTR / get two chars
JMS PRAST2 / go print
ISZ STPTR / bump ptr
JMP PRAST1 / loop
/ print one 6b char in AC<6:11> as 8b ascii
PRAST2, 0 / return address
AND [77 / mask low 6b
SNA / skip if not 00
JMP I PRAST / return from caller
TAD [-37 / check for 37
SZA / skip if 37
JMP PRAST3 / jmp if not 37
JMS I [PREOL / print CRLF
JMP I PRAST2 / return
PRAST3, SPA / skip if 40..77
TAD [100 / 01..36 maps to 301..336
TAD [237 / 40..77 maps to 240..277
JMS I [PRCHR / print character
JMP I PRAST2 / return
/ TEXT ~@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_~ / 00..37 -> 300..337
/ TEXT ~ !"#$%&'()*+,-./0123456789:;<=>?~ / 40..77 -> 240..277
EJECT
/ ------------------------------------------------------------
/
/ print a SPACE
/
/ return with AC=0
PRSPA, 0 / return address
CLA / zero
TAD [240 / SP
JMS I [PRCHR / print one char
JMP I PRSPA / return
/ ------------------------------------------------------------
/
/ print a BELL
/
/ return with AC=0
PRBEL, 0 / return address
CLA / zero
TAD [207 / BELL
JMS I [PRCHR / print one char
JMP I PRBEL / return
/ ------------------------------------------------------------
/
/ print a CRLF sequence
/
/ return with AC=0
PREOL, 0 / return address
CLA / zero
TAD [215 / CR
JMS I [PRCHR / print one char
TAD [212 / CR
JMS I [PRCHR / print one char
JMP I PREOL / return
/ ------------------------------------------------------------
/
/ print one character from AC
/
/ return with AC=0
PRCHR, 0 / return address
TSF / wait for done
JMP .-1 / loop until done
AND [177 / mask to 7 bits
TLS / print character
CLA / zero
JMP I PRCHR / return
EJECT
/ ------------------------------------------------------------
/
/ get h/w or s/w switch register, as appropriate
/
/ return with AC=SR
READSR, 0 / return address
CLA IAC R3L / generate 0010 on HD6120 only
TAD [-10 / expected
SZA / skip if matches
JMP .+3 / non-6120 cpu, go do LAS
TAD SSR / load s/w switches
SKP / skip over next
LAS / load h/w switches
JMP I READSR / return
EJECT
/ ------------------------------------------------------------
/
/ ptr <- ptr+1
/ uses TMP1
SAVEAC=TMP1
PTRINC, 0 / return address
DCA SAVEAC / save AC
IAC / +1
TAD PTR / PTR+1
DCA PTR / save
TAD SAVEAC / restore AC
JMP I PTRINC / return
/ ------------------------------------------------------------
/
/ ptr <- ptr-1
/ uses TMP1
SAVEAC=TMP1
PTRDEC, 0 / return address
DCA SAVEAC / save AC
CMA / -1
TAD PTR / PTR-1
DCA PTR / save
TAD SAVEAC / restore AC
JMP I PTRDEC / return
EJECT
/ ------------------------------------------------------------
/
/ set DF to current test field, adjust PTR as necessary
/
/ setup MEMBEG,MEMCNT depending upon DF selected
/ setup PTR to MEMBEG or MEMEND
/ return with AC=PASSES
SETUPI, 0 / return address
JMS SETUPX / common setup
TAD MEMBEG / starting test location
DCA PTR / into memory ptr
TAD PASSES / get passcount into AC
TAD PTR / start at ptr
JMP I SETUPI / return
SETUPD, 0 / return address
JMS SETUPX / common setup
TAD MEMEND / ending test location
DCA PTR / into memory ptr
TAD PASSES / get passcount into AC
TAD PTR / start at ptr
JMP I SETUPD / return
SETUPX, 0 / return address
JMS SETTDF / set test data field
CLA CLL / clear AC and LK
TAD SETTDF+1 / get test DF
CIA / negate for test
TAD SETCDF+1 / get current DF
SNA CLA / skip if not equal; clr AC
JMP SETUP1 / jmp if equal
DCA MEMBEG / set MEMBEG to 0000
DCA MEMCNT / set MEMCNT to -10000
JMP SETUP2 / continue
SETUP1, TAD [MEMTST / first free location
DCA MEMBEG / set MEMBEG to MEMTST
TAD MEMEND / MEMEND
CMA / -(MEMEND+1)
TAD MEMBEG / MEMBEG-(MEMEND+1)
DCA MEMCNT / into MEMCNT
SETUP2, JMP I SETUPX / return
EJECT
/ ------------------------------------------------------------
PAGE / start of next page
LOADER, ZBLOCK 200 /
/ ------------------------------------------------------------
PAGE / start of next page
MEMTST, / dummy
/ ------------------------------------------------------------
/ autostart program after download via RIMLDR
*0 / page 0
LITBAS / force all literals out
*7751 / align to RIMLDR location
START / addr of program start
KCC / first instr in std RIMLDR
TAD .-1 / get KCC instr
DCA .+2 / restore into RIMLDR
JMP I .-4 / start program
JMP .-3 / overlay first word of RIMLDR
$ / the end

BIN
d8tape/verify.bin Normal file
View File

Binary file not shown.

806
d8tape/verify.dump Normal file
View File

@ -0,0 +1,806 @@
00000/7402 hlt
00001/7402 hlt
00002/7402 hlt
00003/7402 hlt
00040/0001 and 1
00041/0000 and 0
00042/0000 and 0
00043/0000 and 0
00044/0000 and 0
00045/0000 and 0
00046/0000 and 0
00047/0000 and 0
00050/0000 and 0
00051/0000 and 0
00052/0000 and 0
00053/0000 and 0
00054/7777 cla mqa mql
00055/0000 and 0
00056/0000 and 0
00057/6251 iot 25,1
00060/6241 iot 24,1
00061/6251 iot 25,1
00062/5456 jmp i 56
00063/0000 and 0
00064/6252 iot 25,2
00065/6242 iot 24,2
00066/6252 iot 25,2
00067/5463 jmp i 63
00200/7300 cla cll
00201/7303 cla cll iac bsw
00202/3051 dca 51
00203/3052 dca 52
00204/6040 iot 4,0
00205/1177 tad 177
00206/4576 jms i 176
00207/0000 and 0
00210/7600 cla
00211/0000 and 0
00212/1600 tad i 200
00213/7410 skp
00214/7402 hlt
00215/7200 cla
00216/1051 tad 51
00217/0175 and 175
00220/1174 tad 174
00221/3225 dca 225
00222/7215 cla iac
00223/1173 tad 173
00224/7450 sna
00225/7402 hlt
00226/4572 jms i 172
00227/7006 rtl
00230/7004 ral
00231/0171 and 171
00232/1170 tad 170
00233/3057 dca 57
00234/6214 iot 21,4
00235/1170 tad 170
00236/3064 dca 64
00237/3050 dca 50
00240/5567 jmp i 167
00400/4566 jms i 166
00401/7777 cla mqa mql
00402/0435 and i 35
00403/4565 jms i 165
00404/7421 mql
00405/7501 mqa
00406/3441 dca i 41
00407/7501 mqa
00410/7001 iac
00411/4564 jms i 164
00412/2055 isz 55
00413/5204 jmp 404
00414/4565 jms i 165
00415/7421 mql
00416/7501 mqa
00417/7041 cma iac
00420/1441 tad i 41
00421/7450 sna
00422/5227 jmp 427
00423/3047 dca 47
00424/7501 mqa
00425/3046 dca 46
00426/4563 jms i 163
00427/7501 mqa
00430/7001 iac
00431/4564 jms i 164
00432/2055 isz 55
00433/5215 jmp 415
00434/4063 jms 63
00435/4566 jms i 166
00436/7776 spa sna szl cla osr hlt
00437/0472 and i 72
00440/4562 jms i 162
00441/7421 mql
00442/7501 mqa
00443/3441 dca i 41
00444/7501 mqa
00445/7001 iac
00446/4561 jms i 161
00447/2055 isz 55
00450/5241 jmp 441
00451/4562 jms i 162
00452/7421 mql
00453/7501 mqa
00454/7041 cma iac
00455/1441 tad i 41
00456/7450 sna
00457/5264 jmp 464
00460/3047 dca 47
00461/7501 mqa
00462/3046 dca 46
00463/4563 jms i 163
00464/7501 mqa
00465/7001 iac
00466/4561 jms i 161
00467/2055 isz 55
00470/5252 jmp 452
00471/4063 jms 63
00472/4566 jms i 166
00473/7775 cla mqa mql
00474/0532 and i 132
00475/4565 jms i 165
00476/7421 mql
00477/7501 mqa
00500/4560 jms i 160
00501/3441 dca i 41
00502/7501 mqa
00503/7001 iac
00504/4564 jms i 164
00505/2055 isz 55
00506/5276 jmp 476
00507/4565 jms i 165
00510/7421 mql
00511/7501 mqa
00512/4560 jms i 160
00513/7041 cma iac
00514/1441 tad i 41
00515/7450 sna
00516/5324 jmp 524
00517/3047 dca 47
00520/7501 mqa
00521/4560 jms i 160
00522/3046 dca 46
00523/4563 jms i 163
00524/7501 mqa
00525/7001 iac
00526/4564 jms i 164
00527/2055 isz 55
00530/5310 jmp 510
00531/4063 jms 63
00532/4566 jms i 166
00533/7774 spa sna szl cla osr
00534/0572 and i 172
00535/4562 jms i 162
00536/7421 mql
00537/7501 mqa
00540/4560 jms i 160
00541/3441 dca i 41
00542/7501 mqa
00543/7001 iac
00544/4561 jms i 161
00545/2055 isz 55
00546/5336 jmp 536
00547/4562 jms i 162
00550/7421 mql
00551/7501 mqa
00552/4560 jms i 160
00553/7041 cma iac
00554/1441 tad i 41
00555/7450 sna
00556/5364 jmp 564
00557/3047 dca 47
00560/7501 mqa
00561/4560 jms i 160
00562/3046 dca 46
00563/4563 jms i 163
00564/7501 mqa
00565/7001 iac
00566/4561 jms i 161
00567/2055 isz 55
00570/5350 jmp 550
00571/4063 jms 63
00572/4566 jms i 166
00573/7773 cla mqa mql
00574/0634 and i 434
00575/4565 jms i 165
00576/7421 mql
00577/7501 mqa
00600/4560 jms i 160
00601/7040 cma
00602/3441 dca i 41
00603/7501 mqa
00604/7001 iac
00605/4564 jms i 164
00606/2055 isz 55
00607/5777 jmp i 777
00610/4565 jms i 165
00611/7421 mql
00612/7501 mqa
00613/4560 jms i 160
00614/7001 iac
00615/1441 tad i 41
00616/7450 sna
00617/5226 jmp 626
00620/3047 dca 47
00621/7501 mqa
00622/4560 jms i 160
00623/7040 cma
00624/3046 dca 46
00625/4563 jms i 163
00626/7501 mqa
00627/7001 iac
00630/4564 jms i 164
00631/2055 isz 55
00632/5211 jmp 611
00633/4063 jms 63
00634/4566 jms i 166
00635/7772 spa sna szl cla hlt
00636/0676 and i 676
00637/4562 jms i 162
00640/7421 mql
00641/7501 mqa
00642/4560 jms i 160
00643/7040 cma
00644/3441 dca i 41
00645/7501 mqa
00646/7001 iac
00647/4561 jms i 161
00650/2055 isz 55
00651/5240 jmp 640
00652/4562 jms i 162
00653/7421 mql
00654/7501 mqa
00655/4560 jms i 160
00656/7001 iac
00657/1441 tad i 41
00660/7450 sna
00661/5270 jmp 670
00662/3047 dca 47
00663/7501 mqa
00664/4560 jms i 160
00665/7040 cma
00666/3046 dca 46
00667/4563 jms i 163
00670/7501 mqa
00671/7001 iac
00672/4561 jms i 161
00673/2055 isz 55
00674/5253 jmp 653
00675/4063 jms 63
00676/4566 jms i 166
00677/7771 cla mqa mql
00700/0727 and i 727
00701/4565 jms i 165
00702/7421 mql
00703/4557 jms i 157
00704/3441 dca i 41
00705/4564 jms i 164
00706/2055 isz 55
00707/5303 jmp 703
00710/4565 jms i 165
00711/7421 mql
00712/4557 jms i 157
00713/7041 cma iac
00714/1441 tad i 41
00715/7450 sna
00716/5323 jmp 723
00717/3047 dca 47
00720/7501 mqa
00721/3046 dca 46
00722/4563 jms i 163
00723/4564 jms i 164
00724/2055 isz 55
00725/5312 jmp 712
00726/4063 jms 63
00727/4566 jms i 166
00730/7770 spa sna szl cla
00731/1000 tad 0
00732/4562 jms i 162
00733/7421 mql
00734/4557 jms i 157
00735/3441 dca i 41
00736/4561 jms i 161
00737/2055 isz 55
00740/5334 jmp 734
00741/4562 jms i 162
00742/7421 mql
00743/4557 jms i 157
00744/7041 cma iac
00745/1441 tad i 41
00746/7450 sna
00747/5354 jmp 754
00750/3047 dca 47
00751/7501 mqa
00752/3046 dca 46
00753/4563 jms i 163
00754/4561 jms i 161
00755/2055 isz 55
00756/5343 jmp 743
00757/4063 jms 63
00760/5556 jmp i 156
00777/0576 and i 176
01000/2051 isz 51
01001/7410 skp
01002/5200 jmp 1000
01003/7200 cla
01004/1177 tad 177
01005/4576 jms i 176
01006/0000 and 0
01007/1600 tad i 1000
01010/0000 and 0
01011/7600 cla
01012/4572 jms i 172
01013/7500 sma
01014/4555 jms i 155
01015/4554 jms i 154
01016/1044 tad 44
01017/1051 tad 51
01020/4553 jms i 153
01021/4554 jms i 154
01022/1051 tad 51
01023/1057 tad 57
01024/7112 cll rtr
01025/7010 rar
01026/0175 and 175
01027/1152 tad 152
01030/4551 jms i 151
01031/4554 jms i 154
01032/1055 tad 55
01033/1052 tad 52
01034/4553 jms i 153
01035/4550 jms i 150
01036/4572 jms i 172
01037/7006 rtl
01040/7420 snl
01041/5547 jmp i 147
01042/7402 hlt
01043/5547 jmp i 147
01044/0516 and i 116
01045/0440 and i 40
01046/2001 isz 1
01047/2323 isz 1123
01050/4000 jms 0
01051/4006 jms 6
01052/1105 tad 105
01053/1404 tad i 4
01054/4000 jms 0
01055/4005 jms 5
01056/2222 isz 1022
01057/1722 tad i 1122
01060/2340 isz 1140
01061/0000 and 0
01062/0000 and 0
01063/7300 cla cll
01064/2050 isz 50
01065/1050 tad 50
01066/1662 tad i 1062
01067/7440 sza
01070/7402 hlt
01071/4572 jms i 172
01072/0146 and 146
01073/7450 sna
01074/5304 jmp 1104
01075/1662 tad i 1062
01076/7650 sna cla
01077/5304 jmp 1104
01100/2262 isz 1062
01101/1662 tad i 1062
01102/3262 dca 1062
01103/5662 jmp i 1062
01104/2262 isz 1062
01105/2262 isz 1062
01106/5662 jmp i 1062
01107/0000 and 0
01110/3042 dca 42
01111/1051 tad 51
01112/0145 and 145
01113/7040 cma
01114/3043 dca 43
01115/1042 tad 42
01116/7104 cll ral
01117/7430 szl
01120/7001 iac
01121/2043 isz 43
01122/5316 jmp 1116
01123/5707 jmp i 1107
01124/0000 and 0
01125/7200 cla
01126/1144 tad 144
01127/3042 dca 42
01130/7701 cla mqa
01131/3043 dca 43
01132/1043 tad 43
01133/2042 isz 42
01134/5332 jmp 1132
01135/1143 tad 143
01136/7421 mql
01137/7501 mqa
01140/5724 jmp i 1124
01141/0000 and 0
01142/7701 cla mqa
01143/3042 dca 42
01144/1042 tad 42
01145/7104 cll ral
01146/7104 cll ral
01147/1042 tad 42
01150/1042 tad 42
01151/1042 tad 42
01152/7104 cll ral
01153/7104 cll ral
01154/1042 tad 42
01155/1143 tad 143
01156/7421 mql
01157/7501 mqa
01160/5741 jmp i 1141
01200/0000 and 0
01201/7200 cla
01202/1052 tad 52
01203/0145 and 145
01204/7640 sza cla
01205/5212 jmp 1212
01206/4063 jms 63
01207/4554 jms i 154
01210/1246 tad 1246
01211/4056 jms 56
01212/1051 tad 51
01213/4553 jms i 153
01214/4542 jms i 142
01215/1052 tad 52
01216/4553 jms i 153
01217/4542 jms i 142
01220/1050 tad 50
01221/4553 jms i 153
01222/4542 jms i 142
01223/6214 iot 21,4
01224/7112 cll rtr
01225/7010 rar
01226/1152 tad 152
01227/4551 jms i 151
01230/1041 tad 41
01231/4553 jms i 153
01232/4542 jms i 142
01233/1046 tad 46
01234/4553 jms i 153
01235/4542 jms i 142
01236/1047 tad 47
01237/1046 tad 46
01240/4553 jms i 153
01241/4550 jms i 150
01242/2052 isz 52
01243/7410 skp
01244/5242 jmp 1242
01245/5600 jmp i 1200
01246/3720 dca i 1320
01247/0123 and 123
01250/2340 isz 1340
01251/0522 and i 122
01252/2223 isz 1223
01253/4024 jms 24
01254/0523 and i 123
01255/2440 isz i 40
01256/0104 and 104
01257/0422 and i 22
01260/2340 isz 1340
01261/0530 and i 130
01262/2004 isz 4
01263/4022 jms 22
01264/0326 and 1326
01265/0437 and i 37
01266/0000 and 0
01267/0000 and 0
01270/3333 dca 1333
01271/6214 iot 21,4
01272/1170 tad 170
01273/3331 dca 1331
01274/6224 iot 22,4
01275/1170 tad 170
01276/3277 dca 1277
01277/7402 hlt
01300/1667 tad i 1267
01301/1170 tad 170
01302/3316 dca 1316
01303/2267 isz 1267
01304/1667 tad i 1267
01305/3334 dca 1334
01306/2267 isz 1267
01307/1667 tad i 1267
01310/1170 tad 170
01311/3322 dca 1322
01312/2267 isz 1267
01313/1667 tad i 1267
01314/3335 dca 1335
01315/2267 isz 1267
01316/7402 hlt
01317/1734 tad i 1334
01320/2334 isz 1334
01321/7000 nop
01322/7402 hlt
01323/3735 dca i 1335
01324/2335 isz 1335
01325/7000 nop
01326/2333 isz 1333
01327/5316 jmp 1316
01330/7200 cla
01331/7402 hlt
01332/5667 jmp i 1267
01333/0000 and 0
01334/0000 and 0
01335/0000 and 0
01400/0000 and 0
01401/7104 cll ral
01402/3042 dca 42
01403/1141 tad 141
01404/3043 dca 43
01405/1042 tad 42
01406/7006 rtl
01407/7004 ral
01410/3042 dca 42
01411/1042 tad 42
01412/0175 and 175
01413/1152 tad 152
01414/4551 jms i 151
01415/2043 isz 43
01416/5205 jmp 1405
01417/5600 jmp i 1400
01420/0000 and 0
01421/7200 cla
01422/1620 tad i 1420
01423/3042 dca 42
01424/2220 isz 1420
01425/1442 tad i 42
01426/7002 bsw
01427/4234 jms 1434
01430/1442 tad i 42
01431/4234 jms 1434
01432/2042 isz 42
01433/5225 jmp 1425
01434/0000 and 0
01435/0140 and 140
01436/7450 sna
01437/5620 jmp i 1420
01440/1137 tad 137
01441/7440 sza
01442/5245 jmp 1445
01443/4550 jms i 150
01444/5634 jmp i 1434
01445/7510 spa
01446/1136 tad 136
01447/1135 tad 135
01450/4551 jms i 151
01451/5634 jmp i 1434
01452/0000 and 0
01453/7200 cla
01454/1134 tad 134
01455/4551 jms i 151
01456/5652 jmp i 1452
01457/0000 and 0
01460/7200 cla
01461/1133 tad 133
01462/4551 jms i 151
01463/5657 jmp i 1457
01464/0000 and 0
01465/7200 cla
01466/1147 tad 147
01467/4551 jms i 151
01470/1132 tad 132
01471/4551 jms i 151
01472/5664 jmp i 1464
01473/0000 and 0
01474/6041 iot 4,1
01475/5274 jmp 1474
01476/0131 and 131
01477/6046 iot 4,6
01500/7200 cla
01501/5673 jmp i 1473
01502/0000 and 0
01503/7215 cla iac
01504/1173 tad 173
01505/7440 sza
01506/5311 jmp 1511
01507/1040 tad 40
01510/7410 skp
01511/7604 cla osr
01512/5702 jmp i 1502
01513/0000 and 0
01514/3042 dca 42
01515/7001 iac
01516/1041 tad 41
01517/3041 dca 41
01520/1042 tad 42
01521/5713 jmp i 1513
01522/0000 and 0
01523/3042 dca 42
01524/7040 cma
01525/1041 tad 41
01526/3041 dca 41
01527/1042 tad 42
01530/5722 jmp i 1522
01531/0000 and 0
01532/4347 jms 1547
01533/1053 tad 53
01534/3041 dca 41
01535/1051 tad 51
01536/1041 tad 41
01537/5731 jmp i 1531
01540/0000 and 0
01541/4347 jms 1547
01542/1054 tad 54
01543/3041 dca 41
01544/1051 tad 51
01545/1041 tad 41
01546/5740 jmp i 1540
01547/0000 and 0
01550/4056 jms 56
01551/7300 cla cll
01552/1057 tad 57
01553/7041 cma iac
01554/1064 tad 64
01555/7650 sna cla
01556/5362 jmp 1562
01557/3053 dca 53
01560/3055 dca 55
01561/5370 jmp 1570
01562/1130 tad 130
01563/3053 dca 53
01564/1054 tad 54
01565/7040 cma
01566/1053 tad 53
01567/3055 dca 55
01570/5747 jmp i 1547
01600/0000 and 0
01601/0000 and 0
01602/0000 and 0
01603/0000 and 0
01604/0000 and 0
01605/0000 and 0
01606/0000 and 0
01607/0000 and 0
01610/0000 and 0
01611/0000 and 0
01612/0000 and 0
01613/0000 and 0
01614/0000 and 0
01615/0000 and 0
01616/0000 and 0
01617/0000 and 0
01620/0000 and 0
01621/0000 and 0
01622/0000 and 0
01623/0000 and 0
01624/0000 and 0
01625/0000 and 0
01626/0000 and 0
01627/0000 and 0
01630/0000 and 0
01631/0000 and 0
01632/0000 and 0
01633/0000 and 0
01634/0000 and 0
01635/0000 and 0
01636/0000 and 0
01637/0000 and 0
01640/0000 and 0
01641/0000 and 0
01642/0000 and 0
01643/0000 and 0
01644/0000 and 0
01645/0000 and 0
01646/0000 and 0
01647/0000 and 0
01650/0000 and 0
01651/0000 and 0
01652/0000 and 0
01653/0000 and 0
01654/0000 and 0
01655/0000 and 0
01656/0000 and 0
01657/0000 and 0
01660/0000 and 0
01661/0000 and 0
01662/0000 and 0
01663/0000 and 0
01664/0000 and 0
01665/0000 and 0
01666/0000 and 0
01667/0000 and 0
01670/0000 and 0
01671/0000 and 0
01672/0000 and 0
01673/0000 and 0
01674/0000 and 0
01675/0000 and 0
01676/0000 and 0
01677/0000 and 0
01700/0000 and 0
01701/0000 and 0
01702/0000 and 0
01703/0000 and 0
01704/0000 and 0
01705/0000 and 0
01706/0000 and 0
01707/0000 and 0
01710/0000 and 0
01711/0000 and 0
01712/0000 and 0
01713/0000 and 0
01714/0000 and 0
01715/0000 and 0
01716/0000 and 0
01717/0000 and 0
01720/0000 and 0
01721/0000 and 0
01722/0000 and 0
01723/0000 and 0
01724/0000 and 0
01725/0000 and 0
01726/0000 and 0
01727/0000 and 0
01730/0000 and 0
01731/0000 and 0
01732/0000 and 0
01733/0000 and 0
01734/0000 and 0
01735/0000 and 0
01736/0000 and 0
01737/0000 and 0
01740/0000 and 0
01741/0000 and 0
01742/0000 and 0
01743/0000 and 0
01744/0000 and 0
01745/0000 and 0
01746/0000 and 0
01747/0000 and 0
01750/0000 and 0
01751/0000 and 0
01752/0000 and 0
01753/0000 and 0
01754/0000 and 0
01755/0000 and 0
01756/0000 and 0
01757/0000 and 0
01760/0000 and 0
01761/0000 and 0
01762/0000 and 0
01763/0000 and 0
01764/0000 and 0
01765/0000 and 0
01766/0000 and 0
01767/0000 and 0
01770/0000 and 0
01771/0000 and 0
01772/0000 and 0
01773/0000 and 0
01774/0000 and 0
01775/0000 and 0
01776/0000 and 0
01777/0000 and 0
00130/2000 isz 0
00131/0177 and 177
00132/0212 and 12
00133/0207 and 7
00134/0240 and 40
00135/0237 and 37
00136/0100 and 100
00137/7741 cla mqa
00140/0077 and 77
00141/7774 spa sna szl cla osr
00142/1452 tad i 52
00143/1751 tad i 151
00144/7743 cla mqa
00145/0017 and 17
00146/1700 tad i 100
00147/0215 and 15
00150/1464 tad i 64
00151/1473 tad i 73
00152/0260 and 60
00153/1400 tad i 0
00154/1420 tad i 20
00155/1457 tad i 57
00156/1000 tad 0
00157/1141 tad 141
00160/1107 tad 107
00161/1522 tad i 122
00162/1540 tad i 140
00163/1200 tad 0
00164/1513 tad i 113
00165/1531 tad i 131
00166/1062 tad 62
00167/0400 and i 0
00170/6201 iot 20,1
00171/0070 and 70
00172/1502 tad i 102
00173/7770 spa sna szl cla
00174/6440 iot 44,0
00175/0007 and 7
00176/1267 tad 67
00177/7600 cla
07751/0200 and 7600
07752/6032 iot 3,2
07753/1352 tad 7752
07754/3356 dca 7756
07755/5751 jmp i 7751
07756/5353 jmp 7753
CHKSUM: Computed: 3145, input: 3145 -- PASS

1120
d8tape/verify.list Normal file
View File

File diff suppressed because it is too large Load Diff

1584
d8tape/verify.lst Normal file
View File

File diff suppressed because it is too large Load Diff

1120
d8tape/verify.pal Normal file
View File

File diff suppressed because it is too large Load Diff

1
d8tape/version.c Normal file
View File

@ -0,0 +1 @@
const char *version="0.347";

355
diffrom/diffrom.pl Normal file
View File

@ -0,0 +1,355 @@
#!/usr/bin/perl -w
# Copyright (c) 2005 Don North
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# o Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# o Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# o Neither the name of the copyright holder nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
require 5.008;
=head1 NAME
diffrom.pl - Compare two .hex/.bin format PROM files
=head1 SYNOPSIS
diffrom.pl
S<[--help]>
S<[--debug]>
S<[--verbose]>
S<FILE1>
S<FILE2>
=head1 DESCRIPTION
Compares two PROM files, byte by byte. Format is determined
by file extension: .hex for Intel hex format, .bin for binary.
Outputs a list of all bytes that differ (if any).
=head1 OPTIONS
The following options are available:
=over
=item B<--help>
Output this manpage and exit the program.
=item B<--debug>
Enable debug mode; print input file records as parsed.
=item B<--verbose>
Verbose status; outputs a message if files are equal.
=back
=head1 ERRORS
The following diagnostic error messages can be produced on STDERR.
The meaning should be fairly self explanatory.
C<Aborted due to command line errors> -- bad option or missing file(s)
C<Can't open input file '$file'> -- bad filename or unreadable file
C<File '%s': Unknown record type '%s' ignored> -- bad record type in hex file
C<File '%s': Bad data count, exp=0x%02X rcv=0x%02X, line='%s'> - bad record length in hex file
C<File '%s': Bad checksum, exp=0x%02X rcv=0x%02X, line='%s'> - checksum error in hex file
=head1 EXAMPLES
Some examples of common usage:
diffrom.pl --help
diffrom.pl --verbose file1.bin file2.hex
=head1 AUTHOR
Don North - donorth <ak6dn _at_ mindspring _dot_ com>
=head1 HISTORY
Modification history:
2005-05-05 v1.0 donorth - Initial version.
=cut
# options
use strict;
# external standard modules
use Getopt::Long;
use Pod::Text;
use FindBin;
# external local modules search path
BEGIN { unshift(@INC, $FindBin::Bin);
unshift(@INC, $ENV{PERL5LIB}) if defined($ENV{PERL5LIB}); # cygwin bugfix
unshift(@INC, '.'); }
# external local modules
# generic defaults
my $VERSION = 'v1.0'; # version of code
my $HELP = 0; # set to 1 for man page output
my $DEBUG = 0; # set to 1 for debug messages
my $VERBOSE = 0; # set to 1 for verbose messages
# specific defaults
my $MODE = 'OCT'; # or 'OCT' or 'DEC' or 'BIN'
my $SIZE = 'BYTE'; # or 'WORD'
# process command line arguments
my $NOERROR = GetOptions( "help" => \$HELP,
"debug" => \$DEBUG,
"verbose" => \$VERBOSE,
"bin" => sub { $MODE = 'BIN'; },
"oct" => sub { $MODE = 'OCT'; },
"dec" => sub { $MODE = 'DEC'; },
"hex" => sub { $MODE = 'HEX'; },
"byte" => sub { $SIZE = 'BYTE'; },
"word" => sub { $SIZE = 'WORD'; },
);
# init
$VERBOSE = 1 if $DEBUG; # debug implies verbose messages
# say hello
printf STDERR "diffrom.pl %s by Don North (perl %g)\n", $VERSION, $] if $VERBOSE;
# output the documentation
if ($HELP) {
# output a man page if we can
if (ref(Pod::Text->can('new')) eq 'CODE') {
# try the new way if appears to exist
my $parser = Pod::Text->new(sentence=>0, width=>78);
printf STDOUT "\n"; $parser->parse_from_file($0);
} else {
# else must use the old way
printf STDOUT "\n"; Pod::Text::pod2text(-78, $0);
};
exit(1);
}
# check for correct arguments present, print usage if errors
unless ($NOERROR && scalar(@ARGV) >= 1) {
print STDERR "Usage: $0 [options...] arguments\n";
print STDERR <<"EOF";
--help output manpage and exit
--debug enable debug mode
--verbose verbose status reporting
FILE1 first ROM file
FILE2 second ROM file
EOF
# exit if errors...
die "Aborted due to command line errors.\n";
}
#----------------------------------------------------------------------------------------------------
# compute checksum (twos complement of the sum of bytes)
sub chksum (@) { my $sum = 0; map($sum += $_, @_); (-$sum) & 0xFF; }
# compute checksum (sum of bytes)
sub binsum (@) { my $sum = 0; map($sum += $_, @_); $sum; }
# convert string of byte hex characters to an array of numbers
sub hexa ($) {
my ($dat) = @_;
my @dat = ();
while ($dat) { push(@dat,hex(substr($dat,0,2))); $dat = substr($dat,2); }
return @dat;
}
# read a hex file into an array
sub readhex ($$) {
my ($file,$buf) = @_;
my $extadr = 0; # extended address offset
my $chksum = 0; # total device checksum
# read the input hex-format stream into a buffer
open(HEX, "< $file") || die "Can't open input file '$file'\n";
while (my $line = scalar(<HEX>)) {
$line =~ s/[\015\012]+$//; # strip EOLs
if ($line =~ m/^:([0-9A-F]{2})([0-9A-F]{4})([0][0-3])([0-9A-F]{0,})([0-9A-F]{2})$/i) {
# 00 data record: :NNAAAA00DDDDD...DDDDCC
# 01 end record: :NNAAAA01CC
# 02 extended address record: :NNAAAA02EEEECC
# 03 start record: :NNAAAA03SSSSCC
my ($typ,$cnt,$adr,$chk,@dat) = (hex($3),hex($1),hex($2),hex($5),hexa($4));
# validate data byte count
unless (@dat == $cnt) {
printf STDERR "File '%s': Bad data count, exp=0x%02X rcv=0x%02X, line='%s'\n",
$file, $cnt, scalar(@dat), $line;
next;
}
# compute checksum, validate
my $cmp = &chksum($typ, $cnt, $adr, $adr>>8, @dat);
unless ($cmp == $chk) {
printf STDERR "File '%s': Bad checksum, exp=0x%02X rcv=0x%02X, line='%s'\n",
$file, $cmp, $chk, $line;
next;
}
# print what we read if debugging
printf STDERR "file=%s lin=%s typ=%d cnt=0x%02X adr=0x%04X chk=0x%02X dat=%s\n",
$file, $line, $typ, $cnt, $adr, $chk,
join('',map(sprintf("%02X",$_),@dat)) if $DEBUG;
# process each record type
if ($typ == 0) {
# data record
for (my $idx = 0; $idx < $cnt; $idx++) {
$chksum += ($$buf[$extadr+$adr+$idx] = $dat[$idx]); }
} elsif ($typ == 2) {
# save extended address
$extadr = ($dat[0]<<12)|($dat[1]<<4);
} elsif ($typ == 1) {
# exit if hit last
last;
}
} else {
printf STDERR "File '%s': Unknown record type '%s' ignored\n", $file, $line;
}
} # while (my $line)
close(HEX);
# print stats if requested
printf STDERR "File '%s': size=0x%X (%dx8), checksum=0x%X\n",
$file, (scalar(@$buf))x2, $chksum if $VERBOSE;
return;
}
# read a binary file into an array
sub readbin ($$) {
my ($file,$buf) = @_;
# read the input hex-format stream into a buffer
my $dat = undef;
open(BIN, "< $file") || die "Can't open input file '$file'\n";
read(BIN, $dat, 1<<20);
close(BIN);
@$buf = unpack("C*", $dat);
# print stats if requested
printf STDERR "File '%s': size=0x%X (%dx8), checksum=0x%X\n",
$file, (scalar(@$buf))x2, &binsum(@$buf) if $VERBOSE;
return;
}
# read a file into an array
sub readfile ($$) {
my ($file,$buf) = @_;
&readhex($file, $buf) if $file =~ m/[.]hex$/i;
&readbin($file, $buf) if $file =~ m/[.]bin$/i;
return;
}
#----------------------------------------------------------------------------------------------------
my @buf1 = (); # first ROM file
my @buf2 = (); # second ROM file
# if exactly two files specified do the compare
if (@ARGV == 2) {
# read the two files
&readfile(shift(@ARGV), \@buf1);
&readfile(shift(@ARGV), \@buf2);
# compare the two files
my $err = 0;
my $len = @buf1 >= @buf2 ? @buf1 : @buf2;
for (my $adr = 0; $adr < $len; $adr += $SIZE eq 'BYTE' ? 1 : 2) {
# get bytes/words
my $dat1 = $SIZE eq 'BYTE' ? $buf1[$adr] : ($buf1[$adr+1]<<8)|($buf1[$adr+0]<<0);
my $dat2 = $SIZE eq 'BYTE' ? $buf2[$adr] : ($buf2[$adr+1]<<8)|($buf2[$adr+0]<<0);
# check if same
next if $dat1 == $dat2;
# print if different
if ($SIZE eq 'BYTE') {
if ($MODE eq 'HEX') {
printf "Addr=0x%04X File1=0x%02X File2=0x%02X\n", $adr, $dat1, $dat2;
} elsif ($MODE eq 'DEC') {
printf "Addr=%-5u File1=%-3u File2=%-3u\n", $adr, $dat1, $dat2;
} elsif ($MODE eq 'OCT') {
printf "Addr=%06o File1=%03o File2=%03o\n", $adr, $dat1, $dat2;
} elsif ($MODE eq 'BIN') {
printf "Addr=0b%016b File1=0b%08b File2=0b%08b\n", $adr, $dat1, $dat2;
}
} elsif ($SIZE eq 'WORD') {
if ($MODE eq 'HEX') {
printf "Addr=0x%04X File1=0x%04X File2=0x%04X\n", $adr, $dat1, $dat2;
} elsif ($MODE eq 'DEC') {
printf "Addr=%-5u File1=%-5u File2=%-5u\n", $adr, $dat1, $dat2;
} elsif ($MODE eq 'OCT') {
printf "Addr=%06o File1=%06o File2=%06o\n", $adr, $dat1, $dat2;
} elsif ($MODE eq 'BIN') {
printf "Addr=0b%016b File1=0b%016b File2=0b%016b\n", $adr, $dat1, $dat2;
}
}
$err++;
}
printf "Files are %s\n", $err ? "different" : "identical" if $err || $VERBOSE;
exit($err ? 1 : 0);
} else {
# if just one (or three or more) than just print stats and exit
while (@ARGV) {
# read the file
&readfile(shift(@ARGV), \@buf1);
}
exit(0);
}
#----------------------------------------------------------------------------------------------------
# the end

334
dumpbin8x/dumpbin8x.pl Normal file
View File

@ -0,0 +1,334 @@
#!/usr/bin/perl -w
#!/usr/local/bin/perl -w
require 5.005;
# add additional search libraries
BEGIN { unshift(@INC, $ENV{'PERL5LIB'}) if exists($ENV{'PERL5LIB'}); }
# options
use strict;
# external modules
use Getopt::Long;
use Pod::Text;
use FindBin;
# generic defaults
my $VERSION = 'v0.0d0'; # version of code
my $HELP = 0; # set to 1 for man page output
my $DEBUG = 0; # set to 1 for debug messages
my $VERBOSE = 0; # set to 1 for verbose messages
# specific defaults
my $VERILOG = 0; # set to 1 for verilog format output
my $DISASSEMBLY = 1; # set to 1 for disassembled output
# process command line arguments
my $NOERROR = GetOptions( "help!" => \$HELP,
"debug!" => \$DEBUG,
"verbose!" => \$VERBOSE,
"verilog" => \$VERILOG,
"disassembly!" => \$DISASSEMBLY,
);
# init
$VERBOSE = 1 if $DEBUG; # debug implies verbose messages
# say hello
printf STDERR "%s %s by Don North (perl %g)\n", $0, $VERSION, $] if $VERBOSE;
# output the documentation
if ($HELP) {
# output a man page if we can
if (ref(Pod::Text->can('new')) eq 'CODE') {
# try the new way if appears to exist
my $parser = Pod::Text->new(sentence=>0, width=>78);
printf STDOUT "\n"; $parser->parse_from_file($0);
} else {
# else must use the old way
printf STDOUT "\n"; Pod::Text::pod2text(-78, $0);
};
exit(1);
}
# check for correct arguments present, print usage if errors
unless ($NOERROR && scalar(@ARGV) >= 1) {
print STDERR "Usage: $0 [options...] arguments\n";
print STDERR <<"EOF";
--[no]help output manpage and exit
--[no]debug enable debug mode
--[no]verbose verbose status reporting
--verilog verilog format output
--[no]disassembly disassembly comments
FILENAME a filename...
EOF
# exit if errors...
die "Aborted due to command line errors.\n";
}
# ----------------------------------------------------------------------------------------------
# loop on all input files
foreach my $filename (@ARGV) {
# open .bin papertape image file
printf STDERR "Processing file %s ...\n", $filename if $VERBOSE;
unless (open(INP, "< $filename")) {
printf STDERR "ERROR: cannot open input file %s\n", $filename;
next;
}
binmode(INP);
# file source header
if ($VERILOG) {
printf STDOUT " //\n";
printf STDOUT " // File: %s\n", $filename;
printf STDOUT " //\n";
}
my ($addr,$field,$newfield,$chksum,$seen) = (0,0,0,0,0);
my ($state,$hibyte,$lobyte) = ('JUNK',-1,-1);
# process content bytes
while (!eof(*INP) && $state ne 'DONE') {
# get next input byte
my $byte = get_byte(*INP);
# RUBOUT deletes next byte
if (is_rubout($byte)) {
printf STDOUT " // " if $VERILOG && $VERBOSE;
printf STDOUT " %-4s %03o\n", 'RUB', $byte if $VERBOSE;
$byte = get_byte(*INP);
printf STDOUT " // " if $VERILOG && $VERBOSE;
printf STDOUT " %-4s %03o\n", 'RUB', $byte if $VERBOSE;
$byte = get_byte(*INP);
}
# check for field set (not included in checksum)
if (is_field($byte)) {
$newfield = ($byte>>3)&7;
next;
}
# make a printable string out of a character
sub make_str ($) { my ($t) = @_; return $t < 0x20 || $t > 0x7E ? sprintf("%03o",$t) : sprintf("'%c'",$t); }
# state machine
if ($state eq 'JUNK') {
# skipping junk
if (is_leader($byte)) { $state = 'SKIP'; }
($addr,$field,$newfield,$chksum,$seen) = (0,0,0,0,0);
($hibyte,$lobyte) = (-1,-1);
printf STDOUT " // " if $VERILOG && $VERBOSE;
printf STDOUT " %-4s %s\n", $state, make_str($byte) if $VERBOSE;
} elsif ($state eq 'SKIP') {
# eating leader
if (is_leader($byte)) {
printf STDOUT " // " if $VERILOG && $VERBOSE;
printf STDOUT " %-4s %03o\n", $state, $byte if $VERBOSE;
next;
}
$hibyte = $byte;
$state = 'HI';
printf STDOUT " // " if $VERILOG && $VERBOSE;
printf STDOUT " %-4s %03o\n", $state, $byte if $VERBOSE;
} elsif ($state eq 'HI') {
# first byte
$lobyte = $byte;
$state = 'LO';
printf STDOUT " // " if $VERILOG && $VERBOSE;
printf STDOUT " %-4s %03o\n", $state, $byte if $VERBOSE;
} elsif ($state eq 'LO') {
# second byte
my $word = (($hibyte<<6) | $lobyte) & 07777;
if (is_leader($byte)) {
# this is the final checksum
printf STDOUT " //\n // " if $VERILOG;
printf STDOUT "CHKSUM: Computed: %04o, input: %04o -- %s\n",
$chksum, $word, $chksum == $word ? "PASS" : "FAIL";
printf STDOUT " //\n" if $VERILOG;
$state = 'DONE';
} else {
# this is address or data
$chksum = ($chksum + $hibyte + $lobyte) & 07777;
if (is_address($hibyte)) {
# address word
printf STDOUT " //\n" if $VERILOG && $seen;
$addr = $word;
$seen = 0;
printf STDOUT " // " if $VERILOG && $VERBOSE;
printf STDOUT " %-4s %04o\n", 'ADDR', $word if $VERBOSE;
} else {
# data word
if ($VERILOG) {
printf STDOUT " memory[15'o%o%04o] = 12'o%04o;", $field, $addr, $word;
printf STDOUT " // %s", decode_inst($word, $addr) if $DISASSEMBLY;
printf STDOUT "\n";
} else {
printf STDOUT "%o%04o/%04o", $field, $addr, $word;
printf STDOUT " %s", decode_inst($word, $addr);
printf STDOUT "\n";
}
$addr = ($addr+1) & 07777;
$seen = 1;
printf STDOUT " // " if $VERILOG && $VERBOSE;
printf STDOUT " %-4s %04o\n", 'DATA', $word if $VERBOSE;
}
printf STDOUT " // " if $VERILOG && $VERBOSE;
printf STDOUT " %-4s %o\n", 'FLD', $newfield if $field != $newfield && $VERBOSE;
$field = $newfield;
$hibyte = $byte;
$state = 'HI';
printf STDOUT " // " if $VERILOG && $VERBOSE;
printf STDOUT " %-4s %03o\n", $state, $byte if $VERBOSE;
}
} else { # invalid transition
$state = '????';
die "invalid transition";
}
} # while $state
close(INP);
} # foreach $filename
exit;
# ----------------------------------------------------------------------------------------------
# read next byte from input file, honor pushbacks
my @buffer = ();
sub get_byte {
local (*FILE) = @_;
my ($cnt,$byte) = (-1,-1);
if (defined($buffer[fileno(FILE)]) && @{$buffer[fileno(FILE)]}) {
# prior pushback data exists, use it
$byte = pop(@{$buffer[fileno(FILE)]});
} else {
# no prior pushback data exists, must do a file read
$cnt = read(FILE, $byte, 1);
$byte = !defined($cnt) || $cnt != 1 ? -1 : ord($byte);
}
printf STDOUT "get_char: byte=%03o char='%s' cnt=%d\n", $byte, chr($byte), $cnt if $DEBUG;
# printf STDERR "|%s|\n", join('',map($byte&(1<<(7-$_))?'*':'.',(0..7))) if $DEBUG;
return $byte;
}
# push back a byte to an input file
sub unget_byte {
my ($byte) = shift;
local (*FILE) = shift;
push(@{$buffer[fileno(FILE)]}, $byte);
return $byte;
}
# ----------------------------------------------------------------------------------------------
# paper tape format support routines
sub is_leader { my ($c) = @_; return ($c & 0377) == 0200; }
sub is_field { my ($c) = @_; return ($c & 0307) == 0300; }
sub is_address { my ($c) = @_; return ($c & 0300) == 0100; }
sub is_data { my ($c) = @_; return ($c & 0300) == 0000; }
sub is_rubout { my ($c) = @_; return ($c & 0377) == 0377; }
# ----------------------------------------------------------------------------------------------
# pdp-8 instruction disassembler
sub decode_inst {
my ($inst, $addr) = @_;
my $str = '';
my @opc = ( "and", "tad", "isz", "dca", "jms", "jmp", "iot", "opr" );
if ($inst <= 05777) { # 0..5 memory reference
$str = sprintf("%s%s %o", $opc[($inst>>9)&07],
($inst & 00400) ? " i" : "",
($inst & 00200) ? ($addr & 07600) | ($inst & 00177) : ($inst & 00177));
} elsif (($inst & 07000) == 06000) { # 6 i/o transfer
$str = sprintf("iot %o,%o", ($inst>>3)&077, $inst&07);
} elsif (($inst & 07400) == 07000) { # 7 operate group 1
# sequence 1
if (($inst & 00200) == 00200) { $str .= " cla"; }
if (($inst & 00100) == 00100) { $str .= " cll"; }
# sequence 2
if (($inst & 00040) == 00040) { $str .= " cma"; }
if (($inst & 00020) == 00020) { $str .= " cml"; }
# sequence 3
if (($inst & 00001) == 00001) { $str .= " iac"; }
# sequence 4
if (($inst & 00016) == 00010) { $str .= " rar"; }
if (($inst & 00016) == 00004) { $str .= " ral"; }
if (($inst & 00016) == 00012) { $str .= " rtr"; }
if (($inst & 00016) == 00006) { $str .= " rtl"; }
if (($inst & 00016) == 00002) { $str .= " bsw"; }
# else
if (($inst & 00377) == 00000) { $str .= " nop"; }
# done
} elsif (($inst & 07401) == 07400) { # 7 operate group 2
# sequence 1
if (($inst & 00110) == 00100) { $str .= " sma"; }
if (($inst & 00050) == 00040) { $str .= " sza"; }
if (($inst & 00030) == 00020) { $str .= " snl"; }
if (($inst & 00110) == 00110) { $str .= " spa"; }
if (($inst & 00050) == 00050) { $str .= " sna"; }
if (($inst & 00030) == 00030) { $str .= " szl"; }
if (($inst & 00170) == 00010) { $str .= " skp"; }
# sequence 2
if (($inst & 00200) == 00200) { $str .= " cla"; }
# sequence 3
if (($inst & 00004) == 00004) { $str .= " osr"; }
if (($inst & 00002) == 00002) { $str .= " hlt"; }
# done
} elsif (($inst & 07401) == 07401) { # 7 mq microinstructions
# sequence 1
if (($inst & 00200) == 00200) { $str .= " cla"; }
# sequence 2
if (($inst & 00100) == 00100) { $str .= " mqa"; }
if (($inst & 00020) == 00020) { $str .= " mql"; }
# sequence 3
# else
if (($inst & 00376) == 00000) { $str .= " nop"; }
# done
}
# remove leading spaces, if any
$str =~ s/^\s+//;
return $str;
}
# the end

236
enet2hex/enet2hex.pl Normal file
View File

@ -0,0 +1,236 @@
#!/usr/bin/perl -w
# Copyright (c) 2005 Don North
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# o Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# o Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# o Neither the name of the copyright holder nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
require 5.008;
=head1 NAME
enet2hex.pl - Build .hex image of a DEC ethernet MAC prom
=head1 SYNOPSIS
enet2hex.pl
S<[--help]>
S<[--debug]>
S<[--verbose]>
S<[--macaddr=NN-NN-NN-NN-NN-NN]>
S<[--bytes=N]>
>HEXFILE
=head1 DESCRIPTION
Builds the image of a 'standard' DEC Ethernet MAC address
(station address) 32x8 PROM (82S123 equiv).
=head1 OPTIONS
The following options are available:
=over
=item B<--help>
Output this manpage and exit the program.
=item B<--debug>
Enable debug mode; print input file records as parsed.
=item B<--verbose>
Verbose status; output status messages during processing.
=item B<--macaddr=NN-NN-NN-NN-NN-NN>
The MAC address (in hex format) to be used.
=item B<--bytes=N>
For hex format output files, output N bytes per line (default 16).
=back
=head1 ERRORS
The following diagnostic error messages can be produced on STDERR.
The meaning should be fairly self explanatory.
C<Aborted due to command line errors> -- bad option or missing file(s)
=head1 EXAMPLES
Some examples of common usage:
enet2hex.pl --help
enet2hex.pl --verbose --macaddr=01-23-45-67-89-AB > mac.hex
=head1 AUTHOR
Don North - donorth <ak6dn _at_ mindspring _dot_ com>
=head1 HISTORY
Modification history:
2005-08-05 v1.0 donorth - Initial version.
=cut
# options
use strict;
# external standard modules
use Getopt::Long;
use Pod::Text;
use FindBin;
# external local modules search path
BEGIN { unshift(@INC, $FindBin::Bin);
unshift(@INC, $ENV{PERL5LIB}) if defined($ENV{PERL5LIB}); # cygwin bugfix
unshift(@INC, '.'); }
# external local modules
# generic defaults
my $VERSION = 'v1.0'; # version of code
my $HELP = 0; # set to 1 for man page output
my $DEBUG = 0; # set to 1 for debug messages
my $VERBOSE = 0; # set to 1 for verbose messages
# specific defaults
my $romsize = 32; # number of rom addresses
my $bytesper = -1; # bytes per block in output file
my $macaddr = ''; # mac address
# process command line arguments
my $NOERROR = GetOptions( "help" => \$HELP,
"debug" => \$DEBUG,
"verbose" => \$VERBOSE,
"bytes=i" => \$bytesper,
"macaddr=s" => \$macaddr,
);
# init
$VERBOSE = 1 if $DEBUG; # debug implies verbose messages
# say hello
printf STDERR "enet2hex.pl %s by Don North (perl %g)\n", $VERSION, $] if $VERBOSE;
# output the documentation
if ($HELP) {
# output a man page if we can
if (ref(Pod::Text->can('new')) eq 'CODE') {
# try the new way if appears to exist
my $parser = Pod::Text->new(sentence=>0, width=>78);
printf STDOUT "\n"; $parser->parse_from_file($0);
} else {
# else must use the old way
printf STDOUT "\n"; Pod::Text::pod2text(-78, $0);
};
exit(1);
}
# check for correct arguments present, print usage if errors
unless ($NOERROR && scalar(@ARGV) == 0 && $macaddr ne '') {
print STDERR "Usage: $0 [options...] arguments\n";
print STDERR <<"EOF";
--help output manpage and exit
--debug enable debug mode
--verbose verbose status reporting
--bytes=N bytes per block on output
--macaddr=NN-NN-NN-NN-NN-NN mac address
> OUTFILE output .hex/.txt/.bin file
EOF
# exit if errors...
die "Aborted due to command line errors.\n";
}
#----------------------------------------------------------------------------------------------------
# compute checksum (twos complement of the sum of bytes)
sub chksum (@) { my $sum = 0; map($sum += $_, @_); (-$sum) & 0xFF; }
#----------------------------------------------------------------------------------------------------
# split the mac address info six hex fields
my @macaddr = map(hex($_)&0xFF, split(/-/, $macaddr));
# check supplied MAC address for validity
die "Invalid MAC address '$macaddr' format"
unless @macaddr == 6 && $macaddr eq join('-',map(sprintf("%02X",$_),@macaddr));
# echo what was input and we parsed
printf STDERR "MAC ADDR = %02X-%02X-%02X-%02X-%02X-%02X\n", @macaddr if $VERBOSE;
# compute checksum of the MAC address using 16b shift/add w/endaround carry
my $macchk = 0; # init value
for (my $idx = 0; $idx < $#macaddr; $idx += 2) { # loop on words
$macchk *= 2; # shift left 1
$macchk = ($macchk + ($macchk>>16))&0xFFFF; # end around carry
$macchk += ($macaddr[$idx+0]<<8) + $macaddr[$idx+1]; # add two bytes
$macchk = ($macchk + ($macchk>>16))&0xFFFF; # end around carry
}
printf STDERR "MAC checksum is %06o (0x%04X)\n", ($macchk) x 2 if $VERBOSE;
# split checksum into high/low bytes
my @macchk = (($macchk>>8)&0xFF, ($macchk>>0)&0xFF);
# build the entire device
my @buf = (@macaddr, @macchk, reverse(@macchk), reverse(@macaddr),
@macaddr, @macchk, (0xFF,0x00,0x55,0xAA)x2);
# print checksum of entire device
my $chksum = 0; map($chksum += $_, @buf);
printf STDERR "ROM checksum is %06o (0x%04X)\n", $chksum, $chksum if $VERBOSE;
#----------------------------------------------------------------------------------------------------
# output the entire PROM buffer as an intel hex file
$bytesper = 16 if $bytesper <= 0;
for (my $idx = 0; $idx < $romsize; $idx += $bytesper) {
my $cnt = $idx+$bytesper <= $romsize ? $bytesper : $romsize-$idx; # N bytes or whatever is left
my @dat = @buf[$idx..($idx+$cnt-1)]; # get the data
my $dat = join('', map(sprintf("%02X",$_),@dat)); # map to ascii text
printf ":%02X%04X%02X%s%02X\n", $cnt, $idx, 0x00, $dat, &chksum($cnt, $idx>>0, $idx>>8, 0x00, @dat);
}
printf ":%02X%04X%02X%s%02X\n", 0x00, 0x0000, 0x01, '', &chksum(0x0, 0x0000>>0, 0x0000>>8, 0x01);
#----------------------------------------------------------------------------------------------------
exit;
# the end

969
hex2mac/hex2mac.pl Normal file
View File

@ -0,0 +1,969 @@
#!/usr/bin/perl -w
#!/usr/local/bin/perl -w
# Copyright (c) 2005-2016 Don North
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# o Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# o Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# o Neither the name of the copyright holder nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
require 5.008;
=head1 NAME
hex2mac.pl - Disassembles PDP11 hex/binary files
=head1 SYNOPSIS
hex2mac.pl
S<[--help]>
S<[--debug]>
S<[--verbose]>
S<[--option=STRING]>
S<[--boot]>
S<[--console]>
S<[--binary]>
S<[--logfile=LOGFILE]>
S<--infile=INFILE>
S<--outfile=OUTFILE>
=head1 DESCRIPTION
Disassembles an M9312 Intel-hex format PROM image
file (either a boot PROM or a console/diagnostic PROM)
to macro-11 source format.
=head1 OPTIONS
The following options are available:
=over
=item B<--help>
Output this manpage and exit the program.
=item B<--debug>
Enable debug mode; print input file records as parsed.
=item B<--verbose>
Verbose mode (does nothing right now).
=item B<--boot>
Input file is an M9312 boot PROM image (512x4, half-used).
=item B<--console>
Input file is an M9312 diagnostic/console PROM image (1024x4).
=item B<--binary>
Input file is a PDP-11 binary program file (BIN/BIC/LDA/SYS).
=item B<--option=STRING>
For console PROMs, provide option flag to control disassembly.
=item B<--logfile=FILENAME>
Generate debug output into this file.
=item B<--infile=FILENAME>
Input file in selected format (HEX, BIN, OBJ, etc).
=item B<--outfile=FILENAME>
Output text file in .mac format.
=back
=head1 ERRORS
The following diagnostic error messages can be produced on STDERR.
The meaning should be fairly self explanatory.
C<Aborted due to command line errors> -- bad option or missing file(s)
C<Can't open input file '$file'> -- bad filename or unreadable file
C<File '%s': Unknown record type '%s' ignored> -- bad record type in hex file
C<File '%s': Bad data count, exp=0x%02X rcv=0x%02X, line='%s'> - bad record length in hex file
C<File '%s': Bad checksum, exp=0x%02X rcv=0x%02X, line='%s'> - checksum error in hex file
=head1 EXAMPLES
Some examples of common usage:
hex2mac.pl --help
hex2mac.pl --boot <23-751A9.hex >23-751A9.mac
=head1 NOTES
The disassembly process knows the 'standard' entry points
for boot and console PROMS, but is not real smart about multiple
entry points (it could be improved, but was not really worth
the extra trouble, as there are so few of these PROM images).
Console format was tuned for disassembling the 248F1 11/34,etc PROM.
Disassembly of the 616F1 11/70 PROM (not tried) will likely require
massive tuning to the internal entry point hash table.
=head1 AUTHOR
Don North - donorth <ak6dn _at_ mindspring _dot_ com>
=head1 HISTORY
Modification history:
2005-05-05 v1.0 donorth - Initial version.
2005-10-29 v1.1 donorth - Added auto-detect of boot continue PROM.
2016-09-09 v1.2 donorth - Added binary mode.
=cut
# options
use strict;
# external standard modules
use Getopt::Long;
use Pod::Text;
use FindBin;
use FileHandle;
# external local modules search path
BEGIN { unshift(@INC, $FindBin::Bin);
unshift(@INC, $ENV{PERL5LIB}) if defined($ENV{PERL5LIB}); # cygwin bugfix
unshift(@INC, '.'); }
# external local modules
# generic defaults
my $VERSION = 'v1.2'; # version of code
my $HELP = 0; # set to 1 for man page output
my $DEBUG = 0; # set to 1 for debug messages
my $VERBOSE = 0; # set to 1 for verbose messages
# specific defaults
my $crctype = 'CRC-16'; # type of crc calc to do
my $memsize; # number of instruction bytes allowed
my $memfill; # memory fill pattern
my %excaddr; # words to be skipped in rom crc calc
my $rombase; # base address of rom image
my $romsize; # number of rom addresses
my $romfill; # rom fill pattern
my $romtype = 'NONE'; # default rom type
my $option = ''; # option string
my $infile = undef; # input filename
my $outfile = undef; # output filename
my $logfile = undef; # log filename
# process command line arguments
my $NOERROR = GetOptions( "help" => \$HELP,
"debug" => \$DEBUG,
"verbose" => \$VERBOSE,
"boot" => sub { $romtype = 'BOOT'; },
"console" => sub { $romtype = 'DIAG'; },
"binary" => sub { $romtype = 'BINA'; },
"option=s" => \$option,
"infile=s" => \$infile,
"outfile=s" => \$outfile,
"logfile=s" => \$logfile,
);
# init
$VERBOSE = 1 if $DEBUG; # debug implies verbose messages
# output the documentation
if ($HELP) {
# output a man page if we can
if (ref(Pod::Text->can('new')) eq 'CODE') {
# try the new way if appears to exist
my $parser = Pod::Text->new(sentence=>0, width=>78);
printf STDOUT "\n"; $parser->parse_from_file($0);
} else {
# else must use the old way
printf STDOUT "\n"; Pod::Text::pod2text(-78, $0);
};
exit(1);
}
# check for correct arguments present, print usage if errors
unless ($NOERROR
&& scalar(@ARGV) == 0
&& defined($infile)
&& defined($outfile)
&& $romtype ne 'NONE'
) {
printf STDERR "hex2mac.pl %s by Don North (perl %g)\n", $VERSION, $];
print STDERR "Usage: $0 [options...] arguments\n";
print STDERR <<"EOF";
--help output manpage and exit
--debug enable debug mode
--verbose verbose status reporting
--boot M9312 boot prom
--console M9312 console/diagnostic prom
--binary binary program load image
--option=STRING option string for console prom
--infile=INFILE input object/hex pdp11 code file
--outfile=OUTFILE output ..mac pdp11 macro11 file
--logfile=LOGFILE logging message file
EOF
# exit if errors...
die "Aborted due to command line errors.\n";
}
# setup log file as a file, defaults to STDERR if not supplied
my $LOG = defined($logfile) ? FileHandle->new("> ".$logfile) : FileHandle->new_from_fd(fileno(STDERR),"w");
#----------------------------------------------------------------------------------------------------
# subroutine prototypes
sub pdp11 ($);
sub hexa ($);
sub trim ($);
sub chksum (@);
sub rad2asc (@);
sub crc (%);
sub read_rec ($);
#----------------------------------------------------------------------------------------------------
# fill in the parameters of the device
if ($romtype eq 'BOOT') {
# M9312 512x4 boot prom
%excaddr = ( 024=>1 ); # words to be skipped in rom crc calc
$memsize = 128; # number of instruction bytes allowed
$memfill = 0x00; # memory fill pattern
$romsize = 512; # number of rom addresses (must be a power of two)
$romfill = 0x00; # rom fill pattern
$rombase = 0173000; # base address of rom
} elsif ($romtype eq 'DIAG') {
# M9312 1024x4 diagnostic/console prom
%excaddr = ( ); # words to be skipped in rom crc calc
$memsize = 512; # number of instruction bytes allowed
$memfill = 0x00; # memory fill pattern
$romsize = 1024; # number of rom addresses
$romfill = 0x00; # rom fill pattern
$rombase = 0165000; # base address of rom
} elsif ($romtype eq 'BINA') {
# program load image ... 56KB address space maximum
%excaddr = ( ); # bytes to be skipped in rom crc calc
$memsize = 0; # number of instruction bytes allowed
$memfill = 0x00; # memory fill pattern
$romsize = 8*8192; # number of rom addresses (must be a power of two)
$romfill = 0x00; # image fill pattern
$rombase = 0; # base address of binary image
} else {
# unknown ROM type code
die "ROM type '$romtype' is not supported!\n";
}
if ($VERBOSE) {
printf $LOG "ROM type is '%s'\n", $romtype;
printf $LOG "ROM space is %d. bytes\n", $memsize;
printf $LOG "ROM length is %d. addresses\n", $romsize;
printf $LOG "ROM base address is 0%06o\n", $rombase;
}
#----------------------------------------------------------------------------------------------------
# read/process the input object/binary file records
# physical PROM data bytes
my @rom = ((0) x $romsize);
# real pdp11 memory data words
my @wrd = ();
# open the input file, die if error
my $INP = FileHandle->new("< ".$infile);
die "Error: can't open input file '$infile'\n" unless defined $INP;
if ($romtype eq 'BOOT' or $romtype eq 'DIAG') {
# process hex rom format
# extended address offset
my $extadr = 0;
# read the input hex-format stream into a buffer
while (my $line = scalar(<$INP>)) {
$line =~ s/[\015\012]+$//; # strip EOLs
if ($line =~ m/^:([0-9A-F]{2})([0-9A-F]{4})([0][0-3])([0-9A-F]{0,})([0-9A-F]{2})$/i) {
# 00 data record: :NNAAAA00DDDDD...DDDDCC
# 01 end record: :NNAAAA01CC
# 02 extended address record: :NNAAAA02EEEECC
# 03 start record: :NNAAAA03SSSSCC
my ($typ,$cnt,$adr,$chk,@dat) = (hex($3),hex($1),hex($2),hex($5),hexa($4));
# validate data byte count
unless (@dat == $cnt) {
printf $LOG "Bad data count, exp=0x%02X rcv=0x%02X, line='%s'\n",
$cnt, scalar(@dat), $line;
next;
}
# compute checksum, validate
my $cmp = chksum($typ, $cnt, $adr, $adr>>8, @dat);
unless ($cmp == $chk) {
printf $LOG "Bad checksum, exp=0x%02X rcv=0x%02X, line='%s'\n", $cmp, $chk, $line;
next;
}
# print what we read if debugging
printf $LOG "lin=%s typ=%d cnt=0x%02X adr=0x%04X chk=0x%02X dat=%s\n",
$line, $typ, $cnt, $adr, $chk,
join('',map(sprintf("%02X",$_),@dat)) if $DEBUG;
# process each record type
if ($typ == 0) {
# data record
for (my $idx = 0; $idx < $cnt; $idx++) { $rom[$extadr+$adr+$idx] = $dat[$idx]; }
} elsif ($typ == 2) {
# save extended address
$extadr = $adr<<4;
} elsif ($typ == 1) {
# exit if hit last
last;
}
} else {
printf $LOG "Unknown record type '%s' ignored\n", $line;
}
}
# now we have a buffer full of data, process it
for (my $idx = 0; $idx < $romsize; $idx += 4) {
# true byte address
my $adr = $idx>>1;
# merge 4 nibbles into 16 data bits
my $dat = ($rom[$idx+3]<<12) | ($rom[$idx+2]<<8) | ($rom[$idx+1]<<4) | ($rom[$idx+0]<<0);
$dat = $dat ^ 0x1C00; # bits 12:10 get inverted
$dat = ($dat & 0xFEFE) | ((0x0100&$dat)>>8) | ((0x0001&$dat)<<8); # swap bits 8,0
printf $LOG "adr=%06o dat=%06o\n", $adr, $dat if $DEBUG;
# store it
$wrd[$adr] = $dat;
}
} elsif ($romtype eq 'BINA') {
# process binary format file
while (my @rec = &read_rec($INP)) {
my $len = scalar(@rec)-2;
my $minadr = $rec[1]*256+$rec[0];
foreach my $i (0..($len-1)) {
my ($adr,$dat) = ($minadr+$i,$rec[2+$i]);
printf $LOG "adr=%06o dat=%03o\n", $adr, $dat if $DEBUG;
$wrd[$adr] = $memfill unless defined $wrd[$adr];
if ($adr & 1) {
# upper/odd byte
$wrd[$adr-1] = ($wrd[$adr-1]&0x00FF) | ($dat<<8);
} else {
# lower/even byte
$wrd[$adr+0] = ($wrd[$adr+0]&0xFF00) | ($dat<<0);
}
$memsize = $adr if $adr > $memsize;
}
}
if ($DEBUG) {
for (my $i = 0; defined $wrd[$i]; $i += 2) {
my $ub = ($wrd[$i]>>8)&0xFF; $ub = 056 if $ub < 040 || $ub > 0176;
my $lb = ($wrd[$i]>>0)&0xFF; $lb = 056 if $lb < 040 || $lb > 0176;
printf $LOG "wrd[%06d]=%06o \"%c%c\"\n", $i, $wrd[$i], $lb, $ub;
}
}
}
# done with input file
$INP->close;
#----------------------------------------------------------------------------------------------------
# disassemble the prom image we just unmangled
my $OUT = FileHandle->new("> ".$outfile);
die "Error: can't open output file '$outfile'\n" unless defined $OUT;
my %entry = ();
my %label = ();
my $label = 0;
my $continuation = ($wrd[0] == 0177776); # a continuation boot PROM
if ($romtype eq 'DIAG') {
%label = ( 020=>'DIAG', 0144=>'NODIAG', 0564=>'RSTRT' );
} elsif ($romtype eq 'BOOT') {
if ($continuation) {
%label = ( 02=>'CONT' );
} else {
%label = ( 04=>'PUP0ND', 06=>'PUP0D', 012=>'BOOTSZ', 016=>'BOOTNZ', 020=>'SECD' );
}
} elsif ($romtype eq 'BINA') {
%label = ( 0174=>'START',
0123=>'WTERR', 0134=>'RDERR', 0150=>'ILLCMD' );
}
foreach my $pass (1..2) {
if ($romtype eq 'DIAG') {
# these entry points found by inspection/iteration for the 248F1 PROM
# probably will be different for 616F1 PROM (hasn't been tried yet)
if ($option eq '248F1') {
%entry = ( 0020=>1, 0144=>1, 0564=>1,
0112=>1, 0120=>1, 0124=>1,
0150=>1, 0154=>1, 0160=>1, 0166=>1, 0172=>1, 0200=>1, 0210=>1,
0214=>1, 0220=>1, 0320=>1, 0342=>1, 0352=>1, 0376=>1, 0446=>1,
0510=>1, 0650=>1, 0662=>1, 0700=>1,
);
} elsif ($option eq '616F1') {
%entry = ( 0020=>1, 0144=>1, 0564=>1,
0000=>1, 0340=>1, 0342=>1, 0352=>1, 0354=>1, 0360=>1, 0362=>1,
0554=>1, 0676=>1, 0714=>1, 0716=>1, 0744=>1, 0772=>1,
);
} elsif ($option eq '446F1') {
%entry = ( 0020=>1, 0144=>1, 0564=>1,
0000=>1, 0010=>1, 0016=>1, 0070=>1, 0146=>1, 0366=>1, 0370=>1,
0400=>1, 0402=>1, 0406=>1, 0410=>1, 0466=>1, 0652=>1, 0662=>1,
0666=>1, 0676=>1, 0702=>1, 0704=>1, 0714=>1, 0736=>1,
);
} elsif ($option eq '774F1') {
%entry = ( 0020=>1, 0144=>1, 0564=>1,
0006=>1, 0316=>1, 0364=>1, 0552=>1,
);
} else {
%entry = ( 0020=>1, 0144=>1, 0564=>1 );
}
} elsif ($romtype eq 'BOOT') {
# standard entry points for a single-device boot PROM
if ($continuation) {
%entry = ( 02=>1 );
} else {
%entry = ( 04=>1, 06=>1, 012=>1, 016=>1, 020=>1 );
}
} elsif ($romtype eq 'BINA') {
# binary load image file
%entry = ( 0174=>1 );
}
$label = 1; # reset label counter
if ($pass == 1) {
# now iterate over the words of interest
for (my $adr = 0; $adr < $memsize; $adr += 2) {
if (exists($entry{$adr})) { # an instr should start here
my ($cntr,$inst) = &pdp11($adr);
}
}
} elsif ($pass == 2) {
printf $OUT "\t.sbttl\t%s\n\n", "M9312 $romtype prom";
printf $OUT "\t.asect\n\t.=%o\n\n", $rombase;
# now iterate over the words of interest
for (my $adr = 0; $adr < $memsize; $adr += 2) {
if (exists($entry{$adr})) { # an instr should start here
my ($cntr,$inst) = &pdp11($adr);
printf $OUT "%06o:\t%06o\t", $adr, $wrd[$adr] if $DEBUG;
printf $OUT "%s:", $label{$adr} if $label{$adr};
printf $OUT "\t%s\n", $inst;
while (--$cntr > 0) {
$adr += 2;
printf $OUT "%06o:\t%06o\n", $adr, $wrd[$adr] if $DEBUG;
}
} elsif ($romtype eq 'BOOT' && $adr == 0 && !$continuation) { # special string for boot
printf $OUT "%06o:\t%06o\t", $adr, $wrd[$adr] if $DEBUG;
printf $OUT "\t.ascii\t\"%c%c\"\n", ($wrd[$adr]>>0)&0xFF, ($wrd[$adr]>>8)&0xFF;
} else { # just print it as a data word
printf $OUT "%06o:\t%06o\t", $adr, $wrd[$adr] if $DEBUG;
printf $OUT "%s:", $label{$adr} if $label{$adr};
my $lb = ($wrd[$adr]>>0)&0xFF; $lb = 056 if $lb < 040 || $lb > 0176;
my $ub = ($wrd[$adr]>>8)&0xFF; $ub = 056 if $ub < 040 || $ub > 0176;
printf $OUT "\t.word\t%06o\t\t; \"%c%c\"\n", $wrd[$adr], $lb, $ub;
}
}
printf $OUT "\n\t.end\n";
}
}
# all done
$OUT->close;
exit;
#----------------------------------------------------------------------------------------------------
# disassemble a pdp11 instr at $adr in image $wrd[]
sub pdp11 ($) {
my ($adr) = @_;
# generate a register specifier
sub _r {
my $r = $_[0]&7;
return $r == 7 ? 'pc' : $r == 6 ? 'sp' : 'r'.$r;
} # sub _r
# generate src/dst operand reference
sub _mode {
my ($mode, $adr, $off) = @_;
my ($m, $r) = (($mode>>3)&7, _r(($mode>>0)&7));
if ($r eq 'pc') {
my $ea = ($adr + $off + $wrd[$adr]) & 0xFFFF;
if ($m == 0) { return sprintf("pc"); }
elsif ($m == 1) { return sprintf("(pc)"); }
elsif ($m == 2) { return sprintf("#%o", $wrd[$adr]); }
elsif ($m == 3) { return sprintf("\@#%o", $wrd[$adr]); }
elsif ($m == 4) { return sprintf("-(pc)"); }
elsif ($m == 5) { return sprintf("\@-(pc)"); }
elsif ($m == 6) { return sprintf("%s", exists($label{$ea})?$label{$ea}:sprintf("0%o",$ea)); }
elsif ($m == 7) { return sprintf("\@%s", exists($label{$ea})?$label{$ea}:sprintf("0%o",$ea)); }
} else {
if ($m == 0) { return sprintf("%s", $r); }
elsif ($m == 1) { return sprintf("(%s)", $r); }
elsif ($m == 2) { return sprintf("(%s)+", $r); }
elsif ($m == 3) { return sprintf("\@(%s)+", $r); }
elsif ($m == 4) { return sprintf("-(%s)", $r); }
elsif ($m == 5) { return sprintf("\@-(%s)", $r); }
elsif ($m == 6) { return sprintf("%o(%s)", $wrd[$adr],$r); }
elsif ($m == 7) { return sprintf("\@%o(%s)", $wrd[$adr],$r); }
}
} # sub _mode
# return 1/0 if indicated address mode will eat an instr stream word
sub _eat {
my ($mode) = @_;
my ($m, $r) = (($mode>>3)&7, ($mode>>0)&7);
return ($r == 7 && ($m == 2 || $m == 3)) || $m == 6 || $m == 7 ? 1 : 0;
} # sub _eat
my $wrd = $wrd[$adr]; # instruction word
my $str = 'NONE'; # build the instruction here
my $cnt = 1; # number of instruction words total
delete($entry{$adr}); # eat the current instruction
if ($wrd >= 000000 && $wrd <= 000007) { # ok
#
# misc single-word zop instructions
#
$str = ('halt','wait','rti','bpt','iot','reset','rtt','mfpt')[$wrd&7];
$entry{$adr+2}++ unless $str =~ m/^(halt|rti|rtt)$/i;
} elsif ($wrd >= 0104000 && $wrd <= 0104377) { # ok
#
# trap single-word sop instructions
#
my $opc = ('emt','trap')[($wrd&000400)>>8];
$str = sprintf("%s\t%o", $opc, $wrd&0377);
$entry{$adr+2}++;
} elsif ($wrd >= 000230 && $wrd <= 000237) { # ok
#
# priority-level sop single-word instruction
#
$str = sprintf("spl\t%o", $wrd&7);
$entry{$adr+2}++;
} elsif ($wrd >= 000240 && $wrd <= 000277) { # ok
#
# condition code zop single-word instructions
#
if ($wrd == 000240) { $str = 'nop'; }
elsif ($wrd == 000260) { $str = 'nop2'; }
elsif ($wrd == 000257) { $str = 'ccc'; }
elsif ($wrd == 000277) { $str = 'scc'; }
else { $str = join('', $wrd&020?'se':'cl', $wrd&010?'n':'',$wrd&04?'z':'',$wrd&02?'v':'',$wrd&01?'c':''); }
$entry{$adr+2}++;
} elsif ($wrd >= 000400 && $wrd <= 003777 || $wrd >= 0100000 && $wrd <= 0103777) { # ok
#
# conditional branch sop single-word instructions
#
my $opc = ('xxx','br', 'bne','beq', 'bge','blt','bgt','ble',
'bpl','bmi','bhi','blos','bvc','bvs','bcc','bcs'
) [ (($wrd&0100000)>>12) | (($wrd&03400)>>8) ];
my $off = $wrd&0377; $off = -(0400-$off) if $off >= 0200;
my $npc = $adr+2 + 2*$off;
$label{$npc} = 'L'.$label++ unless exists($label{$npc});
if (0) {
$str = sprintf("%s\t.%s%o\t\t; %06o [%s]",
$opc, $off < 0 ? '-' : '+', abs($npc-$adr), $npc, $label{$npc});
} else {
$str = sprintf("%s\t%s\t\t; %06o [.%s%o]",
$opc, $label{$npc}, $npc, $off < 0 ? '-' : '+', abs($npc-$adr));
}
$entry{$adr+2}++ if $opc ne 'br';
$entry{$npc}++;
} elsif ($wrd >= 077000 && $wrd <= 077777) { # maybe
#
# subtract-one-branch dop single-word instruction
#
my $off = $wrd&077;
my $npc = $adr+2 - 2*$off;
$label{$npc} = 'L'.$label++ unless exists($label{$npc});
if (0) {
$str = sprintf("%s\t%s,.-%o\t\t; %06o [%s]",
'sob', _r($wrd>>6), abs($npc-$adr), $npc, $label{$npc});
} else {
$str = sprintf("%s\t%s,%s\t\t; %06o [.-%o]",
'sob', _r($wrd>>6), $label{$npc}, $npc, abs($npc-$adr));
}
$entry{$adr+2}++;
$entry{$npc}++;
} elsif ($wrd >= 000200 && $wrd <= 000207) { # ok
#
# return-from-subroutine sop single-word instruction
#
$str = sprintf("rts\t%s", _r($wrd>>0));
} elsif ($wrd >= 000100 && $wrd <= 000177) { # maybe
#
# unconditional jump sop single/double-word instruction
#
$str = sprintf("%s\t%s", 'jmp', _mode($wrd>>0,$adr+2,2));
$cnt += _eat($wrd>>0);
if (($wrd&077) == 037) { # absolute address @#FOO
$entry{$wrd[$adr+2]}++;
} elsif (($wrd&067) == 067) { # pc-relative address FOO
my $npc = ($adr+2 + 2 + $wrd[$adr+2]) & 0xFFFF;
$label{$npc} = 'L'.$label++ unless exists($label{$npc});
$entry{$npc}++;
}
} elsif ($wrd >= 004000 && $wrd <= 004777) { # maybe
#
# jump-to-subr dop single/double-word instruction
#
$str = sprintf("%s\t%s,%s", 'jsr', _r($wrd>>6), _mode($wrd>>0,$adr+2,2));
$cnt += _eat($wrd>>0);
if (($wrd&077) == 037) { # absolute address @#FOO
$entry{$wrd[$adr+2]}++;
} elsif (($wrd&067) == 067) { # pc-relative address FOO
my $npc = ($adr+2 + 2 + $wrd[$adr+2]) & 0xFFFF;
$label{$npc} = 'L'.$label++ unless exists($label{$npc});
$entry{$npc}++;
}
$entry{$adr+2 + 2*_eat($wrd>>0)}++;
} elsif ($wrd >= 005000 && $wrd <= 006777 || $wrd >= 0105000 && $wrd <= 0106777 ||
$wrd >= 000300 && $wrd <= 000377) { # maybe
#
# arithmetic sop single/double-word instructions
#
my $opc = ('ror', 'rol', 'asr', 'asl', 'mark','mfpi','mtpi','sxt',
'clr', 'com', 'inc', 'dec', 'neg', 'adc', 'sbc', 'tst',
'rorb','rolb','asrb','aslb','mtps','mfpd','mtpd','mfps',
'clrb','comb','incb','decb','negb','adcb','sbcb','tstb'
) [ (($wrd&0100000)>>11) | (($wrd&001700)>>6) ];
$opc = 'swab' if $wrd <= 000377;
if ($opc eq 'mark') {
$str = sprintf("mark\t%o", $wrd&077);
} else {
if ((($wrd>>0)&067) == 067) {
my $ea = ($adr+2 + 2 + $wrd[$adr+2]) & 0xFFFF;
$label{$ea} = 'L'.$label++ unless exists($label{$ea});;
}
$str = sprintf("%s\t%s", $opc, _mode($wrd>>0,$adr+2,2));
$cnt += _eat($wrd>>0);
$entry{$adr+2 + 2*_eat($wrd>>0)}++;
}
} elsif ($wrd >= 070000 && $wrd <= 074777) { # maybe
#
# arithmetic dop single/double-word instructions
#
my $opc = ('mul','div','ash','ashc','xor') [ ($wrd&007000)>>9 ];
if ((($wrd>>0)&067) == 067) {
my $ea = ($adr+2 + 2 + $wrd[$adr+2]) & 0xFFFF;
$label{$ea} = 'L'.$label++ unless exists($label{$ea});;
}
if ($opc eq 'xor') {
$str = sprintf("%s\t%s,%s", $opc, _r($wrd>>6), _mode($wrd>>0,$adr+2,2));
} else {
$str = sprintf("%s\t%s,%s", $opc, _mode($wrd>>0,$adr+2,2), _r($wrd>>6));
}
$cnt += _eat($wrd>>0);
$entry{$adr+2 + 2*_eat($wrd>>0)}++;
} elsif ($wrd >= 010000 && $wrd <= 067777 || $wrd >= 0110000 && $wrd <= 0167777) { # maybe
#
# arithmetic dop single/double/triple-word instructions
#
my $opc = ('xxx','mov', 'cmp', 'bit', 'bic', 'bis', 'add','xxx',
'xxx','movb','cmpb','bitb','bicb','bisb','sub','xxx'
) [ ($wrd&0170000)>>12 ];
if ((($wrd>>6)&067) == 067) {
my $ea = ($adr+2 + 2 + $wrd[$adr+2]) & 0xFFFF;
$label{$ea} = 'L'.$label++ unless exists($label{$ea});;
}
if ((($wrd>>0)&067) == 067) {
my $ea = ($adr+2 + 2*_eat($wrd>>6) + 2 + $wrd[$adr+2*_eat($wrd>>6)+2]) & 0xFFFF;
$label{$ea} = 'L'.$label++ unless exists($label{$ea});;
}
$str = sprintf("%s\t%s,%s",
$opc, _mode($wrd>>6,$adr+2,2), _mode($wrd>>0,$adr+2+2*_eat($wrd>>6),4));
$cnt += _eat($wrd>>6) + _eat($wrd>>0);
$entry{$adr+2 + 2*_eat($wrd>>6) + 2*_eat($wrd>>0)}++;
} elsif ($wrd >= 0170000 && $wrd <= 0177777) { # TBD
#
# FPP float sop/dop single/double-word instructions
#
$str = 'float';
$entry{$adr+2}++;
} else { # ok
#
# all ILLEGAL opcodes (not previously decoded)
#
$str = 'ILLEGAL';
}
return ($cnt,$str);
}
#----------------------------------------------------------------------------------------------------
# convert string of byte hex characters to an array of numbers
sub hexa ($) {
my ($dat) = @_;
my @dat = ();
while ($dat) { push(@dat,hex(substr($dat,0,2))); $dat = substr($dat,2); }
return @dat;
}
#----------------------------------------------------------------------------------------------------
# trim leading/trailing spaces on a string
sub trim ($) {
my ($str) = @_;
$str =~ s/\s+$//;
$str =~ s/^\s+//;
return $str;
}
#----------------------------------------------------------------------------------------------------
# compute checksum (twos complement of the sum of bytes)
sub chksum (@) {
my $sum = 0;
map($sum += $_, @_);
return (-$sum) & 0xFF;
}
#----------------------------------------------------------------------------------------------------
# RAD50 to ASCII decode
sub rad2asc (@) {
my @str = split(//, ' ABCDEFGHIJKLMNOPQRSTUVWXYZ$.%0123456789'); # RAD50 character subset
my $ascii = "";
foreach my $rad50 (@_) {
$ascii .= $str[int($rad50/1600)%40] . $str[int($rad50/40)%40] . $str[$rad50%40];
}
return $ascii;
}
#----------------------------------------------------------------------------------------------------
# crc computation routine
sub crc (%) {
# pass all args by name
my %args = @_;
# all the crcs we know how to compute
my %crcdat = ( 'CRC-16' => [ 0xA001, 2, 0x0000, 0x0000 ],
'CRC-32' => [ 0xEDB88320, 4, 0xFFFFFFFF, 0xFFFFFFFF ] );
# run next byte thru crc computation, return updated crc
return $args{-table}[($args{-crc}^$args{-byte}) & 0xFF]^($args{-crc}>>8) if exists($args{-byte});
# return initial crc value
return $crcdat{$args{-name}}->[2] if exists($args{-init});
# return final crc value xored with xorout
return $args{-crc} ^ $crcdat{$args{-name}}->[3] if exists($args{-last});
# compute the crc lookup table, return a pointer to it
if (exists($args{-new})) {
my $crctab = [];
my $poly = $crcdat{$args{-name}}->[0];
foreach my $byte (0..255) {
my $data = $byte;
foreach (1..8) { $data = ($data>>1) ^ ($data&1 ? $poly : 0); }
$$crctab[$byte] = $data;
}
return $crctab;
}
}
#----------------------------------------------------------------------------------------------------
# read a record from the object file
sub read_rec ($) {
my ($fh) = @_;
my ($buf, $cnt, $len, $err) = (0,0,0,0);
my @pre = ();
my @dat = ();
my @suf = ();
# Object file format consists of blocks, optionally preceded, separated, and
# followed by zeroes. Each block consists of:
#
# 001 ---
# 000 |
# lo(length) |
# hi(length) > 'length' bytes
# databyte1 |
# : |
# databyteN ---
# checksum
#
# skip over strings of 0x00; exit OK if hit EOF
do { return () unless $cnt = read($fh, $buf, 1); } while (ord($buf) == 0);
# valid record starts with (1)
$err = 1 unless $cnt == 1 && ord($buf) == 1;
push(@pre, ord($buf));
# second byte must be (0)
$cnt = read($fh, $buf, 1);
$err = 2 unless $cnt == 1 && ord($buf) == 0;
push(@pre, ord($buf));
# third byte is low byte of record length
$cnt = read($fh, $buf, 1);
$err = 3 unless $cnt == 1;
$len = ord($buf);
push(@pre, ord($buf));
# fourth byte is high byte of record length
$cnt = read($fh, $buf, 1);
$err = 4 unless $cnt == 1;
$len += ord($buf)<<8;
push(@pre, ord($buf));
# bytes five thru end-1 are data bytes
$cnt = read($fh, $buf, $len-4);
$err = 5 unless $cnt == $len-4 && $len >= 4;
@dat = unpack("C*", $buf);
# last byte is checksum
$cnt = read($fh, $buf, 1);
$err = 6 unless $cnt == 1;
my $rcv = ord($buf);
push(@suf, ord($buf));
# output the record if debugging
if ($DEBUG) {
my $fmt = "%03o";
my $n = 16;
my $pre = sprintf("RECORD: [%s] ",join(" ",map(sprintf($fmt,$_),@pre)));
printf $LOG "\n\n%s", $pre;
my $k = length($pre);
my @tmp = @dat;
while (@tmp > $n) {
printf $LOG "%s\n%*s", join(" ",map(sprintf($fmt,$_),splice(@tmp,0,$n))), $k, '';
}
printf $LOG "%s", join(" ",map(sprintf($fmt,$_),@tmp)) if @tmp;
printf $LOG " [%s]\n\n", join(" ",map(sprintf($fmt,$_),@suf));
}
# check we have a well formatted record
die sprintf("Error: invalid object file record format (%d)", $err) if $err;
# compare rcv'ed checksum vs exp'ed checksum
my $exp = &chksum(0x01, $len>>0, $len>>8, @dat);
die sprintf("Error: Bad checksum exp=0x%02X rcv=0x%02X", $exp, $rcv) unless $exp == $rcv;
# all is well, return the record
return @dat;
}
#----------------------------------------------------------------------------------------------------
# the end

586
img2sdcard/img2sdcard.pl Normal file
View File

@ -0,0 +1,586 @@
#!/usr/bin/perl -w
#!/usr/local/bin/perl -w
# options
use strict;
# external global modules
use Getopt::Long;
use Pod::Text;
use FindBin;
use FileHandle;
use File::Copy;
use File::Compare;
use POSIX;
use Expect;
# external local modules search path
BEGIN { unshift(@INC, $FindBin::Bin);
unshift(@INC, '.'); }
# external local modules
# defaults
my $VERSION = 'v1.0'; # version of code
my $HELP = 0; # set to 1 for man page output
my $DEBUG = 0; # set to 1 for debug messages
my $VERBOSE = 0; # set to 1 for verbose messages
# arguments
my $XMLFILE = undef; # define for XML file output
my $DEVICE = undef; # define for device selection as /dev/DEVICE
my $SLICE = undef; # define for device selection as $DEVICE.$SLICE
my $SCSI = undef; # list of scsi IDs per partition
my $READFILE = undef; # image file to read
my $WRITEFILE = undef; # image file to write
my $COMPAREFILE = undef; # image file to compare
my $PARTITIONS = undef; # list of data partitions to create
# process command line arguments
my $NOERROR = GetOptions( "help!" => \$HELP,
"debug!" => \$DEBUG,
"verbose!" => \$VERBOSE,
"xmlfile=s" => \$XMLFILE,
"readfile=s" => \$READFILE,
"writefile=s" => \$WRITEFILE,
"comparefile=s" => \$COMPAREFILE,
"device=s" => \$DEVICE,
"slice=i" => \$SLICE,
"scsi=s" => \$SCSI,
"partitions=s" => \$PARTITIONS,
);
# init
$VERBOSE = 1 if $DEBUG; # debug implies verbose messages
# output the documentation
if ($HELP) {
# output a man page if we can
if (ref(Pod::Text->can('new')) eq 'CODE') {
# try the new way if appears to exist
my $parser = Pod::Text->new(sentence=>0, width=>78);
printf STDOUT "\n"; $parser->parse_from_file($0);
} else {
# else must use the old way
printf STDOUT "\n"; Pod::Text::pod2text(-78, $0);
};
exit(1);
}
# check for correct arguments present, print usage if errors
unless ($NOERROR
&& scalar(@ARGV) == 0
&& defined($DEVICE)
) {
printf STDERR "%s %s (perl %g)\n", $0, $VERSION, $];
print STDERR "Usage: $0 [options...] arguments\n";
print STDERR <<"EOF";
--help output manpage and exit
--debug enable debug mode
--verbose verbose status reporting
--device=DEVICE device SDcard is mounted on (ie, sdd) [REQUIRED]
--slice=N logical partition number 5..8 [optional]
--xmlfile=XMLFILE generated .xml description file [optional]
--readfile=IMGFILE image file to read from disk [optional]
--writefile=IMGFILE image file to write to disk [optional]
--comparefile=IMGFILE image file to compare to disk [optional]
--scsi=S1[,S2[,S3[,S4]]] scsi id per partition [optional]
--partitions=P1[,P2[,P3[,P4]]] logical partition sizes [optional]
EOF
# exit if errors...
die "Aborted due to command line errors.\n";
}
# ------------------------------------------------------------------------------
# database setup
my %db = ();
my %slice = ();
my $devfile = '/dev/'.$DEVICE;
my %disktab = ( # type legacy#blocks assigned#blocks size-in-MB text-description
RL01 => { actual => 10240, allocate => 10240, capacity => 5, description => 'DEC RL01' },
RL02 => { actual => 20480, allocate => 20480, capacity => 10, description => 'DEC RL02' },
RD51 => { actual => 21600, allocate => 22528, capacity => 11, description => 'DEC RD51 Winchester' },
RK06 => { actual => 27126, allocate => 28672, capacity => 14, description => 'DEC RK06' },
RD31 => { actual => 41560, allocate => 43008, capacity => 21, description => 'DEC RD31 Winchester' },
RC25 => { actual => 50902, allocate => 51200, capacity => 25, description => 'RCF25' },
RK07 => { actual => 53790, allocate => 55296, capacity => 27, description => 'DEC RK07' },
RD52 => { actual => 60480, allocate => 61440, capacity => 30, description => 'DEC RD52 Winchester' },
RD32 => { actual => 83236, allocate => 83968, capacity => 41, description => 'DEC RD32 Winchester' },
RZ22 => { actual => 102432, allocate => 104448, capacity => 51, description => 'DEC RZ22 Winchester' },
AMP980 => { actual => 131680, allocate => 133120, capacity => 65, description => 'AMPEX DM980' },
RM03 => { actual => 131680, allocate => 133120, capacity => 65, description => 'DEC RM03' },
RD33 => { actual => 138565, allocate => 139264, capacity => 68, description => 'DEC RD33 Winchester' },
RD53 => { actual => 138672, allocate => 139264, capacity => 68, description => 'DEC RD53 Winchester' },
RP05 => { actual => 171798, allocate => 172032, capacity => 84, description => 'DEC RP05' },
RZ23 => { actual => 204864, allocate => 206848, capacity => 101, description => 'DEC RZ23 Winchester' },
RA80 => { actual => 237212, allocate => 237568, capacity => 116, description => 'DEC RA80 Winchester' },
RZ23L => { actual => 237588, allocate => 239616, capacity => 117, description => 'DEC RZ23L Winchester' },
RM80 => { actual => 242606, allocate => 243712, capacity => 119, description => 'DEC RM80' },
RB80 => { actual => 242606, allocate => 243712, capacity => 119, description => 'DEC R80 on 730 IDC' },
ESE20 => { actual => 245757, allocate => 245760, capacity => 120, description => 'DEC ESE20 Electronic' },
CDC9730 => { actual => 263360, allocate => 264192, capacity => 129, description => 'CDC 9730' },
FUJ160 => { actual => 263360, allocate => 264192, capacity => 129, description => 'Fujitsu 160' },
RF30 => { actual => 293040, allocate => 294912, capacity => 144, description => 'DEC RF30 Winchester' },
RD54 => { actual => 311200, allocate => 311296, capacity => 152, description => 'DEC RD54 Winchester' },
RP06 => { actual => 340670, allocate => 342016, capacity => 167, description => 'DEC RP06' },
RA60 => { actual => 400176, allocate => 401408, capacity => 196, description => 'DEC RA60 Removable' },
RZ24 => { actual => 409792, allocate => 411648, capacity => 201, description => 'DEC RZ24 Winchester' },
AMP9300 => { actual => 495520, allocate => 495616, capacity => 242, description => 'Ampex 9300' },
CDC9766 => { actual => 500384, allocate => 501760, capacity => 245, description => 'CDC 9766' },
RM05 => { actual => 500384, allocate => 501760, capacity => 245, description => 'DEC RM05' },
AMP330 => { actual => 524288, allocate => 524288, capacity => 256, description => 'Ampex Capricorn' },
RA70 => { actual => 547041, allocate => 548864, capacity => 268, description => 'DEC RA70 Winchester' },
RZ55 => { actual => 649040, allocate => 649216, capacity => 317, description => 'DEC RZ55 Winchester' },
RF31 => { actual => 744400, allocate => 745472, capacity => 364, description => 'DEC RF31 Winchester' },
RF71 => { actual => 781440, allocate => 782336, capacity => 382, description => 'DEC RF71 Winchester' },
EAGLE => { actual => 808320, allocate => 808960, capacity => 395, description => 'Fujitsu Eagle (48 sectors)' },
RZ25 => { actual => 832527, allocate => 833536, capacity => 407, description => 'DEC RZ25 Winchester' },
RA81 => { actual => 891072, allocate => 892928, capacity => 436, description => 'DEC RA81 Winchester' },
RP07 => { actual => 1008000, allocate => 1009664, capacity => 493, description => 'DEC RP07' },
CDC9775 => { actual => 1079040, allocate => 1079296, capacity => 527, description => 'CDC 9775' },
RA82 => { actual => 1216665, allocate => 1218560, capacity => 595, description => 'DEC RA82 Winchester' },
RZ56 => { actual => 1299174, allocate => 1300480, capacity => 635, description => 'DEC RZ56 Winchester' },
RZ80 => { actual => 1308930, allocate => 1310720, capacity => 640, description => 'Maxtor 8760 Winchester' },
RA71 => { actual => 1367310, allocate => 1368064, capacity => 668, description => 'DEC RA71 Winchester' },
RA72 => { actual => 1953300, allocate => 1953792, capacity => 954, description => 'DEC RA72 Winchester' },
RF72 => { actual => 1954050, allocate => 1955840, capacity => 955, description => 'DEC RF72 Winchester' },
RZ57 => { actual => 2025788, allocate => 2027520, capacity => 990, description => 'DEC RZ57 Winchester' },
M2266 => { actual => 2096256, allocate => 2097152, capacity => 1024, description => 'Fujitsu M2266' },
M2694 => { actual => 2117025, allocate => 2117632, capacity => 1034, description => 'Fujitsu M2694' },
RA90 => { actual => 2376153, allocate => 2377728, capacity => 1161, description => 'DEC RA90 Winchester' },
RZ58 => { actual => 2698061, allocate => 2699264, capacity => 1318, description => 'DEC RZ58 Winchester' },
RA92 => { actual => 2940951, allocate => 2942976, capacity => 1437, description => 'DEC RA92 Winchester' },
M2652 => { actual => 3409965, allocate => 3411968, capacity => 1666, description => 'Fujitsu M2652' },
RA73 => { actual => 3920490, allocate => 3921920, capacity => 1915, description => 'DEC RA73 Winchester' },
ST32171 => { actual => 4110000, allocate => 4110336, capacity => 2007, description => 'Seagate ST32171N' },
ST32550 => { actual => 4194995, allocate => 4196352, capacity => 2049, description => 'Seagate ST32550N' },
);
# defaults
$db{ByteCount} = undef;
$db{SectorCount} = undef;
$db{SectorSize} = 512;
$db{IDcode} = 0xDA;
# ------------------------------------------------------------------------------
# initialize SDcard device structure
if (defined($DEVICE) && defined($PARTITIONS)) {
# setup for expect
my $prompt_cmd = qr/\nCommand \(m for help\): /;
my $timeout = 10;
# launch fdisk as an interactive subprocess
my $exp = Expect->spawn('/sbin/fdisk', $devfile) or die;
# enable debugging if set to 1
$exp->exp_internal(0);
# init MBR
$exp->expect($timeout,
[ $prompt_cmd, sub { $exp->send("o\n"); } ] );
# print disk info
$exp->expect($timeout,
[ $prompt_cmd, sub { $exp->send("p\n"); exp_continue; } ],
[ qr/\nDisk \S+: \S+ \S+, (\d+) bytes, (\d+) sectors/,
sub { $db{ByteCount} = ($exp->matchlist)[0];
$db{SectorCount} = ($exp->matchlist)[1];
$db{SectorSize} = int($db{ByteCount}/$db{SectorCount}); } ] );
# compute size of extra FAT partition as about 100MB; use rest for data partitions
my $use_size_mb = int($db{ByteCount}/1048576 - 100.5);
# create logical container partition 1
$exp->expect($timeout,
[ $prompt_cmd, sub { $exp->send("n\n"); exp_continue; } ],
[ qr/\nSelect.+: /, sub { $exp->send("e\n"); exp_continue; } ],
[ qr/\nPartition.+: /, sub { $exp->send("1\n"); exp_continue; } ],
[ qr/\nFirst sector.+: /, sub { $exp->send("\n"); exp_continue; } ],
[ qr/\nLast sector.+: /, sub { $exp->send("+".$use_size_mb."M\n"); } ] );
# create filesystem partition 2
$exp->expect($timeout,
[ $prompt_cmd, sub { $exp->send("n\n"); exp_continue; } ],
[ qr/\nSelect.+: /, sub { $exp->send("p\n"); exp_continue; } ],
[ qr/\nPartition.+: /, sub { $exp->send("2\n"); exp_continue; } ],
[ qr/\nFirst sector.+: /, sub { $exp->send("\n"); exp_continue; } ],
[ qr/\nLast sector.+: /, sub { $exp->send("\n"); } ] );
# change filesystem partition 2 to FAT32
$exp->expect($timeout,
[ $prompt_cmd, sub { $exp->send("t\n"); exp_continue; } ],
[ qr/\nPartition.+: /, sub { $exp->send("2\n"); exp_continue; } ],
[ qr/\nHex code.+: /, sub { $exp->send("0b\n"); } ] );
# create data partitions
foreach my $entry (split(/,/,uc($PARTITIONS))) {
# partition size; lookup from table, else just use it
my $size = exists $disktab{$entry} ? $disktab{$entry}{allocate} : $entry;
# created partition number
my $n = undef;
# create data partition N
$exp->expect($timeout,
[ $prompt_cmd, sub { $exp->send("n\n"); exp_continue; } ],
[ qr/\nSelect.+: /, sub { $exp->send("l\n"); exp_continue; } ],
[ qr/\nAdding logical partition (\d+)/,
sub { $n = ($exp->matchlist)[0]; exp_continue; } ],
[ qr/\nFirst sector.+: /, sub { $exp->send("\n"); exp_continue; } ],
[ qr/\nLast sector.+: /, sub { $exp->send("+".$size."\n"); } ] );
# change data partition N to raw data
if (defined($n)) {
$exp->expect($timeout,
[ $prompt_cmd, sub { $exp->send("t\n"); exp_continue; } ],
[ qr/\nPartition.+: /, sub { $exp->send($n."\n"); exp_continue; } ],
[ qr/\nHex code.+: /, sub { $exp->send(sprintf("%02x\n",$db{IDcode})); } ] );
}
# exit loop if created last partition
last if $n >= 8;
} # foreach my $entry
# print partitions
$exp->expect($timeout,
[ $prompt_cmd, sub { $exp->send("p\n"); } ] );
# write and quit
$exp->expect($timeout,
[ $prompt_cmd, sub { $exp->send("w\n"); } ] );
# and done
$exp->soft_close();
}
# ------------------------------------------------------------------------------
# gather data from existing SDcard device
if (defined($DEVICE)) {
# read the partition map and get the partitions of the selected type
if (open(my $fh, '-|', '/sbin/fdisk --list '.$devfile)) {
# scan all lines
while (my $line = scalar(<$fh>)) {
$line =~ s/[\015\012]+$//;
if ($line =~ m/^${devfile}(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\S+)\s+(\S+)/i) {
# process partition definition lines
my ($id, $start, $end, $count, $size, $type) = ($1+0,$2+0,$3+0,$4+0,$5,hex($6));
if ($type == $db{IDcode} && $count == $end-$start+1) {
$slice{$id}{start} = $start;
$slice{$id}{end} = $end;
$slice{$id}{count} = $count;
}
} elsif ($line =~ m/^disk\s+${devfile}:\s+[0-9.]+\s+[a-z]+,\s+(\d+)\s+bytes,\s+(\d+)\s+sectors/i) {
# process line with total physical device byte and sector count
$db{ByteCount} = ($1+0);
$db{SectorCount} = ($2+0);
$db{SectorSize} = int($db{ByteCount}/$db{SectorCount});
}
}
close($fh);
} # if (open(my $fh ...
if ($DEBUG) {
printf STDERR "\n[ SectorSize = %d ]\n", $db{SectorSize};
printf STDERR "[ SectorCount = %d ]\n", $db{SectorCount};
printf STDERR "[ ByteCount = %d ]\n\n", $db{ByteCount};
printf STDERR "[ Device Sector Sector Sector ]\n";
printf STDERR "[ & Slice Start End Count ]\n";
foreach my $id (sort(keys(%slice))) {
printf STDERR "[ %-10s %10d %10d %10d ]\n", $devfile.$id,
$slice{$id}{start}, $slice{$id}{end}, $slice{$id}{count};
}
printf STDERR "\n";
}
}
# ------------------------------------------------------------------------------
# write image file to partition
if (defined($DEVICE) && defined($WRITEFILE) && defined($SLICE)) {
# some parameters
my $blksize = $db{SectorSize};
my $bufsize = 2048*$blksize;
# configure partition start/length blocks
my $start = $slice{$SLICE}{start};
my $end = $slice{$SLICE}{end};
my $count = $slice{$SLICE}{count};
# check input exists
if (open(my $ifh, '<', $WRITEFILE)) {
# check output exists
if (open(my $ofh, '+<', $devfile)) {
# seek to output position
die unless sysseek($ofh, $start*$blksize, 0) == $start*$blksize;
# this many bytes per chunk
my $buffer = undef;
# read/write byte counts
my $rdtotal = 0;
my $wrtotal = 0;
# read/write byte positions
my $rdpos = sysseek($ifh, 0, 1);
my $wrpos = sysseek($ofh, 0, 1);
while ((my $rdsize = sysread($ifh, $buffer, $bufsize)) > 0) {
# read bytes
$rdtotal += $rdsize;
printf STDERR "[ write slice %d rd %12d at %12d ]\n", $SLICE, $rdsize, $rdpos if $DEBUG;
# check write bytes vs partition size; set partition size as maximum
if ($wrtotal+$rdsize > $count*$blksize) {
$rdsize = $count*$blksize - $wrtotal;
printf STDERR "Write overflow; truncating read to %d bytes\n", $rdsize;
}
# write bytes
my $wrsize = syswrite($ofh, $buffer, $rdsize);
$wrtotal += $wrsize;
printf STDERR "[ write slice %d wr %12d at %12d ]\n", $SLICE, $wrsize, $wrpos if $DEBUG;
# continue
$rdpos = sysseek($ifh, 0, 1);
$wrpos = sysseek($ofh, 0, 1);
} # while ((my $rdsize ...
# summary
printf STDERR "Write image file %s %d bytes to slice %d %d bytes\n",
$WRITEFILE, $rdtotal, $SLICE, $wrtotal if $VERBOSE;
close($ofh);
} # if (open(my $ofh ...
close($ifh);
} # if (open(my $ifh ...
}
# ------------------------------------------------------------------------------
# read partition to image file
if (defined($DEVICE) && defined($READFILE) && defined($SLICE)) {
# some parameters
my $blksize = $db{SectorSize};
my $bufsize = 2048*$blksize;
# configure partition start/length blocks
my $start = $slice{$SLICE}{start};
my $end = $slice{$SLICE}{end};
my $count = $slice{$SLICE}{count};
# check input exists
if (open(my $ifh, '+<', $devfile)) {
# create output file
if (open(my $ofh, '>', $READFILE)) {
# seek to input position
die unless sysseek($ifh, $start*$blksize, 0) == $start*$blksize;
# this many bytes per chunk
my $buffer = undef;
# read/write byte counts
my $rdtotal = 0;
my $wrtotal = 0;
# read/write byte positions
my $rdpos = sysseek($ifh, 0, 1);
my $wrpos = sysseek($ofh, 0, 1);
while ($rdtotal < $count*$blksize) {
# shrink buffer on last read if extends past partition
$bufsize = $count*$blksize - $rdtotal if $rdtotal+$bufsize > $count*$blksize;
# read bytes
my $rdsize = sysread($ifh, $buffer, $bufsize);
$rdtotal += $rdsize;
printf STDERR "[ read slice %d rd %12d at %12d ]\n", $SLICE, $rdsize, $rdpos if $DEBUG;
# write bytes
my $wrsize = syswrite($ofh, $buffer, $rdsize);
$wrtotal += $wrsize;
printf STDERR "[ read slice %d wr %12d at %12d ]\n", $SLICE, $wrsize, $wrpos if $DEBUG;
# continue
$rdpos = sysseek($ifh, 0, 1);
$wrpos = sysseek($ofh, 0, 1);
} # while ((my $rdsize ...
# summary
printf STDERR "Read slice %d %d bytes to image file %s %d bytes\n",
$SLICE, $rdtotal, $READFILE, $wrtotal if $VERBOSE;
close($ofh);
} # if (open(my $ofh ...
close($ifh);
} # if (open(my $ifh ...
}
# ------------------------------------------------------------------------------
# read partition to temp file and compare to named file
if (defined($DEVICE) && defined($COMPAREFILE) && defined($SLICE)) {
# some parameters
my $blksize = $db{SectorSize};
my $bufsize = 2048*$blksize;
# configure partition start/length blocks
my $start = $slice{$SLICE}{start};
my $end = $slice{$SLICE}{end};
my $count = $slice{$SLICE}{count};
# locals
my $tmpfile = sprintf("img2sdcard_%s%d_%d.tmp", $DEVICE, $SLICE, $$);
# check input exists
if (open(my $ifh, '+<', $devfile)) {
# create output file
if (open(my $ofh, '>', $tmpfile)) {
# seek to input position
die unless sysseek($ifh, $start*$blksize, 0) == $start*$blksize;
# this many bytes per chunk
my $buffer = undef;
# read/write byte counts
my $rdtotal = 0;
my $wrtotal = 0;
# read/write byte positions
my $rdpos = sysseek($ifh, 0, 1);
my $wrpos = sysseek($ofh, 0, 1);
while ($rdtotal < $count*$blksize) {
# shrink buffer on last read if extends past partition
$bufsize = $count*$blksize - $rdtotal if $rdtotal+$bufsize > $count*$blksize;
# read bytes
my $rdsize = sysread($ifh, $buffer, $bufsize);
$rdtotal += $rdsize;
printf STDERR "[ read slice %d rd %12d at %12d ]\n", $SLICE, $rdsize, $rdpos if $DEBUG;
# write bytes
my $wrsize = syswrite($ofh, $buffer, $rdsize);
$wrtotal += $wrsize;
printf STDERR "[ read slice %d wr %12d at %12d ]\n", $SLICE, $wrsize, $wrpos if $DEBUG;
# continue
$rdpos = sysseek($ifh, 0, 1);
$wrpos = sysseek($ofh, 0, 1);
} # while ((my $rdsize ...
close($ofh);
} # if (open(my $ofh ...
close($ifh);
} # if (open(my $ifh ...
# now do the compare
if (-r $tmpfile && -r $COMPAREFILE) {
# compare only length of compare file
my $len = (stat($COMPAREFILE))[7];
# do the compare, print result
my $sts = system('/usr/bin/cmp', '-b', '-n '.$len, $tmpfile, $COMPAREFILE);
printf STDERR "Compare slice %d %d bytes to image file %s %d bytes; status is '%s'\n",
$SLICE, $len, $COMPAREFILE, $len, $sts == 0 ? 'files match' : 'FILES DIFFER';
# delete tmp file if no error and not debug
unlink($tmpfile) if -e $tmpfile && $sts == 0 && !$DEBUG;
}
}
# ------------------------------------------------------------------------------
# write an XML description file if requested and device exists
if (defined($DEVICE) && defined($XMLFILE)) {
if (open(my $fh, '>', $XMLFILE)) {
# BoardConfig
my %bc = ( unitAttention => 'true',
enableDisconnect => 'true',
parity => 'true',
enableScsi2 => 'false',
disableGlitchFilter => 'false',
enableCache => 'false',
selLatch => 'false',
mapLunsToIds => 'false',
selectionDelay => '255',
startupDelay => '0',
);
# SCSITarget per unit
my %st = ( enabled => 'false', # overwritten
sdSectorStart => '0', # overwritten
scsiSectors => '311200', # overwritten
deviceType => '0x0',
deviceTypeModifier => '0x0',
bytesPerSector => '512',
sectorsPerTrack => '63',
headsPerCylinder => '255',
vendor => 'SCSItoSD',
revision => '4.71',
prodId => sprintf("%-16s", 'RA81'), # overwritten
serial => sprintf("%-16d", 12345), # overwritten
modePages => '',
quirks => '',
vpd => '',
);
# XML header
printf $fh "<SCSI2SD>\n";
# board configuration
printf $fh " <BoardConfig>\n";
foreach my $key (sort(keys(%bc))) {
printf $fh " <%s>%s</%s>\n", $key, $bc{$key}, $key;
}
printf $fh " </BoardConfig>\n";
# list of defined units and corresponding scsi id
my @list = sort({$a <=> $b}keys(%slice));
my @scsi = defined($SCSI) ? (split(/,/,$SCSI)) : (0..$#list);
# exactly four mapped units in SCSItoSD
foreach my $unit (0..3) {
# get unit number from list
my $id = $list[$unit];
# check if less than all units defined
if (defined($id)) {
# configure partition start/length
$st{sdSectorStart} = $slice{$id}{start};
$st{scsiSectors} = $slice{$id}{count};
$st{enabled} = 'true';
$st{serial} = sprintf("%-16d", 1000+$unit);
# search type database for next same or larger entry
my @types = sort({$disktab{$a}{allocate}<=>$disktab{$b}{allocate}}keys(%disktab));
foreach my $type (@types) {
$st{prodId} = sprintf("%-16s", $type);
last if $disktab{$type}{allocate} >= $st{scsiSectors};
}
} else {
# undefined unit
$st{enabled} = 'false';
}
# print per unit configuration
printf $fh " <SCSITarget id=\"%d\">\n", $scsi[$unit];
foreach my $key (sort(keys(%st))) {
printf $fh " <%s>%s</%s>\n", $key, $st{$key}, $key;
}
printf $fh " </SCSITarget>\n";
} # foreach my $unit ...
# XML trailer
printf $fh "</SCSI2SD>\n";
# all done
close($fh);
} # if (open(my $fh ...
}
# ------------------------------------------------------------------------------
exit;
# ------------------------------------------------------------------------------
# the end

46
macro8x/Makefile Normal file
View File

@ -0,0 +1,46 @@
# makefile for pdp8 support routines
# system dependencies
ifeq ($(WINDIR),)
# unix
BINDIR=../../../tools/bin
EXE=
else
# cygwin
BINDIR=../../../tools/exe
EXE=.exe
endif
# omit frame pointer option needed for 25% speed improvment
OPTFLGS=-fno-strength-reduce -fomit-frame-pointer
# select compiler
CC=gcc
# cflags when making optimized version
CFLAGS=-O3 -Wall $(OPTFLGS)
# cflags when making debugging version
##CFLAGS=-g
# linker flags
LFLAGS=-lm
# system libs
LIBS=
# all the bins
BIN=macro8x$(EXE)
all: $(BIN)
clean:
rm -f $(BIN)
install:
cp $(BIN) $(BINDIR)
# make the macro8x binary
macro8x$(EXE): macro8x.c
$(CC) $(CFLAGS) $(LFLAGS) $(LIBS) -o $@ $<
# the end

4432
macro8x/macro8x.c Normal file
View File

File diff suppressed because it is too large Load Diff

46
palbart/Makefile Normal file
View File

@ -0,0 +1,46 @@
# makefile for pdp8 support routines
# system dependencies
ifeq ($(WINDIR),)
# unix
BINDIR=../../../tools/bin
EXE=
else
# cygwin
BINDIR=../../../tools/exe
EXE=.exe
endif
# omit frame pointer option needed for 25% speed improvment
OPTFLGS=-fno-strength-reduce -fomit-frame-pointer
# select compiler
CC=gcc
# cflags when making optimized version
CFLAGS=-O3 -Wall $(OPTFLGS)
# cflags when making debugging version
##CFLAGS=-g
# linker flags
LFLAGS=-lm
# system libs
LIBS=
# all the bins
BIN=palbart$(EXE)
all: $(BIN)
clean:
rm -f $(BIN)
install:
cp $(BIN) $(BINDIR)
# make the palbart binary
palbart$(EXE): palbart.c
$(CC) $(CFLAGS) $(LFLAGS) $(LIBS) -o $@ $<
# the end

220
palbart/palbart.1 Normal file
View File

@ -0,0 +1,220 @@
.\" Hey, EMACS: -*- nroff -*-
.\" First parameter, NAME, should be all caps
.\" Second parameter, SECTION, should be 1-8, maybe w/ subsection
.\" other parameters are allowed: see man(7), man(1)
.TH PALBART 1 "June 23, 2013"
.\" Please adjust this date whenever revising the manpage.
.\"
.\" Some roff macros, for reference:
.\" .nh disable hyphenation
.\" .hy enable hyphenation
.\" .ad l left justify
.\" .ad b justify to both left and right margins
.\" .nf disable filling
.\" .fi enable filling
.\" .br insert line break
.\" .sp <n> insert n+1 empty lines
.\" for manpage-specific macros, see man(7)
.SH NAME
palbart \- BART enhanced PDP8 crossassembler
.SH SYNOPSIS
.B palbart
.RI [options] inputfile
.br
.SH DESCRIPTION
This manual page documents briefly the
.B palbart
command.
It is a cross-assembler to for PDP/8 assembly language programs.
It will produce an output file in bin format, rim format, and using the
appropriate pseudo-ops, a combination of rim and bin formats.
A listing file is always produced and with an optional symbol table
and/or a symbol cross-reference (concordance). The permanent symbol
table can be output in a form that may be read back in so a customized
permanent symbol table can be produced. Any detected errors are output
to a separate file giving the filename in which they were detected
along with the line number, column number and error message as well as
marking the error in the listing file.
.PP
The following file name extensions are used:
.PP
.pal source code (input)
.PP
.lst assembly listing (output)
.PP
.bin assembly output in DEC's bin format (output)
.PP
.rim assembly output in DEC's rim format (output)
.PP
.err assembly errors detected (if any) (output)
.PP
.prm permanent symbol table in form suitable for reading after the EXPUNGE pseudo-op.
.PP
.SH OPTIONS
A summary of options is included below.
.TP
.B \-$
Don't require a $ at end of file
.TP
.B \-a
Enable additional features not compatible with PAL8.
.TP
.B \-d
Show symbol table at end of assembly
.TP
.B \-e
Generate error if link generated
.TP
.B \-h
Display help
.TP
.B \-l
Allow generation of links and literals (default)
.TP
.B \-n
Don't allow redefinition of permanent symbols
.TP
.B \-p
Generate a file with the permanent symbols in it.
(To get the current symbol table, assemble a file than has only
a $ in it.)
.TP
.B \-r
Produce output in rim format (default is bin format)
.TP
.B \-t N
Set tab stops to N
.TP
.B \-v
Display version information
.TP
.B \-x
Generate a cross-reference (concordance) of user symbols
.SH ADDITIONAL FEATURES
The additional features flag enables functions that are not compatible
with the PAL8 assemble. Currently only the TITLE and BANK pseudo operations
are enabled with this function. There are likely other incompatabilities
that are not under this flag.
.SH DIAGNOSTICS
Assembler error diagnostics are output to an error file and inserted
in the listing file. Each line in the error file has the form
.PP
<filename>(<line>:<col>) : error: <message> at Loc = <loc>
.PP
An example error message is:
.br
bintst.pal(17:9) : error: undefined symbol "UNDEF" at Loc = 07616
.PP
The error diagnostics put in the listing start with a two character
error code (if appropriate) and a short message. A carat '^' is
placed under the item in error if appropriate.
An example error message is:
.PP
17 07616 3000 DCA UNDEF
.br
UD undefined ^
.br
18 07617 1777 TAD I DUMMY
.PP
When an indirect is generated, an at character '@' is placed after the
the instruction value in the listing as an indicator as follows:
.PP
14 03716 1777@ TAD OFFPAG
.PP
Undefined symbols are marked in the symbol table listing by prepending
a '?' to the symbol. Redefined symbols are marked in the symbol table
listing by prepending a '#' to the symbol. Examples are:
.PP
#REDEF 04567
.br
SWITCH 07612
.br
?UNDEF 00000
.PP
Refer to the code for the diagnostic messages generated.
.SH BUGS
Only a minimal effort has been made to keep the listing format
anything like the PAL-8 listing format.
.PP
The RIMPUNch and BINPUNch pseudo-ops do not change the binary output
file type that was specified on startup. This was intentional and
and allows rim formatted data to be output prior to the actual binary
formatted data. On UN*X style systems, the same effect can be achieved
using the "cat" command, but on DOS/Windows systems, doing this was
a major chore.
.PP
The floating point input does not generate values exactly as the DEC
compiler does. I worked out several examples by hand and believe that
this implementation is slightly more accurate. If I am mistaken,
let me know and, if possible, a better method of generating the values.
.br
.SH HISTORICAL NOTE
This assembler was written to support the fleet of PDP-8 systems
used by the Bay Area Rapid Transit System. As of early 1997,
this includes about 40 PDP-8/E systems driving the train destination
signs in passenger stations.
.SH REFERENCES
This assembler is based on the pal assembler by:
.br
Douglas Jones <jones@cs.uiowa.edu> and
.br
Rich Coon <coon@convexw.convex.com>
.SH DISCLAIMER
See the symbol table for the set of pseudo-ops supported.
.PP
See the code for pseudo-ops that are not standard for PDP/8 assembly.
.PP
Refer to DEC's "Programming Languages (for the PDP/8)" for complete
documentation of pseudo-ops.
.PP
Refer to DEC's "Introduction to Programming (for the PDP/8)" or a
lower level introduction to the assembly language.
.SH WARRANTY
If you don't like it the way it works or if it doesn't work, that's
tough. You're welcome to fix it yourself. That's what you get for
using free software.
.SH COPYRIGHT NOTICE
This is free software. There is no fee for using it. You may make
any changes that you wish and also give it away. If you can make
a commercial product out of it, fine, but do not put any limits on
the purchaser's right to do the same. If you improve it or fix any
bugs, it would be nice if you told me and offered me a copy of the
new version.
Gary Messenbrink <gam@rahul.net>
.SH VERSIONS
Version Date by Comments
.br
v1.0 12Apr96 GAM Original
.br
v1.1 18Nov96 GAM Permanent symbol table initialization error.
.br
v1.2 20Nov96 GAM Added BINPUNch and RIMPUNch pseudo-operators.
.br
v1.3 24Nov96 GAM Added DUBL pseudo-op (24 bit integer constants).
.br
v1.4 29Nov96 GAM Fixed bug in checksum generation.
.br
v2.1 08Dec96 GAM Added concordance processing (cross reference).
.br
v2.2 10Dec96 GAM Added FLTG psuedo-op (floating point constants).
.br
v2.3 2Feb97 GAM Fixed paging problem in cross reference output.
.br
v2.4 11Apr97 GAM Fixed problem with some labels being put in cross reference multiple times.
.br
v2.9 23Jun13 DJG David Gesswein djg@pdp8online.com
Combined versions found online and fixed many bugs.
Used source from v2.5 03Nov07 RK and
v2.6 14Jul03 PNT.
.SH AUTHOR
This manual page was written by Vince Mulhollon <vlm@execpc.com>,
for the Debian GNU/Linux system (but may be used by others).

4352
palbart/palbart.c Normal file
View File

File diff suppressed because it is too large Load Diff

218
rx02_image_dump/dumpdsk.pl Normal file
View File

@ -0,0 +1,218 @@
#!/usr/bin/perl -w
# Copyright (c) 2007 Don North
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
#
# o Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
#
# o Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# o Neither the name of the copyright holder nor the names of its
# contributors may be used to endorse or promote products derived from
# this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
# A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
# HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
# PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
# LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
# NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
require 5.008;
=head1 NAME
hdr - Standard template for a Perl module
=head1 SYNOPSIS
hdr
S<[--help]>
S<[--debug]>
S<[--verbose]>
S<[random arguments ...]>
=head1 DESCRIPTION
Description of the command ...
=head1 OPTIONS
The following options are available:
=over
=item B<--help>
Output this manpage and exit the program.
=item B<--debug>
Enable debug mode.
=item B<--verbose>
Verbose status reporting (not implemented).
=back
=head1 ERRORS
The following diagnostic error messages can be produced on STDERR.
The meaning should be fairly self explanatory.
C<List all the error messages here...> -- some error
=head1 EXAMPLES
Some examples of common usage:
hdr --help
hdr --verbose --string 'a string' --integer 5 some_other_argument
=head1 SEE ALSO
Related commands cross reference...
=head1 NOTES
Caveat emptor...
=head1 FILES
Any standard files used?
=head1 AUTHOR
Don North
=head1 HISTORY
Modification history:
2005-05-05 v0.0 donorth - Initial version.
=cut
# options
use strict;
# external standard modules
use Getopt::Long;
use Pod::Text;
use FindBin;
# external local modules search path
BEGIN { unshift(@INC, $FindBin::Bin);
unshift(@INC, $ENV{PERL5LIB}) if defined($ENV{PERL5LIB}); # cygwin bugfix
unshift(@INC, '.'); }
# external local modules
# generic defaults
my $VERSION = 'v0.1'; # version of code
my $ONWIN = $^O eq 'MSWin32'; # true if running under WinPerl
my $HELP = 0; # set to 1 for man page output
my $DEBUG = 0; # set to 1 for debug messages
my $VERBOSE = 0; # set to 1 for verbose messages
# specific defaults
# process command line arguments
my $NOERROR = GetOptions( "help" => \$HELP,
"debug" => \$DEBUG,
"verbose" => \$VERBOSE,
);
# init
$VERBOSE = 1 if $DEBUG; # debug implies verbose messages
# say hello
printf STDERR "dumpdsk.pl %s by Don North (perl %g)\n", $VERSION, $] if $VERBOSE;
# output the documentation
if ($HELP) {
# output a man page if we can
if (ref(Pod::Text->can('new')) eq 'CODE') {
# try the new way if appears to exist
my $parser = Pod::Text->new(sentence=>0, width=>78);
printf STDOUT "\n"; $parser->parse_from_file($0);
} else {
# else must use the old way
printf STDOUT "\n"; Pod::Text::pod2text(-78, $0);
};
exit(1);
}
# check for correct arguments present, print usage if errors
unless ($NOERROR && scalar(@ARGV) == 1) {
print STDERR "Usage: $0 [options...] arguments\n";
print STDERR <<"EOF";
--help output manpage and exit
--debug enable debug mode
--verbose verbose status reporting
DSKFILE binary .dsk file image
EOF
# exit if errors...
die "Aborted due to command line errors.\n";
}
#-------------------------------------------------------------------------------------
# read blocks from the disk image file
foreach my $file (@ARGV) {
if (open(DSK, "< $file")) {
my $SECperTRK = 26;
my $buf = undef;
my $cnt = -1;
my $blk = 0;
my $len = 128;
# read until EOF
while (!eof(DSK)) {
# read one block
$cnt = read(DSK, $buf, $len);
printf "ERROR: CNT<>LEN %d<>%d\n", $cnt, $len unless $cnt == $len;
# print it out
my $sec = ($blk % $SECperTRK)+1;
my $trk = int($blk / $SECperTRK);
printf "blk=%-4d trk=%-2d sec=%d\n", $blk,$trk,$sec;
my @buf = map {ord($_)} split(//,$buf);
my $i = 0;
while ($i < $cnt) {
printf " %02X", $buf[$i];
printf "\n" if $i % 16 == 15;
++$i;
}
printf "\n" unless $i % 16 == 15;
$blk++;
}
printf "Total of %d blocks read\n", $blk;
close(DSK);
} else {
die "Can't open file '$file'";
}
}
#-------------------------------------------------------------------------------------
exit;
# the end

36
rx02_image_dump/rx8e_image_dump.pl Normal file
View File

@ -0,0 +1,36 @@
#!/usr/bin/perl -w
foreach my $file (@ARGV) {
if (open(INP, "< $file")) {
my $size = (stat($file))[7];
die unless $size == 76*26*128 || $size == 77*26*128;
my ($sector,$track,$byte) = (1,0,undef);
$track++ if $size == 76*26*128;
while (!eof(INP)) {
my $sts = read(INP,$byte,128);
my @byte = unpack('C128',$byte);
my @rest = splice(@byte,-32,32);
my @word = map {0xFFF&((($byte[3*($_>>1)+2]<<16)|($byte[3*($_>>1)+1]<<8)|($byte[3*($_>>1)+0]))>>(($_%2)*12))} (0..63);
printf "\n%3d %2d ", $track, $sector;
printf "%1s%s => %s\n", '', join(' ',map {sprintf("%02X",$_)} @byte[0..11]), join(' ',map {sprintf("%04o",$_)} @word[0..7]);
printf "%8s%s => %s\n", '', join(' ',map {sprintf("%02X",$_)} @byte[12..23]), join(' ',map {sprintf("%04o",$_)} @word[8..15]);
printf "%8s%s => %s\n", '', join(' ',map {sprintf("%02X",$_)} @byte[24..35]), join(' ',map {sprintf("%04o",$_)} @word[16..23]);
printf "%8s%s => %s\n", '', join(' ',map {sprintf("%02X",$_)} @byte[36..47]), join(' ',map {sprintf("%04o",$_)} @word[24..31]);
printf "%8s%s => %s\n", '', join(' ',map {sprintf("%02X",$_)} @byte[48..59]), join(' ',map {sprintf("%04o",$_)} @word[32..39]);
printf "%8s%s => %s\n", '', join(' ',map {sprintf("%02X",$_)} @byte[60..71]), join(' ',map {sprintf("%04o",$_)} @word[40..47]);
printf "%8s%s => %s\n", '', join(' ',map {sprintf("%02X",$_)} @byte[72..83]), join(' ',map {sprintf("%04o",$_)} @word[48..55]);
printf "%8s%s => %s\n", '', join(' ',map {sprintf("%02X",$_)} @byte[84..95]), join(' ',map {sprintf("%04o",$_)} @word[56..63]);
if (0) {
printf "%7s[%s]\n", '', join(' ',map {sprintf("%02X",$_)} @rest[0..15]);
printf "%7s[%s]\n", '', join(' ',map {sprintf("%02X",$_)} @rest[16..31]);
}
$track++ if $sector==26;
$sector = $sector==26 ? 1 : $sector+1;
}
}
close(INP);
}
# the end

491
simhtape/simhtape.pl Normal file
View File

@ -0,0 +1,491 @@
#!/usr/bin/perl -w
#!/usr/local/bin/perl -w
# options
use strict;
# external standard modules
use Getopt::Long;
use Pod::Text;
use FindBin;
use FileHandle;
use File::Spec;
use File::Basename;
use File::Path qw( make_path );
# external local modules search path
BEGIN { unshift(@INC, $FindBin::Bin);
unshift(@INC, '.'); }
# external local modules
# generic defaults
my $VERSION = 'v1.0'; # version of code
my $HELP = 0; # set to 1 for man page output
my $DEBUG = 0; # set to >=1 for debug messages
my $VERBOSE = 0; # set to 1 for verbose messages
# specific defaults
my $TAPE = 'NONE'; # set to filename of .tap file
my $MODE = 'NONE'; # set to DUMP, EXTRACT, INSERT
my $PATH = '.'; # path to directory for EXTRACT of files
# process command line arguments
my $NOERROR = GetOptions( "help" => \$HELP,
"debug:1" => \$DEBUG,
"verbose" => \$VERBOSE,
"tape=s" => \$TAPE,
"path=s" => \$PATH,
"dump" => sub { $MODE = 'DUMP'; },
"extract:s" => sub { $MODE = 'EXTRACT'; $PATH = $_[1] if $_[1]; },
"insert" => sub { $MODE = 'INSERT'; },
);
# init
$VERBOSE = 1 if $DEBUG; # debug implies verbose messages
# output the documentation
if ($HELP) {
# output a man page if we can
if (ref(Pod::Text->can('new')) eq 'CODE') {
# try the new way if appears to exist
my $parser = Pod::Text->new(sentence=>0, width=>78);
printf STDOUT "\n"; $parser->parse_from_file($0);
} else {
# else must use the old way
printf STDOUT "\n"; Pod::Text::pod2text(-78, $0);
};
exit(1);
}
# check for correct arguments present, print usage if errors
unless ($NOERROR
&& $TAPE ne 'NONE'
&& $MODE ne 'NONE'
) {
printf STDERR "%s %s (perl %g)\n", $0, $VERSION, $];
print STDERR "Usage: $0 [options...] arguments\n";
print STDERR <<"EOF";
--help output manpage and exit
--debug=N enable debug mode 'N'
--verbose verbose status reporting
--tape=FILENAME name of SIMH .tap file
--dump dump tape contents
--extract extract tape contents to files
--insert FILES... insert files to tape
--path PATH directory for file access [.]
EOF
# exit if errors...
die "Aborted due to command line errors.\n";
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
my @r50asc = split('', ' ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789');
my %irad50 = map {$r50asc[$_],$_} (0..$#r50asc);
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# process tape file
if ($MODE eq 'DUMP') {
&_dump_tape($TAPE);
} elsif ($MODE eq 'EXTRACT') {
&_read_tape($TAPE);
} elsif ($MODE eq 'INSERT') {
&_write_tape($TAPE, \@ARGV);
}
exit;
################################################################################
# dump a full tape
sub _dump_tape {
my ($tape) = @_;
printf STDERR "Dumping tape image file '%s' ...\n", $tape if $VERBOSE;
# init some stats
my $tapemark = 0;
my %bytecount = ();
my %reccount = ();
# input file descriptor
if (open(my $ifh, '<', $tape)) {
# some support code
sub _dump { my ($p,$s) = @_; join(',',map(sprintf("%02X",$_),unpack($p,$s))); }
# loop over whole tape image file
while (1) {
my ($pre,$buf,$suf) = (undef,undef,undef);
# read the 4B record length, little endian
my $prelen = &_read($ifh, 4, \$pre);
last if $prelen == -1 || $prelen == 0; # exit on EOF, no more data
my $preval = unpack('V', $pre);
printf STDERR "\n prefix: len=%d val=%d pre=[%s]\n",
$prelen, $preval, &_dump('C*',$pre) if $DEBUG >= 1;
# a value of zero is a tape mark
if ($prelen == 4 && $preval == 0) {
printf STDERR " *** TAPE MARK ***\n" if $VERBOSE;
next;
}
# a value of -1 indicates EOF, as well as two sequential tapemarks
if ($tapemark == 2 || $prelen == 4 && $preval == 0xFFFFFFFF) {
printf STDERR " *** TAPE EOF ***\n" if $VERBOSE;
my $buflen = &_read($ifh, 1<<20, \$buf);
printf STDERR " extra: len=%d buf=[%s]\n",
$buflen, &_dump('C*',$buf) unless $buflen == 0;
last;
}
# reset tapemark flag
$tapemark = 0;
# read next data record depending upon prefix length
my $buflen = &_read($ifh, $preval, \$buf);
if ($VERBOSE) {
printf STDERR " buffer: len=%d buf=[%s,...]\n",
$buflen, &_dump('C20',$buf) if $DEBUG == 2;
printf STDERR " buffer: len=%d buf=[%s]\n",
$buflen, &_dump('C*',$buf) if $DEBUG >= 3;
if ($buflen == 80) {
# will be an ANSI header record
printf STDERR " alabel: [%s]\n", $buf;
}
}
# count records and data bytes
$reccount{$buflen} += 1;
$bytecount{$buflen} += $buflen;
# SIMH format has a record trailer
my $suflen = &_read($ifh, 4, \$suf);
my $sufval = unpack('V', $suf);
printf STDERR " suffix: len=%d val=%d suf=[%s]\n",
$suflen, $sufval, &_dump('C*',$suf) if $DEBUG >= 1;
# check for valid format
next if $prelen == 4 && $suflen == 4 && $preval == $sufval && $preval == $buflen;
# nope, something is unexpected
printf STDERR " format error: prelen=%d suflen=%d preval=%d sufval=%d buflen=%d\n",
$prelen, $suflen, $preval, $sufval, $buflen;
}
# we be done
close($ifh);
}
# overall counts
printf STDERR "\nDone\n" if $VERBOSE;
foreach my $i (sort({$a<=>$b}keys(%reccount))) {
printf STDERR "Saw %d records of length %d bytes; total %d bytes\n",
$reccount{$i},$i,$bytecount{$i} if $VERBOSE;
}
return;
}
################################################################################
# read a full tape
sub _read_tape {
my ($tape) = @_;
printf STDERR "Reading tape image file '%s' ...\n", $tape if $VERBOSE;
# init some stats
my $tapemark = 0;
my $vollabel = '';
my $filename = '';
my $filedate = '';
my $ofh = undef;
# input file descriptor
if (open(my $ifh, '<', $tape)) {
# loop over whole tape image file
while (1) {
my ($pre,$buf,$suf) = (undef,undef,undef);
# read the 4B record length, little endian
my $prelen = &_read($ifh, 4, \$pre);
last if $prelen == -1 || $prelen == 0; # exit on EOF, no more data
my $preval = unpack('V', $pre);
# a value of zero is a tape mark
next if $prelen == 4 && $preval == 0;
# a value of -1 indicates EOF, as well as two sequential tapemarks
last if $tapemark == 2 || $prelen == 4 && $preval == 0xFFFFFFFF;
# reset tapemark flag
$tapemark = 0;
# read next data record depending upon prefix length
my $buflen = &_read($ifh, $preval, \$buf);
# process header vs data vs trailer
if ($buflen == 80 && substr($buf, 0, 4) eq 'HDR1') {
# HDR1 has filename
$filename = &trim(substr($buf, 4, 17));
$filedate = substr($buf, 42, 5);
printf STDERR "Extracting file '%s' (%s)\n", $filename, $filedate if $VERBOSE;
printf STDERR "%s file=%s date=%s close\n", substr($buf,0,4), $filename, $filedate if $DEBUG;
make_path($PATH);
open($ofh, '>', File::Spec->catfile($PATH, $filename)) || die;
} elsif ($buflen == 80 && substr($buf, 0, 4) eq 'HDR2') {
# HDR2 info we don't use
} elsif ($buflen == 80 && substr($buf, 0, 4) eq 'EOF1') {
# EOF1 info we don;t use except to close file
printf STDERR "%s file=%s close\n", substr($buf,0,4), $filename if $DEBUG;
close($ofh);
} elsif ($buflen == 80 && substr($buf, 0, 4) eq 'EOF2') {
# EOF2 info we don't use
} elsif ($buflen == 80 && substr($buf, 0, 4) eq 'VOL1') {
# VOL1 has volume label
$vollabel = substr($buf, 4, 6);
} else {
# prune trailing zero bytes in record
my $skplen = 0;
while (ord(substr($buf,$buflen-$skplen-1,1)) == 0 && $skplen < $buflen) { ++$skplen; }
my $wrote = &_write($ofh, $buflen-$skplen, \$buf);
printf STDERR "DATA %d (%d)\n", $wrote, -$skplen if $DEBUG;
}
# SIMH format has a record trailer
my $suflen = &_read($ifh, 4, \$suf);
my $sufval = unpack('V', $suf);
# check for valid format
next if $prelen == 4 && $suflen == 4 && $preval == $sufval && $preval == $buflen;
# nope, something is unexpected
printf STDERR " format error: prelen=%d suflen=%d preval=%d sufval=%d buflen=%d\n",
$prelen, $suflen, $preval, $sufval, $buflen;
}
# we be done
close($ifh);
}
return;
}
################################################################################
# write a full tape
sub _write_tape {
my ($tape,$files) = @_;
printf STDERR "Writing tape image file '%s' ...\n", $tape if $VERBOSE;
# local state
my $vollab = 'RSTS';
my $blksiz = 512;
my $wrote = 0;
my $buf = undef;
my $hdr = pack('V', 80);
my $dat = pack('V', $blksiz);
# output file descriptor
if (open(my $ofh, '>', $tape)) {
# write volume label
$buf = sprintf("%-4s%-6s%-1s%-26s%-14s%-28s%-1s",
'VOL1', $vollab, '', '', 'D%B44310100101', '', '3');
$wrote = &_write($ofh, length($hdr), \$hdr);
$wrote = &_write($ofh, length($buf), \$buf);
$wrote = &_write($ofh, length($hdr), \$hdr);
# locals
my $filenumb = 0;
# loop over all files
foreach my $fullname (@$files) {
printf STDERR "Copy file '%s' ...\n", $fullname if $VERBOSE;
# locals
my $blocks = 0; # count blocks written
# open data file for reading
if (open(my $ifh, '<', File::Spec->catfile($fullname))) {
# strip any leading path from name, make uppercase
my $filename = uc((File::Spec->splitpath($fullname))[-1]);
my $filedate = 99050;
# write header1 label
$buf = sprintf("%-4s%-17s%-6s%04d%04d%04d%02d %05d %05d%1s%06d%-13s%-7s",
'HDR1', $filename, $vollab, 1, ++$filenumb, 1, 0, $filedate, $filedate, '', 0, 'DECRSTS/E', '');
$wrote = &_write($ofh, length($hdr), \$hdr);
$wrote = &_write($ofh, length($buf), \$buf);
$wrote = &_write($ofh, length($hdr), \$hdr);
# write header2 label
$buf = sprintf("%-4s%1s%05d%05d%21s%1s%13s%02d%28s",
'HDR2', 'U', $blksiz, 0, '', 'M', '', 0, '');
$wrote = &_write($ofh, length($hdr), \$hdr);
$wrote = &_write($ofh, length($buf), \$buf);
$wrote = &_write($ofh, length($hdr), \$hdr);
# write a record mark
$buf = pack('V', 0);
$wrote = &_write($ofh, length($buf), \$buf);
# copy all the data, blocked to 512 byte records
while ((my $count = &_read($ifh, $blksiz, \$buf)) > 0) {
# write a data block
$wrote = &_write($ofh, length($dat), \$dat);
$wrote = &_write($ofh, length($buf), \$buf);
if ($count < $blksiz) {
# pad out short blocks to blocksize
$buf = pack(sprintf("x[%d]",$blksiz-$count));
$wrote += &_write($ofh, length($buf), \$buf);
}
$wrote = &_write($ofh, length($dat), \$dat);
# count blocks
++$blocks;
}
# write a record mark
$buf = pack('V', 0);
$wrote = &_write($ofh, length($buf), \$buf);
# write trailer1 label
$buf = sprintf("%-4s%-17s%-6s%04d%04d%04d%02d %05d %05d%1s%06d%-13s%-7s",
'EOF1', $filename, $vollab, 1, $filenumb, 1, 0, $filedate, $filedate, '', $blocks, 'DECRSTS/E', '');
$wrote = &_write($ofh, length($hdr), \$hdr);
$wrote = &_write($ofh, length($buf), \$buf);
$wrote = &_write($ofh, length($hdr), \$hdr);
# write trailer2 label
$buf = sprintf("%-4s%1s%05d%05d%21s%1s%13s%02d%28s",
'EOF2', 'U', $blksiz, 0, '', 'M', '', 0, '');
$wrote = &_write($ofh, length($hdr), \$hdr);
$wrote = &_write($ofh, length($buf), \$buf);
$wrote = &_write($ofh, length($hdr), \$hdr);
# write a record mark
$buf = pack('V', 0);
$wrote = &_write($ofh, length($buf), \$buf);
close($ifh);
}
} # foreach my $filename
# write an end of media as two record marks
$buf = pack('V', 0);
$wrote = &_write($ofh, length($buf), \$buf);
$wrote = &_write($ofh, length($buf), \$buf);
# we be done
close($ofh);
}
return;
}
################################################################################
# read LENGTH bytes from FH to BUFFER
sub _read {
my ($fh, $length, $buffer) = @_;
my $offset = 0;
$$buffer = '';
while ($length > 0) {
my $count = sysread($fh, $$buffer, $length, $offset);
return -1 unless defined($count);
return length($$buffer) if $count == 0;
$length -= $count;
$offset += $count;
}
return length($$buffer);
}
################################################################################
# write LENGTH bytes from BUFFER to FH
sub _write {
my ($fh, $length, $buffer) = @_;
my $offset = 0;
while ($length > 0) {
my $count = syswrite($fh, $$buffer, $length, $offset);
return -1 unless defined($count);
$length -= $count;
$offset += $count;
}
return $offset;
}
################################################################################
# rad50 decoder
sub rad50dec {
my $str = '';
foreach my $word (@_) {
my $trip = '';
foreach my $n (1..3) {
my $char = $word % 40;
$word = ($word - $char) / 40;
$trip = $r50asc[$char] . $trip;
}
$str .= $trip;
}
return $str;
}
# rad50 encoder
sub rad50enc {
my ($str) = join('',@_);
$str .= ' ' x (3 - length($str) % 3) if length($str) % 3;
my @out = ();
while (length($str)) {
my $word = 0;
foreach my $char (split('', substr($str,0,3,''))) {
$word *= 40;
$word += exists($irad50{$char}) ? $irad50{$char} : $irad50{'?'};
}
push @out, $word;
}
return pack 'n*', @out;
}
# space trim
sub trim {
my ($str) = join('',@_);
$str =~ s/\s+$//g;
return $str;
}
################################################################################
# the end