glm94/pdp7-unix
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

I'm trying to bring my wktcat.s file into line with the real one.

Browse Source 
I've refactored tools/a7out to have a dprintf() function to printf
only on debugging. I still need to rewrite the command-line arg
storage structure.
This commit is contained in:
Warren Toomey
2016-02-27 08:05:52 +10:00
parent 779e655703
commit d2511c36c0
2 changed files with 53 additions and 47 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tools/a7out
+35 -35
View File
@@ -103,7 +103,7 @@ sub set_arguments {
# No arguments, set the 017777 pointer to 017776 which is NULL # No arguments, set the 017777 pointer to 017776 which is NULL
if (@ARGV==0) { if (@ARGV==0) {
$Mem[ 017777 ] = 017776; $Mem[ 017777 ] = 017776;
print( STDERR "No arguments, so NULL 017777 pointer\n") if ($debug); dprintf("No arguments, so NULL 017777 pointer\n");
return; return;
} }
@@ -151,10 +151,8 @@ sub simulate {
# Work out what any indirect address would be # Work out what any indirect address would be
my $indaddr= ($indirect) ? $Mem[$addr] & 017777 : $addr; my $indaddr= ($indirect) ? $Mem[$addr] & 017777 : $addr;
printf( STDERR dprintf( "PC %06o: instr %06o, op %03o, ind %o, addr %06o ind %06o\n",
"PC %06o: instr %06o, op %03o, ind %o, addr %06o ind %06o\n", $PC, $instruction, $opcode, $indirect, $addr, $indaddr );
$PC, $instruction, $opcode, $indirect, $addr, $indaddr )
if ($debug);
# Simulate the instruction. Each subroutine updates the $PC # Simulate the instruction. Each subroutine updates the $PC
if ( defined( $Oplist{$opcode} ) ) { if ( defined( $Oplist{$opcode} ) ) {
@@ -162,7 +160,7 @@ sub simulate {
} else { } else {
printf( STDERR "Unknown instruction 0%o at location 0%o\n", printf( STDERR "Unknown instruction 0%o at location 0%o\n",
$instruction, $PC ); $instruction, $PC );
die("\n"); exit(1);
} }
} }
} }
@@ -177,9 +175,8 @@ sub dump_memory {
# Load AC # Load AC
sub lac { sub lac {
my ( $instruction, $addr, $indaddr ) = @_; my ( $instruction, $addr, $indaddr ) = @_;
printf( STDERR "PC %06o: lac %05o (value %06o) into AC\n", dprintf( "PC %06o: lac %05o (value %06o) into AC\n",
$PC, $indaddr, $Mem[$indaddr] ) $PC, $indaddr, $Mem[$indaddr] );
if ($debug);
$AC = $Mem[$indaddr]; $AC = $Mem[$indaddr];
$PC++; $PC++;
} }
@@ -187,9 +184,8 @@ sub lac {
# Deposit AC # Deposit AC
sub dac { sub dac {
my ( $instruction, $addr, $indaddr ) = @_; my ( $instruction, $addr, $indaddr ) = @_;
printf( STDERR "PC %06o: dac AC (value %06o) into %05o\n", dprintf( "PC %06o: dac AC (value %06o) into %05o\n",
$PC, $AC, $indaddr ) $PC, $AC, $indaddr );
if ($debug);
$Mem[$indaddr] = $AC; $Mem[$indaddr] = $AC;
$PC++; $PC++;
} }
@@ -197,9 +193,8 @@ sub dac {
# Add to AC # Add to AC
sub tad { sub tad {
my ( $instruction, $addr, $indaddr ) = @_; my ( $instruction, $addr, $indaddr ) = @_;
printf( STDERR "PC %06o: tac AC (value %06o) from addr %05o\n", dprintf( "PC %06o: tac AC (value %06o) from addr %05o\n",
$PC, $AC, $indaddr ) $PC, $AC, $indaddr );
if ($debug);
$AC+= $Mem[$indaddr]; $AC+= $Mem[$indaddr];
$PC++; $PC++;
} }
@@ -207,7 +202,7 @@ sub tad {
# Jump # Jump
sub jmp { sub jmp {
my ( $instruction, $addr, $indaddr ) = @_; my ( $instruction, $addr, $indaddr ) = @_;
printf( STDERR "PC %06o: jmp %06o\n", $PC, $indaddr ) if ($debug); dprintf( "PC %06o: jmp %06o\n", $PC, $indaddr );
$PC = $indaddr; $PC = $indaddr;
} }
@@ -223,18 +218,18 @@ sub special {
exit(1); exit(1);
} }
if ( $instruction == 0741100 ) { # spa: skip on positive AC if ( $instruction == 0741100 ) { # spa: skip on positive AC
printf( STDERR "PC %06o: spa AC %06o\n", $PC, $AC ) if ($debug); dprintf( "PC %06o: spa AC %06o\n", $PC, $AC );
# Because we are dealing with 18 bits, compare the range # Because we are dealing with 18 bits, compare the range
$PC += ( ($AC >= 0) && ($AC < 0400000) ) ? 2 : 1; $PC += ( ($AC >= 0) && ($AC < 0400000) ) ? 2 : 1;
return; return;
} }
if ( $instruction == 0741200 ) { # sna: skip on non-zero AC if ( $instruction == 0741200 ) { # sna: skip on non-zero AC
printf( STDERR "PC %06o: sna AC %06o\n", $PC, $AC ) if ($debug); dprintf( "PC %06o: sna AC %06o\n", $PC, $AC );
$PC += ( $AC != 0 ) ? 2 : 1; $PC += ( $AC != 0 ) ? 2 : 1;
return; return;
} }
if ( $instruction == 0740200 ) { # sza: skip on zero AC if ( $instruction == 0740200 ) { # sza: skip on zero AC
printf( STDERR "PC %06o: sza AC %06o\n", $PC, $AC ) if ($debug); dprintf( "PC %06o: sza AC %06o\n", $PC, $AC );
$PC += ( $AC == 0 ) ? 2 : 1; $PC += ( $AC == 0 ) ? 2 : 1;
return; return;
} }
@@ -260,13 +255,13 @@ sub iot {
$Syscallist{$addr}->(); $Syscallist{$addr}->();
} else { } else {
printf( STDERR "PC %06o: Unknown syscall %d\n", $PC, $addr ); printf( STDERR "PC %06o: Unknown syscall %d\n", $PC, $addr );
die("\n"); exit(1);
} }
} }
# Exit system call # Exit system call
sub sys_exit { sub sys_exit {
printf( STDERR "PC %06o: exit system call\n", $PC ) if ($debug); dprintf( "PC %06o: exit system call\n", $PC );
exit(0); exit(0);
} }
@@ -275,14 +270,14 @@ sub sys_close {
# AC is the file descriptor # AC is the file descriptor
my $fd = $AC; my $fd = $AC;
printf( STDERR "PC %06o: close: closing fd %d\n", $PC, $fd ) if ($debug); dprintf( "PC %06o: close: closing fd %d\n", $PC, $fd );
# Bump up the PC # Bump up the PC
$PC += 1; $PC += 1;
# That filehandle is not open, set an error -1 in octal # That filehandle is not open, set an error -1 in octal
if ( !defined( $FD[$fd] ) ) { if ( !defined( $FD[$fd] ) ) {
print( STDERR "close: fd $fd is not open\n") if ($debug); dprint( "close: fd $fd is not open\n");
$AC = 0777777; $AC = 0777777;
return; return;
} }
@@ -307,7 +302,7 @@ sub sys_open {
# Convert this to a sensible ASCII filename # Convert this to a sensible ASCII filename
my $filename = mem2string($start); my $filename = mem2string($start);
printf( STDERR "PC %06o: open: file %s\n", $PC, $filename ) if ($debug); dprintf( "PC %06o: open: file %s\n", $PC, $filename );
# Open the file # Open the file
if ( open( my $FH, "<", $filename ) ) { if ( open( my $FH, "<", $filename ) ) {
@@ -323,7 +318,7 @@ sub sys_open {
return; return;
} else { } else {
# No filehandle, so it's an error # No filehandle, so it's an error
print( STDERR "open failed: $!\n") if ($debug); dprintf( "open failed: $!\n");
$AC = 0777777; $AC = 0777777;
return; return;
} }
@@ -340,17 +335,17 @@ sub sys_read {
my $fd = $AC; my $fd = $AC;
my $start = $Mem[ $PC + 1 ]; my $start = $Mem[ $PC + 1 ];
my $count = $Mem[ $PC + 2 ]; my $count = $Mem[ $PC + 2 ];
my $end = $start + $count - 1; my $end = ($start + $count - 1) & 017777;
printf( STDERR "PC %06o: read: %d words into %o from fd %d\n", die("sys_read: bad start/end addresses $start $end\n") if ($end < $start);
$PC, $count, $start, $fd ) dprintf( "PC %06o: read: %d words into %o from fd %d\n",
if ($debug); $PC, $count, $start, $fd );
# Bump up the PC # Bump up the PC
$PC += 3; $PC += 3;
# That filehandle is not open, set an error -1 in octal # That filehandle is not open, set an error -1 in octal
if ( !defined( $FD[$fd] ) ) { if ( !defined( $FD[$fd] ) ) {
print( STDERR "read: fd $fd is not open\n") if ($debug); dprint( "read: fd $fd is not open\n");
$AC = 0777777; $AC = 0777777;
return; return;
} }
@@ -393,17 +388,17 @@ sub sys_write {
my $fd = $AC; my $fd = $AC;
my $start = $Mem[ $PC + 1 ]; my $start = $Mem[ $PC + 1 ];
my $count = $Mem[ $PC + 2 ]; my $count = $Mem[ $PC + 2 ];
my $end = $start + $count - 1; my $end = ($start + $count - 1) & 017777;
printf( STDERR "PC %06o: write: %d words from %o to fd %d\n", die("sys_write: bad start/end addresses $start $end\n") if ($end < $start);
$PC, $count, $start, $fd ) dprintf( "PC %06o: write: %d words from %o to fd %d\n",
if ($debug); $PC, $count, $start, $fd );
# Bump up the PC # Bump up the PC
$PC += 3; $PC += 3;
# That filehandle is not open, set an error -1 in octal # That filehandle is not open, set an error -1 in octal
if ( !defined( $FD[$fd] ) ) { if ( !defined( $FD[$fd] ) ) {
print( STDERR "write: fd $fd is not open\n") if ($debug); dprint( "write: fd $fd is not open\n");
$AC = 0777777; $AC = 0777777;
return; return;
} }
@@ -487,3 +482,8 @@ sub string2mem {
} }
return($base); return($base);
} }
# Print out debug messages
sub dprintf {
printf( STDERR @_) if ($debug);
}
tools/wktcat.s
+16 -10
View File
@@ -44,12 +44,12 @@ stdinout:
" This section opens files, and copies their contents to standard output " This section opens files, and copies their contents to standard output
catfiles: catfiles:
" We start with AC pointing to an argument. Save it at label 1f " We start with AC pointing to an argument. Save it at label 1f
dac 1f dac name
" Open the file and get the fd into AC " Open the file and get the fd into AC
sys open; 1:0; 0; 0 sys open; name:0; 0; 0
spa spa
jmp noopen " Bad fd, exit with an error message jmp badfile " Bad fd, exit with an error message
dac fd " Save the file descriptor dac fd " Save the file descriptor
fileloop: fileloop:
@@ -91,14 +91,19 @@ end:
" exit " exit
sys exit sys exit
noopen:
" Print an "err open" string and exit
lac d1
sys write; noopenstr; 5
sys exit
noopenstr: " This code comes from the real cat.s
<er>;<r 040;<op>;<en>;012000 badfile:
lac name " Get the pointer to the filename
dac 1f " Store it in 1f below
lac d8 " Load fd 8 which is stderr
sys write; 1:0; 4 " Write the name, max 4 words
lac d8 " Then write " ?\n"
sys write; 1f; 2
sys exit " and exit
1: 040; 077012
error: error:
" Print an "err read" string and exit " Print an "err read" string and exit
@@ -112,6 +117,7 @@ noreadstr:
fd: 0 " fd of the open file fd: 0 " fd of the open file
d0: 0 " Constants 0 and 1 d0: 0 " Constants 0 and 1
d1: 1 d1: 1
d8: 8 " stderr seems to have fd 8
" Input buffer for read " Input buffer for read
buf: 0; 0; 0; 0; 0 buf: 0; 0; 0; 0; 0