I've added a single-step mode to tools/a7out and rationalised the debug output.
Some small changes to src/cmd/cat.s and wktcat.s to reflect the correct number of arguments to open. Typos fixes to src/cmd/cat.s.
This commit is contained in:
Warren Toomey
+4
-5
@@ -10,7 +10,7 @@
|
||||
dac name
|
||||
|
||||
loop:
|
||||
sys open; name; 0; 0 " Open file, get fd back
|
||||
sys open; name:0; 0; " Open file, get fd back
|
||||
spa
|
||||
jmp badfile " Negative fd, exit with an error message
|
||||
dac fi " save file descriptor in fi
|
||||
@@ -70,14 +70,14 @@ done:
|
||||
rcr
|
||||
dac 1f
|
||||
lac fo " Load fd 1, stdout
|
||||
sys write; iopt+1; 1:..
|
||||
sys write; iopt+1; 1
|
||||
sys exit
|
||||
|
||||
getc: 0
|
||||
lac ipt
|
||||
sad eipt
|
||||
jmp 1f
|
||||
dac 1f
|
||||
dac 2f
|
||||
add o400000
|
||||
dac ipt
|
||||
ral
|
||||
@@ -99,7 +99,7 @@ getc: 0
|
||||
dac ipt
|
||||
jmp getc+1
|
||||
1:
|
||||
lac 64
|
||||
lac o4
|
||||
jmp getc i " return from subroutine
|
||||
|
||||
putc: 0
|
||||
@@ -140,7 +140,6 @@ opt: .+2
|
||||
iopt: .+1; .=.+64 " 64 word output buffer
|
||||
noc: 0
|
||||
fo: 1 " output file descriptor, fd 1 is stdout
|
||||
name: 0 " not in the original
|
||||
|
||||
d1: 1 " octal and decimal constants
|
||||
o4:d4: 4
|
||||
|
||||
+333
-100
@@ -9,35 +9,52 @@ 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
|
||||
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; # Accumulator
|
||||
my $LINK = 0; # Link register
|
||||
my $MQ; # MQ register
|
||||
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 MAXADDR => 017777; # Largest memory address
|
||||
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 ###
|
||||
|
||||
# Optional debug argument
|
||||
if ( ( @ARGV > 0 ) && ( $ARGV[0] eq "-d" ) ) {
|
||||
$debug = 1; shift(@ARGV);
|
||||
# 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] a.outfile [arg1 arg2 ...]\n") if ( @ARGV < 1 );
|
||||
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();
|
||||
|
||||
#dump_memory(0, MAXADDR, 0);
|
||||
#exit(0);
|
||||
simulate();
|
||||
exit(0);
|
||||
@@ -54,7 +71,7 @@ sub load_code {
|
||||
# Set up some open filehandles
|
||||
$FD[0] = \*STDIN;
|
||||
$FD[1] = \*STDOUT;
|
||||
$FD[8] = \*STDERR; # According to cat.s (uses d8 == 8)
|
||||
$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");
|
||||
@@ -78,12 +95,12 @@ sub load_code {
|
||||
### 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)
|
||||
### | +------------+
|
||||
@@ -103,27 +120,30 @@ sub load_code {
|
||||
### +------------+
|
||||
###
|
||||
sub set_arguments {
|
||||
|
||||
# Get the number of arguments including the command name
|
||||
my $argc= scalar(@ARGV);
|
||||
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;
|
||||
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);
|
||||
# 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);
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -133,16 +153,19 @@ sub simulate {
|
||||
|
||||
# List of opcodes that we can simulate
|
||||
my %Oplist = (
|
||||
oct("000") => \&cal,
|
||||
oct("004") => \&dac,
|
||||
oct("010") => \&jms,
|
||||
oct("010") => \&dzm,
|
||||
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,
|
||||
);
|
||||
@@ -156,9 +179,15 @@ sub simulate {
|
||||
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",
|
||||
# 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
|
||||
@@ -173,17 +202,20 @@ sub simulate {
|
||||
}
|
||||
|
||||
# Debug code: dump memory contents
|
||||
# Print from $start to $end.
|
||||
# Print empty locations if $yeszero
|
||||
sub dump_memory {
|
||||
foreach my $i ( 0 .. MAXADDR ) {
|
||||
printf( STDERR "%06o: %06o\n", $i, $Mem[$i] ) if ( $Mem[$i] != 0 );
|
||||
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( "PC %06o: lac %06o (value %06o) into AC\n",
|
||||
$PC, $indaddr, $Mem[$indaddr] );
|
||||
dprintf( "lac %06o (value %06o) into AC\n", $indaddr, $Mem[$indaddr] );
|
||||
$AC = $Mem[$indaddr];
|
||||
$PC++;
|
||||
}
|
||||
@@ -191,26 +223,42 @@ sub lac {
|
||||
# Deposit AC
|
||||
sub dac {
|
||||
my ( $instruction, $addr, $indaddr ) = @_;
|
||||
dprintf( "PC %06o: dac AC (value %06o) into %06o\n",
|
||||
$PC, $AC, $indaddr );
|
||||
dprintf( "dac AC (value %06o) into %06o\n", $AC, $indaddr );
|
||||
$Mem[$indaddr] = $AC;
|
||||
$PC++;
|
||||
}
|
||||
|
||||
# Add to AC
|
||||
# Add to AC, twos complement
|
||||
sub tad {
|
||||
my ( $instruction, $addr, $indaddr ) = @_;
|
||||
dprintf( "PC %06o: tad AC (value %06o) with addr %06o (%06o)\n",
|
||||
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] );
|
||||
$AC= ($AC + $Mem[$indaddr]) & MAXINT;
|
||||
$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( "PC %06o: and AC (value %06o) with addr %06o (%06o)\n",
|
||||
$PC, $AC, $indaddr, $Mem[$indaddr] );
|
||||
dprintf( "and AC (value %06o) with addr %06o (%06o)\n",
|
||||
$AC, $indaddr, $Mem[$indaddr] );
|
||||
$AC &= $Mem[$indaddr];
|
||||
$PC++;
|
||||
}
|
||||
@@ -218,8 +266,8 @@ sub and {
|
||||
# Xor AC and Y
|
||||
sub xor {
|
||||
my ( $instruction, $addr, $indaddr ) = @_;
|
||||
dprintf( "PC %06o: xor AC (value %06o) with addr %06o (%06o)\n",
|
||||
$PC, $AC, $indaddr, $Mem[$indaddr] );
|
||||
dprintf( "xor AC (value %06o) with addr %06o (%06o)\n",
|
||||
$AC, $indaddr, $Mem[$indaddr] );
|
||||
$AC ^= $Mem[$indaddr];
|
||||
$PC++;
|
||||
}
|
||||
@@ -227,40 +275,42 @@ sub xor {
|
||||
# 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;
|
||||
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( "PC %06o: dzm into %06o\n", $PC, $indaddr);
|
||||
$Mem[$indaddr]= 0;
|
||||
dprintf( "dzm into %06o\n", $indaddr );
|
||||
$Mem[$indaddr] = 0;
|
||||
$PC++;
|
||||
}
|
||||
|
||||
# Index and skip if zero
|
||||
sub isz {
|
||||
my ( $instruction, $addr, $indaddr ) = @_;
|
||||
dprintf( "PC %06o: isz %06o\n", $PC, $Mem[$indaddr]);
|
||||
$Mem[$indaddr]++; $Mem[$indaddr] &= MAXINT;
|
||||
$PC += ($Mem[$indaddr] == 0) ? 2 : 1;
|
||||
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( "PC %06o: jmp %06o\n", $PC, $indaddr );
|
||||
dprintf( "jmp %06o\n", $indaddr );
|
||||
$PC = $indaddr;
|
||||
}
|
||||
|
||||
# Jump to subroutine
|
||||
sub jms {
|
||||
my ( $instruction, $addr, $indaddr ) = @_;
|
||||
dprintf( "PC %06o: jms %06o\n", $PC, $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;
|
||||
$Mem[ $indaddr++ ] = $PC + 1 | ( ($LINK) ? 0400000 : 0 );
|
||||
$PC = $indaddr;
|
||||
}
|
||||
|
||||
# Special instructions
|
||||
@@ -271,51 +321,75 @@ sub special {
|
||||
# hlt
|
||||
if ( $instruction == 0740040 ) {
|
||||
printf( STDERR "PC %06o: program halted\n", $PC );
|
||||
dump_memory() if ($debug);
|
||||
dump_memory( 0, MAXADDR, 0 ) if ($debug);
|
||||
exit(1);
|
||||
}
|
||||
if ( $instruction == 0741100 ) { # spa: skip on positive AC
|
||||
dprintf( "PC %06o: spa AC %06o\n", $PC, $AC );
|
||||
dprintf( "spa AC %06o\n", $AC );
|
||||
|
||||
# Because we are dealing with 18 bits, compare the range
|
||||
$PC += ( ($AC >= 0) && ($AC <= MAXINT) ) ? 2 : 1;
|
||||
$PC += ( ( $AC >= 0 ) && ( $AC <= MAXPOSINT ) ) ? 2 : 1;
|
||||
return;
|
||||
}
|
||||
if ( $instruction == 0741200 ) { # sna: skip on non-zero AC
|
||||
dprintf( "PC %06o: sna AC %06o\n", $PC, $AC );
|
||||
dprintf( "sna AC %06o\n", $AC );
|
||||
$PC += ( $AC != 0 ) ? 2 : 1;
|
||||
return;
|
||||
}
|
||||
if ( $instruction == 0740200 ) { # sza: skip on zero AC
|
||||
dprintf( "PC %06o: sza AC %06o\n", $PC, $AC );
|
||||
dprintf( "sza AC %06o\n", $AC );
|
||||
$PC += ( $AC == 0 ) ? 2 : 1;
|
||||
return;
|
||||
}
|
||||
if ( $instruction == 0741400 ) { # szl: Skip when $LINK is zero
|
||||
dprintf( "PC %06o: szl LINK %0o\n", $PC, $LINK );
|
||||
dprintf( "szl LINK %0o\n", $LINK );
|
||||
$PC += ( $LINK == 0 ) ? 2 : 1;
|
||||
return;
|
||||
}
|
||||
if ( $instruction == 0740400 ) { # snl: Skip when $LINK not zero
|
||||
dprintf( "PC %06o: snl LINK %0o\n", $PC, $LINK );
|
||||
dprintf( "snl LINK %0o\n", $LINK );
|
||||
$PC += ( $LINK != 0 ) ? 2 : 1;
|
||||
return;
|
||||
}
|
||||
if ( $instruction == 0741000 ) { # ska: skip always
|
||||
dprintf( "PC %06o: skp\n", $PC );
|
||||
dprintf("skp\n");
|
||||
$PC += 2;
|
||||
return;
|
||||
}
|
||||
if ( ($instruction >= 0760000) && ($instruction <= MAXINT) ) { # law: load word into AC
|
||||
dprintf( "PC %06o: law %06o into AC\n", $PC, $instruction);
|
||||
|
||||
# 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;
|
||||
$PC++;
|
||||
return;
|
||||
}
|
||||
printf( STDERR "PC %06o: unknown instruction %06o\n", $PC, $instruction );
|
||||
exit(1);
|
||||
}
|
||||
|
||||
# I/O transfer: used for system calls
|
||||
sub iot {
|
||||
# cal: used for system calls
|
||||
sub cal {
|
||||
my ( $instruction, $addr, $indaddr ) = @_;
|
||||
|
||||
# Syscalls that we can simulate
|
||||
@@ -336,9 +410,41 @@ sub iot {
|
||||
}
|
||||
}
|
||||
|
||||
# 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( "PC %06o: exit system call\n", $PC );
|
||||
dprintf("exit system call\n");
|
||||
exit(0);
|
||||
}
|
||||
|
||||
@@ -347,14 +453,14 @@ sub sys_close {
|
||||
|
||||
# AC is the file descriptor
|
||||
my $fd = $AC;
|
||||
dprintf( "PC %06o: close: closing fd %d\n", $PC, $fd );
|
||||
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");
|
||||
dprint("close: fd $fd is not open\n");
|
||||
$AC = MAXINT;
|
||||
return;
|
||||
}
|
||||
@@ -366,36 +472,36 @@ sub sys_close {
|
||||
|
||||
# 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?
|
||||
# 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 += 4;
|
||||
$PC += 3;
|
||||
|
||||
# Convert this to a sensible ASCII filename
|
||||
my $filename = mem2arg($start);
|
||||
dprintf( "PC %06o: open: file %s\n", $PC, $filename );
|
||||
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 ) {
|
||||
foreach my $fd ( 0 .. 99 ) {
|
||||
if ( !defined( $FD[$fd] ) ) {
|
||||
$FD[$fd] = $FH;
|
||||
$AC = $fd;
|
||||
$AC = $fd;
|
||||
last;
|
||||
}
|
||||
}
|
||||
return;
|
||||
} else {
|
||||
# No filehandle, so it's an error
|
||||
dprintf( "open failed: $!\n");
|
||||
dprintf("open failed: $!\n");
|
||||
$AC = MAXINT;
|
||||
return;
|
||||
}
|
||||
@@ -412,17 +518,16 @@ sub sys_read {
|
||||
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 );
|
||||
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");
|
||||
dprint("read: fd $fd is not open\n");
|
||||
$AC = MAXINT;
|
||||
return;
|
||||
}
|
||||
@@ -465,17 +570,17 @@ sub sys_write {
|
||||
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 );
|
||||
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");
|
||||
dprint("write: fd $fd is not open\n");
|
||||
$AC = MAXINT;
|
||||
return;
|
||||
}
|
||||
@@ -517,16 +622,17 @@ sub mem2arg {
|
||||
my $addr = shift;
|
||||
my $result = "";
|
||||
|
||||
foreach (1 .. 4) {
|
||||
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);
|
||||
my $word = $Mem[ $addr++ ];
|
||||
my $c1 = ( $word >> 9 ) & 0177;
|
||||
my $c2 = $word & 0177;
|
||||
$result .= chr($c1) . chr($c2);
|
||||
}
|
||||
$result=~ s{ *$}{};
|
||||
return($result);
|
||||
$result =~ s{ *$}{};
|
||||
return ($result);
|
||||
}
|
||||
|
||||
# Given the address of a word in memory, interpret that location
|
||||
@@ -563,5 +669,132 @@ sub mem2string {
|
||||
|
||||
# Print out debug messages
|
||||
sub dprintf {
|
||||
printf( STDERR @_) if ($debug);
|
||||
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, AC, LINK and MQ regs\n");
|
||||
print(" [s]tep: single-step this instruction\n");
|
||||
print(" ?, h, help: print this help list\n");
|
||||
print(" e[x]it, [q]uit: exit this 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);
|
||||
}
|
||||
|
||||
+1
-1
@@ -26,7 +26,7 @@ catfiles:
|
||||
dac name
|
||||
|
||||
" Open the file and get the fd into AC
|
||||
sys open; name:0; 0; 0
|
||||
sys open; name:0; 0;
|
||||
spa
|
||||
jmp badfile " Negative fd, exit with an error message
|
||||
dac fd " Save the file descriptor
|
||||
|
||||
Reference in New Issue
Block a user