*-----------------------------------------------------------
Title[LispS-Group.mc, July 16, 1985  2:31 PMM, asinter];
*-----------------------------------------------------------

KnowRBase[AEmRegs];
TopLevel;

*-----------------------------------------------------------
NPTrap:	* NOPAR trap -- ID=2, which is trap offset
* N = trap location offset, relative to base defined by trap starting location
*-----------------------------------------------------------
Trap00:	T← ID+(130C), Branch[Trapx];	* 530+N
Trap17:	T← ID+(147C), Branch[Trapx];	* 547+N
Trap36:	T← ID+(166C), Branch[Trapx];	* 566+N

Trapx:	T← (R400)+T, MemBase← MDS;
	Fetch← T, Call[GetPC];		* Fetch new PC; get current
	ETemp← T+1;
	T← (R400)+(127C);		* VM 527 ← old PC +1
	Store← T, DBuf← ETemp, T← MD, Branch[Start]; * Start at new PC

*-----------------------------------------------------------
* CYCLE (60000)
*-----------------------------------------------------------
CYCLE:	T← ID AND (17C);		* Cycle count from operand byte
	StkP← spAC1, Branch[.+2, ALU#0];
	T← (Stack) AND (17C);		* Cycle count from AC1
	T← LSH[T, 10], StkP-1;		* Load cycle count into ShC
	T← MD, ShC← T;
	Stack← ShiftNoMask[Stack], IFUJump[0]; * Cycle AC0

*-----------------------------------------------------------
* JSRII (64400)
* MemBase = MDS, Sign = 1.
*-----------------------------------------------------------
JSRII:	T← 2(ID), Q← PCX', Call[EffAdrPCRel1];
JSRIIx:	Fetch← T;
	T← MD, Branch[JSRixf];

*-----------------------------------------------------------
* JSRIS (65000)
* MemBase = MDS, Sign = 1.
*-----------------------------------------------------------
JSRIS:	StkP← spAC2;
	T← ID+(Stack), Branch[JSRIIx];

*-----------------------------------------------------------
* CONVERT (67000)
* MemBase = MDS, Sign = 1.
*-----------------------------------------------------------

RME[PtrXW, ETemp1];
RME[NWords, ETemp2];
RME[DWA, ETemp3];
RME[ShCTemp, ETemp4];

CONVERT: StkP← spAC3;
	PtrXW← Fetch← Stack&-1;		* Fetch FontBase+Char
	T← ID+(Stack&-2);		* T← AC2 + SE(disp)
	PtrXW← (PtrXW)+MD+1;		* PtrXW← address of word XW +1
	T← (Fetch← T)+1;		* NWords← @(AC2 + SE(disp))
	NWords← MD, Fetch← T;		* DBA← @(AC2 + SE(disp) +1)
	DWA← Stack&+1;			* DWA← AC0
	Stack&+2← T← (17S) AND MD;	* AC1← DBA MOD 20B
	ShCTemp← (17S)-T;		* LMask← 17B - DBA
	T← T+1, Branch[CvOneW, ALU=0];	* Branch if DBA = 17 (one dest word)
	ETemp← LSH[T, 14];		* RMask← Count← DBA+1
	T← LCY[ETemp, T, 10];
	ShCTemp← (ShCTemp) OR T;
CvOneW:	Fetch← PtrXW, T← A0;		* Fetch @(PtrXW+1) = HD,,XH
	ETemp← DPF[T, 10, 10, MD], T← MD; * ETemp← XH;
	T← RSH[T, 10];			* T← HD
	T← NWords← (NWords)-1, Cnt← T;	* Really NWords-1 hereafter

* Skip over HD scan lines in the destination bit map.
* Note that we really execute the following loop HD+1 times, but the extra
* time compensates for the fact that DWA-NWords was originally passed in AC0.
	DWA← (DWA)+T+1, Branch[., Cnt#0&-1];

	T← 5C;				* Set ALUFM[17] to "NOT A OR B"
	Stack← ALUFMRW← T, ALUF[17];	* Save previous value in AC3
	T← Cnt← ETemp;			* Cnt← XH
	PtrXW← (PtrXW)-T-1, Branch[CvEnd, Cnt=0&-1]; * PtrXW← -> char bit map

* Main loop of CONVERT
CvLp:	PtrXW← (Fetch← PtrXW)+1;	* Fetch next word of character
	ETemp← MD, Fetch← DWA;		* Fetch word of destination bit map
	PD← ShC← ShCTemp;		* Load ShC and prepare 1-word test
	T← XShMDLMask[ETemp], B← MD, FreezeBC; * Shift and OR character bits
	DWA← T← (Store← DWA)+1, DBuf← T, * Store destination word
		Branch[CvLpx, ALU=0];	* Branch if only one dest word
	Fetch← DWA;			* Fetch second word of destination
	T← XShMDRMask[ETemp], B← MD;	* Shift and OR character bits
	T← Store← DWA, DBuf← T;		* Store destination word
CvLpx:	DWA← T+(NWords), Branch[CvLp, Cnt#0&-1]; * Advance dest ptr and repeat

* End of CONVERT
* PtrXW now again points to word XW, and StkP addresses AC3.
* Return AC3← word XW right-shifted 1, and skip if it was odd (no extension).
CvEnd:	Fetch← PtrXW;
	Stack← MD, ALUFMRW← Stack, ALUF[17]; * Restore ALUFM[17]
	Stack← (Stack) RSH 1, DblBranch[DoSkip, NoSkip, R odd];

*-----------------------------------------------------------
* Parameterless opcodes (61000)
* Dispatch on operand byte if in [0..45], trap otherwise.
* Leave StkP pointing at AC0 before dispatch.
*-----------------------------------------------------------
NOPAR:	T← ID-(46C), ETemp← MD;		* Wait for previous ref to complete
	T← T+(46C), Branch[NPTrap, ALU>=0];
	BigBDispatch← T;
	StkP← spAC0, Branch[DIR];

*-----------------------------------------------------------
* DIR (61000)
*-----------------------------------------------------------
DIR:	NWW← (NWW) OR (100000C), IFUJump[0], At[SD400, 0];

*-----------------------------------------------------------
* DIRS (61013)
*-----------------------------------------------------------
DIRS:	PD← NOT (NWW), At[SD400, 13];
	NWW← (NWW) OR (100000C), DblBranch[DoSkip, NoSkip, ALU<0];

*-----------------------------------------------------------
* EIR (61001)
*-----------------------------------------------------------
EIR:	T← (R400)+(52C), At[SD400, 1];	* WW (=452B)
	Fetch← T;
	NWW← (NWW) OR MD, RescheduleNow; * Will be noticed after 2 cycles
	NWW← (NWW) AND (77777C), Branch[NoSkip];

*-----------------------------------------------------------
* BRI (61002)
*-----------------------------------------------------------
BRI:	T← (R400)+(52C), At[SD400, 2];	* WW (=452B)
	T← (Fetch← T)+(26C);		* PCLOC (=500B)
	T← MD, Fetch← T;
	NWW← (NWW) OR T, RescheduleNow;
	NWW← (NWW) AND (77777C), T← MD, Branch[Start];

*-----------------------------------------------------------
* RCLK (61003)
*-----------------------------------------------------------
RCLK:	RBase← RBase[RTClock], At[SD400, 3];
	T← RTC430, TaskingOff;		* Read the 2 words atomically!!
	Stack&+1← T;			* AC0← high word
	T← RTClock, TaskingOn, Branch[StackGetsT]; * AC1← low word

KnowRBase[AEmRegs];

*-----------------------------------------------------------
* SIO (61004)
*-----------------------------------------------------------
SIO:	Branch[DiskSIO], At[SD400, 4];	* Takes arg in Stack = AC0

*-----------------------------------------------------------
* MUL (61020)
* [high: AC0, low: AC1] ← AC0 + AC1*AC2
*-----------------------------------------------------------
MULx:	StkP+1, At[SD400, 20];
	Q← Stack&+1;			* Q← AC1
	T← Stack&-2, Call[MulSub];	* T← AC2, [T,,Q] ← Q*T
	Stack+1← (Stack&+1)+Q;		* AC1← AC0 + low result
	T← A← T, XorSavedCarry, StkP-1,	* AC0← high result + carry
		Branch[StackGetsT];

*-----------------------------------------------------------
* DIV (61021)
* [quotient: AC1, remainder: AC0] ← [high: AC0, low: AC1] / AC2
* Skips unless overflow would occur.
*-----------------------------------------------------------
DIVx:	T← Stack&+1, At[SD400, 21];	* T← AC0
	Q← Stack&+1;			* Q← AC1
	Temp17← Stack&-1, SCall[DivSub]; * Temp17← AC2
* DivSub computes [quotient: Q, remainder: T] ← [T,,Q]/Temp17.
* DivSub returns to caller+2 if an overflow occurred.
	Stack&-1← Q, Branch[.+2];	* AC1← quotient
	IFUJump[0];
	Stack← T, Branch[DoSkip];	* AC0← remainder

*-----------------------------------------------------------
* BLT (61005)
* Accepts AC0: first source -1, AC1: last destination, AC3: -count.
* If interrupted, returns with ACs prepared for remainder of transfer.
* Normally, returns AC0: last source +1, AC1: unchanged, AC3: 0.
*-----------------------------------------------------------
BLT:	Stack&+3← (Stack&+3)+1, At[SD400, 5]; * AC0+1 = first source adr
	ETemp3← T← Stack&-2;		* AC3 = -count
	ETemp← (Stack&-1)+T+1;		* AC1-count+1 = first dest adr

* StkP points to AC0 during the body of this code.
	Stack← (Fetch← Stack)+1;	* Fetch first source word
	T← (0S)-T;			* T← count
	T← T AND (17C);			* T← count MOD 20B
	ETemp3← (ETemp3)+(Cnt← T);	* Adjust remainder, load Cnt

* PreFetch words 2 munches ahead of where we are now
BLTmor:	T← (Stack)+(40C), Branch[BLTnpf, ALU=0]; * Don't if last munch
	PreFetch← T;
	T← (ETemp)+(40C);
	PreFetch← T, DblBranch[BLTlp, BLTlpx, Cnt#0&-1];

* Test for going around loop zero times (count MOD 17B = 0)
BLTnpf:	DblBranch[BLTlp, BLTlpx, Cnt#0&-1];

* Main loop.  One word has been fetched ahead.
* This code depends on MD not being clobbered by Store← or PreFetch←.
BLTlp:	Stack← (Fetch← Stack)+1, T← MD;
	ETemp← (Store← ETemp)+1, DBuf← T, Branch[BLTlp, Cnt#0&-1];

* Fell out of main loop.  Check for more munches to do.
BLTlpx:	T← ETemp3, Cnt← 20S, Branch[BLTint, Reschedule];
	ETemp3← (ETemp3)+(20C), Branch[BLTmor, ALU#0];

* All done, update state in ACs.
	Stack&+3← (Stack&+3)-1, Branch[BLKxit]; * AC0← last source +1, AC3← 0

* Interrupt pending, save state and process interrupt.
BLTint:	Stack&+3← (Stack&+3)-(2C), Branch[BLKint]; * AC0← last source

*-----------------------------------------------------------
* BLKS (61006)
* Accepts AC0: value, AC1: last destination, AC3: -count.
* If interrupted, returns with ACs prepared for remainder of transfer.
* Normally, returns AC0: unchanged, AC1: unchanged, AC3: 0.
*-----------------------------------------------------------
BLKS:	T← Stack&+3, At[SD400, 6];	* AC0 = value
	T← Stack&-2, Q← T;		* AC3 = -count
	ETemp← (Stack&+2)+T+1;		* AC1-count+1 = first dest adr

* StkP points to AC3 during the remainder of this instruction
	T← (0S)-T;			* T← count
	T← T AND (17C);			* T← count MOD 20B
	Stack← (Stack)+(Cnt← T);	* Adjust remainder, load Cnt

* PreFetch words 2 munches ahead of where we are now
BLKmor:	T← (ETemp)+(40C), Branch[BLKnpf, ALU=0]; * Don't if last munch
	PreFetch← T, DblBranch[BLKlp, BLKlpx, Cnt#0&-1];

* Test for going around loop zero times (count MOD 17B = 0)
BLKnpf:	DblBranch[BLKlp, BLKlpx, Cnt#0&-1];

* Main loop.
BLKlp:	ETemp← (Store← ETemp)+1, DBuf← Q, Branch[BLKlp, Cnt#0&-1];

* Fell out of main loop.  Check for more munches to do.
BLKlpx:	T← Stack, Cnt← 20S, Branch[BLKint, Reschedule];
	Stack← (Stack)+(20C), Branch[BLKmor, ALU#0];

* All done
BLKxit:	Stack← A0, IFUJump[0];		* AC3 = 0

* Interrupt pending, save state and process interrupt.
BLKint:	Stack← T, Branch[AEmuReschedule]; * AC3← -count remaining

*-----------------------------------------------------------
* BITBLT (61024)
*-----------------------------------------------------------
BitBltA: At[SD400, 24],
% no such instruction in Lisp
	StkP+2;
	T← Stack&-2;			* AC0← AC2
	Stack&+1← T, SCall[BitBltSub];	* TOS-1=BBTable, TOS=scan line count
	 Branch[AEmuReschedule];	* +1 return: interrupt pending
%
	IFUJump[0];			* +2 return: done

*-----------------------------------------------------------
* XMLDA (61025)		AC0 ← @AC1 in alternate bank
*-----------------------------------------------------------
XMLDA:	MemBase← ScratchBR, At[SD400, 25];
	T← A0, BRHi← EmuXMBRHiReg;
	StkP+1, BRLo← T;
	Fetch← Stack&-1, Branch[StackGetsMD];

*-----------------------------------------------------------
* XMSTA (61026)		@AC1 ← AC0 in alternate bank
*-----------------------------------------------------------
XMSTA:	MemBase← ScratchBR, At[SD400, 26];
	T← A0, BRHi← EmuXMBRHiReg;
	T← Stack&+1, BRLo← T;
	Store← Stack, DBuf← T, IFUJump[0];

*-----------------------------------------------------------
* Special D-machine-only parameterless opcodes.
*-----------------------------------------------------------

*-----------------------------------------------------------
* SetDisplayFieldRate (61027) [Dorado/Dolphin]
* Sets vertical sync pulse width from AC0, top border from AC1, and total visible
* line count (including borders) from AC2.  All counts are number of scan lines
* in the even field.
* Note: Dolphin has the same instruction, but it works differently.
*-----------------------------------------------------------
SetDisplayFieldRateA: At[SD400, 27],
	StkP+2, Branch[SetDisplayFieldRate];

*-----------------------------------------------------------
* GetMemConf (61033) [Dorado/Dolphin]
* Returns number of pages of real memory in AC0 and number of 64K banks
* of virtual memory in AC1.
*-----------------------------------------------------------
GetMemConfA: At[SD400, 33],
	RBase← RBase[RealPages];
	T← RealPages;
	Stack&+1← T;
	T← VirtualBanks, Branch[StackGetsT];

KnowRBase[AEmRegs];

*-----------------------------------------------------------
* PowerOff (61034) [Dorado/Dolphin]
* Turns off power and does not return.
*-----------------------------------------------------------
PowerOffA: At[SD400, 34],
	IFUJump[0];
% disabled for LISP
	Nop;

* Simply tell the baseboard to turn me off.
* This is done by setting the baseboard communication register to 2,
* which in turn is done by executing manifold function 2262.
	T← 2000C;
	T← T OR (262C), Call[SetDMuxAddress]; * 2262
	UseDMD;
	Branch[.];		* Baseboard will stop me eventually


*-----------------------------------------------------------
* Checksum (61035) [Dorado/Dolphin]
* AC0 = sum (initially 0), AC1 = pointer, AC3 = word count.
* Returns result in AC0.  Interruptible.
*-----------------------------------------------------------
ChecksumA: At[SD400, 35],
	StkP+3;
	Cnt← Stack&-2;
	Stack&-1← (Fetch← Stack&-1)+1, Branch[ChecksumDn, Cnt=0&-1];

ChecksumLp:
	T← (Stack&+1)+MD, Branch[ChecksumInt, Reschedule];
	Stack&-1← (Fetch← Stack&-1)+1, Branch[.+2, Carry];
	Stack← T LCY 1, DblBranch[ChecksumLp, ChecksumDn, Cnt#0&-1];
	Stack← (T+1) LCY 1, DblBranch[ChecksumLp, ChecksumDn, Cnt#0&-1];

ChecksumDn:
	PD← (Stack)+1;			* Turn -0 (=177777b) into +0
	Stack← A← Stack, XorSavedCarry, IFUJump[0];

ChecksumInt:
	Stack&+2← (Stack&+2)-1;		* Fix pointer and count for interrupt
	Stack← Cnt;
	Stack← (Stack)+1, Branch[AEmuReschedule];

% ********* End of unimplemented code *********

*-----------------------------------------------------------
* LoadRam (61036) [Dorado/Dolphin]
* AC0 = pointer, AC1 = flag
* load the array of Items at [MDS,,pointer];
* if flag is odd then jump to the start address in the new Ram image
* else resume normal emulation at the next opcode.
* In the latter case, the address of the next Item is returned in AC0.
*-----------------------------------------------------------
LoadRamA: At[SD400, 36],
	T← Stack&+1, MemBase← ScratchBR;
	BRLo← T, T← NOT (Stack&-1);	* LoadRam reverses the sense of flag
	LRFlag← T;
	BRHi← EmuBRHiReg, Call[LoadRam];
	T← LRItem;			* If it returns, pass back ending address
	Stack← (Stack)+T, Branch[AEmuNext]; * Restart IFU

*-----------------------------------------------------------
* SetDefaultDisk (61037) [Dorado/Dolphin]
* If AC0 = 0, returns AC0 = current default partition.
* If AC0 # 0 and legal, sets default partition and returns -1.
* If AC0 is illegal, returns 0.
*-----------------------------------------------------------
SetDefaultDiskA: At[SD400, 37],
	T← Stack, RBase← RBase[DefaultPartition];
	PD← T-(MaxPartition)-1, Branch[.+2, ALU#0];
	 T← DefaultPartition, Branch[StackGetsT]; * Return current default
	T← T-(Q← T)-1, Branch[.+2, Carry'];
	 Stack← A0, IFUJump[0];		* Illegal
	DefaultPartition← Q;		* Set new partition and return -1
StackGetsT:
	Stack← T, IFUJump[0];

KnowRBase[AEmRegs];

*-----------------------------------------------------------
* DoradoIn (61040) [Dorado only]
*-----------------------------------------------------------
DoradoIn: At[SD400, 40],
	StkP+1;
	T← A0, TIOA← Stack&-1;
	Stack← Input, Branch[ResIOA];

*-----------------------------------------------------------
* DoradoOut (61041) [Dorado only]
*-----------------------------------------------------------
DoradoOut: At[SD400, 41],
	StkP+1;
	T← A0, TIOA← Stack&-1;
	Output← Stack;
ResIOA:	TIOA← T, IFUJump[0];

*-----------------------------------------------------------
* DoradoHalt (61042) [Dorado only]
*-----------------------------------------------------------
DoradoHalt: At[SD400, 42],
	IFUJump[0], Breakpoint;

*-----------------------------------------------------------
* SetPCHist (61043) [Dorado only]
* If AC0#0, enables emulator PC sampling and uses the 8192-word table
* pointed to by AC0 to maintain a histogram (double-precision counters).
* If AC0=0, disables PC sampling.
*-----------------------------------------------------------
SetPCHistA: At[SD400, 43],
	T← Stack;
	T← A0, Q← T, Branch[.+2, ALU=0]; * Long pointer in T,,Q, branch if nil
	T← EmuBRHiReg;			* Non-nil, lengthen pointer
	RBase← RBase[Events], Call[SetPCHistAddr];
	IFUJump[0];

*-----------------------------------------------------------
* GenIn (61044) [Dorado only]
* Reads GenIn register into AC0.
*-----------------------------------------------------------
GenInA: At[SD400, 44],
	Stack← NOT (EventCntA'), IFUJump[0];

*-----------------------------------------------------------
* GenOut (61045) [Dorado only]
* Writes GenOut register from AC0.
*-----------------------------------------------------------
GenOutA: At[SD400, 45],
	EventCntB← Stack, IFUJump[0];


*-----------------------------------------------------------
* IFU declarations
* Note that all the S-group opcodes that trap are defined in xTraps.mc.
*-----------------------------------------------------------
EmIFUReg[140, CYCLE, 0, 17];	* 60000-60377 CYCLE
EmIFUReg[142, NOPAR, 0, 17];	* 61000-61377 Parameterless opcodes
EmIFUPause[151, JSRII, MDS, 1];	* 64400-64777 JSRII
EmIFUPause[152, JSRIS, MDS, 1];	* 65000-65377 JSRIS
EmIFUReg[156, CONVERT, 1, 17];  * 67000-67377 CONVERT