{File name NewMoreLisp.mc
Description: DandeLion Interlisp Emulator
Author: Purcell
Created: June 8, 1981
charnley:     24-Apr-84  9:27:36  added CAR/CDR NIL 
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
	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;
	
makeTosNilC1:
	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;
	PC ← PC + 1, L2 ← L2.0,	c3;

	Noop, GOTO[IB.nop],	c1;
IB.nop:
	L2 ← L2.0, IBDisp, GOTO[DNI.nop],	c2;

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;

	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[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[$, makeTosNil, 2],	c1;{rhTOS?%}
	TOSH ← uTOSH, L2 ← L2.0, IBDisp,	c2;
	TOSH ← TOSH and 0FF, L2 ← L2.0, DISPNI[OpTable],	c3;

tosNil:	CANCELBR[makeTosNilC1, 3],	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, GOTO[IB.nop],	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;
	MDR ← Q,	c2;
	TT{saveMP} ← MD,	c3;

	MAR ← [rhRx, IOPage.key+0],  GOTO[MPWait7],	c1;
	
{"stop" key hard reset is 0 in bit 15}
{"undo" key down is 0 in bit 13}
raidLp1:	MAR ← [rhRx, IOPage.key+0],  DISP4[raidEnd, 0A]	c1;
MPWait7:
	Noop ,	c2, at[0F, 10, raidEnd];
	Xbus ← MD, XDisp, GOTO[raidLp1],	c3;

	Q ← 1,	c2, at[0E, 10, raidEnd];
	uWDC ← Q, L2←0,	c3;

	MAR ← [rhRx, IOPage.MP+0], CANCELBR[$, 0F],	c1;
	MDR ← TT{saveMP},	c2;
	Rx ← {TeleRaidFXP}30'b, GOTO[PUNT],	c3;

	GOTO[stopEnd],	c2, at[0A, 10, raidEnd];
	GOTO[stopEnd],	c2, at[0B, 10, raidEnd];
stopEnd:
	,	c3;

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

{pop "b" items and push 1 item}

@SUBR:	opcode[175'b],
	TT ← ib, L2←L2.0,	c1;
	Rx ← TT xor 0F, ZeroBr,	c2;
	Ybus ← TT xor 15'b, ZeroBr, BRANCH[$, RaidS],	c3;

WellContinueHere:
	Ybus ← TT xor 6, ZeroBr, BRANCH[$, logout],	c1;
	Ybus ← TT xor 9, ZeroBr, BRANCH[$, BackGround],	c2;
	TT ← TT xor 10, BRANCH[$, DspBout3],	c3;

	Ybus ← TT, ZeroBr,	c1;
	Ybus ← TT xor 2, ZeroBr, BRANCH[$, Pup],	c2;
	Ybus ← TT xor 3, ZeroBr, BRANCH[$, SETSCREENCOLOR],	c3;

	Rx ← ib, ZeroBr, BRANCH[$, ShowDisplay],	c1;
SubrXXX:
	PC ← PC + 1, BRANCH[SubrXXX1, subrPush],	c2;
SubrXXX1:
	Rx ← (Rx -1) LShift1, SE←0,	c3;

Subrs:	S ← S - Rx,	c1;
	PC ← PC + PC16, L2←L2.0,	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 ← ib, ZeroBr, CANCELBR[$],	c1;
	PC ← PC + 1, BRANCH[SubrXXX1, subrPush],	c2;

Pup:	CANCELBR[SETSCREENCOLOR],	c3;

SETSCREENCOLOR: Rx ← ib, ZeroBr, CANCELBR[NoopS2],	c1;

DspBout3:	Rx ← ib, ZeroBr, GOTO[NoopS2],	c1;

NoopS2:	PC ← PC + 1, BRANCH[$, subrPush3],	c2;
	Rx ← (Rx -1) LShift1, SE←0,	c3;

subrEnd:
	S ← S - Rx, GOTO[IB.pc1],	c1;

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

{*******************************************************************}
BackGround:
	CANCELBR[SETSCREENCOLOR],	c3;

{*******************************************************************}
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{8800} or 22, L2 ← L2.0,	c2;
	DCtl←Q LRot0, L2 ← L2.0, DISPNI[OpTable],	c3;

{*******************************************************************}
@RCLK:	opcode[167'b],
	uTOSH ← TOSH,	c1;
	rhTT ← TOSH LRot0,	c2;
	,	c3;

	Map ← TT ← [rhTT, TOS], L0 ← L0.RedoClk,	c1;
	PC ← PC + PC16, L1 ← L1.DecOnly,	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];

{*******************************************************************
	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,	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, GOTO[MiscInEnd],	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 }