github.com/DoctorWkt.pdp7-unix
1
0
Fork 0
mirror of https://github.com/DoctorWkt/pdp7-unix.git synced 2026-01-28 04:58:08 +00:00
Code Issues Releases Wiki Activity
Files
acabff96889b600b3fa99883e17d4018fb10dd51
DoctorWkt.pdp7-unix/tools/a7out
Warren Toomey d6d4c9b814 According to cat.s, fd 8 is standard error (not fd2!). I've updated 
the a7out simulator to have STDERR on fd 8.
2016-02-26 22:37:03 +10:00

490 lines
13 KiB
Perl
Executable File
Raw Blame History

#!/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
### 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( shift(@ARGV) );
set_arguments(@ARGV);
#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 .. 017777 ) {
$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 017777 that points at the array.
###
### At the moment, this is NOT what PDP-7 Unix uses, but it's
### a start and it will help us to grok the real thing.
###
### For now, assume abc, def and ghi are stored in memory.
### The layout of the pointers and strings would be:
###
### +-------+
### | |
### | +-----|---------+
### | | | |
### | | +---|---------|---------+
### | | | | | |
### | | | V V V
### |o|o|o|0|<ab>|<c 0|<de>|<f 0|<gh>|<i 0|o|
### ^ |
### | |
### +-------------------------------------+
### 0 0 0 0 0 0 0 0 0 0 0
### 1 1 1 1 1 1 1 1 1 1 1
### 7 7 7 7 7 7 7 7 7 7 7
### 7 7 7 7 7 7 7 7 7 7 7
### 6 6 6 7 7 7 7 7 7 7 7
### 5 6 7 0 1 2 3 4 5 6 7
###
sub set_arguments {
# No arguments, set the 017777 pointer to 017776 which is NULL
if (@ARGV==0) {
$Mem[ 017777 ] = 017776;
print( STDERR "No arguments, so NULL 017777 pointer\n") if ($debug);
return;
}
# Count the number of words to store each string and its pointer
my $wordcount=2; # 2 as we count the NULL pointer at end of array
my $argcount= @ARGV;
foreach my $arg (@ARGV) {
# +1 before /2 to allow for the NUL character at end of string
# += +1 to include the pointer to the string
$wordcount += 1 + ( (length($arg) +1)/2);
}
my $arraybase= 017777 - $wordcount;
my $stringbase= $arraybase + $argcount + 1; # include NULL pointer
$Mem[ 017777 ] = $arraybase;
# Now copy each string into memory and initialise the pointer
foreach my $arg (@ARGV) {
$Mem[$arraybase++]= $stringbase;
$stringbase= string2mem($arg, $stringbase);
}
}
### 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("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 & 017777;
# Work out what any indirect address would be
my $indaddr= ($indirect) ? $Mem[$addr] & 017777 : $addr;
printf( STDERR
"PC %06o: instr %06o, op %03o, ind %o, addr %06o ind %06o\n",
$PC, $instruction, $opcode, $indirect, $addr, $indaddr )
if ($debug);
# 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 );
die("\n");
}
}
}
# Debug code: dump memory contents
sub dump_memory {
foreach my $i ( 0 .. 017777 ) {
printf( STDERR "%06o: %06o\n", $i, $Mem[$i] ) if ( $Mem[$i] != 0 );
}
}
# Load AC
sub lac {
my ( $instruction, $addr, $indaddr ) = @_;
printf( STDERR "PC %06o: lac %05o (value %06o) into AC\n",
$PC, $indaddr, $Mem[$indaddr] )
if ($debug);
$AC = $Mem[$indaddr];
$PC++;
}
# Deposit AC
sub dac {
my ( $instruction, $addr, $indaddr ) = @_;
printf( STDERR "PC %06o: dac AC (value %06o) into %05o\n",
$PC, $AC, $indaddr )
if ($debug);
$Mem[$indaddr] = $AC;
$PC++;
}
# Add to AC
sub tad {
my ( $instruction, $addr, $indaddr ) = @_;
printf( STDERR "PC %06o: tac AC (value %06o) from addr %05o\n",
$PC, $AC, $indaddr )
if ($debug);
$AC+= $Mem[$indaddr];
$PC++;
}
# Jump
sub jmp {
my ( $instruction, $addr, $indaddr ) = @_;
printf( STDERR "PC %06o: jmp %06o\n", $PC, $indaddr ) if ($debug);
$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
printf( STDERR "PC %06o: spa AC %06o\n", $PC, $AC ) if ($debug);
# 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
printf( STDERR "PC %06o: sna AC %06o\n", $PC, $AC ) if ($debug);
$PC += ( $AC != 0 ) ? 2 : 1;
return;
}
if ( $instruction == 0740200 ) { # sza: skip on zero AC
printf( STDERR "PC %06o: sza AC %06o\n", $PC, $AC ) if ($debug);
$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 );
die("\n");
}
}
# Exit system call
sub sys_exit {
printf( STDERR "PC %06o: exit system call\n", $PC ) if ($debug);
exit(0);
}
# Close system call
sub sys_close {
# AC is the file descriptor
my $fd = $AC;
printf( STDERR "PC %06o: close: closing fd %d\n", $PC, $fd ) if ($debug);
# Bump up the PC
$PC += 1;
# That filehandle is not open, set an error -1 in octal
if ( !defined( $FD[$fd] ) ) {
print( STDERR "close: fd $fd is not open\n") if ($debug);
$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 = mem2string($start);
printf( STDERR "PC %06o: open: file %s\n", $PC, $filename ) if ($debug);
# 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
print( STDERR "open failed: $!\n") if ($debug);
$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;
printf( STDERR "PC %06o: read: %d words into %o from fd %d\n",
$PC, $count, $start, $fd )
if ($debug);
# Bump up the PC
$PC += 3;
# That filehandle is not open, set an error -1 in octal
if ( !defined( $FD[$fd] ) ) {
print( STDERR "read: fd $fd is not open\n") if ($debug);
$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;
printf( STDERR "PC %06o: write: %d words from %o to fd %d\n",
$PC, $count, $start, $fd )
if ($debug);
# Bump up the PC
$PC += 3;
# That filehandle is not open, set an error -1 in octal
if ( !defined( $FD[$fd] ) ) {
print( STDERR "write: fd $fd is not open\n") if ($debug);
$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 word in memory, interpret that location
# and those following as a NUL-terminated ASCII string and return
# a copy of this string
sub mem2string {
my $addr = shift;
my $result = "";
while (1) {
# Stop when the address leave the 8K word address space
return ($result) if ( $addr > 017777 );
# 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++;
}
}
# Given a string and the address of a word in memory, copy
# the string into memory starting at that address and NUL
# terminate the string. Return the first address after the string.
#
# We will go off the end of the string: suppress warnings
no warnings ('substr');
sub string2mem {
my ($str, $base)= @_;
# <= length so we go off the end and insert a NUL
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), $base);
$Mem[$base++]= (ord($c1) << 9 ) | ord($c2);
}
return($base);
}
Reference in New Issue View Git Blame Copy Permalink