;-----------------------------------------------------------------
; MesacROM.Mu - Jumps, Load/Store, Read/Write, Binary/Unary/Stack Operators
; Last modified by Levin - March 7, 1979  8:29 AM
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; J u m p s
;-----------------------------------------------------------------

; The following requirements are assumed:
;	1) J2-J9, JB are usable (in that order) as subroutine
;	   returns (by JEQx and JNEx).
;	2) since J2-J9 and JB are opcode entry points,
;	   they must meet requirements set by opcode dispatch.

;-----------------------------------------------------------------
; Jn - jump PC-relative
;-----------------------------------------------------------------
!1,2,JnA,Jbranchf;

J2:		L_ONE, :JnA;
J3:		L_2, :JnA;
J4:		L_3, :JnA;
J5:		L_4, :JnA;
J6:		L_5, :JnA;
J7:		L_6, :JnA;
J8:		L_7, :JnA;
J9:		L_10, :JnA;

JnA:		L_M-1, :Jbranchf;				A-aligned - adjust distance

;-----------------------------------------------------------------
; JB - jump PC-relative by alpha, assuming:
;	JB is A-aligned
;	Note:  JEQB and JNEB come here with branch (1) pending
;-----------------------------------------------------------------
!1,1,JBx;							shake JEQB/JNEB branch
!1,1,Jbranch;							must be odd (shakes IR_ below)

JB:		T_ib, :JBx;
JBx:		L_400 OR T;					_DISP will do sign extension
		IR_M;						400 above causes branch (1)
		L_DISP-1, :Jbranch;				L: ib (sign extended) - 1

;-----------------------------------------------------------------
; JW - jump PC-relative by alphabeta, assuming:
;	if JW is A-aligned, B byte is irrelevant
;	alpha in B byte, beta in A byte of word after JW
;-----------------------------------------------------------------

JW:		IR_sr1, :FetchAB;				returns to JWr
JWr:		L_ALLONES+T, :Jbranch;				L: alphabeta-1


;-----------------------------------------------------------------
; Jump destination determination
;	L has (signed) distance from even byte of word addressed by mpc+1
;-----------------------------------------------------------------
!1,2,Jforward,Jbackward;
!1,2,Jeven,Jodd;

Jbranch:	T_0+1, SH<0;					dispatch fwd/bkwd target
Jbranchf:	SINK_M, BUSODD, TASK, :Jforward;		dispatch even/odd target

Jforward:	temp_L RSH 1, :Jeven;				stash positive word offset
Jbackward:	temp_L MRSH 1, :Jeven;				stash negative word offset

Jeven:		T_temp+1, :NOOP;				fetch and execute even byte
Jodd:		T_temp+1, :nextXB;				fetch and execute odd byte

;-----------------------------------------------------------------
; JZEQB - if TOS (popped) = 0, jump PC-relative by alpha, assuming:
;	stack has precisely one element
;	JZEQB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
!1,2,Jcz,Jco;

JZEQB:		SINK_stk0, BUS=0;				test TOS = 0
		L_stkp-1, TASK, :Jcz;


;-----------------------------------------------------------------
; JZNEB - if TOS (popped) ~= 0, jump PC-relative by alpha, assuming:
;	stack has precisely one element
;	JZNEB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
!1,2,JZNEBne,JZNEBeq;

JZNEB:		SINK_stk0, BUS=0;				test TOS = 0
		L_stkp-1, TASK, :JZNEBne;

JZNEBne:	stkp_L, :JB;					branch, pick up alpha
JZNEBeq:	stkp_L, :nextA;					no branch, alignment => nextA

;-----------------------------------------------------------------
; JEQn - if TOS (popped) = TOS (popped), jump PC-relative by n, assuming:
;	stack has precisely two elements
;-----------------------------------------------------------------
!1,2,JEQnB,JEQnA;
!7,1,JEQNEcom;							shake IR_ dispatch

JEQ2:		IR_sr0, L_T, :JEQnB;				returns to J2
JEQ3:		IR_sr1, L_T, :JEQnB;				returns to J3
JEQ4:		IR_sr2, L_T, :JEQnB;				returns to J4
JEQ5:		IR_sr3, L_T, :JEQnB;				returns to J5
JEQ6:		IR_sr4, L_T, :JEQnB;				returns to J6
JEQ7:		IR_sr5, L_T, :JEQnB;				returns to J7
JEQ8:		IR_sr6, L_T, :JEQnB;				returns to J8
JEQ9:		IR_sr7, L_T, :JEQnB;				returns to J9


;-----------------------------------------------------------------
; JEQB - if TOS (popped) = TOS (popped), jump PC-relative by alpha, assuming:
;	stack has precisely two elements
;	JEQB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------

JEQB:		IR_sr10, :JEQnA;				returns to JB


;-----------------------------------------------------------------
; JEQ common code
;-----------------------------------------------------------------
!1,2,JEQcom,JNEcom;						return points from JEQNEcom

JEQnB:		temp_L RSH 1, L_T, :JEQNEcom;			temp:0, L:1 (for JEQNEcom)
JEQnA:		temp_L, L_T, :JEQNEcom;				temp:1, L:1 (for JEQNEcom)

!1,2,JEQne,JEQeq;

JEQcom:		L_stkp-T-1, :JEQne;				L: old stkp - 2

JEQne:		SINK_temp, BUS, TASK, :Setstkp;			no jump, reset stkp
JEQeq:		stkp_L, IDISP, :JEQNExxx;			jump, set stkp, then dispatch


;
;	JEQ/JNE common code
;
; !7,1,JEQNEcom;	appears above with JEQn
; !1,2,JEQcom,JNEcom;	appears above with JEQB

JEQNEcom:	T_stk1;
		L_stk0-T, SH=0;					dispatch EQ/NE
		T_0+1, SH=0, :JEQcom;				test outcome and return

JEQNExxx:	SINK_temp, BUS,	:J2;				even/odd dispatch

;-----------------------------------------------------------------
; JNEn - if TOS (popped) ~= TOS (popped), jump PC-relative by n, assuming:
;	stack has precisely two elements
;-----------------------------------------------------------------
!1,2,JNEnB,JNEnA;

JNE2:		IR_sr0, L_T, :JNEnB;				returns to J2
JNE3:		IR_sr1, L_T, :JNEnB;				returns to J3
JNE4:		IR_sr2, L_T, :JNEnB;				returns to J4
JNE5:		IR_sr3, L_T, :JNEnB;				returns to J5
JNE6:		IR_sr4, L_T, :JNEnB;				returns to J6
JNE7:		IR_sr5, L_T, :JNEnB;				returns to J7
JNE8:		IR_sr6, L_T, :JNEnB;				returns to J8
JNE9:		IR_sr7, L_T, :JNEnB;				returns to J9


;-----------------------------------------------------------------
; JNEB - if TOS (popped) = TOS (popped), jump PC-relative by alpha, assuming:
;	stack has precisely two elements
;	JNEB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------

JNEB:		IR_sr10, :JNEnA;				returns to JB


;-----------------------------------------------------------------
; JNE common code
;-----------------------------------------------------------------


JNEnB:		temp_L RSH 1, L_0, :JEQNEcom;			temp:0, L:0
JNEnA:		temp_L, L_0, :JEQNEcom;				temp:1, L:0

!1,2,JNEne,JNEeq;

JNEcom:		L_stkp-T-1, :JNEne;				L: old stkp - 2

JNEne:		stkp_L, IDISP, :JEQNExxx;			jump, set stkp, then dispatch
JNEeq:		SINK_temp, BUS, TASK, :Setstkp;			no jump, reset stkp

;-----------------------------------------------------------------
; JrB - for r in {L,LE,G,GE,UL,ULE,UG,UGE}
;   if TOS (popped) r TOS (popped), jump PC-relative by alpha, assuming:
;	stack has precisely two elements
;	JrB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------

; The values loaded into IR are not returns but encoded actions:
;    Bit 12:	0 => branch if carry zero
;		1 => branch if carry one (mask value: 10)
;    Bit 15:	0 => perform add-complement before testing carry
;		1 => perform subtract before testing carry (mask value: 1)
; (These values were chosen because of the masks available for use with _DISP
;  in the existing constants ROM.  Note that IR_ causes no dispatch.)

JLB:		IR_10, :Jscale;					adc, branch if carry one
JLEB:		IR_11, :Jscale;					sub, branch if carry one
JGB:		IR_ONE, :Jscale;				sub, branch if carry zero
JGEB:		IR_0, :Jscale;					adc, branch if carry zero

JULB:		IR_10, :Jnoscale;				adc, branch if carry one
JULEB:		IR_11, :Jnoscale;				sub, branch if carry one
JUGB:		IR_ONE, :Jnoscale;				sub, branch if carry zero
JUGEB:		IR_0, :Jnoscale;				adc, branch if carry zero


;-----------------------------------------------------------------
; Comparison "subroutine":
;-----------------------------------------------------------------
!1,2,Jadc,Jsub;
; !1,2,Jcz,Jco;	appears above with JZEQB
!1,2,Jnobz,Jbz;
!1,2,Jbo,Jnobo;

Jscale:		T_77777, :Jadjust;
Jnoscale:	T_ALLONES, :Jadjust;

Jadjust:	L_stk1+T+1;					L:stk1 + (0 or 100000)
		temp_L;
		SINK_DISP, BUSODD;				dispatch ADC/SUB
		T_stk0+T+1, :Jadc;

Jadc:		L_temp-T-1, :Jcommon;				perform add complement
Jsub:		L_temp-T, :Jcommon;				perform subtract

Jcommon:	T_ONE;						warning: not T_0+1
		L_stkp-T-1, ALUCY;				test ADC/SUB outcome
		SINK_DISP, SINK_lgm10, BUS=0, TASK, :Jcz;	dispatch on encoded bit 12

Jcz:		stkp_L, :Jnobz;					carry is zero (stkp_stkp-2)
Jco:		stkp_L, :Jbo;					carry is one (stkp_stkp-2)

Jnobz:		L_mpc+1, TASK, :nextAput;			no jump, alignment=>nextAa
Jbz:		T_ib, :JBx;					jump
Jbo:		T_ib, :JBx;					jump
Jnobo:		L_mpc+1, TASK, :nextAput;			no jump, alignment=>nextAa

;-----------------------------------------------------------------
; JIW - see Principles of Operation for description
;   assumes:
;	stack contains precisely two elements
;	if JIW is A-aligned, B byte is irrelevant
;	alpha in B byte, beta in A byte of word after JIW
;-----------------------------------------------------------------
!1,2,JIuge,JIul;
!1,1,JIWx;

JIW:		L_stkp-T-1, TASK, :JIWx;			stkp_stkp-2
JIWx:		stkp_L;
		T_stk0;
		L_XMAR_mpc+1;					load alphabeta
		mpc_L;
		L_stk1-T-1;					do unsigned compare
		ALUCY;
		T_MD, :JIuge;

JIuge:		L_mpc+1, TASK, :nextAput;			out of bounds - to 'nextA'
JIul:		L_cp+T, TASK;					(removing this TASK saves a
		taskhole_L;					word, but leaves a run of
		T_taskhole;					15 instructions)
		XMAR_stk0+T;					fetch <<cp>+alphabeta+X>
		NOP;
		L_MD-1, :Jbranch;				L: offset

;-----------------------------------------------------------------
; L o a d s
;-----------------------------------------------------------------

; Note: These instructions keep track of their parity



;-----------------------------------------------------------------
; LLn - push <<lp>+n>
;	Note:  LL3 must be odd!
;-----------------------------------------------------------------

; Note: lp is offset by 2, hence the adjustments below

LL0:		MAR_lp-T-1, :pushMD;
LL1:		MAR_lp-1, :pushMD;
LL2:		MAR_lp, :pushMD;
LL3:		MAR_lp+T, :pushMD;
LL4:		MAR_lp+T+1, :pushMD;
LL5:		T_3, SH=0, :LL3;				pick up ball 1
LL6:		T_4, SH=0, :LL3;				pick up ball 1
LL7:		T_5, SH=0, :LL3;				pick up ball 1


;-----------------------------------------------------------------
; LLB - push <<lp>+alpha>
;-----------------------------------------------------------------

LLB:		IR_sr4, :Getalpha;				returns to LLBr
LLBr:		T_nlpoffset+T+1, SH=0, :LL3;			undiddle lp, pick up ball 1


;-----------------------------------------------------------------
; LLDB - push <<lp>+alpha>, push <<lp>+alpha+1>
;	LLDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------

LLDB:		T_lp, :LDcommon;
LDcommon:	T_nlpoffset+T+1, :Dpush;

;-----------------------------------------------------------------
; LGn - push <<gp>+n>
;	Note:  LG2 must be odd!
;-----------------------------------------------------------------

; Note: gp is offset by 1, hence the adjustments below

LG0:		MAR_gp-1, :pushMD;
LG1:		MAR_gp, :pushMD;
LG2:		MAR_gp+T, :pushMD;
LG3:		MAR_gp+T+1, :pushMD;
LG4:		T_3, SH=0, :LG2;				pick up ball 1
LG5:		T_4, SH=0, :LG2;				pick up ball 1
LG6:		T_5, SH=0, :LG2;				pick up ball 1
LG7:		T_6, SH=0, :LG2;				pick up ball 1


;-----------------------------------------------------------------
; LGB - push <<gp>+alpha>
;-----------------------------------------------------------------

LGB:		IR_sr5, :Getalpha;				returns to LGBr
LGBr:		T_ngpoffset+T+1, SH=0, :LG2;			undiddle gp, pick up ball 1


;-----------------------------------------------------------------
; LGDB - push <<gp>+alpha>, push <<gp>+alpha+1>
;	LGDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------

LGDB:		T_gp+T+1, :LDcommon;				T: gp-gpoffset+lpoffset

;-----------------------------------------------------------------
; LIn - push n
;-----------------------------------------------------------------
!1,2,LI0xB,LI0xA;						keep ball 1 in air

; Note:  all BUS dispatches use old stkp value, not incremented one

LI0:		L_stkp+1, BUS, :LI0xB;
LI1:		L_stkp+1, BUS, :pushT1B;
LI2:		T_2, :pushTB;
LI3:		T_3, :pushTB;
LI4:		T_4, :pushTB;
LI5:		T_5, :pushTB;
LI6:		T_6, :pushTB;

LI0xB:		stkp_L, L_0, TASK, :push0;
LI0xA:		stkp_L, BUS=0, L_0, TASK, :push0;		BUS=0 keeps branch pending


;-----------------------------------------------------------------
; LIN1 - push -1
;-----------------------------------------------------------------

LIN1:		T_ALLONES, :pushTB;


;-----------------------------------------------------------------
; LINI - push 100000
;-----------------------------------------------------------------

LINI:		T_100000, :pushTB;


;-----------------------------------------------------------------
; LIB - push alpha
;-----------------------------------------------------------------

LIB:		IR_sr2, :Getalpha;				returns to pushTB
;								Note: pushT1B will handle
;								any pending branch


;-----------------------------------------------------------------
; LINB - push (alpha OR 377B8)
;-----------------------------------------------------------------

LINB:		IR_sr26, :Getalpha;				returns to LINBr
LINBr:		T_177400 OR T, :pushTB;


;-----------------------------------------------------------------
; LIW - push alphabeta, assuming:
;	if LIW is A-aligned, B byte is irrelevant
;	alpha in B byte, beta in A byte of word after LIW
;-----------------------------------------------------------------

LIW:		IR_msr0, :FetchAB;				returns to LIWr
LIWr:		L_stkp+1, BUS, :pushT1A;			duplicates pushTA, but
;								because of overlapping
;								return points, we
;								can't use it

;-----------------------------------------------------------------
; S t o r e s
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; SLn - <<lp>+n>_TOS (popped)
;	Note: SL3 is odd!
;-----------------------------------------------------------------

; Note: lp is offset by 2, hence the adjustments below

SL0:		MAR_lp-T-1, :StoreB;
SL1:		MAR_lp-1, :StoreB;
SL2:		MAR_lp, :StoreB;
SL3:		MAR_lp+T, :StoreB;
SL4:		MAR_lp+T+1, :StoreB;
SL5:		T_3, SH=0, :SL3;
SL6:		T_4, SH=0, :SL3;
SL7:		T_5, SH=0, :SL3;


;-----------------------------------------------------------------
; SLB - <<lp>+alpha>_TOS (popped)
;-----------------------------------------------------------------

SLB:		IR_sr6, :Getalpha;				returns to SLBr
SLBr:		T_nlpoffset+T+1, SH=0, :SL3;			undiddle lp, pick up ball 1


;-----------------------------------------------------------------
; SLDB - <<lp>+alpha+1>_TOS (popped), <<lp>+alpha>_TOS (popped), assuming:
;	SLDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------

SLDB:		T_lp, :SDcommon;
SDcommon:	T_nlpoffset+T+1, :Dpop;

;-----------------------------------------------------------------
; SGn - <<gp>+n>_TOS (popped)
;	Note: SG2 must be odd!
;-----------------------------------------------------------------

; Note: gp is offset by 1, hence the adjustments below

SG0:		MAR_gp-1, :StoreB;
SG1:		MAR_gp, :StoreB;
SG2:		MAR_gp+T, :StoreB;
SG3:		MAR_gp+T+1, :StoreB;


;-----------------------------------------------------------------
; SGB - <<gp>+alpha>_TOS (popped)
;-----------------------------------------------------------------

SGB:		IR_sr7, :Getalpha;				returns to SGBr
SGBr:		T_ngpoffset+T+1, SH=0, :SG2;			undiddle gp, pick up ball 1


;-----------------------------------------------------------------
; SGDB - <<gp>+alpha+1>_TOS (popped), <<gp>+alpha>_TOS (popped), assuming:
;	SGDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------

SGDB:		T_gp+T+1, :SDcommon;				T: gp-gpoffset+lpoffset

;-----------------------------------------------------------------
; P u t s
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; PLn - <<lp>+n>_TOS (stack is not popped)
;-----------------------------------------------------------------
!1,1,PLcommon;							drop ball 1

; Note: lp is offset by 2, hence the adjustments below

PL0:		MAR_lp-T-1, SH=0, :PLcommon;			pick up ball 1
PL1:		MAR_lp-1, SH=0, :PLcommon;
PL2:		MAR_lp, SH=0, :PLcommon;
PL3:		MAR_lp+T, SH=0, :PLcommon;

PLcommon:	L_stkp, BUS, :StoreBa;				don't decrement stkp

;-----------------------------------------------------------------
; B i n a r y   o p e r a t i o n s
;-----------------------------------------------------------------

; Warning!  Before altering this list, be certain you understand the additional addressing
; requirements imposed on some of these return locations!  However, it is safe to add new
; return points at the end of the list.

!37,40,ADDr,SUBr,ANDr,ORr,XORr,MULr,DIVr,LDIVr,SHIFTr,EXCHr,RSTRr,WSTRr,WSBr,WS0r,WSFr,WFr,
	WSDBrb,WFSrb,BNDCKr,RWBLrb,WBLrb,,,,,,,,,,,;


;-----------------------------------------------------------------
; Binary operations common code
;	Entry conditions:
;	  Both IR and T hold return number.  (More precisely, entry at
;	   'BincomB' requires return number in IR, entry at 'BincomA' requires
;	   return number in T.)
;	Exit conditions:
;	  left operand in L (M), right operand in T
;	  stkp positioned for subsequent push (i.e. points at left operand)
;	  dispatch pending (for push0) on return
;	  if entry occurred at BincomA, IR has been modified so
;	    that mACSOURCE will produce 1
;-----------------------------------------------------------------

;  dispatches on stkp-1, so Binpop1 = 1 mod 20B

!17,20,Binpop,Binpop1,Binpop2,Binpop3,Binpop4,Binpop5,Binpop6,Binpop7,,,,,,,,;
!1,2,BincomB,BincomA;
!4,1,Bincomx;							shake IR_ in BincomA

BincomB:	L_T_stkp-1, :Bincomx;				value for dispatch into Binpop
Bincomx:	stkp_L, L_T;
		L_M-1, BUS, TASK;				L:value for push dispatch
Bincomd:	temp2_L, :Binpop;				stash briefly

BincomA:	L_2000 OR T;					make mACSOURCE produce 1
Binpop:		IR_M, :BincomB;

Binpop1:	T_stk1;
		L_stk0, :Binend;
Binpop2:	T_stk2;
		L_stk1, :Binend;
Binpop3:	T_stk3;
		L_stk2, :Binend;
Binpop4:	T_stk4;
		L_stk3, :Binend;
Binpop5:	T_stk5;
		L_stk4, :Binend;
Binpop6:	T_stk6;
		L_stk5, :Binend;
Binpop7:	T_stk7;
		L_stk6, :Binend;

Binend:		SINK_DISP, BUS;					perform return dispatch
		SINK_temp2, BUS, :ADDr;				perform push dispatch

;-----------------------------------------------------------------
; ADD - replace <TOS> with sum of top two stack elements
;-----------------------------------------------------------------

ADD:		IR_T_ret0, :BincomB;
ADDr:		L_M+T, mACSOURCE, TASK, :push0;			M addressing unaffected


;-----------------------------------------------------------------
; ADD01 - replace stk0 with <stk0>+<stk1>
;-----------------------------------------------------------------
!1,1,ADD01x;							drop ball 1

ADD01:		T_stk1-1, :ADD01x;
ADD01x:		T_stk0+T+1, SH=0;				pick up ball 1
		L_stkp-1, :pushT1B;				no dispatch => to push0

;-----------------------------------------------------------------
; SUB - replace <TOS> with difference of top two stack elements
;-----------------------------------------------------------------

SUB:		IR_T_ret1, :BincomB;
SUBr:		L_M-T, mACSOURCE, TASK, :push0;			M addressing unaffected


;-----------------------------------------------------------------
; AND - replace <TOS> with AND of top two stack elements
;-----------------------------------------------------------------

AND:		IR_T_ret2, :BincomB;
ANDr:		L_M AND T, mACSOURCE, TASK, :push0;		M addressing unaffected


;-----------------------------------------------------------------
; OR - replace <TOS> with OR of top two stack elements
;-----------------------------------------------------------------

OR:		IR_T_ret3, :BincomB;
ORr:		L_M OR T, mACSOURCE, TASK, :push0;		M addressing unaffected


;-----------------------------------------------------------------
; XOR - replace <TOS> with XOR of top two stack elements
;-----------------------------------------------------------------

XOR:		IR_T_ret4, :BincomB;
XORr:		L_M XOR T, mACSOURCE, TASK, :push0;		M addressing unaffected

;-----------------------------------------------------------------
; MUL - replace <TOS> with product of top two stack elements
;   high-order bits of product recoverable by PUSH
;-----------------------------------------------------------------
!7,1,MULDIVcoma;						shakes stack dispatch
!1,2,GoROMMUL,GoROMDIV;
!7,2,MULx,DIVx;							also shakes bus dispatch

MUL:		IR_T_ret5, :BincomB;
MULr:		AC1_L, L_T, :MULDIVcoma;			stash multiplicand

MULDIVcoma:	AC2_L, L_0, :MULx;				stash multiplier or divisor

MULx:		AC0_L, T_0+1, :MULDIVcomb;			AC0_0 keeps ROM happy
DIVx:		AC0_L, T_0, BUS=0, :MULDIVcomb;			BUS=0  => GoROMDIV

MULDIVcomb:	L_MULDIVretloc+T, SWMODE, :GoROMMUL;		prepare return address

GoROMMUL:	PC_L, :ROMMUL;					go to ROM multiply
GoROMDIV:	PC_L, :ROMDIV;					go to ROM divide

MULDIVret:	:MULDIVret1;					No divide - someday a trap
;								perhaps, but garbage now.
MULDIVret1:	T_AC1;						Normal return
		L_stkp+1;
		L_T, SINK_M, BUS;
		T_AC0, :dpush;					Note! not a subroutine
;								call, but a direct
;								dispatch.


;-----------------------------------------------------------------
; DIV - push quotient of top two stack elements (popped)
;   remainder recoverable by PUSH
;-----------------------------------------------------------------

DIV:		IR_T_ret6, :BincomB;
DIVr:		AC1_L, L_T, BUS=0, :MULDIVcoma;			BUS=0 => DIVx


;-----------------------------------------------------------------
; LDIV - push quotient of <TOS-1>,,<TOS-2>/<TOS> (all popped)
;   remainder recoverable by PUSH
;-----------------------------------------------------------------

LDIV:		IR_sr27, :Popsub;				get divisor
LDIVf:		AC2_L;						stash it
		IR_T_ret7, :BincomB;				L:low bits, T:high bits
LDIVr:		AC1_L, L_T, IR_0, :DIVx;			stash low part of dividend
;								and ensure mACSOURCE of 0.

;-----------------------------------------------------------------
; SHIFT - replace <TOS> with <TOS-1> shifted by <TOS>
;   <TOS> > 0 => left shift, <TOS> < 0 => right shift
;-----------------------------------------------------------------
!7,1,SHIFTx;							shakes stack dispatch
!1,2,Lshift,Rshift;
!1,2,DoShift,Shiftdone;
!1,2,DoRight,DoLeft;
!1,1,Shiftdonex;

SHIFT:		IR_T_ret10, :BincomB;
SHIFTr:		temp_L, L_T, TASK, :SHIFTx;			L: value, T: count
SHIFTx:		count_L;
		L_T_count;
		L_0-T, SH<0;					L: -count, T: count
		IR_sr1, :Lshift;				IR_ causes no branch

Lshift:		L_37 AND T, TASK, :Shiftcom;			mask to reasonable size

Rshift:		T_37, IR_37;					equivalent to IR_msr0
		L_M AND T, TASK, :Shiftcom;			mask to reasonable size

Shiftcom:	count_L, :Shiftloop;

Shiftloop:	L_count-1, BUS=0;				test for completion
		count_L, IDISP, :DoShift;
DoShift:	L_temp, TASK, :DoRight;

DoRight:	temp_L RSH 1, :Shiftloop;
DoLeft:		temp_L LSH 1, :Shiftloop;

Shiftdone:	SINK_temp2, BUS, :Shiftdonex;			dispatch to push result
Shiftdonex:	L_temp, TASK, :push0;

;-----------------------------------------------------------------
; D o u b l e - P r e c i s i o n   A r i t h m e t i c
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; DADD - add two double-word quantities, assuming:
;	stack contains precisely 4 elements
;-----------------------------------------------------------------
!1,1,DoRamDoubles;						shake B/A dispatch

DADD:		L_4, SWMODE, :DoRamDoubles;			drop ball 1
DoRamDoubles:	SINK_M, BUS, TASK, :ramOverflow;		go to overflow code in RAM


;-----------------------------------------------------------------
; DSUB - subtract two double-word quantities, assuming:
;	stack contains precisely 4 elements
;-----------------------------------------------------------------

DSUB:		L_5, SWMODE, :DoRamDoubles;			drop ball 1


;-----------------------------------------------------------------
; DCOMP - compare two long integers, assuming:
;	stack contains precisely 4 elements
;	result left on stack is -1, 0, or +1 (single-precision)
;	  (i.e. result = sign(stk1,,stk0 DSUB stk3,,stk2) )
;-----------------------------------------------------------------

DCOMP:		L_6, SWMODE, :DoRamDoubles;			drop ball 1


;-----------------------------------------------------------------
; DUCOMP - compare two long cardinals, assuming:
;	stack contains precisely 4 elements
;	result left on stack is -1, 0, or +1 (single-precision)
;	  (i.e. result = sign(stk1,,stk0 DSUB stk3,,stk2) )
;-----------------------------------------------------------------

DUCOMP:		L_7, SWMODE, :DoRamDoubles;			drop ball 1

;-----------------------------------------------------------------
; R a n g e   C h e c k i n g
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; NILCK - check TOS for NIL (0), trap if so
;-----------------------------------------------------------------
!1,2,InRange,OutOfRange;

NILCK:		L_ret17, :Xpopsub;				returns to NILCKr
NILCKr:		T_ONE, SH=0, :NILCKpush;			test TOS=0

NILCKpush:	L_stkp+T, :InRange;

InRange:	SINK_ib, BUS=0, TASK, :Setstkp;			pick up ball 1
OutOfRange:	T_sBoundsFaultm1+T+1, :KFCr;			T:SD index; go trap


;-----------------------------------------------------------------
; BNDCK - check subrange inclusion
;	if TOS-1 ~IN [0..TOS) then trap (test is unsigned)
;	only TOS is popped off
;-----------------------------------------------------------------
!7,1,BNDCKx;							shake push dispatch

BNDCK:		IR_T_ret22, :BincomB;				returns to BNDCKr
BNDCKr:		SINK_M-T, :BNDCKx;				L: value, T: limit
BNDCKx:		T_0, ALUCY, :NILCKpush;

;-----------------------------------------------------------------
; R e a d s
;-----------------------------------------------------------------

; Note: RBr must be odd!


;-----------------------------------------------------------------
; Rn - TOS_<<TOS>+n>
;-----------------------------------------------------------------

R0:		T_0, SH=0, :RBr;
R1:		T_ONE, SH=0, :RBr;
R2:		T_2, SH=0, :RBr;
R3:		T_3, SH=0, :RBr;
R4:		T_4, SH=0, :RBr;


;-----------------------------------------------------------------
; RB - TOS_<<TOS>+alpha>, assuming:
;-----------------------------------------------------------------
!1,2,ReadB,ReadA;						keep ball 1 in air

RB:		IR_sr15, :Getalpha;				returns to RBr
RBr:		L_stkp-1, BUS, :ReadB;

ReadB:		stkp_L, :MAStkT;				to pushMD
ReadA:		stkp_L, BUS=0, :MAStkT;				to pushMDA


;-----------------------------------------------------------------
; RDB - temp_<TOS>+alpha, push <<temp>>, push <<temp>+1>, assuming:
;	RDB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------

RDB:		IR_sr30, :Popsub;				returns to Dpush


;-----------------------------------------------------------------
; RD0 - temp_<TOS>, push <<temp>>, push <<temp>+1>
;-----------------------------------------------------------------

RD0:		IR_sr32, :Popsub;				returns to RD0r
RD0r:		L_0, :Dpusha;

;-----------------------------------------------------------------
; RILP - push <<<lp>+alpha[0-3]>+alpha[4-7]>
;-----------------------------------------------------------------

RILP:		L_ret0, :Splitalpha;				get two 4-bit values
RILPr:		T_lp, :RIPcom;					T:address of local 2 


;-----------------------------------------------------------------
; RIGP - push <<<gp>+alpha[0-3]>+alpha[4-7]>
;-----------------------------------------------------------------
!3,1,IPcom;							shake IR_ at WILPr

RIGP:		L_ret1, :Splitalpha;				get two 4-bit values
RIGPr:		T_gp+1, :RIPcom;				T:address of global 2 

RIPcom:		IR_msr0, :IPcom;				set up return to pushMD

IPcom:		T_-3+T+1;					T:address of local or global 0
		MAR_lefthalf+T;					start memory cycle
		L_righthalf;
IPcomx:		T_MD, IDISP;					T:local/global value
		MAR_M+T, :pushMD;				start fetch/store


;-----------------------------------------------------------------
; RIL0 - push <<<lp>>>
;-----------------------------------------------------------------
!1,2,RILxB,RILxA;

RIL0:		MAR_lp-T-1, :RILxB;				fetch local 0

RILxB:		IR_msr0, L_0, :IPcomx;				to pushMD
RILxA:		IR_sr1, L_sr1 AND T, :IPcomx;			to pushMDA, L_0(!)


;-----------------------------------------------------------------
; RXLP - TOS_<<TOS>+<<lp>+alpha[0-3]>+alpha[4-7]>
;-----------------------------------------------------------------

RXLP:		L_ret3, :Splitalpha;				will return to RXLPra
RXLPra:		IR_sr34, :Popsub;				fetch TOS
RXLPrb:		L_righthalf+T, TASK;				L:TOS+alpha[4-7]
		righthalf_L, :RILPr;				now act like RILP

;-----------------------------------------------------------------
; W r i t e s
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; Wn - <<TOS> (popped)+n>_<TOS> (popped)
;-----------------------------------------------------------------
!1,2,WnB,WnA;							keep ball 1 in air

W0:		T_0, :WnB;
W1:		T_ONE, :WnB;
W2:		T_2, :WnB;

WnB:		IR_sr2, :Wsub;					returns to StoreB

WnA:		IR_sr3, :Wsub;					returns to StoreA

;-----------------------------------------------------------------
; Write subroutine:
;-----------------------------------------------------------------
!7,1,Wsubx;							shake IR_ dispatch

Wsub:		L_stkp-1, BUS, :Wsubx;
Wsubx:		stkp_L, IDISP, :MAStkT;


;-----------------------------------------------------------------
; WB - <<TOS> (popped)+alpha>_<TOS-1> (popped)
;-----------------------------------------------------------------

WB:		IR_sr16, :Getalpha;				returns to WBr
WBr:		:WnB;						branch may be pending


;-----------------------------------------------------------------
; WSB - act like WB but with stack values reversed, assuming:
;	WSB is A-aligned (also ensures no pending branch at entry)
;-----------------------------------------------------------------
!7,1,WSBx;							shake stack dispatch

WSB:		IR_T_ret14, :BincomA;				alignment requires BincomA
WSBr:		T_M, L_T, :WSBx;

WSBx:		MAR_ib+T, :WScom;
WScom:		temp_L;
WScoma:		L_stkp-1;
		MD_temp;
		mACSOURCE, TASK, :Setstkp;


;-----------------------------------------------------------------
; WS0 - act like WSB but with alpha value of zero
;-----------------------------------------------------------------
!7,1,WS0x;							shake stack dispatch

WS0:		IR_T_ret15, :BincomB;
WS0r:		T_M, L_T, :WS0x;

WS0x:		MAR_T, :WScom;

;-----------------------------------------------------------------
; WILP - <<lp>+alpha[0-3]>+alpha[4-7] _ <TOS> (popped)
;-----------------------------------------------------------------

WILP:		L_ret2, :Splitalpha;				get halves of alpha
WILPr:		IR_sr2;						IPcom will exit to StoreB
		T_lp, :IPcom;					prepare to undiddle


;-----------------------------------------------------------------
; WXLP - <TOS>+<<lp>+alpha[0-3]>+alpha[4-7] _ <TOS-1> (both popped)
;-----------------------------------------------------------------

WXLP:		L_ret4, :Splitalpha;				get halves of alpha
WXLPra:		IR_sr35, :Popsub;				fetch TOS
WXLPrb:		L_righthalf+T, TASK;				L:TOS+alpha[4-7]
		righthalf_L, :WILPr;				now act like WILP


;-----------------------------------------------------------------
; WDB - temp_alpha+<TOS> (popped), pop into <temp>+1 and <temp>, assuming:
;	WDB is A-aligned (also ensures no pending branch at entry) 
;-----------------------------------------------------------------

WDB:		IR_sr31, :Popsub;				returns to Dpop


;-----------------------------------------------------------------
; WD0 - temp_<TOS> (popped), pop into <temp>+1 and <temp>
;-----------------------------------------------------------------

WD0:		L_ret6, TASK, :Xpopsub;				returns to WD0r
WD0r:		L_0, :Dpopa;


;-----------------------------------------------------------------
; WSDB - like WDB but with address below data words, assuming:
;	WSDB is A-aligned (also ensures no pending branch at entry) 
;-----------------------------------------------------------------
!7,1,WSDBx;

WSDB:		IR_sr24, :Popsub;				get low data word
WSDBra:		saveret_L;					stash it briefly
		IR_T_ret20, :BincomA;				alignment requires BincomA
WSDBrb:		T_M, L_T, :WSDBx;				L:high data, T:address
WSDBx:		MAR_T_ib+T+1;					start store of low data word
		temp_L, L_T;					temp:high data
		temp2_L, TASK;					temp2:updated address
		MD_saveret;					stash low data word
		MAR_temp2-1, :WScoma;				start store of high data word

;-----------------------------------------------------------------
; L o n g   P o i n t e r   o p e r a t i o n s
;-----------------------------------------------------------------

!1,1,RWBLcom;							drop ball 1

;-----------------------------------------------------------------
; RBL - like RB, but uses a long pointer
;-----------------------------------------------------------------

RBL:		L_M AND NOT T, T_M, SH=0, :RWBLcom;		L: ret0, T: L at entry


;-----------------------------------------------------------------
; WBL - like WB, but uses a long pointer
;-----------------------------------------------------------------

WBL:		L_T, T_M, SH=0, :RWBLcom;			L: ret1, T: L at entry

;
; Common long pointer code
;
!1,2,RWBLcomB,RWBLcomA;
!1,1,RWBLxa;							drop ball 1
!7,1,RWBLxb;							shake stkp dispatch
!7,1,WBLx;							shake stkp dispatch
!3,4,RBLra,WBLra,WBLrc,;
!3,4,RWBLdone,RBLdone,,WBLdone;

RWBLcom:	entry_L, L_T, :RWBLcomB;			stash return, restore L

RWBLcomB:	IR_sr37, :Getalpha;
RWBLcomA:	IR_sr37, :GetalphaA;

RWBLra:		IR_ret23, L_T, :RWBLxa;				L: alpha byte
RWBLxa:		alpha_L, :BincomB;				stash alpha, get long pointer
RWBLrb:		MAR_BankReg, :RWBLxb;				fetch bank register
RWBLxb:		L_T, T_M;					T: low half, L: high half
		temp_L;						temp: high pointer
		L_alpha+T;					L: low pointer+alpha
		T_MD;						T: bank register to save
		MAR_BankReg;					reaccess bank register
		frame_L, L_T;					frame: pointer
		taskhole_L, TASK;				taskhole: old bank register
		MD_temp, :WBLx;					set new alternate bank value

WBLx:		XMAR_frame;					start memory access
		L_entry+1, BUS;					dispatch RBL/WBL
		entry_L, L_T, :RBLra;				(L_T for WBLrc only)

RBLra:		T_MD, :RWBLtail;				T: data from memory
WBLra:		IR_ret24, :BincomB;				returns to WBLrb
WBLrb:		T_M, :WBLx;					T: data to write

WBLrc:		MD_M, :RWBLtail;				stash data in memory

RWBLtail:	MAR_BankReg;
		SINK_entry, BUS;				dispatch return
RWBLdone:	MD_taskhole, :RWBLdone;				restore bank register

RBLdone:	L_temp2+1, BUS, :pushT1B;			temp2: original stkp-2
WBLdone:	L_temp2, TASK, :Setstkp;			temp2: original stkp-3

;-----------------------------------------------------------------
; U n a r y  o p e r a t i o n s
;-----------------------------------------------------------------

; XMESA Note:  Untail is wired down by a pre-def in MesaROM.mu


;-----------------------------------------------------------------
; INC - TOS _ <TOS>+1
;-----------------------------------------------------------------

INC:		IR_sr14, :Popsub;
INCr:		T_0+T+1, :pushTB;


;-----------------------------------------------------------------
; NEG - TOS _ -<TOS>
;-----------------------------------------------------------------

NEG:		L_ret11, TASK, :Xpopsub;
NEGr:		L_0-T, :Untail;


;-----------------------------------------------------------------
; DBL - TOS _ 2*<TOS>
;-----------------------------------------------------------------

DBL:		IR_sr25, :Popsub;
DBLr:		L_M+T, :Untail;


;-----------------------------------------------------------------
; Unary operation common code
;-----------------------------------------------------------------

Untail:		T_M, :pushTB;

;-----------------------------------------------------------------
; S t a c k   a n d   M i s c e l l a n e o u s   O p e r a t i o n s
;-----------------------------------------------------------------


;-----------------------------------------------------------------
; PUSH - add 1 to stack pointer
;-----------------------------------------------------------------
!1,1,PUSHx;

PUSH:		L_stkp+1, BUS, :PUSHx;				BUS checks for overflow
PUSHx:		SINK_ib, BUS=0, TASK, :Setstkp;			pick up ball 1


;-----------------------------------------------------------------
; POP - subtract 1 from stack pointer
;-----------------------------------------------------------------

POP:		L_stkp-1, SH=0, TASK, :Setstkp;			L=0 <=> branch 1 pending
;								need not check stkp=0


;-----------------------------------------------------------------
; DUP - temp_<TOS> (popped), push <temp>, push <temp>
;-----------------------------------------------------------------
!1,1,DUPx;

DUP:		IR_sr2, :DUPx;					returns to pushTB
DUPx:		L_stkp, BUS, TASK, :Popsuba;			don't pop stack


;-----------------------------------------------------------------
; EXCH - exchange top two stack elements
;-----------------------------------------------------------------
!1,1,EXCHx;							drop ball 1

EXCH:		IR_ret11, :EXCHx;
EXCHx:		L_stkp-1;					dispatch on stkp-1
		L_M+1, BUS, TASK, :Bincomd;			set temp2_stkp
EXCHr:		T_M, L_T, :dpush;				Note: dispatch using temp2


;-----------------------------------------------------------------
; LADRB - push alpha+lp (undiddled)
;-----------------------------------------------------------------
!1,1,LADRBx;							shake branch from Getalpha

LADRB:		IR_sr10, :Getalpha;				returns to LADRBr
LADRBr:		T_nlpoffset+T+1, :LADRBx;
LADRBx:		L_lp+T, :Untail;


;-----------------------------------------------------------------
; GADRB - push alpha+gp (undiddled)
;-----------------------------------------------------------------
!1,1,GADRBx;							shake branch from Getalpha

GADRB:		IR_sr11, :Getalpha;				returns to GADRBr
GADRBr:		T_ngpoffset+T+1, :GADRBx;
GADRBx:		L_gp+T, :Untail;

;-----------------------------------------------------------------
; S t r i n g   O p e r a t i o n s
;-----------------------------------------------------------------
!7,1,STRsub;							shake stack dispatch
!1,2,STRsubA,STRsubB;
!1,2,RSTRrx,WSTRrx;

STRsub:		L_stkp-1;					update stack pointer
		stkp_L;
		L_ib+T;						compute index and offset
		SINK_M, BUSODD, TASK;
		count_L RSH 1, :STRsubA;

STRsubA:	L_177400, :STRsubcom;				left byte
STRsubB:	L_377, :STRsubcom;				right byte

STRsubcom:	T_temp;						get string address
		MAR_count+T;					start fetch of word
		T_M;						move mask to more useful place
		SINK_DISP, BUSODD;				dispatch to caller
		mask_L, SH<0, :RSTRrx;				dispatch B/A, mask for WSTR


;-----------------------------------------------------------------
; RSTR - push byte of string using base (<TOS-1>) and index (<TOS>)
;	assumes RSTR is A-aligned (no pending branch at entry)
;-----------------------------------------------------------------
!1,2,RSTRB,RSTRA;

RSTR:		IR_T_ret12, :BincomB;
RSTRr:		temp_L, :STRsub;				stash string base address
RSTRrx:		L_MD AND T, TASK, :RSTRB;			isolate good bits

RSTRB:		temp_L, :RSTRcom;
RSTRA:		temp_L LCY 8, :RSTRcom;				right-justify byte

RSTRcom:	T_temp, :pushTA;				go push result byte


;-----------------------------------------------------------------
; WSTR - pop <TOS-2> into string byte using base (<TOS-1>) and index (<TOS>)
;	assumes WSTR is A-aligned (no pending branch at entry)
;-----------------------------------------------------------------
!1,2,WSTRB,WSTRA;

WSTR:		IR_T_ret13, :BincomB;
WSTRr:		temp_L, :STRsub;				stash string base
WSTRrx:		L_MD AND NOT T, :WSTRB;				isolate good bits

WSTRB:		temp2_L, L_ret0, TASK, :Xpopsub;		stash them, return to WSTRrB
WSTRA:		temp2_L, L_ret0+1, TASK, :Xpopsub;		stash them, return to WSTRrA

WSTRrA:		taskhole_L LCY 8;				move new data to odd byte
		T_taskhole, :WSTRrB;

WSTRrB:		T_mask.T;
		L_temp2 OR T;
		T_temp;						retrieve string address
		MAR_count+T;
		TASK;
		MD_M, :nextA;

;-----------------------------------------------------------------
; F i e l d   I n s t r u c t i o n s
;-----------------------------------------------------------------

; temp2 is coded as follows:
;	0 - RF, RFS
;	1 - WF, WSF, WFS
;	2 - RFC

%1,3,2,RFrr,WFrr;						returns from Fieldsub
!7,1,Fieldsub;							shakes stack dispatch
; !7,1,WFr; (required by WSFr) is implicit in ret17 (!)


;-----------------------------------------------------------------
; RF - push field specified by beta in word at <TOS> (popped) + alpha
;	if RF is A-aligned, B byte is irrelevant
;	alpha in B byte, beta in A byte of word after RF
;-----------------------------------------------------------------

RF:		IR_sr12, :Popsub;
RFr:		L_ret0, :Fieldsub;
RFrr:		T_mask.T,  :pushTA;				alignment requires pushTA


;-----------------------------------------------------------------
; WF - pop data in <TOS-1> into field specified by beta in word at <TOS> (popped) + alpha
;	if WF is A-aligned, B byte is irrelevant
;	alpha in B byte, beta in A byte of word after WF
;-----------------------------------------------------------------
; !1,2,WFnzct,WFret; - see location-specific definitions

WF:		IR_T_ret17, :BincomB;				L:new data, T:address
WFr:		newfield_L, L_ret0+1, :Fieldsub;		(actually, L_ret1)

WFrr:		T_mask;
		L_M AND NOT T;					set old field bits to zero
		temp_L;						stash result
		T_newfield.T;					save new field bits
		L_temp OR T, TASK;				merge old and new
		CYCOUT_L;					stash briefly
		T_index, BUS=0;					get position, test for zero
		L_WFretloc, :WFnzct;				get return address from ROM

WFnzct:		PC_L;						stash return
		L_20-T, SWMODE;					L:remaining count to cycle
		T_CYCOUT, :RAMCYCX;				go cycle remaining amount
WFret:		MAR_frame;					start memory
		L_stkp-1;					pop remaining word
		MD_CYCOUT, TASK, :JZNEBeq;			stash data, go update stkp


;-----------------------------------------------------------------
; WSF - like WF, but with top two stack elements reversed
;	if WSF is A-aligned, B byte is irrelevant
;	alpha in B byte, beta in A byte of word after WSF
;-----------------------------------------------------------------

WSF:		IR_T_ret16, :BincomB;				L:address, T:new data
WSFr:		L_T, T_M, :WFr;

;-----------------------------------------------------------------
; RFS - like RF, but with a word containing alpha and beta on top of stack
;	if RFS is A-aligned, B byte is irrelevant
;-----------------------------------------------------------------

RFS:		L_ret12, TASK, :Xpopsub;			get alpha and beta
RFSra:		temp_L;						stash for WFSa
		L_ret13, TASK, :Xpopsub;			T:address
RFSrb:		L_ret0, BUS=0, :Fieldsub;			returns quickly to WFSa


;-----------------------------------------------------------------
; WFS - like WF, but with a word containing alpha and beta on top of stack
;	if WFS is A-aligned, B byte is irrelevant
;-----------------------------------------------------------------
!1,2,Fieldsuba,WFSa;

WFS:		L_ret14, TASK, :Xpopsub;			get alpha and beta
WFSra:		temp_L;						stash temporarily
		IR_T_ret21, :BincomB;				L:new data, T:address
WFSrb:		newfield_L, L_ret0+1, BUS=0, :Fieldsub;		returns quickly to WFSa
WFSa:		frame_L;					stash address
		T_177400;					to separate alpha and beta
		L_temp AND T, T_temp, :Getalphab;		L:alpha, T:both
;								returns to Fieldra


;-----------------------------------------------------------------
; RFC - like RF, but uses <cp>+<alpha>+<TOS> as address
;	if RFC is A-aligned, B byte is irrelevant
;	alpha in B byte, beta in A byte of word after RF
;-----------------------------------------------------------------

RFC:		L_ret16, TASK, :Xpopsub;			get index into code segment
RFCr:		L_cp+T;
		T_M;						T:address
		L_ret2, :Fieldsub;				returns to RFrr

;-----------------------------------------------------------------
; Field instructions common code
;	Entry conditions:
;	  L holds return offset
;	  T holds base address
;	Exit conditions:
;	  mask: right-justified mask
;	  frame: updated address, including alpha
;	  index: left cycles needed to right-justify field [0-15]
;	  L,T: data word from location <frame> cycled left <index> bits
;-----------------------------------------------------------------
%2,3,1,NotCodeSeg,IsCodeSeg;

Fieldsub:	temp2_L, L_T, IR_msr0, TASK, :Fieldsuba;	stash return
Fieldsuba:	frame_L, :GetalphaA;				stash base address
;								T: beta, ib: alpha
Fieldra:	L_ret5;
		saveret_L, :Splitcomr;				get two halves of beta
Fieldrb:	T_righthalf;					index for MASKTAB
		MAR_MASKTAB+T;					start fetch of mask
		T_lefthalf+T+1;					L:left-cycle count
		L_17 AND T;					mask to 4 bits
		index_L;					stash position
		L_MD, TASK;					L:mask for caller's use
		mask_L;						stash mask
		SINK_temp2, BUS;				temp2=2 <=> RFC
		T_frame, :NotCodeSeg;				get base address
NotCodeSeg:	L_MAR_ib+T, :StashFieldLoc;			add alpha
IsCodeSeg:	XMAR_ib+T, :DoCycle;				add alpha

StashFieldLoc:	frame_L, :DoCycle;				stash updated address for WF
DoCycle:	L_Fieldretloc;					return location from RAMCYCX
		PC_L;
		T_MD, SWMODE;					data word into T for cycle
		L_index, :RAMCYCX;				count to cycle, go do it
Fieldrc:	SINK_temp2, BUSODD;				return dispatch
		L_T_CYCOUT, :RFrr;				cycled data word in L and T