*-----------------------------------------------------------
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