Title[BCPLRuntime.mc...January 27, 1980  11:45 AM...Taft];

TopLevel;
KnowRBase[AEmRegs];

* JSR code dispatches here for JSR 300 - 377.
* This code interprets JSR 300 - 332, which are the right-shift
* and left-shift-and-masked-store operations.
* Entry conditions: ETemp = ID-300, MemBase = CODE, StkP = unknown
JSRz300:
	PD_ (ETemp)-(33C);
	StkP_ spAC1, Branch[.+2, ALU<0];
J300x:	Q_ PCX', Branch[JSRx];		* Not one of ours, do normal JSR

* After the dispatch, StkP addresses AC0 and T has the contents of AC1.
* ETemp saves the value of ID, required if a particular routine decides to
* exit to the software routine rather than doing the work itself.
	ETemp_ T, BigBDispatch_ ETemp, T_ MD; * Force memory op to finish
	T_ Stack&-1, Branch[LQ0.6z];	* Leave FF free for placement

* LQa.b right-shifts accumulator a by b positions.
LQ0.6z:	Stack_ RSH[Stack, 6], IFUJump[0],	At[BcplZ300X, 00]; * 300
LQ1.6z:	StkP+1, Branch[LQ0.6z],			At[BcplZ300X, 01];
LQ0.5z:	Stack_ RSH[Stack, 5], IFUJump[0],	At[BcplZ300X, 02];
LQ1.5z:	StkP+1, Branch[LQ0.5z],			At[BcplZ300X, 03];
LQ0.4z:	Stack_ RSH[Stack, 4], IFUJump[0],	At[BcplZ300X, 04];
LQ1.4z:	StkP+1, Branch[LQ0.4z],			At[BcplZ300X, 05];
LQ0.3z:	Stack_ RSH[Stack, 3], IFUJump[0],	At[BcplZ300X, 06];
LQ1.3z:	StkP+1, Branch[LQ0.3z],			At[BcplZ300X, 07];
LQ0.2z:	Stack_ RSH[Stack, 2], IFUJump[0],	At[BcplZ300X, 10]; * 310
LQ1.2z:	StkP+1, Branch[LQ0.2z],			At[BcplZ300X, 11];
LQ0.1z:	Stack_ RSH[Stack, 1], IFUJump[0],	At[BcplZ300X, 12];
LQ1.1z:	StkP+1, Branch[LQ0.1z],			At[BcplZ300X, 13];

	T_ ETemp, Branch[J300x],		At[BcplZ300X, 14];

* SQa.b left-shifts accumulator a by b positions and then performs SNQa.
SQ0.7z:	Stack_ LSH[Stack, 7], Branch[SQ0.x],	At[BcplZ300X, 15];
SQ1.7z:	T_ LSH[T, 7], StkP+1, Branch[SQ1.x],	At[BcplZ300X, 16];
SQ0.6z:	Stack_ LSH[Stack, 6], Branch[SQ0.x],	At[BcplZ300X, 17];
SQ1.6z:	T_ LSH[T, 6], StkP+1, Branch[SQ1.x],	At[BcplZ300X, 20]; * 320
SQ0.5z:	Stack_ LSH[Stack, 5], Branch[SQ0.x],	At[BcplZ300X, 21];
SQ1.5z:	T_ LSH[T, 5], StkP+1, Branch[SQ1.x],	At[BcplZ300X, 22];
SQ0.4z:	Stack_ LSH[Stack, 4], Branch[SQ0.x],	At[BcplZ300X, 23];
SQ1.4z:	T_ LSH[T, 4], StkP+1, Branch[SQ1.x],	At[BcplZ300X, 24];
SQ0.3z:	Stack_ LSH[Stack, 3], Branch[SQ0.x],	At[BcplZ300X, 25];
SQ1.3z:	T_ LSH[T, 3], StkP+1, Branch[SQ1.x],	At[BcplZ300X, 26];
SQ0.2z:	Stack_ LSH[Stack, 2], Branch[SQ0.x],	At[BcplZ300X, 27];
SQ1.2z:	T_ LSH[T, 2], StkP+1, Branch[SQ1.x],	At[BcplZ300X, 30]; * 330
SQ0.1z:	Stack_ LSH[Stack, 1], Branch[SQ0.x],	At[BcplZ300X, 31];
SQ1.1z:	T_ LSH[T, 1], StkP+1, Branch[SQ1.x],	At[BcplZ300X, 32];

SQ0.x:	FlipMemBase;			* MemBase_ MDS
	Branch[SNQ0z];			* Nop for placement
SQ1.x:	Stack&-1_ T, FlipMemBase;	* MemBase_ MDS
	Branch[SNQ1z];			* Nop for placement

* JSR code dispatches here for JSR @340 - 377.
* This code interprets JSR @340 - 370.
* Entry conditions: ETemp = ID-340, MemBase = MDS, StkP = unknown
JSRiz340:
	PD_ (ETemp)-(31C);
	StkP_ spAC1, Branch[.+2, ALU<0];
J340x:	Fetch_ T, FlipMemBase, Branch[JSRix]; * Not one of ours, do normal JSR

* After the dispatch, StkP addresses AC0, and T has the contents of AC1,
* which has just been sent through the ALU.
* ETemp saves the value of ID, required if a particular routine decides to
* exit to the software routine rather than doing the work itself.
	ETemp_ T, BigBDispatch_ ETemp, T_ MD; * Force memory op to finish
	T_ Stack&-1, Branch[IORz];	* Leave FF free for placement


* Logical operations IOR, XOR, EQV: perform AC0 _ AC0 op AC1
IORz:	Stack_ (Stack) OR T, IFUJump[0],	At[BcplZ340X, 00]; * 340
XORz:	Stack_ (Stack) XOR T, IFUJump[0],	At[BcplZ340X, 01];
EQVz:	T_ NOT T, Branch[XORz],			At[BcplZ340X, 02];


* Multiply and divide: let the standard runtime do these, as they
* are complicated and relatively infrequent.
	T_ ETemp, Branch[J340x],		At[BcplZ340X, 03]; * Mult
	T_ ETemp, Branch[J340x],		At[BcplZ340X, 04]; * DivRem
	T_ ETemp, Branch[J340x],		At[BcplZ340X, 05]; * DivRem


* AC0_ AC0 lshift AC1 (note that AC1 can be negative)
LSHz:	PD_ (17S)-T, Branch[LSHneg, ALU<0],	At[BcplZ340X, 06];
LSH1:	T_ T OR (40C), DblBranch[SHge20, SHls20, ALU<0]; * T..R

* AC0_ AC0 rshift AC1 (note that AC1 can be negative)
RSHz:	T_ (0S)-T,				At[BcplZ340X, 07];
	PD_ (17S)+T, Branch[RSHneg, ALU>=0];
RSH1:	T_ T AND (37C), DblBranch[SHge20, SHls20, ALU<0]; * R..T

SHge20:	Stack_ A0, IFUJump[0];
SHls20:	T_ LSH[T, 10];
	T_ A0, ShC_ T;
	Stack_ ShiftNoMask[Stack], IFUJump[0];

* Negative shift count, use other shift routine
LSHneg:	PD_ (17S)+T, Branch[RSH1];
RSHneg:	PD_ (17S)-T, Branch[LSH1];

* Branch: "switchon" implemented by dispatch.
* Calling sequence:
*	JSR @350;	with switchon value in AC0
*	 value of last case
*	 number of cases
*	 lastTarget-.
*	 ...
*	 firstTarget-.
*	return here if out of range, AC0 unchanged

Brnchz:	Q_ PCX',				At[BcplZ340X, 10]; * 350
	T_ (NOT Q) RSH 1;
	T_ (RCODE)+T+1;			* T_ PC+1
	ETemp_ (Fetch_ T)+1;		* Fetch last case value
	ETemp_ (Fetch_ ETemp)+1, T_ MD;	* Fetch number of cases
	T_ T-(Stack);			* T_ last case value - switchon value
	PD_ T-MD, Branch[Brnch1, Carry']; * Test (lastCase-value) ge numCases
	T_ (ETemp)+T, Branch[Brnch2, Carry];
Brnchx:	ETemp_ Fetch_ T;		* In range, fetch self-relative ptr
Brnch1:	T_ (ETemp)+MD, FlipMemBase, Branch[JMPx];
Brnch2:	T_ (ETemp)+MD, FlipMemBase, Branch[JMPx];


* Lookup: "switchon" implemented by table lookup.
* Calling sequence:
*	JSR @351;	with switchon value in AC0
*	 number of cases
*	 case value 1
*	 target1-.
*	 ...
*	 case value n
*	 targetn-.
*	return here if not found, AC0 unchanged

Lookz:	Q_ PCX',				At[BcplZ340X, 11];
	T_ (NOT Q) RSH 1;
	T_ (RCODE)+T+1;			* T_ PC+1
	ETemp_ (Fetch_ T)+1;		* Fetch number of cases
	ETemp_ (Fetch_ ETemp)+(2C), T_ MD; * Fetch first case value
	PD_ T-(Cnt_ T)-1;		* Force ALU#0 on first iteration

* Inner loop: have fetched one case value ahead, and ETemp is advanced by 2.
* Note that the ALU=0 branch tests the result of the previous iteration.
	ETemp_ (Fetch_ ETemp)+(2C), T_ MD, Branch[Lookm, ALU=0];
	PD_ (Stack)-T, Branch[.-1, Cnt#0&-1];

* Ran out of cases, return at table end.
	T_ (ETemp)-(5C), Branch[GFDon2]; * GFDon2 will add 1 and go to JMPx

* Found matching case, do self-relative jump to corresponding target.
Lookm:	T_ (ETemp)-(5C), Branch[Brnchx];


* Operations that we let the software do
	T_ ETemp, Branch[J340x],		At[BcplZ340X, 12]; * Util
	T_ ETemp, Branch[J340x],		At[BcplZ340X, 13]; * Finish
	T_ ETemp, Branch[J340x],		At[BcplZ340X, 14]; * Abort


* LongJump
* Calling sequence:
*	JSR @355
*	 target-.

LongJz:	Q_ PCX',				At[BcplZ340X, 15];
	T_ (NOT Q) RSH 1;
	T_ (RCODE)+T+1, Branch[Brnchx];	* T_ PC+1, go jump to T+@T


* Operations that we let the software do
	T_ ETemp, Branch[J340x],		At[BcplZ340X, 16]; * GetLV
	T_ ETemp, Branch[J340x],		At[BcplZ340X, 17]; * MulPlus

* Store partial-word field into a structure.
* Calling sequence:
*	JSR @360 or 361
*	 mask
*	returns here
* SNQ0 executes @AC1 _ (@AC1 & not mask) % (AC0 & mask)
* SNQ1 executes @AC0 _ (@AC0 & not mask) % (AC1 & mask)

SNQ0z:	Q_ PCX', StkP+1,			At[BcplZ340X, 20]; * 360
	ETemp_ Fetch_ Stack&-1, Branch[SNQx]; * Fetch @AC1

SNQ1z:	Q_ PCX',				At[BcplZ340X, 21];
	ETemp_ Fetch_ Stack&+1;		* Fetch @AC0

SNQx:	T_ (NOT Q) RSH 1;
	T_ (RCODE)+T+1;			* T_ PC+1
	Fetch_ T, T_ MD;		* Fetch mask
	T_ T AND NOT MD;
	Stack_ (Stack) AND MD;
	T_ T OR (Stack);
	Store_ ETemp, DBuf_ T, Branch[DoSkip];


* Load byte from array.
* LY01 loads the AC1th byte from the array pointed to by AC0
* and returns it right-justified in AC0 (note that AC1 may be negative).
* LY10 does the same, but with the roles of AC0 and AC1 interchanged.

LY01z:	ETemp_ T, Branch[.+2],			At[BcplZ340X, 22];
LY10z:	ETemp_ Stack&+1,			At[BcplZ340X, 23];
	T_ (ETemp) ARSH 1;		* T_ array word offset
	T_ (Stack)+T;			* T_ address of word
	Fetch_ T;
	T_ MD, ETemp, Branch[.+2, R odd];
	Stack_ RSH[T, 10], IFUJump[0];	* Left (even) byte
	Stack_ T AND (377C), IFUJump[0]; * Right (odd) byte


* Store byte into array.
* SY01 stores the byte now contained in frame temp 3 (AC2!3) into
* the AC1th byte of the array pointed to by AC0.
* SY10 does the same, but with the roles of AC0 and AC1 interchanged.

SY01z:	ETemp_ T, StkP+2,			At[BcplZ340X, 24];
	T_ (Stack&-2)+(3C), Branch[SYxx];

SY10z:	ETemp_ Stack&+2,			At[BcplZ340X, 25];
	T_ (Stack&-1)+(3C);

SYxx:	Fetch_ T;			* Fetch AC2!3
	T_ (ETemp) ARSH 1;		* T_ array word offset
	T_ (Stack)+T;			* T_ address of word
	Fetch_ T, ETemp_ MD, Branch[.+2, R odd];
	ETemp_ DPF[ETemp, 10, 10, MD], Branch[.+2]; * Left (even) byte
	ETemp_ DPF[ETemp, 10, 0, MD];	* Right (odd) byte
	Store_ T, DBuf_ ETemp, Branch[NoSkip]; * Wait 1 cycle due to HW bug

* Return
* Executes AC2_ AC2!0; PC_ (AC2!1)+1

Returnz:
	StkP+2,					At[BcplZ340X, 26];
	Fetch_ Stack;
	Stack_ MD, T_ MD+1;
	Fetch_ T, FlipMemBase;
	T_ MD+1, Branch[JMPx];


* StoreArgs: should never be executed, as GetFrame always skips over it.
	T_ ETemp, Branch[J340x],		At[BcplZ340X, 27];


* GetFrame
* Calling sequence is:
*	STA 3 1 2
*	JSR @370
*	 frame size
*	 JSR @367		; Call to StoreArgs, never executed now
*	first instruction of procedure
* If a stack overflow occurs, control goes to @370, the procedure that
* would have been called if this microcode hadn't gotten into the act.

* Entry conditions: MemBase=AEMBR0, StkP = spAC0
GetFramez:
	Q_ PCX', StkP+2,			At[BcplZ340X, 30]; * 370
	T_ (NOT Q) RSH 1;
	T_ (RCODE)+T+1;			* T_ PC+1
	Fetch_ T, ETemp3_ 335C;		* Fetch frame size
	Fetch_ ETemp3, ETemp3_ T, T_ MD; * Fetch stack min, save PC+1 of JSR
	T_ T+(2C);			* T_ Frame size +2
	T_ (Stack)-T;			* T_ new frame base
	PD_ T-MD;			* Test for stack overflow
	ETemp_ (Stack)+1, Branch[BStkOv, Carry'];

* No stack overflow.  Proceed to plant return link and store args.
	ETemp_ (Fetch_ ETemp)+(2C);	* Fetch saved PC from caller's frame
	Stack_ Store_ T, DBuf_ Stack, T_ MD; * Store return frame link
	Fetch_ T;			* Fetch number of args
	T_ (Stack&-2)+(4C);		* Point to word 4 of new frame
	T_ (Store_ T)+1, DBuf_ Stack&+1, Stack&+1_ MD; * Store AC0 in word 4,
					* AC0_ number of args
	ETemp1_ (Store_ T)+1, DBuf_ Stack&-1; * Store AC1 in word 5

* See whether there are 3 or more args.
* If exactly 3 args, store old frame +3 in new frame +6.
	T_ (Stack)-(3C);
	Fetch_ ETemp, Branch[GFDone, ALU<0]; * Fetch old frame +3
	T_ MD, PD_ Cnt_ T;		* Cnt_ number of args -3

	Store_ ETemp1, DBuf_ T, Branch[GFDon1, ALU=0]; * Branch if 3 args

* More than 3 args, store the 3rd and succeeding args.
	ETemp_ (ETemp)+T;		* Old frame + 3 + extra args offset
	ETemp_ (Fetch_ ETemp)+1;	* Store args starting at new frame +6
	ETemp1_ (Store_ ETemp1)+1, DBuf_ MD, Branch[.-1, Cnt#0&-1];

* Done, set PC to first instruction of called procedure and resume execution.
	T_ (ETemp3)+1, Branch[.+3];
GFDone:	T_ (ETemp3)+1, Branch[.+2];
GFDon1:	T_ (ETemp3)+1;
GFDon2:	T_ T+1, FlipMemBase, Branch[JMPx]; * MemBase_ CODE, go perform jump

* Stack overflow, execute JSR @370 and let normal runtime handle it.
BStkOv:	T_ 370C, Branch[JSRixf];
(1552)