{       This program is a simulator for a somewhat simplified
      version of the DEC PDP-8 computer.
}

program pdp8(input,output,object,dumpfile);

 const
	{ The conventional starting address (O200) for PDP8 programs }
	start = 128;

	{ The PDP-8 instruction repertoire ! }

	and8  = 0;
	tad   = 1;
	isz   = 2;
	dca   = 3;
	jms   = 4;
	jmp   = 5;
	iot   = 6;
	opr   = 7;

	{ Size of memory for this simulated machine }

     coresize = 512;
     corelimit= 511;
	{ These are the decimal equivalents of various octal bit patterns we require }

       mask7  = 7;
       mask177= 127;
       mask200= 128;
       mask400= 256;
       mask770= 504;
       mask777= 511;
      mask7000= 3584;
      mask7600= 3968;
      mask7777= 4095;


	{ These just define positions for various components of display }

	accrow  = 2;            { accumulator register display }
	acccol  = 12;

	irrow   = 2;            { instruction register display }
	ircol   = 50;

	linkrow = 2;            { link register display }
	linkcol = 24;

	marrow  = 5;            { memory address register display }
	marcol  = 12;

	mdrrow  = 5;            { memory data register display }
	mdrcol  = 24;


	pcrow   = 2;            { program counter display }
	pccol   = 36;

	mem1row  = 14;          { Comments on memory }
	mem1col  = 0;

	mem2row  = 17;          { Window into Memory }
	mem2col  = 20;

	busrow   = 11;          { Bus, row, control, address and data }
	busccol  = 15;
	busacol  = 30;
	busdcol  = 45;

	prmptrow =  15;         { prompts re dumpfile etc }
	prmptcol = 0;

	waitrow = 20;           { where "To Continue Press Return" msg goes }
	waitcol = 40;

	macrow  = 8;            { Major Cycle trace }
	maccol  = 40;

	microw  = 9;            { Minor Cycle trace }
	miccol  = 0;

	dirow   = 5;            { Decode of Instruction }
	dicol   = 40;

	temprow = 9;            { Location of temporary results display }
	tempcol = 40;

	{ Some timing constants used in calls to delayn }

	regchng = 10;           { Time to highlight a register, after a change }
	memchng = 10;           { Time to highlight a memory location }
	miphs   = 8;            { Time to delay for a minor phase trace statement }
	maphs   = 24;           { Time to delay for a major phase }
	instrt  = 40;           { Time delay at start of each instruction }

 type
	{ a4k, just a subrange type for keeping to 12 bits }
	a4k   = 0..4095;

	{ symbol, packed array for a name }
	symbol = packed array[1..6] of char;

	 { Classification of symbols in sym table}
	symtype = (label8,mri8,iot8,opr8,indir8);

	{ record structure for entries in symbol table }
	entry = record
		name : symbol;
		stype : symtype;
		value : a4k;
		end;

	{ titles etc are of type string }
	string1 = packed array[1..40] of char;


 var

	{ The files: }
	object : text;    { file containing the "object code" of the PDP-8 program }
	dumpfile : text; { file for output }
	dumpopen : boolean; { flag to indicate if file opened }

	{ The symbol table passed on from "smap" }
	symtab : array[1..128] of entry;
	numsym : 0..128;


	{ The variables representing registers of the simulated machine: }
	acc  : a4k;     { PDP-8 accumulator }
	pc   : a4k;     { PDP-8 program counter }
	link : 0..1;    { PDP-8 link bit }
	mar  : a4k;     { Memory address register }
	mdr  : a4k;     { Memory data register }
	ir   : a4k;     { Instruction register }

	{ Additional variables relating to register use, instruction    }
	{ and address decoding:                                         }
	opcode : 0..7;  { Op code }
	page0 : boolean;
	indirect : boolean;
	location : 0..127;
	running : boolean; { Our flag indicating that program was running }
	aborted : boolean; { Flag to show that current instruction to abort as illegal mem-ref }
	oprbits : 0..511;
	device  : 0..63;
	inst    : 0..7;



	acclink : integer; { A temporary variable to make arithmetic etc
				easier to work with in this PASCAL program }



	{ The PDP-8's memory }
	store : array[0..corelimit] of a4k;



	{ controls on execution and display }
	slowfactor : integer; { depends on terminal speed, determines number of nulls sent }

	singlestep : boolean;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
{       The following functions are just for displaying what is           }
{  happening. They attempt to create a visual window into the simulated   }
{  computer. They use various cursor addressing facilities of VC404       }
{  terminals.                                                             }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure position(line,column: integer);
	const cntrlcoord = 16;
	begin
	{ cursor addressing, cntrl + 2 other chars define coords        }
		write(chr(cntrlcoord));
		write(chr(line+ord(' ')));
		write(chr(column+ord(' ')))
	end;

	{ * * * * * * display functions * * * * * * * }

	procedure slowdown;
	var i : integer;
	begin
	{ The terminal takes a finite time to process some cntrl-characters.
	Provide a delay by sending the terminal a set of null characters.
	(Changed subsequently to make that rubouts, 127 instead of zero,
	because some modems wouldn't accept lots of nulls)
	}
	      for i:=1 to slowfactor do write(chr(127))
	end;



	{ * * * * * * display functions * * * * * * * }

	procedure clrendline;
	const  cntrlclear = 22;         { decimal equivalents of various cntrl characters }
	begin
		write(chr(cntrlclear)); { clear the rest of this line }
		slowdown;               { give it time! }
	end;

	{ * * * * * * display functions * * * * * * * }

	procedure clrendscreen;
	const  cntrlclear = 23;         { decimal equivalents of various cntrl characters }
	begin
		write(chr(cntrlclear)); { clear from here to end of the screen }
		slowdown;               { give it time! }
	end;


	{ * * * * * * display functions * * * * * * * }

	procedure clearscreen;
	const  cntrlclear = 24;         { decimal equivalents of various cntrl characters }
	begin
		write(chr(cntrlclear)); { clear the screen }
		slowdown;               { give it time! }
		slowdown;
		slowdown;
	end;

	{ * * * * * * display functions * * * * * * * }

	procedure invertvideo;
	const inverse = 17;
	begin
		write(chr(inverse));
	end;

	{ * * * * * * display functions * * * * * * * }


	procedure delayn(n : integer);
	var i : integer;
	{ simplest reliable way of getting controllable delays seems      }
	{ to be to send a stream of null characters to the terminal       }
	begin
		for i:=1 to n do slowdown;
	end;



	{ * * * * * * display functions * * * * * * * }

	procedure waitforit;
	begin
	      position(waitrow,waitcol);
	      write('To continue press');
	      invertvideo;
	      write('RETURN');
	      invertvideo;
	      readln;
	      position(waitrow,waitcol);
	      clrendline;
	end;

	{ * * * * * * display functions * * * * * * * }

	procedure box(row,col,size: integer);
	var i : integer;
	begin
	{ Want to have a field on screen @row, col, of length size      }
	{ where will be having some datum displayed.                    }
	{ Draw a box around that field                                  }
		position(row-1,col-1);
		write('+');
		for i:=1 to size do write('-');
		write('+');
		position(row,col-1);
		write('|');
		position(row,col+size);
		write('|');
		position(row+1,col-1);
		write('+');
		for i:=1 to size do write('-');
		write('+');
	end;


	{ * * * * * * display functions * * * * * * * }


	procedure phase(title : string1; row,col,delay : integer; major,inverse : boolean);
	begin


		position(row,col);
		clrendline;


		position(row,col);

		if inverse then invertvideo;
		write(title);
		if inverse then invertvideo;

		if singlestep & major then waitforit else delayn(delay);


	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
{               Utility functions not really part of the                  }
{                      simulator                                          }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	function octread(var inf : text) : integer;
	var ch : char;
	    val : integer;
	begin

	{ skip over leading blanks and other characters         }
	{ read an octal number, stop at first non octal digit   }
	{ drop remaining characters in input line               }
	{ chop number read to twelve bits                       }

	    while not (inf^ in ['0'..'7']) do get(inf);

	    val:=0;

	    while (inf^ in ['0'..'7']) do begin
		ch:=inf^;
		get(inf);
		val:=8*val+(ord(ch)-ord('0'))
		end;

	    readln(inf);  { remove eol mark }

	    { chop to max size of 12 bits }
	    octread:=(val mod 4096)
	end;


{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure octwrite(x : a4k; d : integer;var f : text);
	var temp : 0 .. 7;
	    ch : char;
	begin

	{ write octal number in "x", in a field of width "d"    }
	{ to the file "f"                                       }

	     if d > 1 then octwrite(x div 8, d - 1,f);
	     temp:= x mod 8;
	     ch:=chr(ord('0') + temp);
	     write(f,ch)
	end;



{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }


	function andintegers(alpha,beta : integer) : integer;
	var result,bits : integer;
	begin
	{ Very frequently we will need to mask out specific     }
	{ bits of an integer (alpha will be the source, beta    }
	{ the mask). Of course, this is not allowed in PASCAL.  }
	{ Hence this contrived routine for performing the task. }
	{ Its written to handle just 12-bits, as required for   }
	{ our PDP-8                                             }

		alpha:=alpha mod 4096; { just in case, make them 12bit numbers}
		beta:=beta mod 4096;

		bits:=2048;
		result:=0;
		while bits>0 do begin
			if ((alpha >= bits) and (beta >= bits)) then
				result:=result+bits;
			if (alpha >= bits) then alpha:=alpha-bits;
			if (beta  >= bits) then beta:=beta-bits;
			bits:=bits div 2
			end;
		andintegers:=result
	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	function bitcomplement(alpha : integer) : integer;
	var res,bits : integer;
	begin
	{ Another phony routine to flip the bits in a number            }

		alpha:=alpha mod 4096;
		bits:=2048;
		res:=0;
		while bits>0 do begin
			if alpha < bits then res:=res+bits
				else alpha:=alpha-bits;
			bits:=bits div 2
			end;
		bitcomplement:=res
	end;


{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	function bittest(alpha,beta : integer) : boolean;
	begin
	{ want sometimes to test if two bit strings have any bits       }
	{ in common, i.e. their "AND" is non zero                       }
	{ this functions somewhat clumsily expresses the desired test   }

		bittest:=(0 <> andintegers(alpha,beta))
	end;


{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }


	procedure dumpcore(var dumpfile : text;needregisters : boolean);
	var       i,j: 0..coresize;
	    skip,data,anywritten: boolean;
	begin
	{ This procedure produces a dump, in octal, of the              }
	{ contents of memory, also, of registers                        }
	{ Large areas of empty memory (i.e. zeros) are omitted from     }
	{ the generated listing.                                        }

	   writeln(dumpfile);

	   if needregisters then begin
	       write(dumpfile,'acc : '); octwrite(acc,4,dumpfile);
	       write(dumpfile,'    pc  : '); octwrite(pc,4,dumpfile);
	       write(dumpfile,'    link: '); octwrite(link,1,dumpfile);
	       writeln(dumpfile);
	       writeln(dumpfile);
	       end;

	   i:=0;
	   anywritten:=false;
	   skip:=false;

	   writeln(dumpfile);
	   writeln(dumpfile,'Address                        Contents');
	   writeln(dumpfile);


	   while i< coresize do begin

		data:=false;
		for j:=i to (i+7) do data:=data | (store[j]<>0);

		if data then begin
			if skip & anywritten then
				writeln(dumpfile,'          .     .     .     .     .     .     .     .');
			octwrite(i,4,dumpfile);
			write(dumpfile,' :');
			for j:=i to (i+7) do begin
				write(dumpfile,'  ');
				octwrite(store[j],4,dumpfile);
				end;
			writeln(dumpfile);
			anywritten:=true;
			skip:=false
			end
		else skip:=true;

		i:=i+8

		end;
	end;



{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }


	procedure getprogram;
	var i,n : integer;
	    ch  : char;
	  val,j : integer;
	begin
	{ read in code as produced by "smap" program }
	   reset(object);
	   for i:=0 to corelimit do store[i]:=0;

	{ each line consists of a marker character, * => relocate origin }
	{       space => data for placing in current location            }
	{       $     => end of code                                     }

	    read(object,ch);

	    n:=0;

	    while ch<>'$' do begin
		val:=octread(object);
		case ch of
			' ' : begin
				store[n]:=val;
				n:=n+1
			      end;
			'*' : begin
				if val> corelimit then
					writeln('Illegal address in object file.')
				else n:=val
			      end;
		end;
		read(object,ch)
		end;

	readln(object);

	{ Now the symbol table                                          }
	readln(object,numsym);
	if numsym>0 then
	    for i:=1 to numsym do
		with symtab[i] do begin
			for j:=1 to 6 do read(object,name[j]);
			read(object,j);
			case j of
				0:  stype:=label8;
				1:  stype:=mri8;
				2:  stype:=opr8;
				3:  stype:=iot8;
				4:  stype:=indir8;
				end;
			value:=octread(object);
			end;


	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure highlight(atrow,atcol,value,howbig,howlong : integer);
	begin
	{ draw attention to some particular field containing an octal number }

	{ at position }
	position(atrow,atcol);

	{ inverse video to highlight }
	invertvideo;

	{ write the value, in a field size defined by howbig }
	octwrite(value,howbig,output);

	{ pause a while }
	delayn(howlong);


	{ restore to normal, repeat sequence really }
	position(atrow,atcol);
	invertvideo;
	octwrite(value,howbig,output);

	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	function lookup(want : a4k; st : symtype; var ptr : integer) : boolean;
	var i: integer;
	    found: boolean;
	begin
	{ look through symbol table for a symbol whose value field      }
	{ equals "want" and whose symtype equals "st", if find it       }
	{ return true and pass back index number in table where it is   }

		i:=0;
		found:=false;
		while (i < numsym) do begin
				i:=i+1;
				with symtab[i] do
					if (want=value) & (st=stype) then begin
						found:=true;
						ptr:=i;
						i:=numsym; { i.e. "BREAK" }
						end
			end;
		lookup:=found

	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure memshow(loc : integer);
	var i : integer;
	    l : integer;
	begin
	   for i:=-2 to 2 do begin
		l:=loc+i;
		if l<0 then l:=l+coresize;
		l:=l mod coresize;
		position(mem2row+i,mem2col);
		if l=loc then invertvideo;
		octwrite(l,4,output);
		if l=loc then invertvideo;
		write('  ');
		octwrite(store[l],4,output)
		end
	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure frommemory;

	begin
	{       mdr:= store[mar];                                       }

	    position(busrow,busccol);
	    write('READ ');
	    position(busrow,busdcol);
	    clrendline;
	    position(mem2row-2,0);
	    clrendscreen;

	    highlight(busrow,busacol,mar,4,regchng);

	    if (mar>=0) and (mar<=corelimit) then begin
		memshow(mar);


		highlight(mem2row,mem2col+6,store[mar],4,memchng);
		highlight(mem2row,mem2col+16,store[mar],4,memchng);

		highlight(busrow,busdcol,store[mar],4,regchng);

		mdr:=store[mar];

		highlight(mdrrow,mdrcol,mdr,4,regchng);
		if singlestep then waitforit else delayn(miphs);
		end
	     else begin
		position(mem2row,0);
		writeln('Illegal Memory Reference');
		writeln('Referenced address is outside of store of simulated machine.');
		writeln;
		delayn(100);
		write('Address was '); octwrite(mar,4,output); writeln;
		delayn(250);
		writeln('Program will be terminated.');
		delayn(100);
		running:=false; aborted:=true;
		mdr:=0
		end;
	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure tomemory;
	begin
	{       store[mar] := mdr                                       }

	    position(busrow,busccol);
	    write('WRITE');
	    position(mem2row-2,0);
	    clrendscreen;
	    highlight(busrow,busdcol,mdr,4,regchng);
	    highlight(busrow,busacol,mar,4,regchng);

	    if (mar>=0) and (mar<=corelimit) then begin
		memshow(mar);

		highlight(busrow,busdcol,mdr,4,regchng);
		highlight(mem2row,mem2col+16,mdr,4,regchng);
		highlight(mem2row,mem2col+6,store[mar],4,memchng);
		highlight(mem2row,mem2col+16,mdr,4,regchng);
		position(mem2row,mem2col+6);
		write('    ');
		delayn(memchng);
		highlight(mem2row,mem2col+16,mdr,4,regchng);
		highlight(mem2row,mem2col+6,mdr,4,memchng);

		if singlestep then waitforit else delayn(miphs);

		store[mar]:=mdr
		end
	     else begin
		position(mem2row,0);
		writeln('Illegal Memory Reference');
		writeln('Referenced address is outside of store of simulated machine.');
		writeln;
		delayn(100);
		write('Address was '); octwrite(mar,4,output); writeln;
		delayn(250);
		writeln('Program will be terminated.');
		delayn(100);
		running:=false; aborted:=true;
		end;

	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
{               Things of significance really start about here.           }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure fetchinstruction;
	begin
	{       Instruction fetch,
	copy pc to memory address register,
	access specified memory location, placing copy of its
		contents in memory data register,
	copy from memory data register to instruction register
		prior to instruction decoding.
	increment program counter (summing into temporary register,
		copying 12 bits back to program counter)
	}

		position(dirow,dicol);
		clrendline;

		position(microw,miccol);
		clrendline;

		phase('Fetching Instruction                    ',macrow,maccol,instrt,true,true);

		phase('Copy pc to mar                          ',microw,miccol,miphs,false,false);

		highlight(pcrow,pccol,pc,4,regchng);

		mar:=pc;

		highlight(marrow,marcol,mar,4,regchng);

		phase('Access memory, contents to mdr          ',microw,miccol,miphs,false,false);

	       frommemory;


		phase('Copy fetched instruction to ir          ',microw,miccol,miphs,false,false);

		ir:=mdr;

		highlight(irrow,ircol,ir,4,regchng);

		acclink:=pc+1;
		pc:=andintegers(acclink,mask7777);


		phase('Increment pc                            ',microw,miccol,miphs,false,false);
		highlight(pcrow,pccol,pc,4,regchng);

	end;


{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }


	procedure decodeaddress;
	var ptr : integer;
	begin
	{

	}

		position(microw,miccol);
		clrendline;
		phase('Decoding data address                   ',macrow,maccol,maphs,true,true);


		{ Pick out the bit that indicates if indirection required }
		indirect:=(mask400 = andintegers(ir,mask400));

		if indirect then
			phase('Indirect addressing mode, have pointer  ',microw,miccol,miphs,false,false)
		else
			phase('Direct addressing                       ',microw,miccol,miphs,false,false);

		{ Pick out the bit that says if page 0 or current page }
		page0:=(0 = andintegers(ir,mask200));

		if page0 then
			phase('Referenced address/pointer on page 0    ',microw,miccol,miphs,false,false)
		else
			phase('Referenced address/pointer on this page ',microw,miccol,miphs,false,false);


		{ Pick out the bits that define location within page }
		location:=andintegers(ir,mask177);


		phase('Location on page                        ',microw,miccol,miphs,false,false);
		highlight(temprow,tempcol,location,4,regchng);

		{ Construct address by taking location and page-number,
	if page0 then the location is the absolute address, otherwise we
	need to split out from program counter the bits that identify
	current page and "or" these in (can't use "or" so add them). }

		if page0 then begin
			mar:=location;
			phase('Page 0, address to mar                  ',microw,miccol,miphs,false,false);
			end
		   else begin
			phase('This page, location combined with this  ',microw,miccol,miphs,false,false);
			phase('page number from pc, result to mar      ',microw,miccol,miphs,false,false);
			highlight(temprow,tempcol,location,3,regchng);
			position(temprow,tempcol+5);
			write(' + ');
			highlight(temprow,tempcol+10,andintegers(pc,mask7600),4,regchng);
			position(temprow,tempcol+15);
			write(' = ');
			mar:=andintegers(pc,mask7600) + location;
			highlight(temprow,tempcol+20,mar,4,regchng);

			end;

		highlight(marrow,marcol,mar,4,regchng);

		if indirect then begin
			position(dirow,dicol+5);
			write('i');
			end;

		position(dirow,dicol+7);
		if lookup(mar,label8,ptr) then write(symtab[ptr].name)
		else octwrite(mar,4,output);

		{ Now determine if indirection needed. If so, go do it }

		if indirect then begin

				 phase('Perform indirection, mar identifies ptr ',microw,miccol,miphs,false,false);
				 phase('Fetch from that location into mdr       ',microw,miccol,miphs,false,false);

				 frommemory;
				 highlight(mdrrow,mdrcol,mdr,4,regchng);

				 phase('Copy address from mdr to mar            ',microw,miccol,miphs,false,false);
				 mar:=mdr;
				 highlight(marrow,marcol,mar,4,regchng);
				 end;

		phase('Now have effective address in mar       ',microw,miccol,miphs,false,false);

		highlight(marrow,marcol,mar,4,regchng);



	end;


{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }


	procedure decodeinstruction;
	var temp,ptr : integer;
	begin

		position(microw,miccol);
		clrendline;

		phase('Decoding Instruction                    ',macrow,maccol,maphs,true,true);

		{ First, break out the opcode}

		temp:=andintegers(ir,mask7000);
		opcode:=temp div 512; { UGH, should be a shift }
		phase('Opcode abstracted                       ',microw,miccol,miphs,false,false);
		highlight(temprow,tempcol,opcode,1,regchng);


		{ Now, decide how to deal with rest of data in instruction
	register. If its a Memory Reference Instruction, then want
	the mar to hold the correct address, allowing for indirection etc.


		If the opcode is an IOT, then want device and function
	identified.

		If the opcode is an operate, the want oprbits set.

		}

		position(dirow,dicol);

		case opcode of

		and8,tad,dca,isz,jms,jmp :
			begin

			case opcode of
				and8:  write('and');
				tad:   write('tad');
				dca:   write('dca');
				isz:   write('isz');
				jms:   write('jms');
				jmp:   write('jmp');
			end;
			{ Memory address class, translate rest of word }
			phase('Memory Reference Class                  ',microw,miccol,miphs,false,false);
			decodeaddress;
			end;


		iot : begin

			temp:=andintegers(ir,mask770);
			device:=temp div 8;
			inst:=andintegers(mdr,mask7);
			if lookup(ir,iot8,ptr) then write(symtab[ptr].name)
			else begin write('iot ');
				octwrite(device,2,output);
				write(' ');
				octwrite(inst,1,output)
			     end;
			phase('Input/Output type                       ',microw,miccol,miphs,false,false);
			end;


		opr :   begin
			oprbits:=andintegers(ir,mask777);
			if lookup(ir,opr8,ptr) then write(symtab[ptr].name)
			else begin write('opr ');
				octwrite(oprbits,3,output);
			     end;
			phase('Microcoded "Operate" Class              ',microw,miccol,miphs,false,false);
			end;
		end
	end;


{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }


	procedure inputoutput;

	begin
		clearscreen;
		writeln;
		writeln('Input Output Instructions are not being simulated.');
		write('I/O instruction specified  device #');
		octwrite(device,2,output);
		write(', and operation #');
		octwrite(inst,1,output);
		writeln;
		running:=false
	end;


{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
{       procedures rotateleft and rotateright                             }
{               provide somewhat clumsy mechanisms for treating           }
{               acc and link as a single 13-bit register and performing   }
{               circular shifts on contents thereof                       }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
	procedure rotateleft(doubles : boolean);
	var temp : integer;
	begin
	    if doubles then rotateleft(false);
	    phase('Rotating Left, initial register values  ',microw,miccol,miphs,false,false);
	    highlight(accrow,acccol,acc,4,regchng);
	    highlight(linkrow,linkcol,link,1,regchng);
	    temp:= acc + acc; { double it to achieve shift left }
	    acc:=andintegers(temp,mask7777); { mask out relevant bits }
	    acc:=acc+link; { bring link bit end around }
	    if temp > 4095 then link:=1
		else link:=0;
	    phase('Rotating Left, final register values    ',microw,miccol,miphs,false,false);
	    highlight(accrow,acccol,acc,4,regchng);
	    highlight(linkrow,linkcol,link,1,regchng);
	end;
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
	procedure rotateright(doubles : boolean);
	var temp : integer;
	begin
	    if doubles then rotateright(false);
	    phase('Rotating Right, initial register values ',microw,miccol,miphs,false,false);
	    highlight(accrow,acccol,acc,4,regchng);
	    highlight(linkrow,linkcol,link,1,regchng);
	    temp:= acc mod 2; { pick of bit that will shift into link }
	    acc:=acc div 2;   { divide to achieve shift right }
	    acc:=acc + 2048*link; { add in link with correct offset }
	    link:=temp;
	    phase('Rotating Right, final register values   ',microw,miccol,miphs,false,false);
	    highlight(accrow,acccol,acc,4,regchng);
	    highlight(linkrow,linkcol,link,1,regchng);

	end;
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure operate;

		{ In principle, there are 9 bits available to identify
	operate class instructions, supposedly therefore allowing some
	500 such instructions. It don't work that way.
		Operate instructions are "microcoded". Specific bits
	are used to designate specific instructions etc.
	So only have a few valid possibilites.
		Essentially, there are two classes of operate instructions.
	Group-1 instructions manipulate the contents of the accumulator
	and link. Group-2 instructions are primarily concerned with
	testing operations.


	Group-1:

	     0   1   2   3   4   5   6   7   8   9  10  11
	   +---+---+---+---+---+---+---+---+---+---+---+---+
	   | 1 | 1 | 1 | 0 |cla|cll|cma|cml|rar|ral|0/1|iac|
	   +---+---+---+---+---+---+---+---+---+---+---+---+
	   |< op-code >| ^                           ^
			 |                           |
			 |                      0 : rotate one place
			 |                      1 : rotate two places
			zero here
			specifies group 1


		The microcoding can be used to combine the basic
	set of operate instructions; thus, in a single instruction
	one could for example clear the accumulator (cla), clear the
	link (cll) and increment the accumulator (iac).


	Group-2:

	     0   1   2   3   4   5   6   7   8   9  10  11
	   +---+---+---+---+---+---+---+---+---+---+---+---+
	   | 1 | 1 | 1 | 1 |cla|sma|sza|snl| 0 |osr|hlt| 0 |
	   |   |   |   |   |cla|spa|sna|szl| 1 |osr|hlt|   |
	   +---+---+---+---+---+---+---+---+---+---+---+---+
	   |< op-code >| ^   /interpretation\            ^
			 |   |depends on bit |           |
			 |   |   8.          |           zero for group
			 |                               2.
			one here
			specifies group 2.



		}

	const cla = 128;        { These are the decimal values corresponding }
	      cll = 64;         { to those operate instructions that we implement }
	      cma = 32;
	      cml = 16;
	      rar = 8;
	      ral = 4;
	shifttwice= 2;
	      iac = 1;
	      sma = 64;
	      spa = 64;
	      sza = 32;
	      sna = 32;
	      snl = 16;
	      szl = 16;
	      skp = 8;
	      hlt = 2;


	var toskip : boolean;


	begin

		if bittest(mask400,oprbits) then
			begin
		    { Its a Group-2 skip type instruction. }
		    { Time 1, evaluate the skip conditional }
			phase('Skip instruction                        ',microw,miccol,miphs,false,false);
			toskip:=false;

			if bittest(skp,oprbits) then begin
				{ the AND group and unconditional skip }
				toskip:=true; { unconditional }

				{ Slightly oddly expressed test for
				positive acc reflects twos complement
				arithmetic used in PDP-8 }
				if bittest(spa,oprbits) then
					toskip:=toskip and (acc < 2048);

				if bittest(sna,oprbits) then
					toskip:=toskip and (acc <> 0);

				if bittest(szl,oprbits) then
					toskip:=toskip and (link=0)

				end
			else    begin
				{ the OR group }

				{ slighly oddly expressed test for
				minus acc reflect twos complement
				arithmetic used in PDP-8 }
				if bittest(sma,oprbits) then
					toskip:=toskip or (acc >= 2048);

				if bittest(sza,oprbits) then
					toskip:=toskip or (acc = 0);

				if bittest(snl,oprbits) then
					toskip:=toskip or (link <> 0)

				end;

		    { If appropriate, increment the pc }

			if toskip then begin
				phase('Skip condition true, increment pc       ',microw,miccol,miphs,false,false);
				highlight(pcrow,pccol,pc,4,regchng);
				acclink:=pc+1;
				pc:=andintegers(acclink,mask7777);
				highlight(pcrow,pccol,pc,4,regchng);
				end
			else
			phase('Skip condition false, pc unchanged      ',microw,miccol,miphs,false,false);

		    { Time 2, maybe clear acc }

			if bittest(cla,oprbits) then begin
				phase('Clear acc,                              ',microw,miccol,miphs,false,false);
				acc:=0;
				highlight(accrow,acccol,acc,4,regchng);
				end;

		    { Time 3, maybe halt }

			if bittest(hlt,oprbits) then begin
				phase('Halt                                    ',microw,miccol,miphs,false,false);

				running:=false
				end;


			end
		else    begin
		   { Bit 3 is zero, its a group-1 microinstruction }


		   { First time sequence, cla, cll }

			if bittest(cla,oprbits) then begin
				phase('Clear acc,                              ',microw,miccol,miphs,false,false);
				acc:=0;
				highlight(accrow,acccol,acc,4,regchng);
				end;

			if bittest(cll,oprbits) then begin
				phase('Clear link,                             ',microw,miccol,miphs,false,false);
				link:=0;
				highlight(linkrow,linkcol,link,1,regchng);
				end;


		   { 2nd time sequence, complement acc and link }

			if bittest(cma,oprbits) then begin
				phase('Complement acc                          ',microw,miccol,miphs,false,false);
				highlight(accrow,acccol,acc,4,regchng);
				acc:=bitcomplement(acc);
				highlight(accrow,acccol,acc,4,regchng);
				end;

			if bittest(cml,oprbits) then begin
				phase('Complement link                         ',microw,miccol,miphs,false,false);
				highlight(linkrow,linkcol,link,1,regchng);
				if link=1 then link:=0
					else link:=1;
				highlight(linkrow,linkcol,link,1,regchng);
				end;

		   { 3rd time sequence, increment acc }

			if bittest(iac,oprbits) then begin
				phase('Increment acc                           ',microw,miccol,miphs,false,false);
				highlight(accrow,acccol,acc,4,regchng);
				acclink:=acc+1;
				acc:=andintegers(acclink,mask7777);
				highlight(accrow,acccol,acc,4,regchng);
				end;

		    { 4th time sequence, rotates }

			if bittest(ral,oprbits) then
				rotateleft(bittest(shifttwice,oprbits))
			else
			if bittest(rar,oprbits) then
				rotateright(bittest(shifttwice,oprbits))

			end
	end;


{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure executeinstruction;

	begin
		position(microw,miccol);
		clrendline;


		phase('Executing Instruction                   ',macrow,maccol,maphs,true,true);


		case opcode of
			and8: begin
				{ The AND instruction causes a bit-by-bit
			Boolean and operation between the contents of
			the accumulator and the data word specified
			by the instruction. The result is left in the
			accumulator.
				}
			      phase('Data Fetch                   ',microw,miccol,miphs,false,false);
			      frommemory;
			      if not aborted then begin
				phase('AND of acc and mdr                      ',microw,miccol,miphs,false,false);
				highlight(accrow,acccol,acc,4,regchng);
				highlight(mdrrow,mdrcol,mdr,4,regchng);
				acc:=andintegers(acc,mdr);
				phase('AND of acc and mdr gives                ',microw,miccol,miphs,false,false);
				highlight(temprow,tempcol,acc,4,regchng);
				highlight(accrow,acccol,acc,4,regchng);
				end;
			      end;


			tad:  begin
				{ TAD perfomrs addition between the
			specified data word and the contents of the
			accumulator leaving the result of the addition
			in the accumulator. If a carry out of the
			most significant bit of the accumulator should
			occur then the link bit is complemented.
				}
			      phase('Data Fetch                   ',microw,miccol,miphs,false,false);
			      frommemory;
			      if not aborted then begin
				phase('TAD of acc and mdr                      ',microw,miccol,miphs,false,false);
				highlight(accrow,acccol,acc,4,regchng);
				highlight(mdrrow,mdrcol,mdr,4,regchng);
				acclink:=acc+mdr;
				if acclink>4095 then begin
					{ have carry bit, complement link }
					if link=1 then link:=0
						else link:=1;
					phase('carry complements link                  ',microw,miccol,miphs,false,false);
					highlight(linkrow,linkcol,link,1,regchng);
					end;
				acc:=andintegers(acclink,mask7777);
				phase('TAD of acc and mdr gives                ',microw,miccol,miphs,false,false);

				highlight(temprow,tempcol,acc,4,regchng);
				highlight(accrow,acccol,acc,4,regchng);
				end;
			      end;





			isz:  begin
				{ The ISZ instruction adds a 1 to the
			referenced data word and then examines the result
			of the addition. If a zero result occurs, the
			instruction following the ISZ is skipped. If the
			result is not zero, the instruction following the
			ISZ is performed. In either case, the result of
			the addition replaces the original data word in
			memory.
				}
			      phase('Data Fetch                   ',microw,miccol,miphs,false,false);
			      frommemory;
			      if not aborted then begin
				highlight(mdrrow,mdrcol,mdr,4,regchng);
				phase('Increment fetched value by 1 ',microw,miccol,miphs,false,false);
				acclink:=mdr+1;
				if acclink > 4095 then mdr:=0
				else mdr:=acclink;
				highlight(mdrrow,mdrcol,mdr,4,regchng);
				phase('Write back new value         ',microw,miccol,miphs,false,false);
				phase('Data Store                   ',microw,miccol,miphs,false,false);
				tomemory;
				if mdr=0 then begin
					phase('New value 0, need to skip    ',microw,miccol,miphs,false,false);
					phase('Increment pc                 ',microw,miccol,miphs,false,false);
					highlight(pcrow,pccol,pc,4,regchng);
					pc:=pc+1;
					highlight(pcrow,pccol,pc,4,regchng);
					end;
				end;
			      end;




			dca:  begin
				{ DCA, deposit and clear accumulator.
			The DCA instruction stores the contents of the
			ac in the referenced location, destroying the
			original contents of the location. The ac
			is the set to zero
				}
			      phase('acc to mdr                   ',microw,miccol,miphs,false,false);
			      highlight(accrow,acccol,acc,4,regchng);
			      mdr:=acc;
			      highlight(mdrrow,mdrcol,mdr,4,regchng);
			      phase('Data Store                   ',microw,miccol,miphs,false,false);
			      tomemory;
			      if not aborted then begin
				acc:=0;
				phase('clear acc                    ',microw,miccol,miphs,false,false);
				highlight(accrow,acccol,acc,4,regchng);
				end;
			      end;



			jms:  begin
				{ JMS, Jump to subroutine.
			The value of the pc (the address of the JMS instruction
			+1) is always stored in the first location of the
			subroutine, replacing its original contents;

			Program control is always transferred to the location
			of the operand + 1 (second location of the subroutine).

				}

			      phase('Subroutine call, save return ',microw,miccol,miphs,false,false);
			      phase('copy pc to mdr               ',microw,miccol,miphs,false,false);
			      highlight(pcrow,pccol,pc,4,regchng);
			      mdr:=pc;
			      highlight(mdrrow,mdrcol,mdr,4,regchng);
			      phase('Data Store                   ',microw,miccol,miphs,false,false);
			      tomemory;
			      if not aborted then begin
				phase('Set program counter from mar ',microw,miccol,miphs,false,false);
				highlight(marrow,marcol,mar,4,regchng);
				pc:=mar+1;
				phase('pc:=mar+1                    ',microw,miccol,miphs,false,false);
				highlight(pcrow,pccol,pc,4,regchng);
				end;

			      end;



			jmp:  begin
				{ JMP, jump (goto) instruction.
			Loads effective address calculated during
			instruction decode into the program counter pc.
				}
			      phase('Jmp i.e. GOTO instruction    ',microw,miccol,miphs,false,false);
			      phase('Set program counter from mar ',microw,miccol,miphs,false,false);
			      highlight(marrow,marcol,mar,4,regchng);
			      pc:=mar;
			      highlight(pcrow,pccol,pc,4,regchng);
			      end;



			iot:  inputoutput;




			opr:  operate
		 end
	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure initialize;
	var ch : char;
	begin
		slowfactor:=8; { temporary set at a default value }
		clearscreen;
		{ VC404 terminals take time to respond to some characters }
		{ so fill with nulls, appropriate number depends on       }
		{ whether have 300 baud phone in line, 1200 normal or     }
		{ 19.2k fast line, more nulls needed for faster terminals }
		{ also depends on load on machine etc etc                 }


writeln('       A delay factor is incoporated into this program. This delay factor');
writeln('is intended to make the display run, as near as possible, at an acceptable');
writeln('speed. The best value for the delay factor depends on system load, the speed');
writeln('of the line connecting your terminal to the computer and on subjective');
writeln('feelings. A suitable value is generally in the range 1-16.');
writeln('(The delay factor scale is linear, a suitable default might be 6).');
writeln;
writeln('Please enter your chosen delay factor: ( a number in range 1 - 16 )');
readln(slowfactor);

		if (slowfactor<1) | (slowfactor> 16) then begin
			writeln('defaulting delay factor to 6.');
			slowfactor:=6;
			end;

		delayn(5);

		clearscreen;
		writeln;
		writeln;
		delayn(5);
		writeln('       PPPP   DDDD   PPPP          888');
		writeln('       P   P   D  D  P   P        8   8');
		writeln('       P   P   D  D  P   P        8   8');
		writeln('       PPPP    D  D  PPPP  #####   888');
		writeln('       P       D  D  P            8   8');
		writeln('       P       D  D  P            8   8');
		writeln('       P      DDDD   P             888');

		delayn(10);

		position(prmptrow,prmptcol);
		write('Do you wish to single-step individual instruction cyles?( Y or N)');
		readln(ch);
		singlestep:=((ch='Y') | (ch='y'));
		position(prmptrow,prmptcol);
		clrendline;
		write('Now reading in the PDP-8 object code of your program.');
		delayn(20)
	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure createdisplay;
	begin
	{ Display is fairly static, so can put up some standard         }
	{ headers, boxes for data etc                                   }

		clearscreen;
		delayn(20);
		position(0,0);
		invertvideo;
		write('C.P.U.');
		invertvideo;
		delayn(20);

		box(accrow,acccol,4);
		position(accrow,acccol-6); invertvideo; write('acc'); invertvideo;
		delayn(5);

		box(linkrow,linkcol,1);
		position(linkrow,linkcol-6); invertvideo; write('link'); invertvideo;
		delayn(5);

		box(pcrow,pccol,4);
		position(pcrow,pccol-6); invertvideo; write('pc'); invertvideo;
		delayn(5);

		box(marrow,marcol,4);
		position(marrow,marcol-6); invertvideo; write('mar'); invertvideo;
		delayn(5);

		box(mdrrow,mdrcol,4);
		position(mdrrow,mdrcol-6); invertvideo; write('mdr'); invertvideo;
		delayn(5);

		box(irrow,ircol,4);
		position(irrow,ircol-6); invertvideo; write('ir'); invertvideo;
		delayn(5);

		delayn(20);

		position(busrow-1,0);
		writeln('______________________________________________________________________');
		delayn(5);
		invertvideo;
		write('BUS:');
		position(busrow,busccol-8);
		write('control');
		position(busrow,busacol-8);
		write('address');
		position(busrow,busdcol-5);
		write('data');
		invertvideo;
		delayn(5);
		position(busrow+1,0);
		writeln('______________________________________________________________________');

		delayn(20);
		position(busrow+2,0);
		invertvideo;
		write('MEMORY');
		invertvideo;
		delayn(10);
		position(mem1row,mem1col);
		write('                 Address  Contents');

		phase('Initial Register Values:                ',macrow,maccol,10,true,true);

		highlight(accrow,acccol,acc,4,10);
		highlight(linkrow,linkcol,link,1,10);
		highlight(pcrow,pccol,pc,4,10);

		delayn(20);
		phase('Initial Instruction Sequence at 0200oct ',macrow,maccol,10,true,true);

		memshow(pc);

		delayn(25);
		phase('Program execution about to begin        ',macrow,maccol,10,true,true);

		delayn(50);



	end;
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure initialdump;
	var ch:char;
	begin
		dumpopen:=false;
		position(prmptrow,prmptcol);
		clrendline;
		write('Do you want initial contents of memory "dumped" to a file?( Y or N)');
		readln(ch);
		if (ch='Y') | (ch='y') then begin
			rewrite(dumpfile);
			writeln(dumpfile,'Printout of contents of memory prior to program execution.');
			writeln(dumpfile);

			dumpcore(dumpfile,false);
			dumpopen:=true
			end;
	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure finaldump;
	var ch:char;
	begin
		write('Do you want final contents of memory and registers "dumped" to a file?( Y or N)');
		readln(ch);
		if (ch='Y') | (ch='y') then begin
			if not dumpopen then rewrite(dumpfile)
			else begin writeln(dumpfile); writeln(dumpfile); writeln(dumpfile) end;

			writeln(dumpfile,'Printout of contents of registers and memory subsequent to program execution.');
			writeln(dumpfile);
			writeln(dumpfile);
			dumpcore(dumpfile,true);
			end;
	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

{ Here is the main program,

	first load the required "PDP-8" code from a file


	initialise program counter to standard start address

	set " running " indicator

	while running
		perform the instruction fetch
			    instruction execute cycle


}



begin

	initialize;

	getprogram;

	initialdump;

	running:=true; aborted:=false;
	pc:=start;
	acc:=0;
	link:=0;

	createdisplay;


	while running do begin
		fetchinstruction;
		decodeinstruction;
		if not aborted then executeinstruction;
		if (pc<0) | (pc > corelimit) then begin
			delayn(50);
			clearscreen;
			delayn(50);
			writeln('Your program has bugs (or is too large?).');
			writeln('Attempt to transfer control to an address');
			writeln('outside of available memory.');
			writeln;
			write('Address referenced was ');
			octwrite(pc,4,output);
			writeln;
			delayn(250);
			running:=false;
			end;
		end;

	clearscreen;
	delayn(10);
	writeln('Program finished.');
	finaldump;
	position(22,0); { position cursor at bottom of screen on exit }

end.