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

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

 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 = 2048;
       corelimit= 2047;
	elim    = 20;   { maximum number of "events" }
       symlim   = 320;  { number of symbols in user symbol table }

	{ These are the decimal equivalents of various octal bit patterns we require }

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


	{ These just define positions for various components of display }

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

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

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

	mem1row  = 12;          { Window into memory, instructions }
	mem1col  = 10;

	mem2row  = 12;          { Window into Memory, data }
	mem2col  = 29;

	mem0row  = 7;           { Header for Memory Displays }

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

	dirow   = 2;            { Decode of Instruction }
	dicol   = 45;

	tirow   = 5;            { "Time" }
	ticol   = 12;

	periphrow = 16;         { Peripherals }

	d00row  = 17;           { "DEVICE" flags etc }
	d00col  = 0;

	d03row  = 18;
	d03col  = 0;

	d04row  = 19;
	d04col  = 0;

	d50row  = 20;
	d50col  = 0;

	d60row  = 21;
	d60col  = 0;



	{ some device id codes for i/o, as decimal equivs }
	d00     = 0;
	d03     = 3;
	d04     = 4;
	d50     = 40;
	d60     = 48;



	{ 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 }

 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;


 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 }
	kbd     : text;  { file for pseudo-keyboard input }
	tty     : text;  { file for pseudo-teletype output }


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


	{ The variables representing registers of the simulated machine: }
	acc  : a4k;     { PDP-8 accumulator }
	pc   : a4k;     { PDP-8 program counter }
	opc  : a4k;     { copy of same, useful for catching certain bugs }
	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 indicate if execution aborted by 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;
	breakpts : array[0..corelimit] of boolean;


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

	singlestep : boolean;
	regdisplay : boolean;
	progdisplay : boolean;
	datadisplay : boolean;
	dcddisplay  : boolean;
	perdisplay  : boolean;
	reglog     : boolean;
	fast       : boolean;

	time    : integer;
	idelay  : integer;
	icount  : integer;

	{ Variables used in several of the breakpoint routines  }
	userinput : array[1..80] of char; { user's command }
	chcnt : integer;


	{ Flags etc for i/o simulations }
	ionf    : 0..1;
	d03f    : 0..1;
	d04f    : 0..1;
	d50f    : 0..1;
	d60f    : 0..1;

	d03b    : 0..255;       { Buffers for simulated i/o devices }
	d04b    : 0..255;

	d60b    : 0..1023;


	etime   : array[1..elim] of integer;  { Event table for i/o simulations }
	etype   : array[1..elim] of integer;

	times   : array[false..true,0..5] of integer;
	rtimes  : array[false..true,0..5] of integer;

{ The times arrays are used in association with postevent, they }
{ define the basic delay, and random component of delay. }
{ the true false indicator says whether or not have set "fast" mode }
{ when very little delay for peripherals or in more normal mode }
{ the various entries are }
{ 0   unused }
{ 1   the keyboard }
{ 2   the teletype }
{ 3   the clock    }
{ 4   the a/d      }
{ 5   unused       }

	numevents : integer;
	ranseed   : integer;
	interrupt : boolean;
	clockoff  : boolean;
	intsused  : 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 later to rubout, character 127 instead of character 0,
	because some modems could not deal with streams 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 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 * * * * * * * }

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
{               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 orintegers(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) | (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;
		orintegers:=result
	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,'    Time: ',time:8,'*10^-7 seconds, Instruction Count: ',icount:8);
	       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 }
	if regdisplay then begin
		{ 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
	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; instruction : boolean);
	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;
		if instruction then position(mem1row+i,mem1col)
		else 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(instruction: boolean);
	var disp : boolean;
	begin
	{       mdr:= store[mar];                                       }
	if (mar>=0) and (mar<=corelimit) then begin
	 disp:=(instruction & progdisplay) | ((not instruction) & datadisplay);

	 if disp then begin
		memshow(mar,instruction);
		if instruction then highlight(mem1row,mem1col+6,store[mar],4,memchng)
		else highlight(mem2row,mem2col+6,store[mar],4,memchng);
		end;
	 mdr:=store[mar];
	 time:=time+10;
	 end
	else begin
		position(mem0row,0);
		clrendline;
		write('Illegal Memory Reference.');
		delayn(200);
		clearscreen;
		write('Reference to location '); octwrite(mar,4,output);
		writeln;
		writeln('Address outside of memory of simulated machine.');
		delayn(100);
		writeln('Program will be terminated after you have examined');
		writeln('machine state with break functions.');
		running:=false; aborted:=true;
		delayn(100)
	     end;

	end;

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

	procedure tomemory(instruction : boolean);
	var disp:boolean;
	begin
	{       store[mar] := mdr                                       }
	if (mar>=0) and  (mar<=corelimit) then begin
	  disp:=(instruction & progdisplay) | ((not instruction) & datadisplay);

	  if disp then memshow(mar,instruction);

	  store[mar]:=mdr;

	  if disp then begin
		if instruction then highlight(mem1row,mem1col+6,store[mar],4,memchng)
		else highlight(mem2row,mem2col+6,store[mar],4,memchng);
		end;
	  time:=time+10;
	  end
	else begin
		position(mem0row,0);
		clrendline;
		write('Illegal Memory Reference.');
		delayn(200);
		clearscreen;
		write('Reference to location '); octwrite(mar,4,output);
		writeln;
		writeln('Address outside of memory of simulated machine.');
		delayn(100);
		writeln('Program will be terminated after you have examined');
		writeln('machine state with break functions.');
		running:=false; aborted:=true;
		delayn(100)
	     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)
	}

		if regdisplay then begin
			position(tirow,ticol);
			write(time:8);
			end;

		if dcddisplay then begin
			position(dirow,dicol);
			clrendline;
			end;

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

		mar:=pc;
		frommemory(true);

		ir:=mdr;

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

	end;


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


	procedure decodeaddress(executing,display: boolean);
	var ptr : integer;
	begin
	{
	*** note that this routine is called from debug system
	*** (via decodeinstruction); then real indirection cycle
	*** shouldn't be performed.
	}


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

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


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

		{ 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;
			end
		   else begin
			mar:=andintegers(pc,mask7600) + location;
			end;


		if display then begin
			if indirect then write(' i ')
			else write('   ');
			if lookup(mar,label8,ptr) then write(symtab[ptr].name)
			else begin octwrite(mar,4,output); write('  ') end;
			end;

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

		if executing & indirect then begin

				{ deal with special case of autoincrementing memory registers }
				{ and treat as a special case! }
				 if (8<= mar) & (mar <=15) then begin
					store[mar]:=store[mar]+1
					end;

				 frommemory(false);

				 mar:=mdr;
				 time:=time+2;
				 end;

	end;


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


	procedure decodeinstruction(executing,display: boolean);
	var temp,ptr : integer;
	begin
	{ *** Note that this routine also called from debug package     }
	{ when want dump of memory as instructions                      }

		{ First, break out the opcode}

		temp:=andintegers(ir,mask7000);
		opcode:=temp div 512; { UGH, should be a shift }

		{ 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.

		}

		if executing & display then position(dirow,dicol);

		case opcode of

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

			if display then
			    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 }
			decodeaddress(executing,display);
			end;


		iot : begin

			temp:=andintegers(ir,mask770);
			device:=temp div 8;
			inst:=andintegers(mdr,mask7);
			if display then begin
				if lookup(ir,iot8,ptr) then write(symtab[ptr].name,'      ')
				else begin write('iot ');
					   octwrite(device,2,output);
					   write(' ');
					   octwrite(inst,1,output);
					   write('    ');
					   end;
				end;
			end;


		opr :   begin
			oprbits:=andintegers(ir,mask777);
			if display then begin
				if lookup(ir,opr8,ptr) then write(symtab[ptr].name,'      ')
				else begin write('opr ');
					   octwrite(oprbits,3,output);
					   write('     ');
				    end;
			  end;
			end;
		end
	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
{       postevent,                                                        }
{               record an event that is to be signalled sometime later    }
{       by external event procedure. "events" kept ordered by time        }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
	procedure postevent(itype,btime,rtime : integer);
	var  j,i,ir,t : integer;
	begin
	  if numevents=elim then begin
		running:=false;
		writeln('Event queue for peripheral devices has overflowed!');
		writeln('WHAT ARE YOU DOING????????');
		end
	  else begin
		ranseed:=(ranseed*109+853) mod 4096;
		if rtime <> 0 then ir:=ranseed mod rtime
			else ir:=0;
		t:=time+btime+ir;
		i:=1;
		while (i<=numevents) and (t > etime[i]) do i:=i+1;
		j:=numevents;
		while (j>=i) do begin
			etime[j+1]:=etime[j];
			etype[j+1]:=etype[j];
			j:=j-1
			end;
		numevents:=numevents+1;
		etime[i]:=t;
		etype[i]:=itype
	  end;
	end;


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

	procedure showperiphs(dev : integer);
	begin
	if perdisplay then begin
		case dev of
		  d00 : begin
			position(d00row,d00col); clrendline;
			if ionf=1 then write('(interrupts enabled)');
			end;
		  d03 : begin
			position(d03row,d03col); clrendline;
			if d03f=1 then begin
				write('Keyboard flag set, data ');
				octwrite(d03b,3,output);
				end;
			end;
		  d04 : begin
			position(d04row,d04col); clrendline;
			if d04f=1 then write('Teletype flag set.');
			end;
		  d50 : begin
			position(d50row,d50col); clrendline;
			if d50f=1 then write('Clock flag set.');
			end;
		  d60 : begin
			position(d60row,d60col); clrendline;
			if d60f=1 then begin
				write('A/D flag set, data ');
				octwrite(d60b,4,output);
				end;
			end;
		end;
	    end;
	end;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
{                                                                         }
{       Input-Output,                                                     }
{                                                                         }
{       I/O devices:                                                      }
{              00       cpu status                                        }
{              03       keyboard                                          }
{              04       teletype                                          }
{              50       clock                                             }
{              60       a/d                                               }
{       "device" 0                                                        }
{                     cpu status                                          }
{               6001    enable interrupts                                 }
{               6002    disable interrupts                                }
{       "device" 03    (keyboard)                                         }
{               6031   ksf, keyboard skip flag                            }
{               6032   clear flag and accumulator                         }
{               6034   read buffer into acc                               }
{               N.B. krb 6036 combines 6032, 6034                         }
{       "device" 04    (teletype)                                         }
{               6041   tsf                                                }
{               6042   tcf                                                }
{               6044   load tty buffer                                    }
{               N.B. tls 6046 combines 6042, 6044                         }
{       "device" 50    (clock)                                            }
{               6501    clear clock flag (starts clock counting down again) }
{               6502    skip if clock flag set                            }
{               6504    start/stop clock                                  }
{                                                                         }
{       "device" 60                                                       }
{                       a/d converter                                     }
{               6601    clear data flag and read into acc                 }
{               6602    skip if data ready flag set                       }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }


	procedure inputoutput;
	var temp: integer;
	begin
	   if device=d00 then begin
		if bittest(inst,2) then ionf:=0;
		if bittest(inst,1) then begin
			{ setting of interrupts on must be deferred for }
			{ one instruction, }
			intsused:=true; { flag that using interrupts }
			idelay:=1;
			end;
		showperiphs(d00);
		end
	   else
	   if device=d03 then begin
		time:=time+26;
		if bittest(inst,1) & (d03f=1) then begin
				pc:=pc+1; { skip if flag set }
				time:=time+2;
				highlight(pcrow,pccol,pc,4,regchng);
				end;
		if bittest(inst,2) then begin
			d03f:=0;
			acc:=0;
			highlight(accrow,acccol,acc,4,regchng);
			showperiphs(d03);
			end;
		if bittest(inst,4) then begin
			acc:=orintegers(acc,d03b);
			highlight(accrow,acccol,acc,4,regchng);
			d03b:=0;
			end;
		end
	   else
	   if device=d04 then begin
		time:=time+26;
		if bittest(inst,1) & (d04f=1) then begin
			pc:=pc+1; { skip if flag set }
			time:=time+2;
			highlight(pcrow,pccol,pc,4,regchng);
			end;
		if bittest(inst,2) then begin
			d04f:=0;
			showperiphs(d04);
			end;
		if bittest(inst,4) then begin
			temp:=orintegers(d04b,acc);
			d04b:=andintegers(temp,mask177);
			postevent(d04,times[fast,2],rtimes[fast,2])
			end;
		end
	   else
	   if device=d50 then begin
		time:=time+20;
		if bittest(inst,1) then begin
			{ clock tick, clear flag, postevent for another tick }
			d50f:=0;
			showperiphs(d50);
			postevent(d50,times[fast,3],rtimes[fast,3])
			end;
		if bittest(inst,2) and (d50f=1) then begin
			pc:=pc+1; { skip if set }
			time:=time+2;
			highlight(pcrow,pccol,pc,4,regchng);
			end;
		if bittest(inst,4) then begin
			if clockoff then begin
				clockoff:=false;
				postevent(d50,(times[fast,3] div 3),rtimes[fast,3])
				end
			else clockoff:=true
			end
		end
	   else
	   if device=d60 then begin
		time:=time+20;
		if bittest(inst,1) then begin
			{ a/d conversion done, clear flag read buffer }
			d60f:=0;
			showperiphs(d60);
			acc:=d60b
			end;
		if bittest(inst,2) and (d60f=1) then begin
			pc:=pc+1; { skip if set }
			time:=time+2;
			highlight(pcrow,pccol,pc,4,regchng);
			end;
		if bittest(inst,4) then
			postevent(d60,times[fast,4],rtimes[fast,4])

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

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
{       External event                                                    }
{               entered during each instruction cycle                     }
{               compares count of instructions with times in event queue  }
{               and performs tasks as required                            }
{                                                                         }
{       (some minor problems, if interrupts being used (intsused=true)    }
{       then want missed kbd, clock etc to count and be errors            }
{       but if not using interrupts dont want to loose keyboard characters}
{                                                                         }
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure externalevent;
	const cr = 13; { carriage return character (?) }
	var i,j: integer;
	    ch : char;
	    temp : integer;
	begin

		i:=1;
		while (i <= numevents) & (time >= etime[i]) do begin
			case etype[i] of

				d03: if (d03f=0) | intsused then begin
					d03f:=1;
					{ Keyboard, flag now set, data ready }
					{ "or" into kbd-buffer }
					if eoln(kbd) then begin
						readln(kbd);
						temp:=cr; { cr character }
						end
					else begin
						read(kbd,ch);
						temp:=ord(ch)
					     end;
					temp:=orintegers(temp,d03b);
					d03b:=andintegers(temp,mask177);
					if not eof(kbd) then postevent(d03,times[fast,1],rtimes[fast,1]);
					showperiphs(d03);
				     end
				    else
				    if d03f=1 then postevent(d03,(times[fast,1] div 3),rtimes[fast,1]);
				d04: begin
					{ tty ready, do real output of data }
					if d04b=cr then writeln(tty)
					else write(tty,chr(d04b));
					d04b:=0;
					d04f:=1;
					showperiphs(d04);
				     end;
				d50: if not clockoff then begin
					d50f:=1;
					showperiphs(d50);
					end;
				d60: begin
					d60f:=1;
					ranseed:=(109*ranseed + 853) mod 4096;
					d60b:=ranseed mod 1024;
					showperiphs(d60);
				     end;
				end;
			i:=i+1
			end;
		j:=0;
		while (i <= numevents) do begin
			j:=j+1;
			etime[j]:=etime[i];
			etype[j]:=etype[i];
			i:=i+1
			end;
		numevents:=j;
	end;

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

	procedure evaluateinterrupt;

	begin

	externalevent;

	{ Lines for devices 03, 04, 50 and 60 are wired to interrupt line }

	interrupt:=(ionf=1) and ((d50f=1) or (d60f=1) or (d04f=1) or (d03f=1));
	if interrupt then begin
			if reglog then begin
				if not dumpopen then begin
					rewrite(dumpfile);
					dumpopen:=true;
					writeln(dumpfile,'Log of Registers at interrupts:');
					writeln(dumpfile);
					end;
				writeln(dumpfile);
				writeln('Interrupt;  pc '); octwrite(pc,4,dumpfile);
				write(';   time ',time:8,';');
				if d50f=1 then write(dumpfile,' Clock');
				if d60f=1 then write(dumpfile,' A/D');
				if d03f=1 then write(dumpfile,' kbd');
				if d04f=1 then write(dumpfile,' tty');
				writeln(dumpfile);
				end;
			mdr:=pc;
			mar:=0;
			tomemory(true);
			pc:=1;
			highlight(pcrow,pccol,pc,4,regchng);
			if perdisplay then begin
				position(d00row,d00col);
				clrendline;
				invertvideo;
				write('INTERRUPT');
				invertvideo;
				end;
			ionf:=0;
			end

	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);
	    time:=time+1;
	    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;
	end;
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
	procedure rotateright(doubles : boolean);
	var temp : integer;
	begin
	    if doubles then rotateright(false);
	    time:=time+1;
	    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;
	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 }
			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
				time:=time+2;
				acclink:=pc+1;
				pc:=andintegers(acclink,mask7777);
				end;

		    { Time 2, maybe clear acc }

			if bittest(cla,oprbits) then begin
				acc:=0;
				highlight(accrow,acccol,acc,4,regchng);
				end;

		    { Time 3, maybe halt }

			if bittest(hlt,oprbits) then begin
				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
				acc:=0;
				highlight(accrow,acccol,acc,4,regchng);
				end;

			if bittest(cll,oprbits) then begin
				 link:=0;
				 highlight(linkrow,linkcol,link,1,regchng);
				 end;


		   { 2nd time sequence, complement acc and link }

			if bittest(cma,oprbits) then begin
				acc:=bitcomplement(acc);
				highlight(accrow,acccol,acc,4,regchng);
				end;

			if bittest(cml,oprbits) then begin
				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
				time:=time+2;
				acclink:=acc+1;
				acc:=andintegers(acclink,mask7777);
				highlight(accrow,acccol,acc,4,regchng);
				end;

		    { 4th time sequence, rotates }

			if bittest(ral,oprbits) then begin
				rotateleft(bittest(shifttwice,oprbits));
				highlight(accrow,acccol,acc,4,regchng);
				highlight(linkrow,linkcol,link,1,regchng);
				end
			else
			if bittest(rar,oprbits) then begin
				rotateright(bittest(shifttwice,oprbits));
				highlight(accrow,acccol,acc,4,regchng);
				highlight(linkrow,linkcol,link,1,regchng);
				end
			end
	end;


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

	procedure executeinstruction;

	begin


		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.
				}
			      frommemory(false);
			      if not aborted then begin
				acc:=andintegers(acc,mdr);
				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.
				}
			      frommemory(false);
			      if not aborted then begin
				acclink:=acc+mdr;
				if acclink>4095 then begin
					{ have carry bit, complement link }
					if link=1 then link:=0
						else link:=1;
					highlight(linkrow,linkcol,link,1,regchng);
					end;
				acc:=andintegers(acclink,mask7777);
				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.
				}
			      frommemory(false);
			      if not aborted then begin
				acclink:=mdr+1;
				if acclink > 4095 then mdr:=0
				else mdr:=acclink;
				tomemory(false);
				if mdr=0 then begin
					  time:=time+2;
					  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
				}
			      mdr:=acc;
			      tomemory(false);
			      if not aborted then begin
				acc:=0;
				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).

				}

			      mdr:=pc;
			      tomemory(true);
			      if not aborted then begin
				pc:=mar+1;
				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.
				}
			      pc:=mar;
			      highlight(pcrow,pccol,pc,4,regchng);
			      end;



			iot:  inputoutput;




			opr:  operate
		 end
	end;

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

	procedure initialize;
	var i : integer;
	   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);


	{ Need events mechanism initialized in order to set up keyboard correctly }
		numevents:=0;
		ranseed:=1275;

		clearscreen;
		writeln;
		writeln;
		writeln('PDP-8 simulator, version-B.');
		writeln;
writeln('       Does the PDP-8 program, that you intend to run, require "keyboard"');
writeln('input from a file? (I need to know before I try to open the file ".8.kbd.1."');
writeln('for reading).');
writeln;
writeln('Any "keyboard" input? (Y or N)');
		readln(ch);
		if (ch='y') | (ch='Y') then begin
			reset(kbd,'.8.kbd.1');
			postevent(d03,1250,500)
			end;
writeln;
		rewrite(tty,'.8.tty.1');

writeln('       You control the execution of your PDP-8 program through the');
writeln('facilities of the automatic "debugging" package built into this simulator');
writeln('program.');
writeln;
writeln('       The object code of your program is now being loaded. When this');
writeln('loading process is complete control will be transferred to the "debug"');
writeln('routines where you may define display options, specify single-step execution');
writeln('of instructions, or set breakpoints.');

		delayn(20);
		regdisplay:=true;
		progdisplay:=true;
		datadisplay:=true;
		dcddisplay:=true;
		singlestep:=false;
		perdisplay:=true;
		reglog:=false;
		fast:=false;

		{ the keyboard times }
		times[false,1]:=1400; times[true,1]:=150;
		rtimes[false,1]:=300; rtimes[true,1]:=0;

		{ the tty times }
		times[false,2]:=600; times[true,2]:=100;
		rtimes[false,2]:=0; rtimes[true,2]:=0;

		{ the clock times }
		times[false,3]:=1800; times[true,0]:=180;
		rtimes[false,3]:=0; rtimes[true,3]:=0;

		{ the a/d times }
		times[false,4]:=350; times[true,4]:=45;
		rtimes[false,4]:=0; rtimes[true,4]:=0;

writeln;
		for i:=0 to corelimit do
			breakpts[i]:=false;

	end;

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

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

	   clearscreen;
	   if regdisplay then begin
		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);

		position(tirow,ticol-6);
		write('Time :',time:8,' x 10  seconds');
		position(tirow-1,ticol+13);
		write('-7');

		delayn(20);
		end;

	   if progdisplay | datadisplay then begin

		position(mem0row-1,0);
		writeln('______________________________________________________________________');

		position(mem0row,0);
		invertvideo;
		write('MEMORY');
		invertvideo;
		delayn(10);

		if progdisplay then begin
			position(mem1row-4,mem1col-1);
			write('Instructions');
			position(mem1row-3,mem1col-3);
			write('Address  Contents');
			end;
		if datadisplay then begin
			position(mem2row-4,mem2col+2);
			write('Data');
			position(mem2row-3,mem2col-3);
			write('Address  Contents');
			end;
		end;

	   if perdisplay then begin

		position(periphrow-1,0);
		writeln('______________________________________________________________________');

		position(periphrow,0);
		invertvideo;
		write('PERIPHERAL DEVICES');
		invertvideo;
		delayn(10);
		showperiphs(d00);
		showperiphs(d03);
		showperiphs(d04);
		showperiphs(d50);
		showperiphs(d60);
		end;

	   if regdisplay then begin
		highlight(accrow,acccol,acc,4,10);
		highlight(linkrow,linkcol,link,1,10);
		highlight(pcrow,pccol,pc,4,10);
		delayn(20);
		end;

	   if progdisplay then begin
		memshow(pc,true);
		delayn(25);
		end;
	end;

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

	procedure initialdump;
	var ch:char;
	begin
		dumpopen:=false;

		writeln('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;

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

	procedure baddata(i: integer);
	var j:integer;
	begin
	writeln('Malformed command.');
	writeln(userinput);
	for j:=1 to i do write(' ');
	writeln('|');
	writeln('Error detected near marker.');
	end;

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

	function findname(var wh,val: integer): boolean;
	var ch : char;
	 uname : symbol;
	 found : boolean;
	     j : integer;
	begin
		found:=false;
		for j:=1 to 6 do uname[j]:=' ';
		ch:=userinput[wh];
		j:=0;
		while ch in ['a'..'z','0'..'9'] do begin
			j:=j+1;
			if (j<=6) then uname[j]:=ch;
			wh:=wh+1;
			ch:=userinput[wh]
			end;

		if (0<j) & (j<=6) then begin
			j:=0;
			while j<numsym do begin
				j:=j+1;
				with symtab[j] do
				    if (stype=label8) & (name=uname) then begin
					found:=true;
					val:=j;
					j:=numsym
					end;
				end;

			end;

		findname:=found
	end;


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

	procedure findoct(var where,val : integer);
	var ch: char;
	begin
		val:=0;
		ch:=userinput[where];
		while ch in ['0'..'7'] do begin
			val:=8*val + (ord(ch) - ord('0'));
			val:= val mod 4096;
			where:=where+1;
			ch:=userinput[where]
			end;

	end;

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

	procedure getusercommand;
	var i:integer;
	   ch:char;
	begin
	   for i:=2 to 79 do userinput[i]:=' ';
	   userinput[1]:='?';
	   userinput[80]:='?';
	   chcnt:=0;

	   while not eoln do begin
		read(ch);
		if ch <> ' ' then begin
			chcnt:=chcnt+1;
			if chcnt < 80 then userinput[chcnt]:=ch
			end;
		end;
	   readln;

	end;

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

	procedure setbreak(setting : boolean);
	var n,addr,ptr : integer;
	begin
	writeln('Address for breakpoint>');
	getusercommand;
	n:=1;
	if userinput[1] in ['0'..'7'] then begin
		findoct(n,addr);
		if (0 <= addr) & (addr <= corelimit) then breakpts[addr]:=setting
		else writeln('Address outside of memory.');
		end
	else
	if userinput[1] in ['a'..'z'] then begin
		if findname(n,ptr) then begin
			addr:=symtab[ptr].value;
			breakpts[addr]:=setting;
			end
		else begin
			baddata(1);
			writeln('(Possibly you have mistyped an identifier name.');
			end
		end
	else begin
		baddata(1);
		writeln('You must just specify an address, i.e. one of the labels in');
		writeln('your program or an octal constant.');
	     end;
	end;

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

	procedure breaksub4(var flag: boolean);
	var i,j: integer;
	    ch : char;

	begin

	ch:=userinput[2];

	{ : commands                            }
	if ch='d' then dumpcore(output,true)
	else
	if ch='r' then begin
		write('acc : '); octwrite(acc,4,output);
		write('    pc  : '); octwrite(pc,4,output);
		write('    link: '); octwrite(link,1,output);
		writeln;
		writeln('    Time: ',time:8,'*10^-7 seconds, Instruction Count: ',icount:8);
		writeln;
		end
	else
	if ch='c' then flag:=true
	else
	if ch='b' then setbreak(true)
	else
	if ch='u' then setbreak(false)
	else
	if ch='s' then begin
		writeln('User symbols: ');
		j:=0;
		for i:=1 to numsym do
			with symtab[i] do
				if stype=label8 then begin
					j:=j+1;
					write(name,'  ');
					octwrite(value,4,output);
					if 0 = (j mod 4) then writeln
					else write(';  ');
					end;
		if j=0 then writeln('(none defined)');
		writeln;
		end
	else
	if ch='q' then begin flag:=true; running:=false end
	else begin
		writeln(' ":" commands are:');
		writeln(' :?    produce this summary.');
		writeln(' :b    set breakpoint.');
		writeln(' :c    continue execution of PDP-8 program.');
		writeln(' :d    "dump" registers and memory to terminal screen.');
		writeln(' :q    terminate PDP-8 program.');
		writeln(' :r    "dump" registers to terminal screen.');
		writeln(' :s    list user defined symbols (labels).');
		writeln(' :u    undo breakpoint.');
	     end;
	end;
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure breaksub3;
	var setting : boolean;
	    ch  : char;
	begin

	setting:=userinput[1]='+';
	ch:=userinput[2];

	if ch='*' then begin
		writeln('Current display settings:');
		writeln('C.P.U.                       : ',regdisplay);
		writeln('"Data" Memory Window         : ',datadisplay);
		writeln('"Instructions" Memory Window : ',datadisplay);
		writeln('Status of Peripherals shown  : ',perdisplay);
		writeln('Single step mode             : ',singlestep);
		writeln('Translation of instructions  : ',dcddisplay);
		end
	else
	if ch='c' then regdisplay:=setting
	else
	if ch='d' then datadisplay:=setting
	else
	if ch='f' then fast:=setting
	else
	if ch='i' then progdisplay:=setting
	else
	if ch='l' then reglog:=setting
	else
	if ch='p' then perdisplay:=setting
	else
	if ch='s' then singlestep:=setting
	else
	if ch='t' then dcddisplay:=setting
	else begin
		writeln(' "+" and "-" commands are:');
		writeln(' ?   produce this summary.');
		writeln(' *   list current display settings.');
		writeln(' c   set/reset CPU display.');
		writeln(' d   set/reset memory display for "data".');
		writeln(' i   set/reset memory display for "instructions".');
		writeln(' l   set/reset logging of registers on interrupts.');
		writeln(' p   set/reset display for status of peripherals.');
		writeln(' s   set/reset single step mode.');
		writeln(' t   set/reset instruction translation display.');
	     end;
	end;

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

	procedure breaksub2(st,nd: integer; md: char);
	var i,j,ptr,v: integer;
		pcsav: a4k;

		procedure outch(chi:integer);
		begin
			if (32<=chi) & (chi<=127) then write(chr(chi))
			else write('?')
		end;

	begin
		pcsav:=pc;
		j:=0;
		for i:=st to nd do begin
			if lookup(i,label8,ptr) then write(symtab[ptr].name,'  ')
			else write('        ');
			octwrite(i,4,output);
			write(' /  ');
			v:=store[i];
			case md of
				'd' :   begin
					    if v>2047 then
						v:=-(1+bitcomplement(v));
					    write(v:5);
					end;
				'c' :   outch(v);
				'o' :   octwrite(v,4,output);
				'p' :   begin
					    outch(andintegers(v,mask7700) div 64);
					    outch(andintegers(v,mask77));
					end;
				'i' :   begin
					    pc:=i;
					    ir:=v;
					    decodeinstruction(false,true);
					end;
				end;
			j:=j+1;
			if 0=(j mod 2) then writeln
			else write('      ');
			end;
		writeln;
		pc:=pcsav
	end;

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

	procedure breaksub1;
	var st,n,ptr,rpt : integer;
	    ok : boolean;
	    ch : char;
	begin
	ok:=true;
	n:=1;
	st:=0;
	ch:=userinput[1];

	if ch in ['0'..'7'] then findoct(n,st)
	else
	if findname(n,ptr) then st:=symtab[ptr].value
	else begin
	   baddata(1);
	   writeln('(Possibly you have mistyped an identifier name.');
	   ok:=false;
	   end;

	if (st<0) | (st>corelimit) then begin
	   writeln('Address lies outside memory of simulated machine.');
	   ok:=false;
	   end;

	if ok then begin
	   { deal with optional [,<repeat>]             }

	   if userinput[n] = ',' then begin
		n:=n+1;
		if userinput[n] in ['0'..'7'] then begin
		     findoct(n,rpt);
		     if (st+rpt-1) > corelimit then begin
			ok:=false;
			writeln('Too large a repeat factor!');
			end
		     end
		else begin
		     ok:=false;
		     baddata(n);
		     writeln('An octal number for repeat factor is required.');
		     end;
		end
	   else rpt:=1;

	   if ok then begin
		{ try for /<char>                       }

		if userinput[n]='/' then begin
		     n:=n+1;
		     ch:=userinput[n];
		     if ch in ['c','d','i','o','p'] then breaksub2(st,st+rpt-1,ch)
		     else begin
			  baddata(n);
			  writeln('Allowed print formats are :');
			  writeln(' c  one ASCII character/word.');
			  writeln(' d  word value in signed decimal.');
			  writeln(' i  word interpreted as an instruction.');
			  writeln(' o  word value in octal.');
			  writeln(' p  two 6-bit characters packed in word.')
			  end;
		     end
		else begin
		     baddata(n);
		     writeln(' /<char> expected.');
		     end;
		end;

	   end;

	end;

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

	procedure breakhelp;
	begin
		if userinput[1] <> '?' then begin
			writeln(userinput);
			writeln('Illegal breakpoint command.');
			writeln;
			end;

		writeln('Breakpoint commands:');
		writeln('  ?        Produces this "HELP" summary.');
		writeln('  +/-      Turn on/off various run time displays.');
		writeln('  :        Set/remove breakpoints, start/resume execution of program.');
		writeln(' <address>/<char> Print contents of addressed memory location');
		writeln('                                       in format determined by char.');
		writeln(' <address>,<repeat-factor>/<char> Print contents of each of a');
		writeln('                                       range of addressed memory locations.');
	end;
{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

	procedure break;
	var ptr: integer;
	    done : boolean;
	    ch: char;
	begin
		clearscreen;
		invertvideo;
		writeln('BREAKPOINT');
		invertvideo;
		write('Break address     : ');
		if lookup(pc,label8,ptr) then write(symtab[ptr].name)
		else octwrite(pc,4,output);
		writeln;
		done:=false;
		repeat
			writeln('break> ');
			getusercommand;
			ch:=userinput[1];
			if ch in ['a'..'z','0'..'7'] then breaksub1
			else
			if ch in ['+','-'] then breaksub3
			else
			if ch = ':' then breaksub4(done)
			else breakhelp;
		until done;

		if running then createdisplay;
	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;
	time:=0;

	d03f:=0;
	d04f:=0;
	d03b:=0;
	d04b:=0;
	d50f:=0;
	d60f:=0;
	d60b:=0;
	ionf:=0;
	interrupt:=false;
	intsused:=false;

	clockoff:=true;

	icount:=0;
	idelay:=-1;



	break;

	while running do begin
		icount:=icount+1;
		if idelay=0 then begin
				ionf:=1;
				showperiphs(d00);
				end;
		idelay:=idelay-1;
		opc:=pc;
		evaluateinterrupt;
		fetchinstruction;
		decodeinstruction(true,dcddisplay);
		if not aborted then executeinstruction;
		if singlestep then waitforit;
		if (pc < 0 ) | (pc > corelimit) then begin
			clearscreen;
			writeln('Transfer to address outside of memory of simulated machine.');
			write('Referenced address was ');
			octwrite(pc,4,output);
			writeln;
			delayn(100);
			write('executing instruction at about ');
			octwrite(opc,4,output);
			writeln;
			delayn(100);
			running:=false;
			pc:=opc;
			break;
			end
		else
		if aborted then begin
			writeln('Instruction aborted, entering break package.');
			delayn(50);
			break;
			end
		else
		if breakpts[pc] then break;
		end;

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

end.