I've added code to detect binary PDP-7 files to a7out. This is needed

for doing the seek() and tell() syscalls which are next to do.

tools/3dump

@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+#
+# Dump a binary PDP-7 file where a word is encoded as three bytes,
+# with sixbits are stored big-endian in each of the three byte.
+#
+use strict;
+use warnings;
+
+die("Usage: $0 binaryfile\n") if (@ARGV==0);
+
+open(my $IN, "<", $ARGV[0]) || die("Can't open $ARGV[0]: $!\n");
+while (1) {
+  # Convert three bytes into one 18-bit word
+  my $result= read($IN, my $three, 3);
+  last if ($result != 3);       # Not enough bytes read
+  my ($b1, $b2, $b3)= unpack("CCC", $three);
+  my $word= (($b1 & 077) << 12) | ($b2 << 6) | $b3;
+
+  my $c1= ($word >> 9) & 0777;
+  $c1= ($c1 < 0200) ? chr($c1) : " ";
+  my $c2= $word & 0777;
+  $c2= ($c2 < 0200) ? chr($c2) : " ";
+  printf("%06o %s%s\n", $word, $c1, $c2)
+}
+close($IN);
+exit(0);

tools/a7out

@@ -6,6 +6,7 @@
 #
 use strict;
 use warnings;
+use Fcntl qw(:seek);
 use DateTime;
 use Data::Dumper;
 
@@ -15,6 +16,7 @@ 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
+my @ISBINARY;          # Array of filehandle flags: ASCII or binary files?
 
 # Registers
 my $PC   = 010000;     # Program counter
@@ -141,6 +143,7 @@ sub set_arguments {
         # Truncate and/or space pad the argument
         my $str = sprintf( "%-8s", substr( $_, 0, 8 ) );
 
+        # XXX: use ascii2words
         # Store pairs of characters into memory
         for ( my $i = 0 ; $i < length($str) ; $i += 2 ) {
             my $c1 = substr( $str, $i,     1 ) || "";
@@ -192,8 +195,11 @@ sub simulate {
 
         # Auto-increment locations 010 to 017 if $indirect
         # and this is an instruction that does increment
-	if ($indirect && ($addr >= 010) && ($addr <= 017) &&
+        if (   $indirect
-		!defined($NoIncr{$opcode})) {
+            && ( $addr >= 010 )
+            && ( $addr <= 017 )
+            && !defined( $NoIncr{$opcode} ) )
+        {
             $Mem[$addr]++;
             $Mem[$addr] &= MAXINT;
         }
@@ -215,7 +221,8 @@ sub simulate {
         # Simulate the instruction. Each subroutine updates the $PC
         if ( defined( $Oplist{$opcode} ) ) {
             $Oplist{$opcode}->( $instruction, $addr, $indaddr );
-        } else {
+        }
+        else {
             printf( STDERR "Unknown instruction 0%06o at location 0%06o\n",
                 $instruction, $PC );
             exit(1);
@@ -229,6 +236,7 @@ sub simulate {
 sub dump_memory {
     my ( $start, $end, $yeszero ) = @_;
     foreach my $i ( $start .. $end ) {
+
         # Convert the word into possibly two ASCII characters
         my $c1 = ( $Mem[$i] >> 9 ) & 0777;
         $c1 = ( $c1 < 0200 ) ? chr($c1) : " ";
@@ -380,18 +388,21 @@ sub opr {
 
     $skip = 1 if ( ( $i == 1 ) && ( $AC & SIGN ) != 0 );      # sma
     $skip = 1 if ( ( $i == 2 ) && ( $AC & MAXINT ) == 0 );    # sza
-    $skip = 1 if ( ( $i == 3 )
+    $skip = 1
+      if ( ( $i == 3 )
         && ( ( ( $AC & MAXINT ) == 0 ) || ( ( $AC & SIGN ) != 0 ) ) )
       ;                                                       # sza | sma
     $skip = 1 if ( ( $i == 4 ) && ($LINK) );                         # snl
     $skip = 1 if ( ( $i == 5 ) && ( $LINK || ( $AC >= SIGN ) ) );    # snl | sma
     $skip = 1 if ( ( $i == 6 ) && ( $LINK || ( $AC == 0 ) ) );       # snl | sza
-    $skip = 1 if ( ( $i == 7 )
+    $skip = 1
+      if ( ( $i == 7 )
         && ( $LINK || ( $AC >= SIGN ) || ( $AC == 0 ) ) );    # snl | sza | sma
     $skip = 1 if ( $i == 010 );                                     # skp
     $skip = 1 if ( ( $i == 011 ) && ( ( $AC & SIGN ) == 0 ) );      # spa
     $skip = 1 if ( ( $i == 012 ) && ( ( $AC & MAXINT ) != 0 ) );    # sna
-    $skip = 1 if ( ( $i == 013 )
+    $skip = 1
+      if ( ( $i == 013 )
         && ( ( $AC & MAXINT ) != 0 )
         && ( ( $AC & SIGN ) == 0 ) );                               # sna & spa
     $skip = 1 if ( ( $i == 014 ) && ( $LINK == 0 ) );               # szl
@@ -399,17 +410,20 @@ sub opr {
       if ( ( $i == 015 ) && ( $LINK == 0 ) && ( $AC < SIGN ) );     # szl & spa
     $skip = 1
       if ( ( $i == 016 ) && ( $LINK == 0 ) && ( $AC != 0 ) );       # szl & sna
-    $skip = 1 if ( ( $i == 017 )
+    $skip = 1
+      if ( ( $i == 017 )
         && ( $LINK == 0 )
         && ( $AC != 0 )
         && ( $AC != 0 ) );    # szl & sna & spa
 
     # Clear operations
     if ( $instruction & 010000 ) {    # cla
-        dprintf(" cla"); $AC = 0;
+        dprintf(" cla");
+        $AC = 0;
     }
     if ( $instruction & 004000 ) {    # cli
-        dprintf(" cli"); $LINK = 0;
+        dprintf(" cli");
+        $LINK = 0;
     }
     if ( $instruction & 000002 ) {    # cmi
         dprintf(" cmi");
@@ -537,18 +551,22 @@ sub cal {
 
     # Syscalls that we can simulate
     my %Syscallist = (
+
         # 1: save
         2 => \&sys_getuid,
         3 => \&sys_open,
         4 => \&sys_read,
         5 => \&sys_write,
         6 => \&sys_creat,
+
         # 7 seek
         # 8 tell
         9 => \&sys_close,
+
         # 10 link
         11 => \&sys_unlink,
         12 => \&sys_setuid,
+
         # 13 rename
         14 => \&sys_exit,
         15 => \&sys_time,
@@ -556,12 +574,14 @@ sub cal {
         17 => \&sys_chdir,
         18 => \&sys_chmod,
         19 => \&sys_chown,
+
         # 20 badcal
         # 21 syslog
         # 22 badcal
         # 23 capt
         # 24 rele
         25 => \&sys_status,
+
         # 26 badcal
         27 => \&sys_smes,
         28 => \&sys_rmes,
@@ -571,7 +591,8 @@ sub cal {
     # Simulate the syscall. Each syscall updates the $PC
     if ( defined( $Syscallist{$addr} ) ) {
         $Syscallist{$addr}->();
-    } else {
+    }
+    else {
         printf( STDERR "PC %06o: Unknown syscall %d\n", $PC, $addr );
         exit(1);
     }
@@ -593,6 +614,7 @@ sub sys_getuid {
 
 # Setuid system call
 sub sys_setuid {
+
     # For now, do nothing
     dprint("setuid system call\n");
     $PC += 1;
@@ -601,6 +623,7 @@ sub sys_setuid {
 
 # Intrp system call
 sub sys_intrp {
+
     # For now, do nothing
     dprint("intrp system call\n");
     $PC += 1;
@@ -625,6 +648,7 @@ sub sys_fork {
 # sys exit, that's going to wake wait() up and do the
 # rmes anyway.
 sub sys_smes {
+
     # For now, do nothing
     dprintf("smes system call\n");
     $PC += 1;
@@ -659,21 +683,34 @@ sub sys_close {
     }
     close( $FD[$fd] );
     $FD[$fd]       = undef;
+    $ISBINARY[$fd] = 0;       # For next time
     $AC            = 0;
     return;
 }
 
 # Open something which could be a file or a directory
-# Convert directories into files. Return the file handle.
+# Convert directories into files. Return the file handle and
+# if the file is ASCII or binary.
 sub opensomething {
     my ( $readorwrite, $filename ) = @_;
     my $tempfile = "/tmp/a7out.$$";
     my $FH;
 
-    # If this is not a directory, simply open and return the FH
+    # If this is not a directory, open it and return the FH
     if ( !-d $filename ) {
         open( $FH, $readorwrite, $filename ) || return (undef);
-       return($FH);
+
+        # Determine if the file is pure ASCII or contains 18-bit
+        # words encoded in 24-bit groups. We test the msb of the
+        # first character in the file. If it's on then it's a
+        # binary file and not ASCII.
+        # XXX: This means that we have to seek back to the beginning,
+        # which may be a problem on things like stdin.
+        my $ch = getc($FH);
+        my $isbinary = ( defined($ch) && ( ord($ch) & 0x80 ) ) ? 1 : 0;
+        binmode($FH) if ($isbinary);
+        seek( $FH, 0, SEEK_SET );
+        return ( $FH, $isbinary );
     }
 
     # It's a directory. The on-disk format for this was:
@@ -690,19 +727,30 @@ sub opensomething {
 
     my @list = sort( readdir($dh) );
     foreach my $name (@list) {
-        # Get the file's i-node number
-        my (undef,$inode)= stat($name);
 
-        # ARGH! For now we are still read/writing ASCII files, so there's
+        # Get the file's i-node number and write it
-	# no way to represent a proper 18-bit value. For now I'll pad
+        my ( undef, $inode ) = stat($name);
-	# with spaces to create the record
+        print( $FH word2three($inode) );
-        printf( $FH "  %-8s      ", substr( $name, 0, 8 ) );
+
+        # Convert the name into 8 characters, space padded
+        my $spaceword = sprintf( "%-8s", substr( $name, 0, 8 ) );
+
+        # Convert to four words and write each as three bytes
+        foreach my $word ( ascii2words($spaceword) ) {
+            print( $FH word2three($word) );
+        }
+
+        # Now write three zero words to pad to eight in total
+        print( $FH word2three(0) );
+        print( $FH word2three(0) );
+        print( $FH word2three(0) );
     }
     closedir($dh);
     close($FH);
     open( $FH, "<", $tempfile ) || return (undef);
+    binmode($FH);
     unlink($tempfile);
-    return($FH);
+    return ( $FH, 1 );
 }
 
 # Common code for creat and open
@@ -710,7 +758,7 @@ sub creatopen {
     my ( $filename, $readorwrite ) = @_;
 
     # Open the file
-    my $FH= opensomething($readorwrite, $filename );
+    my ( $FH, $isbinary ) = opensomething( $readorwrite, $filename );
     if ($FH) {
 
         # Find a place in the @FD array to store this filehandle.
@@ -718,11 +766,13 @@ sub creatopen {
         foreach my $fd ( 0 .. 99 ) {
             if ( !defined( $FD[$fd] ) ) {
                 $FD[$fd]       = $FH;
+                $ISBINARY[$fd] = $isbinary;
                 $AC            = $fd;
                 last;
             }
         }
-    } else {
+    }
+    else {
         # No filehandle, so it's an error
         dprintf("open failed: $!\n");
         $AC = MAXINT;
@@ -755,6 +805,7 @@ sub sys_open {
 
 # Creat system call
 sub sys_creat {
+
     # Creat seems to have 1 argument: PC+1 is a pointer to the filename.
     # Some programs seem to have a second argument always set to 0.
     # AC is the opened fd on success, or -1 on error
@@ -806,12 +857,23 @@ sub sys_read {
     $count = 0;
     foreach my $addr ( $start .. $end ) {
 
+        if ( $ISBINARY[$fd] ) {
+
+            # Convert three bytes into one 18-bit word
+            my $result = read( $FH, my $three, 3 );
+            last if ( $result != 3 );    # Not enough bytes read
+            my ( $b1, $b2, $b3 ) = unpack( "CCC", $three );
+            $Mem[$addr] = ( ( $b1 & 077 ) << 12 ) | ( $b2 << 6 ) | $b3;
+        }
+        else {
+            # Convert two ASCII characters into one 18-bit word
             my $c1 = getc($FH);
             last if ( !defined($c1) );    # No character, leave the loop
             my $c2 = getc($FH);           # No character, make it a NUL
             $c2 = "" if ( !defined($c2) );
             $Mem[$addr] =
               ( ord($c1) << 9 ) | ord($c2);    # Pack both into one word
+        }
         $count++;
     }
 
@@ -822,6 +884,7 @@ sub sys_read {
 
 # 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
 
@@ -858,6 +921,7 @@ sub sys_write {
 
 # Chmod system call
 sub sys_chmod {
+
     # Chmod gets the permission bits in AC and a pointer
     # to the file's name in PC+1. s2.s has these instruction for chmod:
     # 	lac u.ac; and o17    		so only the lowest 4
@@ -888,6 +952,7 @@ sub sys_chmod {
 
 # Chown system call
 sub sys_chown {
+
     # Chown gets the numeric user-id in AC and a pointer
     # to the file's name in PC+1.
     # Get the start address of the string
@@ -907,6 +972,7 @@ sub sys_chown {
 
 # Chdir system call
 sub sys_chdir {
+
     # Chdir gets the directory name in PC+1
     # Return 0 on success, -1 on error
     # Convert this to a sensible ASCII filename
@@ -926,6 +992,7 @@ sub sys_chdir {
 
 # Unlink system call
 sub sys_unlink {
+
     # Unlink gets the file name in PC+1
     # Return 0 on success, -1 on error
     # Convert this to a sensible ASCII filename
@@ -940,6 +1007,7 @@ sub sys_unlink {
 
 # Time system call
 sub sys_time {
+
     # Dennis' draft says: The call   sys time   returns in
     # the AC and MQ registers the number of sixtieths of
     # a second since the start of the current year.
@@ -969,6 +1037,7 @@ sub sys_time {
 
 # Status system call
 sub sys_status {
+
     # This seems to called as follows:
     #   law statbuf
     #   sys status; scrname; dd
@@ -996,7 +1065,8 @@ sub sys_status {
     dprintf( "status file %s statbuf %06o\n", $filename, $AC );
 
     # Get the file's details
-    my (undef,undef,$mode,$nlink,$uid,undef,undef,$size)= stat($filename);
+    my ( undef, undef, $mode, $nlink, $uid, undef, undef, $size ) =
+      stat($filename);
 
     # Set up the statbuf if we got a result
     if ($nlink) {
@@ -1012,9 +1082,11 @@ sub sys_status {
         $perms |= 020     if ( -d $filename );    # Directory
         $perms |= 0200000 if ( $size > 4096 );    # Large file
         $Mem[$AC] = $perms;
+
         # Set AC to zero as we got something, else return -1
         $AC = 0;
-    } else {
+    }
+    else {
         $AC = MAXINT;
     }
 
@@ -1022,6 +1094,32 @@ sub sys_status {
     return;
 }
 
+# Convert an 18-bit word into a scalar which has three sixbit
+# values in three bytes. Set the msb in the first byte
+sub word2three {
+    my $val = shift;
+
+    my $b1 = ( ( $val >> 12 ) & 077 ) | 0x80;
+    my $b2 = ( $val >> 6 ) & 077;
+    my $b3 = $val & 077;
+    return ( pack( "CCC", $b1, $b2, $b3 ) );
+}
+
+# Convert an ASCII string into an array of 18-bit word values
+# where two characters are packed into each word. Put NUL in
+# if the string has an odd number of characters. Return the array
+sub ascii2words {
+    my $str = shift;
+    my @words;
+    for ( my $i = 0 ; $i < length($str) ; $i += 2 ) {
+        my $c1 = substr( $str, $i,     1 ) || "\0";
+        my $c2 = substr( $str, $i + 1, 1 ) || "\0";
+
+        push( @words, ( ord($c1) << 9 ) | ord($c2) );
+    }
+    return (@words);
+}
+
 # Convert an 18-bit word into two ASCII characters and return them.
 # Don't return NUL characters
 sub word2ascii {
@@ -1102,7 +1200,8 @@ sub get_user_command {
         my $leave;
         if ( defined($cmd) && defined( $Cmdlist{$cmd} ) ) {
             $leave = $Cmdlist{$cmd}->( $addr, $endaddr );
-        } else {
+        }
+        else {
             printf( "%s: unknown command\n", $cmd || "" );
             cmd_help();
         }