mirror of
https://github.com/DoctorWkt/pdp7-unix.git
synced 2026-01-26 20:22:50 +00:00
fafeae7470
line memory storage convention, and I've rewritten tools/wktcat.s to deal with this. I've imported some code from the real cat.s and now wktcat.s actually works as per the real cat.s.
500 lines
13 KiB
Perl
Executable File
500 lines
13 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# a7out: user-mode simulator for PDP-7 Unix applications
|
|
#
|
|
# (c) 2016 Warren Toomey, GPL3
|
|
#
|
|
use strict;
|
|
use warnings;
|
|
use Data::Dumper;
|
|
|
|
### Global variables ###
|
|
my $debug = 0; # Debug flag
|
|
my @Mem; # 8K 18-bit words of main memory
|
|
my @FD; # Array of open filehandles
|
|
|
|
# Registers
|
|
my $PC = 0; # Program counter
|
|
my $AC; # Accumulator
|
|
my $LINK; # Link register
|
|
my $MQ; # MQ register
|
|
|
|
# Constants
|
|
my $MAXINT = 0777777; # Biggest unsigned integer
|
|
my $MAXADDR = 017777; # Largest memory address
|
|
|
|
### Main program ###
|
|
|
|
# Optional debug argument
|
|
if ( ( @ARGV > 0 ) && ( $ARGV[0] eq "-d" ) ) {
|
|
$debug = 1; shift(@ARGV);
|
|
}
|
|
|
|
# Check the arguments
|
|
die("Usage: $0 [-d] a.outfile [arg1 arg2 ...]\n") if ( @ARGV < 1 );
|
|
|
|
# Load the a.out file into memory
|
|
# and simulate it
|
|
load_code( $ARGV[0] );
|
|
set_arguments();
|
|
#dump_memory();
|
|
#exit(0);
|
|
simulate();
|
|
exit(0);
|
|
|
|
### Load the a.out file into memory
|
|
sub load_code {
|
|
my $filename = shift;
|
|
|
|
# Fill all the 8K words in memory with zeroes
|
|
foreach my $i ( 0 .. $MAXADDR ) {
|
|
$Mem[$i] = 0;
|
|
}
|
|
|
|
# Set up two file open filehandles
|
|
$FD[0] = \*STDIN;
|
|
$FD[1] = \*STDOUT;
|
|
$FD[8] = \*STDERR; # According to cat.s (uses d8 == 8)
|
|
|
|
# Open up the file
|
|
open( my $IN, "<", $filename ) || die("Unable to open $filename: $!\n");
|
|
while (<$IN>) {
|
|
chomp;
|
|
|
|
# Lose any textual stuff after a tab character
|
|
$_ =~ s{\t.*}{};
|
|
|
|
# Split into location and value, both in octal
|
|
my ( $loc, $val ) = split( /:\s+/, $_ );
|
|
|
|
# Convert from octal and save
|
|
$loc = oct($loc);
|
|
$val = oct($val);
|
|
$Mem[$loc] = $val;
|
|
}
|
|
close($IN);
|
|
}
|
|
|
|
### Copy the arguments into the PDP-7 memory space, and build
|
|
### an array of pointers to these arguments. Build a pointer
|
|
### at $MAXADDR that points at the array.
|
|
###
|
|
### Each argument string is four words long and space padded if the
|
|
### string is not eight characters long. These are stored below
|
|
### address $MAXADDR. Below this is the count of words in the strings.
|
|
### Address $MAXADDR points at the word count. Graphically (for two arguments):
|
|
###
|
|
### +------------+
|
|
### +--| | Location 017777 ($MAXADDR)
|
|
### | +------------+
|
|
### | |............|
|
|
### | |............| argv[2]
|
|
### | |............|
|
|
### | +------------+
|
|
### | |............|
|
|
### | |............| argv[1]
|
|
### | |............|
|
|
### | +------------+
|
|
### | |............|
|
|
### | |............| argv[0]
|
|
### | |............|
|
|
### | +------------+
|
|
### +->| argc=12 |
|
|
### +------------+
|
|
###
|
|
sub set_arguments {
|
|
# Get the number of arguments including the command name
|
|
my $argc= scalar(@ARGV);
|
|
|
|
# We now know that argc will appear in memory
|
|
# 4*argc +1 below location $MAXADDR
|
|
# Set argc to the number of words
|
|
my $addr= $MAXADDR - (4*$argc+1);
|
|
$Mem[ $MAXADDR ] = $addr;
|
|
$Mem[ $addr++ ] = $argc*4;
|
|
|
|
# Now start saving the arguments
|
|
foreach (@ARGV) {
|
|
# Truncate and/or space pad the argument
|
|
my $str= sprintf("%-8s", substr($_, 0, 8));
|
|
|
|
# Store pairs of characters into memory
|
|
for (my $i=0; $i < length($str); $i += 2) {
|
|
my $c1= substr($str, $i, 1) || "";
|
|
my $c2= substr($str, $i+1, 1) || "";
|
|
#printf("Saving %06o to %05o\n", (ord($c1) << 9 ) | ord($c2), $addr);
|
|
$Mem[$addr++]= (ord($c1) << 9 ) | ord($c2);
|
|
}
|
|
}
|
|
}
|
|
|
|
### Simulate the machine code loaded into memory
|
|
sub simulate {
|
|
|
|
# List of opcodes that we can simulate
|
|
my %Oplist = (
|
|
oct("004") => \&dac,
|
|
oct("020") => \&lac,
|
|
oct("034") => \&tad,
|
|
oct("054") => \&sad,
|
|
oct("060") => \&jmp,
|
|
oct("070") => \&iot,
|
|
oct("074") => \&special,
|
|
);
|
|
|
|
# Loop indefinitely
|
|
while (1) {
|
|
|
|
# Get the instruction pointed to by PC and decode it
|
|
my $instruction = $Mem[$PC];
|
|
my $opcode = ( $instruction >> 12 ) & 074;
|
|
my $indirect = ( $instruction >> 13 ) & 1;
|
|
my $addr = $instruction & $MAXADDR;
|
|
|
|
# Work out what any indirect address would be
|
|
my $indaddr= ($indirect) ? $Mem[$addr] & $MAXADDR : $addr;
|
|
#dprintf( "PC %06o: instr %06o, op %03o, ind %o, addr %06o ind %06o\n",
|
|
# $PC, $instruction, $opcode, $indirect, $addr, $indaddr );
|
|
|
|
# Simulate the instruction. Each subroutine updates the $PC
|
|
if ( defined( $Oplist{$opcode} ) ) {
|
|
$Oplist{$opcode}->( $instruction, $addr, $indaddr );
|
|
} else {
|
|
printf( STDERR "Unknown instruction 0%o at location 0%o\n",
|
|
$instruction, $PC );
|
|
exit(1);
|
|
}
|
|
}
|
|
}
|
|
|
|
# Debug code: dump memory contents
|
|
sub dump_memory {
|
|
foreach my $i ( 0 .. $MAXADDR ) {
|
|
printf( STDERR "%06o: %06o\n", $i, $Mem[$i] ) if ( $Mem[$i] != 0 );
|
|
}
|
|
}
|
|
|
|
# Load AC
|
|
sub lac {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "PC %06o: lac %05o (value %06o) into AC\n",
|
|
$PC, $indaddr, $Mem[$indaddr] );
|
|
$AC = $Mem[$indaddr];
|
|
$PC++;
|
|
}
|
|
|
|
# Deposit AC
|
|
sub dac {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "PC %06o: dac AC (value %06o) into %05o\n",
|
|
$PC, $AC, $indaddr );
|
|
$Mem[$indaddr] = $AC;
|
|
$PC++;
|
|
}
|
|
|
|
# Add to AC
|
|
sub tad {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "PC %06o: tad AC (value %06o) from addr %05o\n",
|
|
$PC, $AC, $indaddr );
|
|
$AC= ($AC + $Mem[$indaddr]) & $MAXINT;
|
|
$PC++;
|
|
}
|
|
|
|
# Skip if AC different to Y
|
|
sub sad {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "PC %06o: sad AC %06o cf. %06o\n", $PC, $AC, $Mem[$indaddr]);
|
|
$PC += ($AC != $Mem[$indaddr]) ? 2 : 1;
|
|
}
|
|
|
|
# Jump
|
|
sub jmp {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "PC %06o: jmp %06o\n", $PC, $indaddr );
|
|
$PC = $indaddr;
|
|
}
|
|
|
|
# Special instructions
|
|
sub special {
|
|
my $instruction = shift;
|
|
|
|
# Deal with each one in turn
|
|
# hlt
|
|
if ( $instruction == 0740040 ) {
|
|
printf( STDERR "PC %06o: program halted\n", $PC );
|
|
dump_memory() if ($debug);
|
|
exit(1);
|
|
}
|
|
if ( $instruction == 0741100 ) { # spa: skip on positive AC
|
|
dprintf( "PC %06o: spa AC %06o\n", $PC, $AC );
|
|
# Because we are dealing with 18 bits, compare the range
|
|
$PC += ( ($AC >= 0) && ($AC < 0400000) ) ? 2 : 1;
|
|
return;
|
|
}
|
|
if ( $instruction == 0741200 ) { # sna: skip on non-zero AC
|
|
dprintf( "PC %06o: sna AC %06o\n", $PC, $AC );
|
|
$PC += ( $AC != 0 ) ? 2 : 1;
|
|
return;
|
|
}
|
|
if ( $instruction == 0740200 ) { # sza: skip on zero AC
|
|
dprintf( "PC %06o: sza AC %06o\n", $PC, $AC );
|
|
$PC += ( $AC == 0 ) ? 2 : 1;
|
|
return;
|
|
}
|
|
printf( STDERR "PC %06o: unknown instruction %06o\n", $PC, $instruction );
|
|
exit(1);
|
|
}
|
|
|
|
# I/O transfer: used for system calls
|
|
sub iot {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
|
|
# Syscalls that we can simulate
|
|
my %Syscallist = (
|
|
3 => \&sys_open,
|
|
4 => \&sys_read,
|
|
5 => \&sys_write,
|
|
9 => \&sys_close,
|
|
14 => \&sys_exit,
|
|
);
|
|
|
|
# Simulate the syscall. Each syscall updates the $PC
|
|
if ( defined( $Syscallist{$addr} ) ) {
|
|
$Syscallist{$addr}->();
|
|
} else {
|
|
printf( STDERR "PC %06o: Unknown syscall %d\n", $PC, $addr );
|
|
exit(1);
|
|
}
|
|
}
|
|
|
|
# Exit system call
|
|
sub sys_exit {
|
|
dprintf( "PC %06o: exit system call\n", $PC );
|
|
exit(0);
|
|
}
|
|
|
|
# Close system call
|
|
sub sys_close {
|
|
|
|
# AC is the file descriptor
|
|
my $fd = $AC;
|
|
dprintf( "PC %06o: close: closing fd %d\n", $PC, $fd );
|
|
|
|
# Bump up the PC
|
|
$PC += 1;
|
|
|
|
# That filehandle is not open, set an error -1 in octal
|
|
if ( !defined( $FD[$fd] ) ) {
|
|
dprint( "close: fd $fd is not open\n");
|
|
$AC = 0777777;
|
|
return;
|
|
}
|
|
close( $FD[$fd] );
|
|
$FD[$fd] = undef;
|
|
$AC = 0;
|
|
return;
|
|
}
|
|
|
|
# Open system call
|
|
sub sys_open {
|
|
|
|
# Open seems to have arguments: PC+1 has a pointer to the filename,
|
|
# PC+2 and PC+3 I don't know yet, probably read/write and mask?
|
|
# AC is the opened fd on success, or -1 on error
|
|
|
|
# Get the start address of the string
|
|
my $start = $Mem[ $PC + 1 ];
|
|
|
|
# Bump up the PC
|
|
$PC += 4;
|
|
|
|
# Convert this to a sensible ASCII filename
|
|
my $filename = mem2arg($start);
|
|
dprintf( "PC %06o: open: file %s\n", $PC, $filename );
|
|
|
|
# Open the file
|
|
if ( open( my $FH, "<", $filename ) ) {
|
|
|
|
# Find a place in the @FD array to store this filehandle. 99 is arbitrary
|
|
foreach my $fd ( 0 .. 99 ) {
|
|
if ( !defined( $FD[$fd] ) ) {
|
|
$FD[$fd] = $FH;
|
|
$AC = $fd;
|
|
last;
|
|
}
|
|
}
|
|
return;
|
|
} else {
|
|
# No filehandle, so it's an error
|
|
dprintf( "open failed: $!\n");
|
|
$AC = 0777777;
|
|
return;
|
|
}
|
|
}
|
|
|
|
# Read system call
|
|
sub sys_read {
|
|
|
|
# Read seems to have arguments: AC is the file descriptor, PC+1 is
|
|
# the pointer to the buffer and PC+2 is the number of words to read.
|
|
# Return the number of words read in AC on success, or -1 on error.
|
|
|
|
# Get the file descriptor, start address and end address
|
|
my $fd = $AC;
|
|
my $start = $Mem[ $PC + 1 ];
|
|
my $count = $Mem[ $PC + 2 ];
|
|
my $end = ($start + $count - 1) & $MAXADDR;
|
|
die("sys_read: bad start/end addresses $start $end\n") if ($end < $start);
|
|
dprintf( "PC %06o: read: %d words into %o from fd %d\n",
|
|
$PC, $count, $start, $fd );
|
|
|
|
# Bump up the PC
|
|
$PC += 3;
|
|
|
|
# That filehandle is not open, set an error -1 in octal
|
|
if ( !defined( $FD[$fd] ) ) {
|
|
dprint( "read: fd $fd is not open\n");
|
|
$AC = 0777777;
|
|
return;
|
|
}
|
|
|
|
# Read each word in
|
|
my $FH = $FD[$fd];
|
|
$count = 0;
|
|
foreach my $addr ( $start .. $end ) {
|
|
|
|
# It's a terminal, so convert from ASCII
|
|
if ( -t $FH ) {
|
|
my $c1 = getc($FH);
|
|
last if ( !defined($c1) ); # No character, leave the loop
|
|
my $c2 = getc($FH) || ""; # No character, make it a NUL
|
|
$Mem[$addr] =
|
|
( ord($c1) << 9 ) | ord($c2); # Pack both into one word
|
|
$count++;
|
|
} else {
|
|
# otherwise (for now) read in one line and convert to octal
|
|
my $line = <$FH>;
|
|
last if ( !defined($line) ); # No line, leave the loop
|
|
chomp($line);
|
|
$Mem[$addr] = oct($line) & 0777777;
|
|
$count++;
|
|
}
|
|
}
|
|
|
|
# No error
|
|
$AC = $count;
|
|
return;
|
|
}
|
|
|
|
# Write system call
|
|
sub sys_write {
|
|
|
|
# Write seems to have arguments: AC is the file descriptor, PC+1 is
|
|
# the pointer to the buffer and PC+2 is the number of words to write
|
|
|
|
# Get the file descriptor, start address and end address
|
|
my $fd = $AC;
|
|
my $start = $Mem[ $PC + 1 ];
|
|
my $count = $Mem[ $PC + 2 ];
|
|
my $end = ($start + $count - 1) & $MAXADDR;
|
|
die("sys_write: bad start/end addresses $start $end\n") if ($end < $start);
|
|
dprintf( "PC %06o: write: %d words from %o to fd %d\n",
|
|
$PC, $count, $start, $fd );
|
|
|
|
# Bump up the PC
|
|
$PC += 3;
|
|
|
|
# That filehandle is not open, set an error -1 in octal
|
|
if ( !defined( $FD[$fd] ) ) {
|
|
dprint( "write: fd $fd is not open\n");
|
|
$AC = 0777777;
|
|
return;
|
|
}
|
|
|
|
# Write each word out
|
|
my $FH = $FD[$fd];
|
|
foreach my $addr ( $start .. $end ) {
|
|
|
|
# It's a terminal, so convert to ASCII
|
|
# otherwise (for now) print in octal
|
|
if ( -t $FH ) {
|
|
print( $FH word2ascii( $Mem[$addr] ) );
|
|
} else {
|
|
printf( $FH "%06o\n", $Mem[$addr] );
|
|
}
|
|
}
|
|
|
|
# No error
|
|
$AC = 0;
|
|
return;
|
|
}
|
|
|
|
# Convert an 18-bit word into two ASCII characters and return them.
|
|
# Don't return NUL characters
|
|
sub word2ascii {
|
|
my $word = shift;
|
|
my $c1 = ( $word >> 9 ) & 0177;
|
|
my $c2 = $word & 0177;
|
|
my $result = "";
|
|
$result .= chr($c1) if ($c1);
|
|
$result .= chr($c2) if ($c2);
|
|
return ($result);
|
|
}
|
|
|
|
# Given the address of a four word argument string in
|
|
# memory, return a copy of the string in ASCII format.
|
|
# Lose any trailing spaces as well.
|
|
sub mem2arg {
|
|
my $addr = shift;
|
|
my $result = "";
|
|
|
|
foreach (1 .. 4) {
|
|
# Stop if the address leave the 8K word address space
|
|
last if ( $addr > $MAXADDR );
|
|
my $word = $Mem[$addr++];
|
|
my $c1 = ( $word >> 9 ) & 0177;
|
|
my $c2 = $word & 0177;
|
|
$result .= chr($c1) . chr($c2);
|
|
}
|
|
$result=~ s{ *$}{};
|
|
return($result);
|
|
}
|
|
|
|
# Given the address of a word in memory, interpret that location
|
|
# and those following as a NUL-terminated ASCII string and return
|
|
# a copy of this string
|
|
# XXX: not sure if I still need this.
|
|
sub mem2string {
|
|
my $addr = shift;
|
|
my $result = "";
|
|
|
|
while (1) {
|
|
|
|
# Stop when the address leave the 8K word address space
|
|
return ($result) if ( $addr > $MAXADDR );
|
|
|
|
# Stop when the value there is zero
|
|
my $word = $Mem[$addr];
|
|
return ($result) if ( $word == 0 );
|
|
|
|
# Get the top ASCII character, return if NUL
|
|
my $c1 = ( $word >> 9 ) & 0177;
|
|
return ($result) if ( $c1 == 0 );
|
|
$result .= chr($c1);
|
|
|
|
# Get the bottom ASCII character, return if NUL
|
|
my $c2 = $word & 0177;
|
|
return ($result) if ( $c2 == 0 );
|
|
$result .= chr($c2);
|
|
|
|
# Move up to the next address
|
|
$addr++;
|
|
}
|
|
}
|
|
|
|
# Print out debug messages
|
|
sub dprintf {
|
|
printf( STDERR @_) if ($debug);
|
|
}
|