#!/usr/bin/perl -w

# Simulator for the Universal Machine
# $Id: sim,v 1.35 2002/10/17 01:31:20 tomj Exp $

# This is a full simulator for the Universal Machine. Only
# the machine control orders are not emulated:

# HALT (terminates the simulator)
# STZ, STNZ, SRZ, SRNZ (skips always)
# TTO, PTO (does nothing)

# Additionally the simulator directly emulates TTYO and
# TTYI at drum addresses defined below. Arguments go in
# TTCHAR and A contains the return address. Upon return
# A contains TTCHAR, and Z is set if the character
# is NULL.

# (Execution time is NOT yet calculated; we need to measure and
# estimate from code not yet written.)

# TRACK 0
# SECTOR 0
#
# MAIN:	JUMP ...		# program start
# TTYO:	JUMP ...		# tty output
# TTYI: JUMP ...		# tty input
#
# SECTOR 20			# whatever
# TTCHAR: 0			# tty character

$EM_TTYO= 1;			# emulated TTYO
$EM_TTYI= 2;			# emulated TTYI
$EM_TTCHAR= 20;			# drum location for TTCHAR

use Getopt::Std;

# Basic machine timing and geometry. It is extremely
# unlikely to change.
$CYCLE= 10;			# bit timing, microseconds
$WSIZE= 18;			# bits per logical word
$DEADBITS= 2;			# dead bits per drum word


# --track----|----sector-----
# t t t t t t s s s s s s s s	address bit field layout
$KSIZE= 12;			# bits per address field/K
$SSIZE= 8;			# number of bits in SECTOR field

# Machine execution time, in microseconds. 
$WORDTIME= $CYCLE * ($WSIZE + $DEADBITS); # drum word time

# Default drum geometry. Very likely to change. See spreadsheet
# for values to plug in.
$SECTORS= 64;			# sectors per track
$TRACKS= 64;			# number of tracks
$SKEWFACT= 4;			# drum sector skew
$TRACKTIME= 20000;		# track-sel relay tree time

# Teletype interface; 177800 is for a single I/O bit
# eg. a bit banger. It's slow enough we may need to
# build a UART.
$TTYTIME= 177800;		# tty character time (60 WPM)

# Convenience values.
$CHARMASK= 63;			# bits in a character
$WMAX= (2**$WSIZE);		# range of values
$WMASK= ($WMAX-1);		# maximum value/bit mask
$KMAX= (2**$KSIZE);		# K maximum value
$KMASK= ($KMAX-1);		# address mask

# Opcodes.
@OPCODES=(
	"FETCH", "HALT", "SWA",
	"SZ", "SNZ", "SC", "SNC", 
	"RLC", "SR", "NEG",	
	"STZ", "STNZ", "TTO", 
	"ADC", "ADD", "AND", "OR", 
	"LD", "JUMP",
	"ADCM", "ADDM", "ANDM", "ORM", "LDM", "LDA",
	"STA", "STO",
	"STOR",	
);

#$FIGS= 27;
#$LTRS= 31;

# U.S.TTY/ITA2 characters

# This table does the translation; it contains 64ASCII characters
# in U.S.TTY/ITA2 order. The table is indexed by [U.S.TTY/ITA2 char +
# state]; state is set to 0 (first 32 chars, FIGS code set) or 32 (last
# 32 characters, LTRS code set) when a FIGS or LTRS character is detected
# in the character stream.

@B2A = (
# LTRS
"", "E",  "\n", "A", " ", "S", "I", "U",  
"\r", "D", "R", "J", "N", "F", "C", "K", 
"T", "Z", "L", "W", "H", "Y", "P", "Q", 
"O", "B", "G",  "~", "M", "X", "V", "~",
# FIGS
"", "3",  "\n", "-", " ", "\b", "8", "7", 
"\r", "\$", "4", "\'", ",", "!", ":", "(", 
"5", "\"", ")", "2", "#", "6", "@", "1", 
"9", "?", "&",  "~", ".", "/", ";", "~" 
);


# Logical machine.

$regC= 0;			# register C contents
$regA= 0;			# register A contents
$regK= 0;			# register K contents
$Z= 0;				# Z flag
$C= 0;				# C flag

# Physical machine.

$sector= 0;			# sector within track,
$track= 0;			# drum track
@DRUM= ();			# "drum" is a big linear array of orders
@SKEW= ();			# sector skew table

@FLAGS= ();			# simulator drum meta data
$WRITTEN= 1;			# drum loc written to,

# Simulator.
$EMTTY= 0;			# emulate tty I/O routines
$arch= $JUMP;			# machine architecture,
    $SKIP= 0;			# SKIP orders,
    $JUMP= 1;			# JUMP orders,
$runtime= 0;			# accumulated realtime
$ttytime= 0;			# realtime of last TTO (to wait for SR drain)
$orders= 0;			# orders executed
$total_searches= 0;		# count of memory searches,
$total_distance= 0;		# tally of sector distances searched
$hline= 9999;


# This avoids warnings; look up real solution.
	use vars qw/$opt_i $opt_j $opt_h $opt_q $opt_w $opt_y $opt_l $opt_t $opt_r/;

	use vars qw/ $opt_f /;
	getopts('iqwyejoltrh:k:n:m:v:');		# verbose option

	$ifile= $ARGV[0];			# first arg is source file,
	if (! defined($ifile)) {
		print "Usage:\n    sim [opts] file.o\n";
		print "    -e   print subroutine emulation data\n";
		print "    -h   display header every 24 lines; -hN every N lines\n";
		print "    -o   display addresses as TRK:SECT\n";
		print "    -j   display drum search\n";
		print "\n";

		print "    -kN  set skew to N (overrides .o)\n";
		print "    -mN  set tracks/drum to N (overrides .o)\n";
		print "    -nN  set sectors/track to N (overrides .o)\n";
		print "    -vN  set track-switch time to N (overrides .o)\n";
		print "    -i   random-access memory (vs. drum)\n";
		print "\n";

		print "    -r   real-time execution\n";
		print "    -t   trace program execution\n";
		print "    -q   Allow read/fetch of un-written drum\n";
		print "\n";

		print "    -w   Emulate library tty routine calls\n";
		print "    -y   display skew table\n";
		print "    -l   list program as loaded\n";

		exit 2;
	}
	$opt_j= 0 if ! defined ($opt_j);
	$opt_h= 24 if ! defined ($opt_h) or ($opt_h < 2);

# First get compilation data like tracks and sectors
# and skew. With this we can create the skew table,
# prefill memory and check for errors.

	open (F, "<$ifile") || die ("OBJECT FILE /$ifile/ NOT FOUND\n"); 
	$i= 0;					# file integrity check
	while (<F>) {
		chomp;
		($op, $addr, $opcode)= split(/\s+/, $_);
		print "$opcode compiled by $addr\n" 	if $op eq "SOF";
		$SECTORS= $addr 			if $op eq "sectors";
		$TRACKS= $addr 				if $op eq "tracks";
		$SKEWFACT= $addr 			if $op eq "skew";
		$TRACKTIME= $addr 			if $op eq "tracktime";
		$EMTTY= $addr				if $op eq "emtty";
		$SSIZE= $addr				if $op eq "ssize";
		$arch= $addr				if $op eq "arch";
		$memorg= $addr				if $op eq "memorg";
		last 					if $op eq "EOH";
	}
	die ("/$ifile/ NOT AN OBJECT FILE\n") if $op ne "EOH";

	$SMAX=(2**$SSIZE);			# a convenience value

# Possibly override memory geometry.

	$SECTORS= $opt_n if $opt_n;		# now override sectors/track,
	$TRACKS= $opt_m if $opt_m;
	$SKEWFACT= $opt_k if $opt_k;		# optionally set skew
	$EMTTY= 1 if defined $opt_w;		# enable library emulation
	$memorg= 1 if defined ($opt_i);

	print "Memory: $TRACKS tracks, $SECTORS sectors/track, skew factor $SKEWFACT.\n";
	print "TTY I/O library emulation ", $EMTTY ? "on" : "off", "\n";
	print  $memorg ? "Random-access" : "serial drum", " memory organization\n";

# Now we can build the skew table and prefill memory.

# Fill in the skew table. Note that many combinations of
# sector & skew do not repeat; we fix most of these by
# incrementing N if an iteration would overwrite a previous.

	$n= 0;					# physical sector number,
	for ($i= 0; $i < $SECTORS; ++$i) {
		$SKEW[$n]= $i;
		$n += $SKEWFACT;
		if ($n >= $SECTORS) {		# wraparound,
			$n -= $SECTORS;		# modulo SECTORS,
			++$n if $SKEW[$n] || $n == 0;
		}
	}

	&printskew if $opt_y;

# Now load the drum from the object file.

	$n= 0;					# count drum locs used
	while (<F>) {
		chomp;
		($op, $addr, $opcode)= split(/\s+/, $_);
		next if $op ne "drum";		# what we don't know

		$op= $opcode >> $KSIZE;		# decode opcode field
		$regK= $opcode & $KMASK;	# decode K field
		if ($opt_l) {			# optionally list program load
			print sprintf("%02o:%03o ", 
			    $addr >> $SSIZE, $addr & ($SMAX - 1));
			print sprintf("%6s %o\n", $OPCODES[$op], $regK);
		}
		$DRUM[$addr]= $opcode;		# set drum contents
		$FLAGS[$addr]= $WRITTEN;	# drum loc written to
		++$n;
	}
	close F;
	print "$n drum locations filled\n";

# Now run the program we just loaded. Latency calcs are somewhat subtle; 
# not only fetch and mem searches are counted, but also code
# execution. All operations take 3 word times, and 4 if drum is
# referenced.
#
# A and Z and C are changed in here; note that each order code section
# must either bound A to WMASK width or call &cc( which does it.

	$regC= $regA= 0;			# reset the machine
	$Z= $C= 0;
	$sector= int $SECTORS / 2;		# set initial drum position
	$track= 0;				#
	$runtime= 0;				# start execution

	while (1) {
		error ("FETCH FROM UNFILLED DRUM LOCATION /$regC/")
		    if !$opt_q && ($FLAGS[$regC] != $WRITTEN);
		$thisC= $regC;			# remember for display,
		print "      Fetch " if $opt_j;
		$fetchtime= &search($regC);	# search for next inst
		$fetchtime += $WORDTIME;	# fetch:load phase
		&fetch;				# fetch next order,
		++$regC;			# C advances here,
		++$sector;			# disk rotates during fetch:load

		if ($op == 1) {			# HALT, see end of loop

		} elsif ($op == 2) {		# SWA
			$regA= 0;		# assume all switches off

		} elsif ($op == 3) {		# SZ/JZ
			++$regC if $Z and $arch == $SKIP;
			$recC= $regK if $Z and $arch == $JUMP;

		} elsif ($op == 4) {		# SNZ/JNZ
			++$regC if ! $Z and $arch == $SKIP;
			$recC= $regK if ! $Z and $arch == $JUMP;

		} elsif ($op == 5) {		# SC/JC
			++$regC if $C and $arch == $SKIP;
			$recC= $regK if $C and $arch == $JUMP;

		} elsif ($op == 6) {		# SNC/JNC
			++$regC if ! $C and $arch == $SKIP;
			$recC= $regK if ! $C and $arch == $JUMP;

		} elsif ($op == 7) {		# RLC 
			$regA= $regA + $regA + $C;# A + A + Cy --> A 
			&cc;			# change CC flip-flops,

		} elsif ($op == 8) {		# SR k
			$regA= ($regA >> 1) + $C;# (A / 2) + K --> A
			&cc;			# change CC flip-flops,

		} elsif ($op == 9) {		# NEG k
			$regA= ~$regA;
			$regA += $regK;		# add K (1's or 2's compl)
			&cc;

		} elsif ($op == 10) {		# STZ/JTZ (always branches)
			++$regC if $arch == $SKIP;
			$recC= $regK if $arch == $JUMP;

		} elsif ($op == 11) {		# STNZ/JTNZ
						# (never skips)

		} elsif ($op == 12) {		# TTO
# For emulating the tto shift reg
#			$ttotime= $runtime;	# shift reg starts

		} elsif ($op == 13) {		# ADC
			$regA += $regK;
			$regA += $C;
			&cc;

		} elsif ($op == 14) {		# ADD
			$regA += $regK;
			&cc;

		} elsif ($op == 15) {		# AND
			$regA &= $regK;
			&cc;

		} elsif ($op == 16) {		# OR
			$regA |= $regK;
			&cc;

		} elsif ($op == 17) {		# LD
			$regA= $regK;		# no CC adjust

		} elsif ($op == 18) {		# JUMP
			if ($opt_w && ($regK == $EM_TTYO)) {# emulate
				&em_ttyo;	# these subroutines

			} elsif ($opt_w && ($regK == $EM_TTYI)) {
				&em_ttyi;

			} else {
				$regC= $regK;
			}

		} elsif ($op == 19) {		# ADCM
			&unwritten ($regK);
			$regA += ($DRUM[$regK] + $C);
			&cc;

		} elsif ($op == 20) {		# ADDM
			&unwritten ($regK);
			$regA += $DRUM[$regK];
			&cc;

		} elsif ($op == 21) {		# ANDM
			&unwritten ($regK);
			$regA &= $DRUM[$regK];
			&cc;

		} elsif ($op == 22) {		# ORM
			&unwritten ($regK);
			$regA |= $DRUM[$regK];
			&cc;

		} elsif ($op == 23) {		# LDM
			&unwritten ($regK);
			$regA= $DRUM[$regK];

		} elsif ($op == 24) {		# LDA
			$regA= $regK;		# no CC adjust

		} elsif ($op == 25) {		# STA
			$DRUM[$regK] &= ~$KMASK;# strip addr, leave opcode
			$DRUM[$regK] |= ($regA & $KMASK); # add in address
			$FLAGS[$regK]= $WRITTEN; # mark as written

		} elsif ($op == 26) {		# STO
			$DRUM[$regK]= $regA;
			$FLAGS[$regK]= $WRITTEN; # mark as written

		} elsif ($op == 27) {		# STOR
			$regC += ($runtime - $ttytime > TTYTIME) ? 1 : 0;

		} else {
			print "ILLEGAL OPCODE /$op/ AT ";
			print sprintf("%02o:%03o\n", 
			    $thisC >> $SSIZE, $thisC & ($SMAX - 1));
			exit;
		}

		$runtime += $fetchtime;		# compute execution time,
		$runtime += $WORDTIME;		# add exec:run time,
		++$sector;			# disk rotates during exec:run
		$optime= 0;			# assume no operand,
		print "      Operand " if $op >= 19 && $opt_j;
		$optime= &search($regK) if $op >= 19;	# locate operand,
		$runtime += $optime;		# add op search time,

# Program trace display. Ad hoc but simple, mainly detailed print formatting.

		if ($opt_t) {			# if program trace option
			if ($opt_h && (++$hline > $opt_h)) {
				$hline= 1;	# reset line counter,
print "   time location   word     order operand     flags       A (decimal)   fetch operand    drum\n";
			}

			# absolute execution time
			print sprintf("%7.3f  ", $runtime / 1000000);

			# location word    ORDER 
			print sprintf(" %02o:%03o %06o      %-6s", 
			    $thisC >> $SSIZE, 
			    $thisC & ($SMAX - 1), $opcode, $OPCODES[$op]);

			# display track:sector for mem-ref ops
			if ($op >= 18) {		
				print sprintf("%02o:%03o ", 
				    $regK >> $SSIZE, $regK & ($SMAX - 1));

			} else {
				print sprintf("%04o   ", $regK)
			}

			# print flags
			print "    ";
			print ($Z ? "Z  " : "NZ ");
			print ($C ? "C  " : "NC ");

			# print A
			print sprintf(" %-15s ", 
			    sprintf("%06o (%d)", $regA, $regA));

			# fetch and operand search times, mS
			$m= $fetchtime / 1000;
			print " " if $m < 10;		# %2.1f doesnt pad right
			print sprintf ("  %2.1fmS  ", $m);

			if ($optime > 0) {		# if there was operand,
				$m= $optime / 1000;	# oper.-search time, mS,
				print " " if $m < 10;	# %2.1f doesnt pad right
				print sprintf ("%2.1fmS  ", $m);
				print sprintf ("%06o", $DRUM[$regK])
				    if defined ($DRUM[$regK]);
			}
			print "\n";
		}
		&realtime($fetchtime + $WORDTIME + $optime);

# Check for bad things.

		if ($regC == $thisC) {		# if it jumps to itself
			print "JUMPS TO ITSELF AT /$regC/\n";
			exit 1;			# whine, complain, etc
		}

# The HALT opcode is special. It terminates the program.

		if ($op == 1) {			# HALT
			print "\n\nHALT $regK\n";
			print "Stats: \n";
			$runtime /= 1000000;	# make seconds,
			print "  $orders orders executed\n";
			print "  $runtime seconds total execution time\n";
			$n= int (1 /  ($runtime / $orders / 10)) / 10;
			print "  $n orders/second\n";
			$n= int ($total_distance / $total_searches + 0.5);
			$i= ($total_distance * $WORDTIME) / 1e6;
			$j= $i / $total_searches; # avg search time, uS
			$j= int ($j * 10000) / 10; # in mS, 1 digit R of dot
			print "  $total_searches memory searches\n";
			print "  $i sec spent searching the drum\n";
			print "  $n sector average distance\n";
			print "  ${j}mS average search time\n";
			exit 0;
		}
	}

# Emulated TTY routines. This has to play horrible games with
# the values in B2A because Perl does all sorts of oddities
# to the typeness of the datums. But then I'm a C programmer.

sub em_ttyi { 

	$DRUM[$EM_TTCHAR]= getc() & $CHARMASK;
	$regA= $DRUM[$EM_TTCHAR];
	&cc;					# sec CCs
	$runtime += $TTYTIME;			# assuming 60WPM
	&realtime($TTYTIME);			# execute in real time,
	print "EMULATE TTYI: A=$regA Z=$Z\n" if $opt_e;
}

sub em_ttyo { 
	my($b, $c, $i);

	$regC= $regA;				# "return"
	$b= $DRUM[$EM_TTCHAR];			# get TTCHAR,
	$c= $b & $CHARMASK;
	$i= $B2A[$c];				# convert to ASCII

	$regA= $c;				# as per library spec
	&cc;					# set CCs
	print "EMULATE TTYO: A=$c Z=$Z char=/" if $opt_e;
	$i= "0" if $i eq "@";
	print $i if $i ne "";
	print "/\n" if $opt_e;
	$runtime += $TTYTIME;			# assuming 60WPM
	&realtime($TTYTIME);			# execute in real time,
}


# Set condition code FF's and bound A to machine width.

sub cc {
	$C= 0; $Z= 0;
	++$C if $regA & $WMAX;
	$regA &= $WMASK;			# bound A
	++$Z if $regA == 0;
}

# Fetch an order.

sub fetch {
	$opcode= $DRUM[$regC];			# fetch it,
	++$orders;
	$op= $opcode >> $KSIZE;			# decode opcode field
	$regK= $opcode & $KMASK;		# decode K field
}

# Search for drum location N, $track and $sector set to
# the destination and returns how long the search took, in microseconds.

sub search {
	my($dest)= $_[0];
	my($d, $t, $s);

	$t= $dest >> $SSIZE;			# target track selection,
	$s= $dest & ($SMAX - 1);		# target logical sector,

# Determine the number of sector times to the destination. This
# brute-force searches the skew table for the target sector. This is
# guaranteed to terminate as long as the sector is in range.

	&error("SECTOR /$s/ OUT OF RANGE AT C=$C") if $s >= $SECTORS;
	print "Search for $s: " if $opt_j;

	$d= 1;					# assume random access,
	if ($memorg == 0) {			# if parallel memory,
		for ($d= 0; ; ++$d) {		# D= distance to target
			$sector= 0 if $sector >= $SECTORS;# go 'round the drum,
			print "$SKEW[$sector], " if $opt_j > 1;
			last if $SKEW[$sector] == $s;	# found it,
			++$sector;		# drum is rotating
			&error ("OOPS, SKEW TABLE/MEM SEARCH FAILS! \
		    	(run again with -jty)")
		    	if $d >= $SECTORS;
		}
	}
	print "distance= $d\n" if $opt_j;

	$total_distance += $d;			# total sector difference,
	++$total_searches;			# another search

# Track-switch delay is invoked when the target track is different from
# the current track. The hardware is a one-shot; the simulation of it
# is to add (SECTORS) to the distance to the target if the search time
# would be less than the track-change delay time. Eg. we miss a revolution.

	if ($t != $track) {
print "foo t=$t track=$track\n";
		$d += $SECTORS if ($d * $WORDTIME) < $TRACKTIME;
	}
	$track= $t;				# new track 
	return($d * $WORDTIME);			# calc sector search time,
}

sub set_sym {
	my($name)= $_[0];		# symbol to assign to,
	my($arg)= $_[1];		# value to assign to it

	&error("SYMBOL /$name/ ALREADY EXISTS") if &sym($name);
	$SYM{$name}= &sym($arg);		# set new value
	&error("SYMBOL /$name/ VALUE /$arg/ OUT OF RANGE") 
	    if &sym($arg) > $WMAX;
#	++$symbols;				# count another symbol
}

# Return the numerical value of the given symbol. If the
# given symbol is a number it is returned.

sub sym {
	my($name)= $_[0];		# symbol 
	my($s);

	return($name) if $name =~ /^[0-9]/;	# value itself if 0 - 9
	$s= $SYM{$name};
	&error("SYMBOL /$name/ NOT DEFINED") if ! defined($s);
	return($s);
}

# Pause execution for realtime emulation.

sub realtime {
	my ($t)= $_[0];			# time, in microseconds

#	print "t=$t\n";
	`/bin/usleep $t` if $opt_r;			# linux-specific
}

# Runtime error.

sub error {
	print "\n$_[0]\n";
	exit(1);
}

# Raise an error if we are reading from unwritten location N.

sub unwritten {
my $n= shift;

	error ("READ FROM UNFILLED DRUM LOCATION /$n/")
	    if !$opt_q && $FLAGS[$n] != $WRITTEN;
}

# Print out the skew table.

sub printskew {

my $i;

	print "Sector skew table.\nLogical:  ";
	for ($i= 0; $i < $SECTORS; ++$i) {
		print sprintf ("%02d ", $i);
	}
	print "\n          ";
	for ($i= 0; $i < $SECTORS; ++$i) {
		print "-- ";
	}
	print "\nPhysical: ";
	for ($i= 0; $i < $SECTORS; ++$i) {
		print sprintf ("%02d ", $SKEW[$i]);
	}
	print "\n";
}