{File name MoreLisp.mc
Description: DandeLion Interlisp Emulator
Author: Purcell
Created: June 8, 1981
Charnley:   26-Aug-83 14:49:09
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}


SetTask[0];

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

{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;

{*******************************************************************}
{	MAR ← Q ← [TOS, TOSH + 0], CALL[typ{↑}],	c1, opcode[3'b];{LISTP}}
	TT ← 03'b, CALL[NewTyp],	c1, opcode[3'b];{LISTP}

{	
	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 ← 5 + 0,	c1, at[3,10, NewTypRet];
	PC ← PC + 0, GOTO[typep3],	c2;

	TT ← 05'b, CALL[NewTyp],	c1, opcode[5'b];{TYPEP}

{	
	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; {% reverse?}
	TOSH ← uTOSH, L2 ← L2.0, DISPNI[OpTable],	c3;
noL:	TOS ← 0{nil}, L2 ← L2.0, DISPNI[OpTable],	c3;

listpretnil:
	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;

{*******************************************************************}
	TT ← 06'b, CALL[NewTyp],	c1, opcode[6'b];{DTEST}
{	
	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;


{??	{MAR ←} Rx ← Rx and (Rx LRot8), Xbus ← Rx LRot8, NZeroBr,	c1;	??}
	Ybus ← Rx, NZeroBr,	c1;
	Rx ← 6, BRANCH[$, notOK{, 1}], 	c2;
	Noop,	c3;

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

notOK:	IB ← TT{type} LRot0,	c3;
	PC ← PC - PC16, IBPtr←0, GOTO[ufn2],	c1;

{dtestMap:	Q ← 8'd, GOTO[sink3], 	c2;{MP9008}}
{*******************************************************************}
car:	TT ← 01'b, CALL[NewTyp],	c1, opcode[1'b];{CAR}
cdr:	TT ← 02'b, CALL[NewTyp],	c1, opcode[2'b];{CDR}

{	
	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;
	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;

	BRANCH[carcdrufn, listpretnil],	c1, at[07,10,NewTypDisp];
	BRANCH[carcdrufn, listpretnil],	c1, at[0B,10,NewTypDisp];
	BRANCH[carcdrufn, listpretnil],	c1, at[0F,10,NewTypDisp];

carcdrufn:
	GOTO[ufn3],	c2;

	MAR ← [rhRx, Rx], Rx ← 5 + 0, L0←L0.xRedoCdr, GOTO[cadr],	c1, at[1,10, NewTypRet];
	MAR ← [rhRx, Rx], Rx ← 5 + 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, CANCELBR[$, 1],	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, 10, dumb];
	Q ← 9'd, GOTO[sink1],	c3, at[2, 10, dumb];{MP9009}

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

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

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

{*******************************************************************
	RAID	? %  ? clicks
*******************************************************************}
{display function name in MP; wait for right shift}
RAID:	opcode[76'b],{3E}
	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:	Noop,	c1;
MPWait2:	rhRx ← 41, Rx ← 41-1,	c2;
	Rx{14000} ← Rx LRot8,	c3;

	MAR ← [rhRx, 41+0],	c1;
	Noop,	c2;
	TT{saveMP} ← MD,	c3;

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

{"stop" key hard reset}
raidLp1:	MAR ← [rhRx, 3E+0],  BRANCH[raidEnd1, $, 2]	c1;
	Noop ,	c2;
	Xbus ← MD, XDisp,	c3;

{"undo" key down}
	MAR ← [rhRx, 3E+0],  BRANCH[StopK, $, 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;
	rhRx ← 41, Rx ← 41-1,	c2;
	Rx{14000} ← Rx LRot8,	c3;

	MAR ← [rhRx, 41+0],	c1;
	MDR ← Q,	c2;
	Noop,	c3;
{"undo" key up}
raidLp2:	MAR ← [rhRx, 3E+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, 41+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:	MAR ← [rhRx, 41+0], CANCELBR[$, 0F],	c1;
	MDR ← uTT{saveMP},L2←0, IBDisp,	c2;
	IOPCtl ← 1, L2←0, DISPNI[OpTable],	c3;


StopK:	TT ← UvCL,	c2;
	rhTT ← UvChighL,	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;

	Noop,	c1;
	rhRx ← 41, Rx ← 41-1,	c2;
	Rx{14000} ← Rx LRot8,	c3;

	MAR ← [rhRx, 41+0],	c1;
	MDR ← Q,	c2;
	Noop,	c3;


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

stopEnd2:	Noop,	c2;
	Noop,	c3;

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

{pop "b" items and push 1 item}

SUBR:	TT ← ib, L2←L2.0,	c1, opcode[175'b];{7D}
	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;
	Noop,	c3;

	TT ← 0 RShift1, SE ← 1,	c1;
	rhRx ← 41, Rx ← 41-1,	c2;
	Rx{14000} ← Rx LRot8,	c3;

Off:	MAR ← [rhRx, 5A+0],	c1;
	MDR{8004} ← TT or 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:	Rx ← 1 RRot1, rhRx ← 1, CANCELBR[$, 1],	c2;
	Rx{4000} ← Rx RShift1,	c3;

	Noop, {MAR ← [rhRx, 0EA+0],}	c1;
	Noop, {MDR ← 45,}	c2;
	S ← S - 2{(2 args -1)*2},	c3;

	MAR ← [rhRx, 0EB+0],	c1;
	Noop{MDR ← 0},{wakeup}	c2;
	TT ← 88,	c3;

	MAR ← [rhRx, 0EC+0],	c1;
	MDR ← 0{Q ← 41},	c2;
	TT ← TT LRot8,	c3;

	MAR ← [rhRx, 0ED{0EF}+0],	c1;
	MDR ← TT{88} or 22,	c2;
	PC ← 1 + PC + PC16,	c3;

	Noop, {MAR ← [rhRx, 0E9+0],}	c1;
	Q ← 41, {MDR ← 0, IBDisp,}	c2;
	DCtl←Q LRot0, L2 ← L2.0, DISPNI[OpTable],	c3;


{*******************************************************************}
{
Clock:	PC ← PC + 1, L1 ← L1.Dec3,	c1;
	uTOSH ← TOSH, Xbus ← ib{=1}, GOTO[Clock3],	c2;
}

RCLK:	L1 ← L1.DecOnly,	c1, opcode[167'b]; {77}
	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, XDirtyDisp,	c3;

at[L0.RedoClk,10,WMapFixCaller],
	Q ← uClockHigh, BRANCH[ClkMap,$,1],	c1;
	TOSH ← RShift1 uClockBits, SE←0,	c2;
	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;

ClkMap:	CALL[WLMapFix]{will return at RedoClk},	c2;

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

{OLD: {CAUTION: there is a delicate sharing of .u+D by uTOS and UWidth; during faults UWidth is stored in TOS; at restart {BBpart} it is tested for nonZero and restorted}}
{.u+2 thru .u+C must be preserved accross faults; in particular no bitBlt by fault handler}

{TOS=0 if virgin BB call;  else suspended with saved state on stack under TOS}
{2 args one usually 0 in TOS; S points to ptr to BBtable}
BITBLT:	MAR ← [rhS, S+0],	c1, opcode[166'b];
	{UWidth}Ybus ← TOS, NZeroBr,	c2;
	TOS ← MD, BRANCH[$, BBpart],	c3;

	MAR ← S ← [rhS, S - 1],	c1;
	S←S-1, CANCELBR[$, 2],	c2;
	TOSH ← MD,	c3;

{S points to some stack entry that has nothing to do with BB}
{BBInit vs BBInit1 differ on advacing PC}
	PC ← PC + 1{PC16}{1}{%?}{saveRegs does PC←PC-1},	c1;
	stackP ← 2,	c2;
	Noop,	c3;

	uPCCross ← TOSH xor ~TOSH,{uPCCross#uPCCrossL}	c1;
	STK{UBitBltArg} ← TOS, pop,	c2;
	rhMDS ← TOSH LRot0, GOTO[@BITBLT],	c3;

{@BITBLT returns directly to IBDispOnly; saves and restores L, G, PC}

BBpart:	{Q ← 166'b, GOTO[sink2],	c1;}
	uPCCross ← TOSH xor ~TOSH,{uPCCross#uPCCrossL}	c1;
	PC ← PC + 1{PC16}{1}{%?}{undone by saveRegs},	c2;
	stackP ← 0C{vestigial}, {GOTO[@BITBLT],}	c3;

{restore 12 uRegs from memory stack: u2 thru u0D } 
	stackP ← 0D,	c1;
	Rx ← 0C,	c2;
BBLp:	Noop,	c3;

{Stack pointer points to full odd word } 
	MAR ← S ← [rhS, S +0], 	c1;
	S ← S - 2,	c2;
	TT ← MD,	c3;

	Rx ← Rx - 1, ZeroBr,	c1;
	STK ← TT, pop, BRANCH[BBLp, BBLpD],	c2;

BBLpD:	stackP ← 0C{not vestigial}, GOTO[@BITBLT],	c3;


bbDummy:	Noop, DISP4[ESC2n],	c3;

{@BITBLT returns  to IBDispOnly normally or to SaveRegs if fault {or interrupt}}
{interupts are temporarily disabled in BB}
{S points to some stack entry that has nothing to do with BB}

{if faulting save 12 uRegs to memory stack: u2 thru u0D } 
{then set TOSH,TOS to nonzero to indicate BB suspended (PFault saves TOS)} 
{at PFault TOS is nonzero and under that is saved regs } 
SaveRegs: {come here on pageFault}{{state held in stack (faults can't bitblt)}}
	rhTT ← uFaultParm1, 	c2;
	TT ← uFaultParm0,	c3;

{Stack pointer points to full odd word } 
{save 12 uRegs from memory stack: u2 thru u0D } 
	stackP ← 02,	c1;
	Rx ← 0C,	c2;
BBsLp:	S{even empty} ← S{odd full} + 1,	c3;

	MAR ← S ← [rhS, S +0], 	c1;
	MDR ← smallpl,	c2;
	S ← S + 1,	c3;

	MAR ← S ← [rhS, S +0], 	c1;
	MDR ← STK, push,	c2;
	Noop,	c3;

	Rx ← Rx - 1, ZeroBr,	c1;
	BRANCH[BBsLp, BBsLpD],	c2;

BBsLpD:	stackP ← 0C{not vestigial},	c3;

BBFault:	TOSH ← smallpl,	c1;
	TOS ← 1{UWidth}{uTOS}, L1 ← L1.NoFixes{DecOnly?},	c2;
	stackP ← 0,  GOTO[PFault],	c3;

{S points to some stack entry that has nothing to do with BB}
{Normal BB returns undefined : set TOSH, TOS to any valid object (use smallpl)}
{@BITBLT returns directly to IBDispOnly; saves and restores L{PV}, G{S}, PC}
{stackP was set to zero by BB as we return here; any thing below .u+D is ok}

IBDispOnly: {stackP ← 0} IBDisp, L2 ← L2.0,	c2;
	TOSH ← smallpl, L2 ← L2.0, DISPNI[OpTable],	c3;


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

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

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

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

INPUT:	Ybus ← TOS, YDisp,	c1, at[0D,10, MiscDisp];
	TOSH ← smallpl, IBDisp, DISP4[Inpt, 8],	c2;
Inpt:	TOS ← EIData, L2 ← L2.0, DISPNI[OpTable],	c3, at[8,10,Inpt];
	TOS ← EStatus, L2 ← L2.0, DISPNI[OpTable],	c3, at[9,10,Inpt];
	TOS ← KIData, L2 ← L2.0, DISPNI[OpTable],	c3, at[0A,10,Inpt];
	TOS ← KStatus, L2 ← L2.0, DISPNI[OpTable],	c3, at[0B,10,Inpt];
	   Q ← 120'd, GOTO[sink1],	c3, at[0C,10,Inpt];{MP9120}
	TOS ← MStatus, L2 ← L2.0, DISPNI[OpTable],	c3, at[0D,10,Inpt];
	TOS ← KTest, L2 ← L2.0, DISPNI[OpTable],	c3, at[0E,10,Inpt];
	TOS ← PPort, L2 ← L2.0, DISPNI[OpTable],	c3, at[0F,10,Inpt];



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

OUTPUT:
	MAR ← S ← [rhS, S + 0], Xbus ← uTOS, XDisp,	c1, at[0E,10, MiscDisp];
	S ← S - 2, DISP4[Outpt],	c2;

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

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;
	
	
{*******************************************************************
	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], CANCELBR[$, 07], L1 ← L1.PopOnly,	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)

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}, {PgCarryBr ok *} {BRANCH[$, FVLUfix1,  1],}CANCELBR[$, 2],	c2;
FVLUret1:
	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{too late?%}, 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}

	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 + 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, CANCELBR[$, 2],	c2;
	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;


{***********************} {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} + 0], BRANCH[fvRet2, $, 0E],	c1;
	MDR ← TT ← TT + TOS{offset}, CANCELBR[donefv3, 2], WriteOK,	c2;

fvRet2:	L3Disp, GOTO[fvRet3],	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[$, 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{, opcode[143'b]};{63}
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:	TT ← TOS + ib, CarryBr, L1 ← L1.Dec3,	c1, opcode[312'b];{CA}
	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:	MAR ← [rhS, S + 0], L1 ← L1.fixWF,	c1, opcode[317'b];{CF}
	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, 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, GOTO[joinWF],	c2, at[L2.WFRet, 10, MaskRet];
RedoWF3:	Ybus{pos+size} ← ib{size} - TOSH{-pos-1} - 1, YDisp, GOTO[joinWF],	c2, at[L2.WFRetOdd, 10, MaskRet];
joinWF:	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;

WFMap:	uTT ← TT, TT ← Q, CALL[WLMapFix], {will return to RedoWF}	c2, at[L2.WFRetMap, 10, MaskRet];
WFMapOdd:	uTT ← TT, TT ← Q, CALL[WLMapFix], {will return to RedoWF}	c2, at[L2.WFRetMapOdd, 10, MaskRet];

RedoWF:	TT ← uTT, BRANCH[RedoWF2, RedoWF3],	c1, at[L0.RedoWF,10, WMapFixCaller];

ufnWF:	Rx ← 317'b, GOTO[ufn2incS]	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:	uPCib ← PC, Rx{n1,n2} ← ib, ZeroBr, L2←L2.0,	c1, opcode[21'b];
	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, CANCELBR[$, 2], WriteOK,	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[$, 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:	MAR ← [rhS, S - 1], L3 ← 2, GOTO[nomark],	c1, opcode[22'b];
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 }