#!/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\n") if ( @ARGV != 1 );

# Load the a.out file into memory
# and simulate it
load_code( $ARGV[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;

    # 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);
}

### 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("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;
        #printf( "PC %06o: instruction %08o, op %03o, ind %o, addr %06o\n",
        #    $PC, $instruction, $opcode, $indirect, $addr )
        #  if ($debug);

        # Simulate the instruction. Each subroutine updates the $PC
        if ( defined( $Oplist{$opcode} ) ) {
            $Oplist{$opcode}->( $instruction, $indirect, $addr );
        }
        else {
            printf( "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( "%06o: %08o\n", $i, $Mem[$i] ) if ( $Mem[$i] != 0 );
    }
}

# Load AC
sub lac {
    my ( $instruction, $indirect, $addr ) = @_;
    printf( "PC %06o: lac %05o (value %08o) into AC\n",
        $PC, $addr, $Mem[$addr] )
      if ($debug);
    $AC = ($indirect) ? $Mem[ $Mem[$addr] & 017777 ]: $Mem[$addr];
    $PC++;
}

# Deposit AC
sub dac {
    my ( $instruction, $indirect, $addr ) = @_;
    printf( "PC %06o: dac AC (value %08o) into %05o into AC\n",
        $PC, $AC, $addr )
      if ($debug);
    if ($indirect) {
      $Mem[ $Mem[$addr] & 017777 ] = $PC;
    } else {
      $Mem[$addr] = $AC;
    }
    $PC++;
}

# Special instructions
sub special {
    my $instruction = shift;

    # Deal with each one in turn
    # hlt
    if ( $instruction == 0740040 ) {
        printf( "PC %06o: program halted\n", $PC );
        dump_memory() if ($debug);
        exit(1);
    }
}

# I/O transfer: used for system calls
sub iot {
    my ( $instruction, $indirect, $addr ) = @_;

    # 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( "PC %06o: Unknown syscall %d\n", $PC, $addr );
        die("\n");
    }
}

# Exit system call
sub sys_exit {
  printf("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("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("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("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
    my $fd;
    foreach $fd (0 .. 99) {
      if (!defined($FD[$fd])) {
        $FD[$fd]= $FH; last;
      }
    }
    $AC=$fd; return;
  } else {
    # No filehandle, so it's an error
    print("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("PC %06o: read: %d words from %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("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>;
      chomp($line);
      last if (!defined($line));		# No line, leave the loop
      $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("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("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++;
  }
}