mirror of
https://github.com/DoctorWkt/pdp7-unix.git
synced 2026-01-27 04:32:25 +00:00
516 lines
14 KiB
Perl
Executable File
516 lines
14 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 = 0; # Link register
|
|
my $MQ; # MQ register
|
|
|
|
# Constants
|
|
use constant MAXINT => 0777777; # Biggest unsigned integer
|
|
use constant 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("010") => \&jms,
|
|
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, in %o, addr %06o indaddr %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;
|
|
}
|
|
|
|
# Jump to subroutine
|
|
sub jms {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "PC %06o: jms %06o\n", $PC, $indaddr );
|
|
|
|
# Save the LINK and current PC into the $indaddr location
|
|
$Mem[$indaddr++]= $PC+1 | (($LINK) ? 0400000 : 0);
|
|
$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 <= MAXINT) ) ? 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;
|
|
}
|
|
if ( ($instruction >= 0760000) && ($instruction <= MAXINT) ) { # law: load word into AC
|
|
dprintf( "PC %06o: law %06o into AC\n", $PC, $instruction);
|
|
$AC = $instruction;
|
|
$PC++; 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 = MAXINT;
|
|
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 = MAXINT;
|
|
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 = MAXINT;
|
|
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) & MAXINT;
|
|
$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 = MAXINT;
|
|
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);
|
|
}
|