github.com/DoctorWkt.pdp7-unix
1
0
Fork 0
mirror of https://github.com/DoctorWkt/pdp7-unix.git synced 2026-01-31 05:52:36 +00:00
Code Issues Releases Wiki Activity
Files
a17ba2eec37812ebedfef7eaadc09fea9eeacdb5
DoctorWkt.pdp7-unix/tools/a7out
Warren Toomey 220f87efed Rewording of the a7out help text.
2016-02-29 17:10:25 +10:00

801 lines
22 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 $singlestep = 0; # Are we running in single-step mode?
my %Breakpoint; # Hash of defined breakpoints
my @Mem; # 8K 18-bit words of main memory
my @FD; # Array of open filehandles
# Registers
my $PC = 0; # Program counter
my $AC = 0; # Accumulator
my $LINK = 0; # Link register, either 0 or LINKMASK
my $MQ = 0; # MQ register
# Constants
use constant MAXINT => 0777777; # Biggest unsigned integer
use constant MAXPOSINT => 0377777; # Biggest signed integer
use constant MAXADDR => 017777; # Largest memory address
use constant LINKMASK => 01000000; # Mask for LINK register
use constant EAESTEP => 077; # EAE step count mask
### Main program ###
# Get any optional arguments
while ( defined( $ARGV[0] ) && ( $ARGV[0] =~ m{^-} ) ) {
# -d: debug mode
if ( $ARGV[0] eq "-d" ) {
$debug = 1; shift(@ARGV);
}
# -b: set a breakpoint
if ( $ARGV[0] eq "-b" ) {
$singlestep = 1; shift(@ARGV);
$Breakpoint{ oct( shift(@ARGV) ) } = 1;
}
}
# Check the arguments
die("Usage: $0 [-d] [-b breakpoint] 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(0, MAXADDR, 0);
#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 some open filehandles
$FD[0] = \*STDIN;
$FD[1] = \*STDOUT;
$FD[8] = \*STDERR; # According to cat.s (uses d8 == 8)
# Open up the PDP-7 executable 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 %06o\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("000") => \&cal,
oct("004") => \&dac,
oct("010") => \&jms,
oct("014") => \&dzm,
oct("020") => \&lac,
oct("030") => \&add,
oct("024") => \&xor,
oct("034") => \&tad,
oct("044") => \&isz,
oct("050") => \&and,
oct("054") => \&sad,
oct("060") => \&jmp,
oct("064") => \&eae,
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;
# If this is a breakpoint, stop now and get a user command
$singlestep = 1 if ( defined( $Breakpoint{$PC} ) );
get_user_command() if ($singlestep);
dprintf( "PC %06o: ", $PC );
#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
# Print from $start to $end.
# Print empty locations if $yeszero
sub dump_memory {
my ( $start, $end, $yeszero ) = @_;
foreach my $i ( $start .. $end ) {
printf( STDERR "%06o: %06o\n", $i, $Mem[$i] )
if ( $yeszero || $Mem[$i] != 0 );
}
}
# Load AC
sub lac {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "lac %06o (value %06o) into AC\n", $indaddr, $Mem[$indaddr] );
$AC = $Mem[$indaddr];
$PC++;
}
# Deposit AC
sub dac {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "dac AC (value %06o) into %06o\n", $AC, $indaddr );
$Mem[$indaddr] = $AC;
$PC++;
}
# Add to AC, twos complement
sub tad {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "tad AC (value %06o) with addr %06o (%06o)\n",
$AC, $indaddr, $Mem[$indaddr] );
$AC = $AC + $Mem[$indaddr];
$AC = $AC & MAXINT;
$LINK = $AC & LINKMASK;
$PC++;
}
# Add to AC, ones complement
sub add {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "add AC (value %06o) with addr %06o (%06o)\n",
$PC, $AC, $indaddr, $Mem[$indaddr] );
$LINK = 0;
$AC = $AC + $Mem[$indaddr];
if ( $AC & LINKMASK ) {
$AC++; # End-around carry
$LINK = LINKMASK;
}
$AC = $AC & MAXINT;
$PC++;
}
# And AC and Y
sub and {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "and AC (value %06o) with addr %06o (%06o)\n",
$AC, $indaddr, $Mem[$indaddr] );
$AC &= $Mem[$indaddr];
$PC++;
}
# Xor AC and Y
sub xor {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "xor AC (value %06o) with addr %06o (%06o)\n",
$AC, $indaddr, $Mem[$indaddr] );
$AC ^= $Mem[$indaddr];
$PC++;
}
# Skip if AC different to Y
sub sad {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "sad AC %06o cf. %06o\n", $AC, $Mem[$indaddr] );
$PC += ( $AC != $Mem[$indaddr] ) ? 2 : 1;
}
# Deposit zero in memory
sub dzm {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "dzm into %06o\n", $indaddr );
$Mem[$indaddr] = 0;
$PC++;
}
# Index and skip if zero
sub isz {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "isz %06o\n", $Mem[$indaddr] );
$Mem[$indaddr]++;
$Mem[$indaddr] &= MAXINT;
$PC += ( $Mem[$indaddr] == 0 ) ? 2 : 1;
}
# Jump
sub jmp {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "jmp %06o\n", $indaddr );
$PC = $indaddr;
}
# Jump to subroutine
sub jms {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "jms %06o\n", $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( 0, MAXADDR, 0 ) if ($debug);
exit(1);
}
if ( $instruction == 0741100 ) { # spa: skip on positive AC
dprintf( "spa AC %06o\n", $AC );
# Because we are dealing with 18 bits, compare the range
$PC += ( ( $AC >= 0 ) && ( $AC <= MAXPOSINT ) ) ? 2 : 1;
return;
}
if ( $instruction == 0741200 ) { # sna: skip on non-zero AC
dprintf( "sna AC %06o\n", $AC );
$PC += ( $AC != 0 ) ? 2 : 1;
return;
}
if ( $instruction == 0740200 ) { # sza: skip on zero AC
dprintf( "sza AC %06o\n", $AC );
$PC += ( $AC == 0 ) ? 2 : 1;
return;
}
if ( $instruction == 0741400 ) { # szl: Skip when $LINK is zero
dprintf( "szl LINK %0o\n", $LINK );
$PC += ( $LINK == 0 ) ? 2 : 1;
return;
}
if ( $instruction == 0740400 ) { # snl: Skip when $LINK not zero
dprintf( "snl LINK %0o\n", $LINK );
$PC += ( $LINK != 0 ) ? 2 : 1;
return;
}
if ( $instruction == 0741000 ) { # ska: skip always
dprintf("skp\n");
$PC += 2;
return;
}
# ral: rotate left or rcr: clear link then rotate left
if ( ( $instruction == 0740010 ) || ( $instruction == 0744010 ) ) {
$LINK = 0 if ( $instruction == 0744010 );
$AC = $AC << 1 + ($LINK) ? 1 : 0;
$LINK = $AC & LINKMASK;
$AC = $AC & MAXINT;
$PC++;
return;
}
# rar: rotate right or rcr: clear link then rotate right
if ( ( $instruction == 0740020 ) || ( $instruction == 0744020 ) ) {
$LINK = 0 if ( $instruction == 0744020 );
my $newlink = ( $AC & 1 ) ? LINKMASK : 0;
$AC = ( $LINK | $AC ) >> 1;
$LINK = $newlink;
$PC++;
return;
}
# law: load word into AC
if ( ( $instruction >= 0760000 ) && ( $instruction <= MAXINT ) ) {
dprintf( "law %06o into AC\n", $instruction );
$AC = $instruction;
$PC++;
return;
}
printf( STDERR "PC %06o: unknown instruction %06o\n", $PC, $instruction );
exit(1);
}
# cal: used for system calls
sub cal {
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);
}
}
# Extended arithmetic element instructions
sub eae {
my ( $instruction, $addr, $indaddr ) = @_;
my $step = $instruction & EAESTEP;
if ( $instruction == 0660500 ) { # lrss: long right shift, signed
dprintf( "lrss %06o AC step %d\n", $AC, $step );
# Save the AC's sign into LINK
$LINK = ( $AC << 1 ) & LINKMASK;
# XXX: Do we need to preserve the AC sign?
$AC = $AC >> $step;
$PC++;
return;
}
if ( $instruction == 0660711 ) { # alss: long left shift, signed
dprintf( "alss %06o AC step %d\n", $AC, $step );
# Save the AC's sign into LINK
$LINK = ( $AC << 1 ) & LINKMASK;
# XXX: Do we need to preserve the AC sign?
$AC = ( $AC << $step ) & MAXINT;
$PC++;
return;
}
printf( STDERR "PC %06o: Unknown eae instruction %06o\n",
$PC, $instruction );
exit(1);
}
# Exit system call
sub sys_exit {
dprintf("exit system call\n");
exit(0);
}
# Close system call
sub sys_close {
# AC is the file descriptor
my $fd = $AC;
dprintf( "close: closing fd %d\n", $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 2 arguments: PC+1 is a pointer to the filename.
# PC+2 seems to be 1 for write, 0 for read.
# Some programs seem to have a third argument always set to 0.
# 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 += 3;
# Convert this to a sensible ASCII filename
my $filename = mem2arg($start);
dprintf( "open: base %06o, file %s\n", $start, $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( "read: %d words into %06o from fd %d\n", $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( "write: %d words from %o to fd %d\n", $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) || ($singlestep) );
}
# Get one or more commands from the user and execute them
sub get_user_command {
my %Cmdlist = (
'b' => \&cmd_setbreak,
'break' => \&cmd_setbreak,
'd' => \&cmd_dump,
'dump' => \&cmd_dump,
'db' => \&cmd_delbreak,
'del' => \&cmd_delbreak,
'delete' => \&cmd_delbreak,
'?' => \&cmd_help,
'h' => \&cmd_help,
'help' => \&cmd_help,
's' => \&cmd_step,
'l' => \&cmd_listbreak,
'list' => \&cmd_listbreak,
'step' => \&cmd_step,
'q' => \&cmd_exit,
'x' => \&cmd_exit,
'quit' => \&cmd_exit,
'exit' => \&cmd_exit,
'c' => \&cmd_continue,
'continue' => \&cmd_continue,
'r' => \&cmd_showregs,
'regs' => \&cmd_showregs,
);
# Loop until we get a leave result
while (1) {
# Get a command from the user
# and split into command, start and end addresses.
# Convert addresses from octal
print("a7out> ");
chomp( my $line = <STDIN> );
my ( $cmd, $addr, $endaddr ) = split( /\s+/, $line );
$addr = oct($addr) if ( defined($addr) );
$endaddr = oct($endaddr) if ( defined($endaddr) );
# Run the command
my $leave;
if ( defined($cmd) && defined( $Cmdlist{$cmd} ) ) {
$leave = $Cmdlist{$cmd}->( $addr, $endaddr );
} else {
printf( "%s: unknown command\n", $cmd || "" );
cmd_help();
}
return if ($leave);
}
}
# Exit the program
sub cmd_exit {
exit(0);
}
# Continue by disabling single-step
# and break out of the command loop
sub cmd_continue {
$singlestep = 0;
return (1);
}
# Step by staying in single-step
# but break out of the command loop
sub cmd_step {
return (1);
}
# Set a breakpoint
sub cmd_setbreak {
my $addr = shift;
$Breakpoint{$addr} = 1;
return (0);
}
# Delete a breakpoint
sub cmd_delbreak {
my $addr = shift;
delete( $Breakpoint{$addr} );
printf( "Delete breakpoint %06o\n", $addr );
return (0);
}
sub cmd_help {
print(" [b]reak <octal> set a breakpoint\n");
print(" [c]ontinue leave single-step and continue\n");
print(" [d]ump [<octal>] [<octal>] dump addresses in range\n");
print(" db <octal> delete a breakpoint\n");
print(" [del]ete <octal> delete a breakpoint\n");
print(" [l]ist list breakpoints\n");
print(" [r]egs print PC, LINK, AC and MQ regs\n");
print(" [s]tep single-step next instruction\n");
print(" ?, h, help print this help list\n");
print(" e[x]it, [q]uit exit the program\n");
return (0);
}
sub cmd_showregs {
my $link = ($LINK) ? 1 : 0;
printf( "PC: %06o, L.AC %d.%06o, MQ: %06o\n", $PC, $link, $AC, $MQ );
return (0);
}
sub cmd_dump {
my ( $start, $end ) = @_;
# No arguments, so dump everything but not empty locations
if ( !defined($start) ) {
dump_memory( 0, MAXADDR, 0 );
return (0);
}
# Dump a limited range
$end = $start if ( !defined($end) );
dump_memory( $start, $end, 1 );
return (0);
}
sub cmd_listbreak {
print("Breakpoints:\n");
foreach my $addr ( sort( keys(%Breakpoint) ) ) {
printf( " %06o\n", $addr );
}
return (0);
}
Reference in New Issue View Git Blame Copy Permalink