{File name BXMoreLisp12K.mc
File name MoreLisp12K.mc
Description: DandeLion Interlisp Emulator
Author: Purcell
Created: June 8, 1981
purcell:	11-Jul-84 14:40:05	modify INPUT for BusExt.
purcell:	25-Jun-84 19:07:50	add BusExt i/o.
charnley:     13-Mar-84 15:00:13  moved logout to bank 0 
charnley:     1-Mar-84  9:54:06  removed mem tests{ZZZ} 
charnley:    27-Feb-84 16:40:35  added version 
Lichtenberg: 1-Jan-84 11:58:35 Changed LOGOUT Subr to work with
		Domino 10.0
charnley:    21-Dec-83 11:14:56 
charnley:    10-Nov-83 12:24:09 added another pgcross 
charnley:    10-Nov-83 11:06:20 added pgcross to fvar look up old 9099
Charnley:    2-Nov-83 14:26:38 modified carcdrufn to be ufnX
Charnley:   20-Oct-83 10:36:08
Charnley:  25-Jun-83 11:54:56 {fixed FVAR_ looping}
Purcell: April 12, 1983  6:06 PM ; logout uLispBootMsg=55 to mesa
Purcell: April 12, 1983  1:15 PM ; BBlt reentrant by state on stack
RCLK writes: March 14, 1983  7:31 PM
Last edited: February 24, 1983  5:04 PM
fixes BLT exit S ok, Last edited: February 24, 1983  5:04 PM
fixes to faultable FVAR, Last edited: February 23, 1983  12:58 PM
faultable BitBlt, Last edited: January 7, 1983  6:14 PM
new SUBR #s, Last edited: December 28, 1982  6:39 PM
Hard Reset, Last edited: December 15, 1982  11:17 PM
MPWait, Last edited: December 9, 1982  12:54 AM
subrs, Last edited: August 1, 1982  4:44 PM}

{	contains:
	004	@NTYPX
	003	@LISTP
	005	@TYPEP
	006	@DTEST
	001	@CAR
	002	@CDR
	076	@RAID
	175	@SUBR
	167	@RCLK
	166	@BBLT
	170	@MISC1
	171	@MISC2
	164	@READPRINTERPORT
	165	@WRITEPRINTERPORT
	143	@FVARg
	312	@GBITS
	317	@PUTBITS
	021	@BIND
	023	@DUNBIND
	022	@UNBIND
	}
SetTask[0];

{*******************************************************************
	CAR 2%, CDR 2%, LISTP 1%, TYPEP 1%, DTEST, NTYPX		%  ? clicks
*******************************************************************}
{type table unpacked  at 18000, same segment as map}
@NTYPX:	opcode[4'b],
	MAR _ Q _ [TOS, TOSH + 0], CALL[typ],	c1;

{typ increments PC by a byte, returns Q:0FF; Rx: real address of type table entry}

ntypex1:	MAR _ [rhRx, Rx + 0], L2 _ L2.0,	c1, at[4,10, NewTypRet];
	TOSH _ smallpl, IBDisp, L2 _ L2.0,	c2;
	TOS _ MD and Q,  L2 _ L2.0, DISPNI[OpTable],	c3;

{*******************************************************************}
@LISTP:	opcode[3'b],
	TT _ 0 - 03'b, CALL[NewTyp],	c1;

{	
	NIL will replace the top-of-stack if tos is not a valid LISP pointer (i.e. if it is larger than a 22 bit number).
	ELSE: typ increments PC by a byte, returns Q:0FF; Rx: real address of type table entry. 
}

	MAR _ [rhRx, Rx], Rx _ ListType + 0,	c1, at[3,10, NewTypRet];
	PC _ PC + 0, GOTO[typep3],	c2;

@TYPEP:	opcode[5'b],
	TT _ 0 - 05'b, CALL[NewTyp],	c1;

{	
	NIL will replace the top-of-stack if tos is not a valid LISP pointer (i.e. if it is larger than a 22 bit number).
	ELSE: typ increments PC by a byte, returns Q:0FF; Rx: real address of type table entry. 
}

typep1:	MAR _ [rhRx, Rx], Rx _ ib + 0	c1, at[5,10, NewTypRet];
	PC _ PC + PC16,	c2;
typep3:	Q _ MD xor Rx,	c3;

	Q _ Q - 1, PgCarryBr, L2 _ L2.0,	c1;
	uTOSH _ TOSH, TOSH _ 0{nil}, IBDisp, BRANCH[$, noL],	c2;
	TOSH _ uTOSH, L2 _ L2.0, DISPNI[OpTable],	c3;
noL:	TOS _ 0{nil}, L2 _ L2.0, DISPNI[OpTable],	c3;

listpretnil:
	PC _ PC + PC16, L2Disp,	c2;
	DISP4[listpdisp],	c3;
	
	GOTO[makeTosNil],	c1, at[3,10,listpdisp];
	PC _ PC + PC16, Xbus _ ib, GOTO[makeTosNil],	c1, at[5,10,listpdisp];
makeTosNil:
	TOSH _ 0{nil}, IBDisp, L2 _ L2.0,	c2;
	TOS _ 0{nil}, L2 _ L2.0, DISPNI[OpTable],	c3;

{*******************************************************************}
@DTEST:	opcode[6'b],
	TT _ 06'b, CALL[NewTyp],	c1;
{	
	NewTyp will call ufn[TT] if tos is not a valid LISP pointer (i.e. if it is larger than a 22 bit number).
	ELSE: typ increments PC by a byte, returns Q:0FF; Rx: real address of type table entry. 
}


	MAR _ [rhRx, Rx + 0],	c1, at[6,10, NewTypRet];
	Rx _ DTDbasePage,	c2;
	TT _ MD and Q,	c3;

	Rx _ Rx LRot8,	c1;
	Noop,	c2;
	Noop,	c3;

	TT _ TT LRot4,	c1;
	TT _ Rx + TT, rhTT _ DTDspace,	c2;
	Rx _ ib,	c3;

	Map _ Q _ [rhTT, TT],	c1;
	TT _ Rx LRot8,	c2;
	rhRx _ Rx _ MD, {XRefBr,}	c3;

	MAR _ [rhRx, Q + 0], {BRANCH[dtestMap, $],}	c1;
	TT{type} _ ib or TT,	c2;
	Rx  _ MD xor TT, L2 _ L2.0,	c3;

	Ybus _ Rx, NZeroBr,	c1;
	Rx _ 6, BRANCH[$, DtestnotOK], 	c2;
	Noop,	c3;

	Noop,	c1;
	IBDisp,	c2;
	PC _ PC + 1, L2 _ L2.0, DISPNI[OpTable],	c3;

DtestnotOK:
	IB _ TT{type} LRot0,	c3;
	PC _ PC - PC16, IBPtr_0, GOTO[ufn2],	c1;

{*******************************************************************}
@CAR:	opcode[1'b],
	Ybus _ TOS or TOSH, ZeroBr, GOTO[carcdrcomm],	c1;
@CDR:	opcode[2'b],
	Ybus _ TOS or TOSH, ZeroBr, GOTO[carcdrcomm],	c1;
carcdrcomm:
	Xbus _ TOSH LRot12, XDisp, BRANCH[$, carcdrretNIL],	c2;
	DISP4[NewTypDisp, 3],	c3;

carcdrretNIL:
	CANCELBR[$, 0F],	c3;
	PC _ PC + PC16, GOTO[makeTosNil],	c1;

{	
	NewTyp will call ufn[TT] if tos is not a valid LISP pointer (i.e. if it is larger than a 22 bit number).
	ELSE: typ increments PC by a byte, returns Q:0FF; Rx: real address of type table entry. 
}

NewTyp:
	Xbus _ TOSH LRot12, XDisp,	c2;
NewTypC3:
	Rx _ TT, NegBr, DISP4[NewTypDisp, 3],	c3;

	MAR _ Q _ [TOS, TOSH + 0], CANCELBR[$],	c1, at[03,10,NewTypDisp];
typ:
	Rx _ Q, rhRx _ MDSTYPEspaceReal, 	c2;
	Rx _ Rx LRot8, L1 _ L1.DecOnly,	c3;

	Rx _ Rx RShift1, SE_1,	c1;
	PC _ PC + PC16, L2Disp, 	c2;
	Q _ 0FF, DISP4[NewTypRet],	c3;

	{PC _ PC + PC16, }BRANCH[carcdrufn, listpretnil],	c1, at[07,10,NewTypDisp];
	{PC _ PC + PC16, }BRANCH[carcdrufn, listpretnil],	c1, at[0B,10,NewTypDisp];
	{PC _ PC + PC16, }BRANCH[carcdrufn, listpretnil],	c1, at[0F,10,NewTypDisp];

carcdrufn:
	GOTO[ufnX3],	c2;

	MAR _ [rhRx, Rx], Rx _ ListType + 0, L0_L0.xRedoCdr, GOTO[cadr],	c1, at[1,10, NewTypRet];

	MAR _ [rhRx, Rx], Rx _ ListType + 0, L0_L0.xRedoCdr, GOTO[cadr],	c1, at[2,10, NewTypRet];
cadr:
	rhTT _ TOSH LRot0, ZeroBr,	c2;
	Q _ MD xor Rx, BRANCH[$, cadrN],	c3;

	Map _ TT _ [rhTT, TOS], GOTO[cadr1],	c1;
cadrN:	Map _ TT _ [rhTT, TOS], ZeroBr,	c1;
cadr1:	Q _ Q - 1, PgCarryBr, BRANCH[$, tosNil],	c2;
cadr3:	uTOSH _ TOSH, rhRx _ Rx _ MD, XRefBr, BRANCH[$, cadrUfn],	c3;

cadrH:	MAR _ Q _ [rhRx, TOS], L2Disp, BRANCH[cadrMap, $],	c1, at[L0.xRedoCdr, 10, RxMapFixCaller];
	rhTT _ Rx LRot0, TT _ Q + 1, BRANCH[$, carTail, 0E],	c2;
	Rx _ ~MD, XHDisp,	c3;

{****************cdr cases: cdrLoc, cdrIndLoc, indCell****************}

cdrL:	MAR _ [rhRx, TT], Rx{~,=} _ -Rx-1, CarryBr{0#MDhigh}, BRANCH[cdrInd, cdrDir, 2], LOOPHOLE[pci],	c1;
cdrInd:	rhTOSH _ Rx LRot0, TOSH _ Rx LRot1, BRANCH[indCell, cdrIndLoc, 2],	c2;
cdrDir:	TOSH _ ~Rx LRot8, CANCELBR[$, 3],	c2;

{Regs:	         TOSH{cdr},   uTOSH{tosH}, TOS{tos}	cdrLoc
	         TOSH{cdr},   rhTT{rhRx}, TT{Rx}	cdrIndLoc
	         rhTOSH{carH}, MD{car}	indCell }

cdrLoc:
	TOSH _ (TOSH and u7F) LShift1, ZeroBr,	c3;

	MAR _ TOS _ [TOS, TOSH + 0], BRANCH[$, cdrNil, 2],	c1;{rhTOS?%}
	TOSH _ uTOSH, L2 _ L2.0, IBDisp,	c2;
	TOSH _ TOSH and 0FF, L2 _ L2.0, DISPNI[OpTable],	c3;

tosNil:	Noop, CANCELBR[$, 1],	c3;
	Noop,	c1;
cdrNil:	TOS _ 0, L2 _ L2.0, IBDisp,	c2;
	TOSH _ 0, L2 _ L2.0, DISPNI[OpTable],	c3;

cdrIndLoc:	TOSH _ ~(TOSH LRot8),	c3;
	MAR _ Q _ [rhTT{rhRx}, TOSH{cdr} or 1],	c1;
	TOSH _ 0FF , CANCELBR[$, 2],	c2;
	TOS _ MD,	c3;

	MAR _ [rhTT, Q - 1], L2 _ L2.0, 	c1;
	IBDisp, CANCELBR[$, 2],	c2;
	TOSH _ MD and TOSH, L2 _ L2.0, DISPNI[OpTable],	c3;


{**************** car cases: indCell, other ****************}

carTail:	TOSH _ MD, rhTOSH _ MD, XHDisp,	c3;
carL:	MAR _ [rhRx, TOS + 1], BRANCH[$, carDir, 2],	c1;
	Ybus _ TOSH and ~u0FF, NZeroBr, CANCELBR[$, 2],	c2;

indCell:	TOS _ MD{car}, BRANCH[$, carIndLoc],	c3;
	Map _ [rhTOSH, TOS], TOSH _ rhTOSH, L0_L0.xRedoCdr,	c1;
	rhTT _ TOSH LRot0, {{*}TT _ Q,{*}}GOTO[cadr3], {L0 still set}	c2;

carIndLoc:	TOSH _ rhTOSH,	c1;
	L2 _ L2.0, IBDisp,	c2;
	L2 _ L2.0, DISPNI[OpTable],	c3;

carDir:	TOSH _ rhTOSH, L2 _ L2.0, IBDisp, DISP2[dumb],	c2;
dumb:	TOS _ MD, L2 _ L2.0, DISPNI[OpTable],	c3, at[0, 4, dumb];
	Q _ 9'd, GOTO[sink1],	c3, at[2, 4, dumb];{MP9009}

{**************** exceptions                   ****************}

cadrMap:	TT _ TOS, CANCELBR[RLxMapFix, 0F], {returns to cdrH}	c2;

cadrUfn:	PC _ PC - PC16, CANCELBR[ufnX2],	c1;

{*******************************************************************
	RAID	? %  ? clicks
*******************************************************************}
{display function name in MP; wait for right shift}
@RAID:	opcode[76'b],
	Q _ TOS + 0FF + 1,	c1;
	Q{TOS + 300'd} _ Q + 2C,	c2;
	PC _ PC + PC16, GOTO[sink1],	c3;

{display Q in MP; wait for right shift key; noop}

MPWait:	uLispOptions _ 0,	c1;
MPWait2:	,	c2;
	rhRx _ Rx _ uIOPage,	c3;

	MAR _ [rhRx, IOPage.MP+0],	c1;
	Noop,	c2;
	TT{saveMP} _ MD,	c3;

	MAR _ [rhRx, IOPage.MP+0],	c1;
	MDR _ Q,	c2;
	uTT{saveMP} _ TT, TT _ TT xor ~TT, NZeroBr,	c3;
	{TESTING  - - END OLD }

{"stop" key hard reset}
raidLp1:	MAR _ [rhRx, IOPage.key+0],  BRANCH[raidEnd2, $, 2]	c1;
	Noop ,	c2;
	Xbus _ MD, XDisp,	c3;

{"undo" key down}
	MAR _ [rhRx, IOPage.key+0],  BRANCH[stopEnd2, $, 0B]	c1;
	Noop ,	c2;
	Xbus _ MD, XLDisp, GOTO[raidLp1],	c3;

{raidEnd1:	rhRx _ nRhS,	c2;
	Rx _ PV - 09,	c3;

	MAR _ [rhRx, Rx+0],	c1;
	Noop,	c2;
	Rx{Alink} _ MD,	c3;

	Rx _ Rx and ~1,	c1;
	Rx _ Rx - 8,	c2;
	 Noop,	c3;

	MAR _ [rhRx, Rx+0],	c1;
	Noop,	c2;
	TT{code lo} _ MD,	c3;

	MAR _ [rhRx, Rx+1],	c1;
	Noop, CANCELBR[$ ,2]	c2;
	rhTT{code hi} _ MD,	c3;

	Map _ [rhTT, TT+0],	c1;
	Noop,	c2;
	 rhRx _ Rx _ MD,	c3;

	MAR _ [rhRx, TT+5],	c1;
	Noop, CANCELBR[$ ,2]	c2;
	Q{fn name} _ MD,	c3;

{restore Rx to iopage for MP}
	Noop,	c1;
	,	c2;
	rhRx _ Rx _ uIOPage,	c3;

	MAR _ [rhRx, IOPage.MP+0],	c1;
	MDR _ Q,	c2;
	Noop,	c3;
{"undo" key up}
raidLp2:	MAR _ [rhRx, IOPage.key+0],  BRANCH[$, raidEnd2, 2]	c1;
	Noop ,	c2;
	TT _ MD, XLDisp, GOTO[raidLp2],	c3;
}

raidEnd2:	{Ybus _ TT, YDisp,}	c2;
	{BRANCH[Burdx, $, 0B],}	c3;

raidEnd:	MAR _ [rhRx, IOPage.MP+0], CANCELBR[$, 0F],	c1;
	MDR _ uTT{saveMP},	c2;
	L2_0,	c3;

	Rx _ 1,	c1;
	uWDC _ Rx,	c2;
	Rx _ {TeleRaidFXP}30'b, GOTO[PUNT],	c3;


Burdx:
	Rx _ 41, CANCELBR[$, 0F],	c1;
	DCtl _ Rx LRot0,	c2;
	,	c3;

	MAR _ [rhRx, IOPage.MP+0],	c1;
	MDR _ uTT{saveMP},	c2;
	IOPCtl _ 1, GOTO[Reset],	c3;
	
{
StopK:	TT _ UvCL,	c2;
	rhTT _ UvChighL,	c3;

	Map _ [rhTT, TT+0],	c1;
	Noop,	c2;
	rhRx _ Rx _ MD,	c3;

	MAR _ [rhRx, TT+5],	c1;
	rhRx _ Rx _ uIOPage, CANCELBR[$ ,2]	c2;
	Q{fn name} _ MD,	c3;

	MAR _ [rhRx, IOPage.MP+0],	c1;
	MDR _ Q,	c2;
	Noop,	c3;


{"stop" key up}
stopLp2:	MAR _ [rhRx, IOPage.key+0],  BRANCH[$, stopEnd2, 0B]	c1;
	Noop ,	c2;
	Xbus _ MD, XDisp, GOTO[stopLp2],	c3;
}

stopEnd2:	Noop,	c2;
	Noop,	c3;

	MAR _ [rhRx, IOPage.MP+0],	c1;
	MDR _ uTT{saveMP},	c2;
	Noop, GOTO[Reset],	c3;
{*******************************************************************
	SUBRCALL	? %  ? clicks
*******************************************************************}

{pop "b" items and push 1 item}

@SUBR:	opcode[175'b],
	TT _ ib, L2_L2.0,	c1;
	Ybus _ TT xor 12'b, {ZeroBr,}	c2;
	Noop,{ BRANCH[$, Clock],}	c3;

	Rx _ TT xor 0F{1C},	c1;
	Ybus _ Rx, ZeroBr{=0F{1C}},	c2;
	Noop, BRANCH[$, RaidS],	c3;

	Rx _ TT xor 12{23}, GOTO[subrM],	c1;
subrM:	Ybus _ Rx, ZeroBr{=12{23}},	c2;
	Noop, BRANCH[$, SETSCREENCOLOR],	c3;

	Rx _ TT xor 20'b,	c1;
	Ybus _ Rx, ZeroBr{=20'b},	c2;
	Noop, BRANCH[$, Pup],	c3;

	Rx _ TT xor 15'b,	c1;
	Ybus _ Rx, ZeroBr{=15'b},	c2;
	Noop, BRANCH[$, logout],	c3;

	Rx _ TT xor 6{7},	c1;
	Ybus _ Rx, ZeroBr{=6{7}},	c2;
	Rx _ TT xor 9{21'b}, BRANCH[$, BackGround],	c3;

	Ybus _ Rx, ZeroBr{=9{21'b}},	c1;
	Rx _ TT xor 13{44'b}, BRANCH[$, DspBout3],	c2;
	Ybus _ Rx, ZeroBr{=13{44'b}},	c3;

	Rx _ ib, ZeroBr, BRANCH[$, ShowDisplay],	c1;
	PC _ PC + 1, BRANCH[$, subrPush],	c2;
	Rx _ (Rx -1) LShift1, SE_0,	c3;

Subrs:	S _ S - Rx,	c1;
	PC _ PC + PC16, L2_L2.0, {IBDisp,}	c2;
	Rx _ 26,	c3;

	Rx _ Rx LRot8,	c1;
	Rx{9900=26ACh} _ Rx +0AC,	c2;
	Q _ Rx +TT{raid#}, GOTO[MPWait{sink1}],	c3;

subrPush:	Noop,	c3;
	MAR _ S _ [rhS, S + 1], GOTO[CopyRet],	c1;

RaidS:	Rx _ TT xor 12{23}, GOTO[subrM],	c1;{error}
{RaidS:	Rx _ ib, ZeroBr, GOTO[NoopS2],	c1;}
DspBout3:	Noop,	c3;
SETSCREENCOLOR: Rx _ ib, ZeroBr, GOTO[NoopS2],	c1;
Pup:	Rx _ ib, ZeroBr, GOTO[NoopS2],	c1;
NoopS2:	PC _ PC + 1, BRANCH[$, subrPush3],	c2;
	Rx _ (Rx -1) LShift1, SE_0,	c3;

	S _ S - Rx,	c1;
	PC _ PC + PC16, L2_L2.0, IBDisp,	c2;
	L2_L2.0, DISPNI[OpTable],	c3;

subrPush3:	Noop,	c3;
	MAR _ S _ [rhS, S + 1], GOTO[CopyRet],	c1;

logout:	TT _ 55{password to mesa},	c1;
	uLispBootMsg _ TT,	c2;
	TT _ 0,	c3;

	Bank _ 0 ,	c1;		{MPL  1-Jan-84 13:20:12 Changed for Domino 10}
	,	c2;
	rhRx _ Rx _ uIOPage, CROSS[LOGOUT]	c3;

Off:	MAR _ [rhRx, IOPage.ProcessorCommand+0],	c1, at[LOGOUT];
	MDR{4} _  4,	c2;
	Noop,  GOTO[Off],	c3;

{*******************************************************************}
BackGround:	Rx _ ib, ZeroBr,	c1;
	PC _ PC + 1, BRANCH[$, subrPushBG],	c2;
	Rx _ (Rx -1) LShift1, SE_0,	c3;

	S _ S - Rx,	c1;
	PC _ PC + PC16, L2_L2.0, IBDisp,	c2;
	L2_L2.0, DISPNI[OpTable],	c3;

subrPushBG:	Noop,	c3;
	MAR _ S _ [rhS, S + 1], GOTO[CopyRet],	c1;

{*******************************************************************}
ShowDisplay:	rhRx _ Rx _ uIOPage, CANCELBR[$, 1],	c2;
	S _ S - 2{(2 args -1)*2},	c3;

	TT _ 88,	c1;
	PC _ 1 + PC + PC16,	c2;
	Q _ 41,	c3;

	MAR _ [rhRx, 0EC+0],	c1;
	MDR _ 0,	c2;
	TT _ TT LRot8,	c3;

	MAR _ [rhRx, 0ED{0EF}+0],	c1;
	MDR _ TT{88} or 22, L2 _ L2.0,	c2;
	DCtl_Q LRot0, L2 _ L2.0, DISPNI[OpTable],	c3;

{*******************************************************************}
@RCLK:	opcode[167'b],
	L1 _ L1.DecOnly,	c1;
	uTOSH _ TOSH, GOTO[Clock3],	c2;
Clock3:	rhTT _ TOSH LRot0,	c3;

	Map _ TT _ [rhTT, TOS], L0 _ L0.RedoClk,	c1;
	PC _ PC + PC16,	c2;
	Rx _ rhRx _ MD, XwdDisp{XDirtyDisp},	c3;

at[L0.RedoClk,10,WMapFixCaller],
	Q _ uClockHigh, DISP2[ClkMap],	c1;
	TOSH _ RShift1 uClockBits, SE_0,	c2, at[1, 4, ClkMap];
	TT _ uClockLow,	c3;

	MAR _ [rhRx, TOS+1], L2 _ L2.0,	c1;
	MDR _ TOSH +TT, CANCELBR[$, 2], WriteOK,	c2;
	Ybus _ TOSH +TT, CarryBr,	c3;

	MAR _ [rhRx, TOS+0], BRANCH[ClkNoCar, ClkCar],	c1;
ClkNoCar:	MDR _ Q, IBDisp, GOTO[reTosh],	c2;
ClkCar:	MDR _ Q+1, IBDisp, GOTO[reTosh],	c2;
reTosh:	TOSH _ uTOSH, L2 _ L2.0, DISPNI[OpTable],	c3;

	CALL[WLMapFix]{will return at RedoClk},	c2, at[0, 4, ClkMap];
	CALL[WLMapFix]{will return at RedoClk},	c2, at[2, 4, ClkMap];
	CALL[WLMapFix]{will return at RedoClk},	c2, at[3, 4, ClkMap];

{*******************************************************************}
{is this used?
SClock:	Noop,	c1;
	uTOSH _ TOSH,	c2;
	rhTT _ TOSH LRot0,	c3;

	Map _ TT _ [rhTT, TOS], L0 _ L0.xRedoSClk,	c1;
	PC _ PC + 1, L1 _ L1.DecDec,	c2;
	Rx _ rhRx _ MD, XRefBr,	c3;

at[L0.xRedoSClk,10,RxMapFixCaller],
	MAR _ [rhRx, TOS+1], BRANCH[SClkMap,$],	c1;
	Noop, CANCELBR[$, 2],	c2;
	TT _ MD, L2 _ L2.0,	c3;

	MAR _ [rhRx, TOS+0],	c1;
	Noop,	c2;
	Rx _ MD,	c3;

	uClockHigh _ Rx,	c1;
	uClockLow _ TT, IBDisp, L2 _ L2.0,	c2;
	uClockBits _ 0, L2 _ L2.0, DISPNI[OpTable],	c3;

SClkMap:	CANCELBR[RLxMapFix, 3]{will return at RedoSClk},	c2;
is this used?}

{*****************************************************************************
	BITBLT
*****************************************************************************}
@BBLT:	opcode[166'b],
	Bank _ 2,	c1;
	,	c2;
	CROSS[BBEntry],	c3;

	PC _ PC + PC16{***1}, GOTO[IBDispOnly]	,c1, at[BBExit];
IBDispOnly:
	IBDisp, L2 _ L2.0,	c2;
	TOSH _ smallpl, L2 _ L2.0, DISPNI[OpTable],	c3;


{*****************************************************************************
	MISC	Input
*****************************************************************************}

@MISC1:	opcode[170'b],
	L2 _ L2.0, GOTO[Misc],	c1;
@MISC2:	opcode[171'b],
	L2 _ L2.0,	c1;
Misc:	PC _ PC + 1, Xbus _ ib, XDisp,	c2;
	uTOS _ TOS, YDisp, DISP4[MiscDisp, 0C],	c3;

Misc0:	Q _ 121'd, CANCELBR[sink2, 0F],	c1, at[0C,10, MiscDisp];{MP9121}
Misc3:	Q _ 121'd, CANCELBR[sink2, 0F],	c1, at[0F,10, MiscDisp];{MP9121}

{*****************************************************************************
	INPUT	Input
*****************************************************************************}

INPUT:	TOSH _ smallpl, DISP4[MiscIn],	c1, at[0D,10, MiscDisp];
	TOS _ EIData, IBDisp, L2 _ L2.0, GOTO[MiscInEnd],	c2, at[0,10,MiscIn];
	TOS _ EStatus, IBDisp, L2 _ L2.0, GOTO[MiscInEnd],	c2, at[1,10,MiscIn];
	TOS _ KIData, IBDisp, L2 _ L2.0, GOTO[MiscInEnd],	c2, at[2,10,MiscIn];
	TOS _ KStatus, IBDisp, L2 _ L2.0, GOTO[MiscInEnd],	c2, at[3,10,MiscIn];
	TOS _ uSTATE, IBDisp, L2 _ L2.0, GOTO[MiscInEnd],	c2, at[4,10,MiscIn];
	TOS _ MStatus, IBDisp, L2 _ L2.0, GOTO[MiscInEnd],	c2, at[5,10,MiscIn];
	TOS _ KTest, IBDisp, L2 _ L2.0, GOTO[MiscInEnd],	c2, at[6,10,MiscIn];
	{TOS _ PPort}Q _ 122'd, GOTO[sink3],	c2, at[7,10,MiscIn];
	TOS _ VersionHi, GOTO[MiscVers],	c2, at[8,10,MiscIn];
	{**}{Q _ 122'd, GOTO[sink3],	c2, at[09,10,MiscIn];}{MP9122}
	{Q _ 122'd, GOTO[sink3],	c2, at[0A,10,MiscIn];}{MP9122}
	TOS _ uFLmode, IBDisp, L2 _ L2.0, GOTO[MiscInEnd],	c2, at[0B,10,MiscIn];
	Q _ 122'd, GOTO[sink3],	c2, at[0C,10,MiscIn];{MP9122}
	Q _ 122'd, GOTO[sink3],	c2, at[0D,10,MiscIn];{MP9122}
	Q _ 122'd, GOTO[sink3],	c2, at[0E,10,MiscIn];{MP9122}
	Q _ 122'd, GOTO[sink3],	c2, at[0F,10,MiscIn];{MP9122}
MiscInEnd:
	TOSH _ smallpl, L2 _ L2.0, DISPNI[OpTable],	c3;

MiscVers:
	TOS _ TOS LRot8,	c3;
	TOS _ TOS or VersionLo,	c1;
	IBDisp, L2 _ L2.0, TOS _ TOS or 1, GOTO[MiscInEnd],	c2;


{*****************************************************************************
	OUTPUT	Output
*****************************************************************************}

OUTPUT:
	MAR _ S _ [rhS, S + 0], Xbus _ uTOS, XDisp, CANCELBR[$, 0F],	c1, at[0E,10, MiscDisp];
	S _ S - 2, DISP4[MiscOut],	c2;

	{**}{IOPOData _ MD, GOTO[OutEnd],	c3, at[0,10,MiscOut];}
	IOPCtl _ MD, GOTO[OutEnd],	c3, at[1,10,MiscOut];
	{**}{KOData _ MD, GOTO[OutEnd],	c3, at[2,10,MiscOut];}
	TT _ MD, GOTO[OutSetFPmode],	c3, at[2,10,MiscOut];
	KCtl _ MD, GOTO[OutEnd],	c3, at[3,10,MiscOut];
	EOData _ MD, GOTO[OutEnd],	c3, at[4,10,MiscOut];
	EICtl _ MD, GOTO[OutEnd],	c3, at[5,10,MiscOut];
	DCtl _ MD, GOTO[OutEnd],	c3, at[6,10,MiscOut];
	TT _ MD, GOTO[OutSetBBTime],	c3, at[7,10,MiscOut];
	TT _ MD, GOTO[OutSetOpt],	c3, at[8,10,MiscOut];
	PCtl _ MD, GOTO[OutEnd],	c3, at[9,10,MiscOut];
	TT _ MD, GOTO[OutMCtl],	c3, at[0A,10,MiscOut];
	{**}{   Q _ 120'd, GOTO[sink1],		c3, at[0B,10,MiscOut];}{MP9120}
	EOCtl _ MD, GOTO[OutEnd],	c3, at[0C,10,MiscOut];
	KCmd _ MD, GOTO[OutEnd],	c3, at[0D,10,MiscOut];
	TT _ MD, GOTO[OutPPort],	c3, at[0E,10,MiscOut];
	POData _ MD, GOTO[OutEnd],	c3, at[0F,10,MiscOut];

OutSetFPmode:
	uFLmode _ TT, GOTO[IB.nop],	c1;
OutSetBBTime:
	uBBTime _ TT, GOTO[IB.nop],	c1;
OutEnd:
	Noop, GOTO[IB.nop],	c1;
OutPPort:
	PPort _ TT, GOTO[IB.nop],	c1;
OutSetOpt:
	uLispOptions _ TT, GOTO[IB.nop],	c1;
OutMCtl:
	MCtl _ TT, GOTO[IB.nop],	c1;
IB.nop:
	L2 _ L2.0, IBDisp, GOTO[DNI.nop],	c2;
	
{*******************************************************************
	READPRINTERPORT		3 clicks
*******************************************************************}
@READPRINTERPORT:	opcode[164'b],
	MAR _ S _ [rhS, S + 1],	c1;
ReadRet:
	MDR _ TOSH, S _ S + 1, BRANCH[$, ReadCarry, 1],	c2;
	Ybus _ S xor uStkLimO, ZeroBranch,	c3;

	MAR _ [rhS, S + 0], BRANCH[$, ReadStkLim],	c1;
	MDR _ TOS,	c2;
	TOSH _ smallpl,	c3;

	TOS _ PPort, GOTO[IB.pc1],	c1;

{page cross:}
ReadCarry:	S _ S + 0FF,	c3;
	MAR _ [rhS, S + 0], GOTO[ReadRet],	c1;

{Stack Limit:}
ReadStkLim:	MDR _ TOS, 	c2;
	TOSH _ smallpl,	c3;

	TOS _ PPort,	c1;
	,	c2;
	PC _ PC + PC16, GOTO[StackOverflow],	c3;

{*******************************************************************
	WRITEPRINTERPORT		1 click
*******************************************************************}
@WRITEPRINTERPORT:	opcode[165'b],
	PPort _ TOS, L2 _ L2.0,	c1;
	PC _ PC + PC16, IBDisp,	c2;
	uPPsave _ TOS, L2 _ L2.0, DISPNI[OpTable],	c3;

	
{*******************************************************************
	FVAR		? %  ? clicks
*******************************************************************}

	uTOS _ TOS, TT _ MD, XLDisp, {L1 _ L1.PopOnly,} CANCELBR[$, 1],	c3, at[6, 8, IVar3];

{checks for stack overflow later}

{(Bh) binding pointer high}

	MAR _ Q{chain} _ [rhRx, Rx + 1],  BRANCH[$, FVunfilled, 2],	c1;
	{uPV _ PV,} CANCELBR[$, 2],	c2;
	{Q _} rhTT _ MD, {L1 _ L1.PopOnly,}	c3;

{(MV) map bound val}

fvFilled:	Map _ [rhTT, TT], L1 _ L1.PopOnly, CANCELBR[$, 7],	c1, at[L3.FVAR,10, fvCaller];
	TOS _ uTOS, L0 _ L0.xRedoFV0,	c2;
	Rx _ rhRx _ MD, XRefBr,	c3;

{(V) fetch bound val}

RedoFV0:	MAR _ [rhRx, TT + 1],  BRANCH[fvMap0, $],	c1, at[L0.xRedoFV0,10, RxMapFixCaller];
	[] _ S xor uStkLimO, ZeroBranch, CANCELBR[$,2],	c2;
	TOS _ MD, BRANCH[$, StkOvr2], L2Disp,	c3;

{Var4:}	MAR _ [rhRx, TT + 0], BRANCH[fvPC1, fvPC2, 2],	c1;
fvPC1:	PC _ PC + PC16, IBDisp, GOTO[fvEnd], L2 _ L2.0,	c2;
fvPC2:	PC _ PC + 1, IBDisp, GOTO[fvEnd], L2 _ L2.0,	c2;
fvEnd:	TOSH _ MD, L2 _ L2.0, DISPNI[OpTable],	c3;

StkOvr2:	MAR _ [rhRx, TT + 0], BRANCH[fvPC1ov, fvPC2ov, 2],	c1;
fvPC1ov:	PC _ PC + PC16, GOTO[fvEndov], L2 _ L2.0,	c2;
fvPC2ov:	PC _ PC + 1, GOTO[fvEndov], L2 _ L2.0,	c2;
fvEndov:	TOSH _ MD, GOTO[StackOverflow],	c3;

FVunfilled:	TT _ UvCL, L3 _ L3.FVAR, CANCELBR[$,2],	c2;
	rhTT _ UvChighL, CALL[FVLookUp],	c3;

fvMap0:	TOSH _ uTOSH, CANCELBR[RLxMapFix, 3]{will return to RedoFV0},	c2;

{*******************************************************************
	FREE VAR LOOKUP		? %  ? clicks
*******************************************************************}
{	look up variable in current frame; fill in binding pointer
	(chaining not implemented)

This code assumes that NAMETABLE is contiguous in real memory {either it is on the stack, or within a code header which is non-page crossing}

on Entry:	c1
uTOS	restored to TOS if fault
uTOSH	restored to TOSH if fault
PV	current frame (point to PV region)
Q	{uChain}  (odd) stack pointer to variable to be looked up (Pv + ib + 1)
rhTT, TT	virtual address of name table (usually function header)
L3	caller's return link at[L3, 10, fvCaller]

uses during subroutine:
rhRx, Rx	real address of name table
PV	frame extension pointers (point to PV region)(travel up alinks)
uPV	save local PV
TOS	used
uChain	TOSH{chain}
rhTOSH	nRhS {set once at odd time; must be left}{*} used with TOSH{chain}
uName	TOSH{name} _ [UvCL + T/2 {- UvCL.nlocals} + UvCL.fvaroffset]
ntSize, offset, L0, L1

on Return:	c1
	preserves S, PV, PC, L2, uTOS, uTOSH
	smashes TOS, TOSH {but preserved in uTOS, uTOSH}
rhTT, TT	virtual address of free value
@(chain)	filled in binding pointer
L1	binding type{fvStack, fvGlobal, fvUnbound} Dispatch pending

on Fault:	S _ S - 2, TOS _ uTOS, TOSH _ uTOSH
}


FVLookUp: {map header}

	Map _ [rhTT, TT], L0 _ L0.xRedoFV,	c1;
	TOS{name} _ RShift1 (Q{chain} - PV - 1), SE_0,	c2;
	Rx _ rhRx _ MD, XRefBr,	c3;

fvOff: {fvoffset from fn header}

	MAR _ [rhRx, TT + 7{fnh.nlfv}], BRANCH[fvMap, $],	c1, at[L0.xRedoFV,10, RxMapFixCaller];
	TT _ TT + TOS{name}, CANCELBR[$, 2],	c2;
	TOS{fvoff} _ MD{fvoffset},	c3;

{(L) correct by nlocals}{should be unnecessary}

	uChain _ Q{chain},	c1;
	TOSH{nlocs} _ TOS{fvoff} LRot8,	c2;
	Q{fvoff} _ TOS{fvoff} - TOSH{nlocs},	c3;

fvN: {name from fn header} {*ASSUMES name on same page}

	MAR _ Rx _ [rhRx, TT + Q{fvoff}],	c1;
{#}	uPV _ PV, CANCELBR[$, 2],	c2;
	TOSH{name} _ MD{name}, GOTO[newFrame],	c3;

{************************************}
newFrame: {PV _ PV.alink} {TOSH{name}, PV}

	MAR _ PV _ [rhPV, PV - 9],	c1;
fvA2:	Q _ ~1, BRANCH[$, fvACross, 1],	c2;
	uName _ TOSH{name}, PV{alink} _ MD and Q, {XLDisp,}	c3;

fvFF: {check flags for name table valid}

	MAR _ PV _ [rhPV, PV - 0A{flags-pvar}],	c1;
fvF2:	Q{PVflags} _ PV, ZeroBr, BRANCH[$, fvFCross, 1],	c2;
	Rx _ MD{flags}, BRANCH[$, endStack],	c3;

fvH: {header lo}

	MAR _ PV _ [rhPV, PV + 2{deflo-flags}],	c1;
fvH2:	Xbus _ Rx LRot8, XDisp, BRANCH[$, fvHCross, 1],	c2;
fvH3:	TT _ MD{deflo}, BRANCH[fvH1, ntValid, 0D],	c3;

ntValid:	MAR _ PV _ [rhPV, PV + 4{ntlo-deflo}],	c1;
	Rx _ 0, BRANCH[fvH3, fvHCross, 1],	c2;

{fvH1:} {header hi}

fvH1:	MAR _ [rhPV, PV + 1],	c1;
	PV _ Q{PVflags} + 0A{pvar-flags}, CANCELBR[$, 2],	c2;
	rhTT _ MD{defhi},	c3;

fvMH: {map header}
	TT _ TT and ~3{not really necessary},	c1;
	,	c2;
	TT _ TT + 6,	c3;

	Map _ [rhTT, TT], L0 _ L0.xRedoFVN,	c1;
	TOS{mask} _ ~3, L1 _ L1.fixFV{maybe smashed},	c2;
	Rx _ rhRx _ MD, XRefBr,	c3;

{fvN: ntSize}{#this click could be eliminated possibly by testing for zero (vs ntSize)}

RedoFVN:	MAR _ Q _ [rhRx, TT + 0{6}], BRANCH[fvMapN, $],	c1, at[L0.xRedoFVN,10, RxMapFixCaller];
	Rx _ Q + 2, CANCELBR[$, 2],	c2;
	TOS{cnt} _ TOS{mask} and MD{ntSize}, GOTO[lookFor],	c3;

lookFor: {match?}

	MAR _ Rx _ [rhRx, Rx + 0],	c1;
	Q{ntSize-1} _ TOS{cnt} - 1, {*}rhTOSH _ nRhS, GOTO[matJoin],	c2;

matLp:	MAR _ Rx _ [rhRx, Rx + 0],	c1, at[6, 10, Mat];
	Ybus _ TOS{cnt} - 1, NegBr,	c2;
matJoin:	TT _ TOSH{name} xor MD, BRANCH[$, newFrame],	c3;


{fvM1:  match?}

	MAR _ Rx _ [rhRx, Rx + 1], L0 _ 0,	c1;
	TT _ TT, ZeroBr, CANCELBR[$, 2], 	c2;
	TT _ TOSH{name} xor MD, BRANCH[$, Val0],	c3;

fvM2: {match?}

	MAR _ Rx _ [rhRx, Rx + 1], L0 _ 2, 	c1, at[0, 10, Mat];
	TT _ TT, ZeroBr, CANCELBR[$, 2],	c2;
	TT _ TOSH{name} xor MD, BRANCH[$, Val1],	c3;

{fvM3: match?}

	MAR _ Rx _ [rhRx, Rx + 1], L0 _ 4,	c1, at[2, 10, Mat];
	TT _ TT, ZeroBr, CANCELBR[$, 2],	c2;
	TT _ TOSH{name} xor MD, BRANCH[$, Val2],	c3;

{fvM4: done?}

	Rx _ Rx + 1,	c1, at[4, 10, Mat];
	TT _ TT, ZeroBr, L0 _ 6,	c2;
	TOS{cnt} _ TOS - 4, BRANCH[matLp, Val3],	c3;

{value; fvfound}  {preserve Rx{realNames}, TOS{cnt}, TOSH{name}, Q{ntSize-1}}

Val0:	MAR _ [rhRx, Rx + Q{ntSize-1}], GOTO[Vtail],	c1;
Val1:	MAR _ [rhRx, Rx + Q], GOTO[Vtail],	c1;
Val2:	MAR _ [rhRx, Rx + Q], GOTO[Vtail],	c1;
Val3:	MAR _ [rhRx, Rx + Q], GOTO[Vtail],	c1;
Vtail:
	rhTT _ STACKspace, BRANCH[$, VTailFix, 1],	c2;
Vtail3:
	TT{vtyOffset} _ MD, XHDisp, L1 _ L1.fvStack,	c3;

{##% maybe save a click if offset is words not doublewords}

	TOSH{offset} _ (TT and 0FF) LShift1, BRANCH[fvIVar, $, 2],	c1;
	TOSH{ptrToVal} _ PV{pvar} + TOSH, rhTOSH _ nRhS,	c2;
	Noop{TOSH{chain} _ uChain},	c3;

fvFP: {FVar or PVar}

	MAR _ [rhTOSH, TOSH{ptrToVal} + 0{TT}], {BRANCH[fvIVar, ${, 2}],}	c1;
fvFP2:	Ybus _ TT + TT{varType}, NegBr,	c2;
	TT _  MD, XLDisp{undefinedF}, BRANCH[fvPvar, fvFvar],	c3;

VTailFix:
	Rx _ Rx + Q,	c3;{used to be MP9099}

	MAR _ [rhRx, Rx + 0],	c1;
	Rx _ Rx - Q, GOTO[Vtail3],	c2;

{***********************} {rhTT _ STACKspace}
fvPvar:
	Ybus _ TT, NegBr{undefP}, CANCELBR[$, 3],	c1;
	TT _ TOSH{ptrToVal}, BRANCH[$, lookMore], L0Disp,	c2;
	TOSH{chain} _ uChain, XLDisp, CANCELBR[donefv, 0F],	c3;

{preserved Rx{realNames}, TOS{cnt}, Q{ntSize-1}}
lookMore:	{TT#0} TOSH{name} _ uName, DISP4[Mat],{back}	c3;


{***********************} {free to smash Rx and TOS below here}
fvFvar:
	MAR _ [rhTOSH, TOSH{ptrToVal} + 1], BRANCH[$, fvUnbF, 2],	c1;
	TOSH{chain} _ uChain, CANCELBR[$, 2],	c2;
	rhTT _ MD, 	c3;

	Q _ STACKspace,	c1;
	Ybus _ Q xor rhTT, ZeroBr,	c2;
fvFcon:	Ybus _ TOSH{chain}, YDisp, BRANCH[$, donefvX],	c3;

	CANCELBR[$, 0F],	c1;
	L1 _ L1.fvGlobal,	c2;
	Ybus _ TOSH{chain}, YDisp, GOTO[donefvX],	c3;

fvUnbF:	Noop, CANCELBR[$, 2],	c2;
	TOSH{name} _ uName, GOTO[newFrame],	c3;


{***********************} 
fvIVar:	{rhTT _ uSTACKspace}
	TOS{offset} _ (TT and 0FF) LShift1, CANCELBR[$, 2],	c2;
	PV _ PV - 0B{ivar-pvar},	c3;

	MAR _ [rhPV, PV + 0],	c1;
	TOSH{chain} _ uChain,	c2;
	TT _ MD{ivar}, Ybus _ TOSH{chain}, YDisp,	c3;

	MAR _ [rhTOSH, TOSH{chain} - 1], BRANCH[fvRet2, $, 0E],	c1;
	MDR _ TT _ TT + TOS{offset}, CANCELBR[donefv3, 2], WriteOK,	c2;

fvRet2:	TT _ TT + TOS, L3Disp, CANCELBR[fvRet3, 2],	c2;
	
{***********************}
endStack:
	TT _ uName, L1 _ L1.fvGlobal, GOTO[endStk2],	c1;
endStk1:	TT _ uName, L1 _ L1.fvGlobal,	c1;
endStk2:	TT _ TT + TT, rhTT _ VALspace,	c2;
	TOSH{chain} _ uChain, XLDisp, GOTO[donefv]	c3;


{***********************}
{	TOSH{chain} _ uChain, YDisp, GOTO[donefv]	c3;}

donefvX:	MAR _ [rhTOSH, TOSH{chain} - 1], BRANCH[donefvY, donefv2, 0E],	c1;

donefv:
	MAR _ [rhTOSH, TOSH{chain} - 1], BRANCH[donefvY, donefv2, 0E],	c1;
donefvY:		L3Disp, CANCELBR[fvRet3, 2],	c2;
donefv2:	MDR _ TT, CANCELBR[donefv3, 2], WriteOK,	c2;
donefv3:	Noop,	c3;

fvRet: {donefvlookup}{double up bindptr high}

	Q _ rhTT,	c1;
	Rx _ Q,	c2;
	Rx{rhTT LRot8} _ Rx LRot8,	c3;

	MAR _ [rhTOSH, TOSH{chain} + 0],	c1;
	MDR _ rhTT or Rx{rhTT LRot8}, L3Disp,	c2;
fvRet3:	PV _ uPV, L1Disp, RET[fvCaller],{restore PV}	c3;




{**********************  exceptions:  ***********************}
{trial faster inner loop?}
{	MAR _ [rhB, A], B _ Q, ZeroBr,	c1;}
{	Ybus _ name xor Q, ZeroBr, BRANCH[$, done],	c2;}
{	Q _ MD, BRANCH[$, match],	c3;}

{exceptions:}

fvMap:	uPV _ PV, CANCELBR[RLxMapFix, 3], L1 _ L1.fixFV,{return to RedoFV},	c2;

fvMapN:	CANCELBR[RLxMapFix, 3], L1 _ L1.fixFV,{return to RedoFVN}	c2;


fvFCross:	PV _ PV - 0FF -1, CANCELBR[$, 1],	c3;
	MAR _ PV _ [rhPV, PV + 0], GOTO[fvF2],	c1;

fvACross:	PV _ PV - 0FF -1,	c3;
	MAR _ PV _ [rhPV, PV + 0], GOTO[fvA2],	c1;

fvHCross:	PV _ PV + 0FF + 1, CANCELBR[$, 0F],	c3;
	MAR _ PV _ [rhPV, PV + 0], GOTO[fvH2],	c1;

fvFPCross:	PV _ PV + 0FF + 1, CANCELBR[$, 0F],	c3;
	MAR _ PV _ [rhPV, PV + 0], GOTO[fvFP2],	c1;

fvFix:	TOSH _ uTOSH, L3Disp,	c1, at[L1.fixFV,10,Fix];
	TOS _ uTOS, DISP4[fvfixup],	c2;
	PV _ uPV,{ GOTO[popFix],}	c3,at[L3.FVAR,10,fvfixup];

	S _ S - 2, GOTO[NoMoreFix],	c1;

	PV _ uPV, GOTO[NoFixes],	c3, at[L3.FVARg,10,fvfixup];


{*******************************
	FVAR_	4 clicks ?%
*******************************}
@FVARg:		opcode[143'b],
	MAR _ Q _ [rhPV, PV + ibNA + 1], L3 _ L3.FVARg,	c1;
FVGcont:	Rx _ Q, rhRx _ nRhS, BRANCH[$, FVGCar,1],	c2;
	uTOSH _ TOSH, TT _ rhTT _ MD{address high},	c3;

{compliance: using uSTACKspace with duplicated high byte for bind ptr}

	MAR _ [rhRx, Rx - 1],	c1;
	Ybus _ TT xor uSTACKspace, NZeroBr, CANCELBR[$, 2],	c2; {% incompatable}
	uTOS _ TOS, TT _ MD{address low},
		XLDisp {dispatch if not looked up},
		BRANCH[$, fvgStore1] {branch if not on stack},	c3;

{TOS and TOSH saved in case freeVarLookup is invoked}

fvgStore:	MAR _ [rhS, TT], S _ S + 0, DISP4[fvType, 2],	c1, at[L3.FVARg,10, fvCaller];


fvgStore1:	MAR _ [rhS, TT], S _ S + 0, DISP4[fvType, 6],	c1;


{var bound on stack}
	MDR _ TOSH _ uTOSH,	c2, at[L1.fvStack{2}, 10, fvType];
fvgStore3:	rhTT _ nRhS,	c3;

	MAR _ [rhTT, TT + 1], Xbus _ ib, L2 _ L2.0,	c1;
	MDR _ TOS _ uTOS, IBDisp, CANCELBR[$, 2], WriteOK,	c2;
	PC _ PC + 1, L2 _ L2.0, DISPNI[OpTable],	c3;


fvgUnbnd:	TT _ UvCL, CANCELBR[fvLook, 3],	c2, at[L1.fvUnbound{3}, 10, fvType];
	TT _ UvCL, CANCELBR[fvLook, 3],	c2, at[{L1.fvUnbound1}7, 10, fvType];
fvLook:	rhTT _ UvChighL, CALL[FVLookUp],	c3;

fvgGlobal:TOS _ uTOS,	c2, at[L1.fvGlobal{6}, 10, fvType];
	TOSH _ uTOSH,	c3;

{real version:}
	S_ S+1,	c1;
	Q_ rhTT,	c2;
	Rx_ AtomSETFVAR {376'b},  	c3;

	MAR_ [rhS, S + 0],	c1;
	MDR_ uTOSH, 	c2;
	TOSH_ Q {address high}, IB_ Rx LRot0,	c3;


	MAR_ S_ [rhS, S + 1], IBPtr_0,	c1;
	MDR_ uTOS, CANCELBR[$, 2], WriteOK,	c2;
	TOS_ TT {address low}, L3{ib's}_1,	c3;

	MAR _ Q _ [rhS, S + 1], GOTO[FVcall],	c1;


FVGCar:	Rx _ Q + 0FF +1,	c3;
	MAR _ Q _ [rhRx, Rx + 0], GOTO[FVGcont],	c1;



{*******************************************************************
	GETBITS.N.FD		? %  5 clicks
*******************************************************************}

@GBITS:	opcode[312'b],
	TT _ TOS + ib, CarryBr, L1 _ L1.Dec3,	c1;
	rhTT _ TOSH LRot0, BRANCH[$, GBrhnok],	c2;
GBcont:
	PC _ 1 + PC + PC16,	c3;

	Map _ [rhTT,TT], L0 _ L0.xRedoGF,	c1;
	Q{fd.pos} _ ibHigh{fd.pos}, L2 _ L2.0,	c2;
	Rx _ rhRx _ MD, XRefBr,	c3;

RedoGF:	MAR _ [rhRx, TT + 0], BRANCH[GFMap,$],	c1, at[L0.xRedoGF,10, RxMapFixCaller];
	Rx _ Q{fd.pos} + ib{fd.size} + 1, rhRx _ ib{fd.size},	c2;
	Rx _ MD{data}, Ybus _ Rx{shift}, YDisp, L2 _ L2.GFRet,	c3;

	TT _ LRot1 Rx, DISP4[CycleMask],	c1;

	{CycleMask Subroutine Here}

GFRet:	TOS _ TOS and TT, IBDisp, L2 _ L2.0,	c2, at[L2.GFRet,10,MaskRet];
	TOSH _ smallpl, L2 _ L2.0, DISPNI[OpTable],	c3;

GBrhnok:
	Q _ rhTT + 1, LOOPHOLE[byteTiming],	c3;
	rhTT _ Q LRot0,	c1;
	GOTO[GBcont],	c2;

GFMap:	Noop, CANCELBR[RLxMapFix, 3]{will return to RedoGF},	c2;

{*******************************************************************
	PUTBITS.N.FD (ptr, newval => ptr)		? %  7 clicks
*******************************************************************}
@PUTBITS:	opcode[317'b],
	MAR _ [rhS, S + 0], L1 _ L1.fixWF,	c1;
	Ybus _ TOSH xor smallpl, NZeroBr,	c2;
	TT _ MD{ptr}, BRANCH[$, ufnWF],	c3;

	MAR _ [rhS, S - 1], L0_ L0.RedoWF,	c1;
	TT _ TT + ib, CarryBr, CANCELBR[$, 2],	c2;
	rhTT _ MD{ptrH}, BRANCH[PBrhok, $],	c3;

	Q _ rhTT + 1, LOOPHOLE[byteTiming],	c1;
	rhTT _ Q LRot0,	c2;
	c3;

PBrhok:
	Map _ Q _ [rhTT, TT], L2 _ L2.WFRet{0},	c1;{% segCross}
	TOSH{-pos-1} _ 0 - ibHigh - 1, YDisp, {L2_0,}	c2;
	Rx _ rhRx _ MD, XwdDisp{XDirtyDisp}, DISP4[MaskTbl], {L2Disp,}	c3;

{MaskTbl:	TT _ mask, RET[MaskRet],	c1, at[0, 10, MaskTbl];}

RedoWF2:	Ybus{pos+size} _ ib{size} - TOSH{-pos-1} - 1, YDisp, 	c2, at[L2.WFRetMapOdd{1}, 10, MaskRet];
	TOSH _ smallpl, L2_0, DISP4[Mask],	c3;

Mask:	TT _ ~TT xor u7FFF, L2Disp, GOTO[Left0],{17b}	c*, at[0,10,Mask];
	TT _ ~TT xor uTT3FFF, L2Disp, GOTO[Left12],{0}	c*, at[1,10,Mask];
	TT _ ~TT xor u1FFF, L2Disp, GOTO[Left12],	c*, at[2,10,Mask];
	TT _ ~TT xor u0FFF, L2Disp, GOTO[Left12],	c*, at[3,10,Mask];
	TT _ ~TT xor u7FF, L2Disp, GOTO[Left12],	c*, at[4,10,Mask];
	TT _ ~TT xor uTT3FF, L2Disp, GOTO[Left8],	c*, at[5,10,Mask];
	TT _ ~TT xor u1FF, L2Disp, GOTO[Left8],	c*, at[6,10,Mask];
	TT _ ~TT xor 0FF, L2Disp, GOTO[Left8],	c*, at[7,10,Mask];
	TT _ ~TT xor 7F, L2Disp, GOTO[Left8],	c*, at[8,10,Mask];
	TT _ ~TT xor 3F, L2Disp, GOTO[Left4],	c*, at[9,10,Mask];
	TT _ ~TT xor 1F, L2Disp, GOTO[Left4],	c*, at[0A,10,Mask];
	TT _ ~TT xor 0F, L2Disp, GOTO[Left4],	c*, at[0B,10,Mask];
	TT _ ~TT xor 7, L2Disp, GOTO[Left4],	c*, at[0C,10,Mask];
	TT _ ~TT xor 3, L2Disp, GOTO[Left0],	c*, at[0D,10,Mask];
	TT _ ~TT xor 1, L2Disp, GOTO[Left0],	c*, at[0E,10,Mask];
	TT _ ~TT xor 0, L2Disp, GOTO[Left0],{16b}	c*, at[0F,10,Mask];

Left0:	TOS _ TOS LRot0, DISP4[FinCycle, 0C],	c2;
Left4:	TOS _ TOS LRot4, DISP4[FinCycle, 0C],	c2;
Left8:	TOS _ TOS LRot8, DISP4[FinCycle, 0C],	c2;
Left12:	TOS _ TOS LRot12, DISP4[FinCycle, 0C],	c2;

	TOS _ TOS RRot1, GOTO[wfDo],	c3, at[0C, 10, FinCycle];
	TOS _ TOS + TOS LShift1, GOTO[wfDo],	c3, at[0D, 10, FinCycle];
	TOS _ TOS LShift1, GOTO[wfDo],	c3, at[0E, 10, FinCycle];
	TOS _ TOS, GOTO[wfDo],	c3, at[0F, 10, FinCycle];

wfDo:	MAR _ [rhRx, Q + 0],	c1;
	TOS _ TOS and ~TT{mask},	c2;
	TT _ MD and TT{mask},	c3;

	MAR _ [rhRx, Q + 0],	c1;
	MDR _ TOS or TT,	c2;
	PC _ PC + 1, GOTO[POP],	c3;

	uTT _ TT, TT _ Q, CALL[WLMapFix], {will return to RedoWF}	c2, at[0, 10, MaskRet];
	uTT _ TT, TT _ Q, CALL[WLMapFix], {will return to RedoWF}	c2, at[2, 10, MaskRet];
	uTT _ TT, TT _ Q, CALL[WLMapFix], {will return to RedoWF}	c2, at[3, 10, MaskRet];

RedoWF:	TT _ uTT, DISP2[RedoWF2, 1],	c1, at[L0.RedoWF,10, WMapFixCaller];

ufnWF:	Rx _ 317'b, GOTO[ufn2],	c1;

FixWF:	TOSH _ smallpl, GOTO[NoMoreFix],	c1, at[L1.fixWF,10,Fix];

{*******************************************************************
	CycleMask		? %  1 clicks
*******************************************************************}
{Entry:	Rx = data to be rotated & masked,
	TT = pre-rotated version of Rx
	a DISP4 pending which determines left rotation: (0 => no rotation)
	rhRx = value to be dispatched on to determine mask (0=>1, F=>FFFF)

Exit:	TT holds the mask,
	TOS holds the rotated data,
	Rx does not contain the original data,  rhRx is untouched}


CycleMask:	Xbus _ rhRx, XDisp, GOTO[ShiftOK0],	c*, at[0,10,CycleMask];
	Rx _ TT, Xbus _ rhRx, XDisp, GOTO[ShiftOK0],	c*, at[1,10,CycleMask];
	Rx _ LRot1 TT, Xbus _ rhRx, XDisp, GOTO[ShiftOK0],	c*, at[2,10,CycleMask];
	Rx _ RRot1 Rx, Xbus _ rhRx, XDisp, GOTO[ShiftOK4],	c*, at[3,10,CycleMask];

	Xbus _ rhRx, XDisp, GOTO[ShiftOK4],	c*, at[4,10,CycleMask];
	Rx _ LRot1 Rx, Xbus _ rhRx, XDisp, GOTO[ShiftOK4],	c*, at[5,10,CycleMask];
	Rx _ LRot1 TT, Xbus _ rhRx, XDisp, GOTO[ShiftOK4],	c*, at[6,10,CycleMask];
	Rx _ RRot1 Rx, Xbus _ rhRx, XDisp, GOTO[ShiftOK8],	c*, at[7,10,CycleMask];

	Xbus _ rhRx, XDisp, GOTO[ShiftOK8],	c*, at[8,10,CycleMask];
	Rx _ LRot1 Rx, Xbus _ rhRx, XDisp, GOTO[ShiftOK8],	c*, at[9,10,CycleMask];
	Rx _ LRot1 TT, Xbus _ rhRx, XDisp, GOTO[ShiftOK8],	c*, at[0A,10,CycleMask];
	Rx _ RRot1 Rx, Xbus _ rhRx, XDisp, GOTO[ShiftOK12],	c*, at[0B,10,CycleMask];

	Xbus _ rhRx, XDisp, GOTO[ShiftOK12],	c*, at[0C,10,CycleMask];
	Rx _ LRot1 Rx, Xbus _ rhRx, XDisp, GOTO[ShiftOK12],	c*, at[0D,10,CycleMask];
	Rx _ LRot1 TT, Xbus _ rhRx, XDisp, GOTO[ShiftOK12],	c*, at[0E,10,CycleMask];
	Rx _ RRot1 Rx, Xbus _ rhRx, XDisp, GOTO[ShiftOK0],	c*, at[0F,10,CycleMask];

ShiftOK0:	TOS _ Rx, L2Disp, DISP4[MaskTbl],	c*;
ShiftOK4:	TOS _ Rx LRot4, L2Disp, DISP4[MaskTbl],	c*;
ShiftOK8:	TOS _ Rx LRot8, L2Disp, DISP4[MaskTbl],	c*;
ShiftOK12:	TOS _ Rx LRot12, L2Disp, DISP4[MaskTbl],	c*;

{*********************************************
	MaskTbl  SUBROUTINE	1 cycle
*********************************************}
{	first cycle = c* , one cycle long
This subroutine generates a right justified mask. of n ones
RETURNS THRU MaskRet
}

MaskTbl:	TT _ 1, RET[MaskRet],	c*, at[0,10,MaskTbl];
	TT _ 3, RET[MaskRet],	c*, at[1,10,MaskTbl];
	TT _ 7, RET[MaskRet],	c*, at[2,10,MaskTbl];
	TT _ 0F, RET[MaskRet],	c*, at[3,10,MaskTbl];
	TT _ 1F, RET[MaskRet],	c*, at[4,10,MaskTbl];
	TT _ 3F, RET[MaskRet],	c*, at[5,10,MaskTbl];
	TT _ 7F, RET[MaskRet],	c*, at[6,10,MaskTbl];
	TT _ 0FF, RET[MaskRet],	c*, at[7,10,MaskTbl];
	TT _ LShift1 0FF, SE_1, RET[MaskRet] {TT _ 1FF},	c*, at[8,10,MaskTbl];
	TT _ RShift1 u7FF, RET[MaskRet] {TT _ 3FF},	c*, at[9,10,MaskTbl];
	TT _ u7FF, RET[MaskRet] {TT _ 7FF},	c*, at[0A,10,MaskTbl];
	TT _ RShift1 u1FFF, RET[MaskRet] {TT _ FFF},	c*, at[0B,10,MaskTbl];
	TT _ u1FFF, RET[MaskRet] {TT _ 1FFF},	c*, at[0C,10,MaskTbl];
	TT _ uTT3FFF, RET[MaskRet] {TT _ 3FFF},	c*, at[0D,10,MaskTbl];
	TT _ RShift1 (~TT xor TT), RET[MaskRet] {TT _ 7FFF},	c*, at[0E,10,MaskTbl];
	TT _ ~TT xor TT, RET[MaskRet] {TT _ FFFF},	c*, at[0F,10,MaskTbl];

{*******************************************************************
	BIND		%  ? clicks
*******************************************************************}

{(B) Bind}

@BIND:	opcode[21'b],
	uPCib _ PC, Rx{n1,n2} _ ib, ZeroBr, L2_L2.0,	c1;
	TT _ ibNA LShift1, BRANCH[$, prePush],	c2;
	TT _ PV + TT + 1, rhTT _ nRhS,	c3;

	MAR _ Q _ [rhTT, TT + 0], GOTO[Nloop1],	c1;

{(N) bind var to Nil}	{Q odd,  TT odd}

Nloop:	MAR _ [rhTT, TT + 0],	c1;
Nloop1:	MDR _ PC{nil} _ 0,	c2;
	Rx _ Rx - 0F - 1, CarryBr, {decr n1, <0?}	c3;

	MAR _ [rhTT, TT - 1], BRANCH[VarOdd{n1=-1}, $],	c1;
	MDR _ PC{nil}, Rx _ Rx, ZeroBr{n2}, CANCELBR[$, 2], WriteOK,	c2;
	TT _ TT - 2, BRANCH[Nloop, push],	c3;

{(P) push stack if n2=0}

push:	MAR _ S _ [rhS, S + 1],	c1;
bindCont:	MDR _ TOSH, BRANCH[$, bindCar, 1],	c2;
	Noop,	c3;

	MAR _ S _ [rhS, S + 1],	c1;
	MDR _ TOS, CANCELBR[$, 2], WriteOK,	c2;
	PC _ uPCib, GOTO[endBind],	c3;

{(V) bind var to Val{top of stack}}	{get to VarOdd n1=-1}

VarOdd:	MDR _ TOSH, Rx{n2-1} _ Rx - 1, CANCELBR[VarOdd3, 2], WriteOK,	c2;

Vloop:	MAR _ [rhTT, TT - 1],	c1;
	MDR _ TOSH, CANCELBR[VarOdd3, 2], WriteOK,	c2;
VarOdd3:	PC _ uPCib,	c3;

	MAR _ [rhTT, TT + 0],	c1;
	MDR _ TOS, Rx _ Rx - 1, NibCarryBr{pos},	c2;
	TT _ TT - 2, BRANCH[endBind{n2-1<0}, $],	c3;

{(P) pop stack}

bdP:	MAR _ [rhS, S], S _ S - 1	c1;
	Noop, CANCELBR[$, 2],	c2;
	TOS _ MD,	c3;

{(P) pop stack}

	MAR _ [rhS, S + 0],	c1;
	S _ S - 1,	c2;
	TOSH _ MD, GOTO[Vloop],	c3;

{(M) push binding mark}

endBind:	TOS _ ib LShift1,	c1;
	PC _ PC + 1 + PC16, IBDisp,	c2;
	TOSH _ RRot1 (TT - Q - 1), L2_L2.0, DISPNI[OpTable],	c3;

{exceptions:}

prePush:	Q _ TT, GOTO[push],	c3;

bindCar:	S _ S + 0FF + 1,	c3;
	MAR _ S _ [rhS, S + 0], GOTO[bindCont],	c1;


{*******************************************************************
	UNBIND, DUNBIND
*******************************************************************}
{n1:Nils   n2:Var   N:last pvar    mark[-(n1+n2)-1,, 2*N]}

{check for n1n2=0  ??!!  also N>127}


{(M) check TOS for bind mark in sign bit}

@DUNBIND:	opcode[23'b],
	Rx _ TOSH LRot0 xor ~TOSH, XHDisp, L3 _ 3,	c1;
	TT{cnt} _ ~TOSH, ZeroBr, BRANCH[tosNot, tosMark, 2],	c2;
tosNot:	CANCELBR[again],	c3;

{(M) find bind mark by sign bit}

@UNBIND:	opcode[22'b],
	MAR _ [rhS, S - 1], L3 _ 2, GOTO[nomark],	c1;
again:	MAR _ [rhS, S - 1], BRANCH[nomark, mark, 2],	c1;
nomark:	S _ S - 2, CANCELBR[$, 2],	c2;
	STK _ TOS, TT{cnt} _ ~MD, XHDisp, GOTO[again],	c3;

mark:	TOS _ PV, rhTOS _ nRhS, CANCELBR[$, 2],	c2;
	Rx{allOnes} _ Rx xor ~Rx, L2 _ L2.0,	c3;

{(M) fetch other word of bind mark}	{S even full}

	MAR _ [rhS, S + 2],	c1;
	TT{cnt} _ TT, ZeroBr, BRANCH[$, dunCross, 1],	c2;
dunCon:	Q{NN} _ MD, L3Disp, BRANCH[Uloop1, dunPop1],	c3;

{(L) loop making vars unbound=-1}

tosMark:	TOS{var} _TOS + PV, rhTOS _ nRhS, CANCELBR[$],	c3;

	c1;
	Ybus _ TT, ZeroBr,	c2;
	L3Disp, BRANCH[Uloop, dunPop],	c3;

Uloop1:	MAR _  TOS _ [rhTOS, TOS + Q{NN}], CANCELBR[Uloop2, 3],	c1;
Uloop:	CANCELBR[$, 3],

	MAR _ [rhTOS, TOS + 0],	c1;
Uloop2:	MDR _ Rx{allOnes}, TT{cnt} _ TT - 1, ZeroBr, BRANCH[$, unbCros, 1],	c2;
Uloop3:	TOS{var} _ TOS - 2, BRANCH[Uloop, $], L3Disp,	c3;

{(P) pop stack if dunbind}	{S:odd full}

dunPop:	MAR _ [rhS, S + 0], BRANCH[unbEnd, Pop2, 2],	c1;
dunPop1:	MAR _ [rhS, S + 0], BRANCH[unbEnd, Pop2, 2],	c1;
Pop2:	PC _ PC + PC16, CANCELBR[$, 2],	c2;
	TOS _ MD,	c3;

{(P) pop stack}

	MAR _ [rhS, S - 1], L2_L2.0, 	c1;
	S _ S - 2, IBDisp, CANCELBR[$, 2],	c2;
	TOSH _ MD, L2_L2.0, DISPNI[OpTable],	c3;

{(U) don't pop stack if unbind}

unbEnd:	PC _ PC + PC16, IBDisp, CANCELBR[$, 2],	c2;
	TOS _ STK, L2_L2.0, DISPNI[OpTable],	c3;

{Exceptions:}

dunCross:	S _ S + 2, CANCELBR[$], 	c3;
	MAR _ [rhS, S + 0],	c1;
	S _ S - 2,	c2;
	Q{NN} _ MD,	c3;

	c1;
	TT{cnt} _ TT, ZeroBr,	c2;
	L3Disp, BRANCH[Uloop1, dunPop1],	c3;

unbCros:	TOS _ TOS + 0FF + 1, CANCELBR[$, 1],	c3;
	MAR _ [rhTOS, TOS + 0],	c1;
	MDR _ Rx{allOnes}, TT{cnt} _ TT, ZeroBr, GOTO[Uloop3],	c2;

	{ E N D }