{File name QMoreLisp.mc
Description: DandeLion Interlisp Emulator
Author: Purcell  //  Charnley
Last mod 28-Aug-85 15:29:55
}

{	contains:
	004	@NTYPX
	003	@LISTP
	005	@TYPEP
	006	@DTEST
	056	@TYPECHECK
	001	@CAR
	002	@CDR
	301	@ATOMCELL.N
	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
*******************************************************************}
@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;

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

@TYPEP:	opcode[5'b],
	MAR _ Q _ [TOS, TOSH + 0], CALL[typ],	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;
typep5:
	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;

{new opcode 063: TYPEMASK.N
like TYPEP (opcode 5), except ANDs the alpha-byte with the high-order byte returned from the type table and returns top-of-stack if AND is non-zero, NIL if zero. 
}
@TYPEMASK.N:	opcode[063'b],
	MAR _ Q _ [TOS, TOSH + 0], CALL[typ],	c1;

	MAR _ [rhRx, Rx + 0],	c1, at[0, 10, NewTypRet];
	PC _ PC + PC16,	c2;
	Q _ MD,	c3;

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

	Ybus _ Q and Rx, ZeroBr, GOTO[typep5],	c1;


{*******************************************************************}
@TYPECHECK:	opcode[56'b],
	MAR _ Q _ [TOS, TOSH + 0], L2 _ 6, CALL[typ],	c1;
{	Rx _ Q, rhRx _ crhTypeTable, GOTO[typP1],	c2;}


@DTEST:	opcode[6'b],
	MAR _ Q _ [TOS, TOSH + 0], CALL[typ],	c1;

	MAR _ [rhRx, Rx + 0],	c1, at[6,10, NewTypRet];
	Rx _ uDTDbase,	c2;
	TT _ MD and Q,	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],	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;

	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[ufnX2],	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:
	BRANCH[$, carcdrretNIL],	c2;
	GOTO[NewTypGo],	c3;

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


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

NewTyp:
	,	c2;
NewTypC3:
	,	c3;

NewTypGo:
	MAR _ Q _ [TOS, TOSH + 0],	c1,;
typ:
	Rx _ Q, rhRx _ crhTypeTable, 	c2;
typP1:
	Rx _ Rx LRot8, L1 _ L1.DecOnly,	c3;

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

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, ReadXRefBr, BRANCH[$, cadrUfn],	c3;

cadrH:	MAR _ Q _ [rhRx, TOS], L2Disp, ReadBRANCH[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;

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;

	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, GOTO[cadr3], {L0 still set}	c2;

carIndLoc:	TOSH _ rhTOSH, GOTO[IB.nop],	c1;

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, ReadOK],	c1;

{- - - - - - - - - - - - - - - - - - - - - - - - - -
  #      name        len-1    stk level effect   UFN table entry
 ??      ATOMCELL.N       1        0                 ATOMCELL.N

	(ATOMCELL.N atom)
	if TOSH # 0 return NIL
	else return ( (2^16) * ib) + 2 * TOS

}

@ATOMCELL.N:	opcode[301'b],
	Ybus _ TOSH, ZeroBr,	c1;
	Rx _ ibNA, BRANCH[atomufn, $],	c2;
	TOS _ TOS + TOS, CarryBr,	c3;

	PC _ PC + 1, Xbus _ ib, BRANCH[$, atomcar],	c1;
	TOSH _ Rx, L2 _ L2.0, IBDisp, GOTO[DNI.nop],	c2;

atomcar:
	TOSH _ Rx + 1, L2 _ L2.0, IBDisp, GOTO[DNI.nop],	c2;

atomufn:
	GOTO[ufnX1],	c3;

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

{*************************}
{Traps and Errors:   do hard reset}
{*************************}
sink3:
	,	c3;

sink1:	at[B1sink1],
	CANCELBR[$, 0F],	c1;

sink2:
	Rx _ 23,	c2;
	Rx _ Rx LRot8, 	c3;

	Rx{9000=2328h} _ Rx +28,	c1;
	Q _ Rx +Q{error#}, GOTO[MPWait],	c2;

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

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

	Ybus _ TT xor 6, ZeroBr, BRANCH[$, logout],	c1;
	Ybus _ TT xor 9, ZeroBr, BRANCH[$, BackGround],	c2;
	Q _ TT xor 10, BRANCH[$, DspBout3],	c3;

	Ybus _ Q, ZeroBr,	c1;
	Ybus _ Q xor 2, ZeroBr, BRANCH[$, Pup],	c2;
	Ybus _ Q xor 3, NZeroBr, BRANCH[$, SETSCREENCOLOR],	c3;

	Rx _ ib, ZeroBr, BRANCH[ShowDisplay, SubrXXX],	c1;

RaidS:	Rx _ ib, ZeroBr, CANCELBR[SubrXXX],	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 _ 3,	c3;

	Rx _ Rx LRot8,	c1;
	Rx{900=384'h} _ Rx +84,	c2;
	Q _ Rx +TT{raid#}, GOTO[sink1],	c3;

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

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;

{*******************************************************************
	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;
	CANCELBR[$, 2],	c2;
	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, ReadXRefBr,	c3;

{(V) fetch bound val}

RedoFV0:	MAR _ [rhRx, TT + 1],  ReadBRANCH[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, ReadXRefBr,	c3;

fvOff: {fvoffset from fn header}

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

	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{cautious},	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, ReadXRefBr,	c3;

{fvN: ntSize}

RedoFVN:	MAR _ Q _ [rhRx, TT + 0{6}], ReadBRANCH[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], DISP4[MatX],	c1;
	Ybus _ TOS{cnt} - 1, NegBr,	c2, at[6, 10, MatX];
matJoin:	TT _ TOSH{name} xor MD, BRANCH[$, newFrame],	c3;


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

	MAR _ Rx _ [rhRx, Rx + 1], L0 _ 2, 	c1;
fixedRx:
	Ybus _ TT, ZeroBr, BRANCH[$, fixRxnow, 1],	c2, at[2, 10, MatX];
	TT _ TOSH{name} xor MD, BRANCH[$, Val1],	c3;

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

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

fixRxnow:
	Rx _ Rx + 0FF + 1, CANCELBR[$],	c3;
	MAR _ Rx _ [rhRx, Rx + 0], GOTO[fixedRx],	c1;

{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], CANCELBR[Vtail, 0F],	c1;
Vtail:
	rhTT _ STACKspace, BRANCH[$, VTailFix, 1],	c2;
Vtail3:
	TT{vtyOffset} _ MD, XHDisp, L1 _ L1.fvStack,	c3;

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

fvFP: {FVar or PVar}

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

VTailFix:
	Rx _ Rx + Q,	c3;

	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],	c2;
	TOSH{chain} _ uChain, XLDisp, GOTO[donefv],	c3;

{preserved Rx{realNames}, TOS{cnt}, Q{ntSize-1}}
lookMore:	{TT#0} TOSH{name} _ uName, GOTO[matLp], L0Disp,{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} _ LShift1 (TT and 0FF), 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, NegBr, L1 _ L1.fvGlobal, GOTO[endStk2],	c1;
endStk1:
	TT _ uName, NegBr, L1 _ L1.fvGlobal,	c1;
endStk2:
	TT _ TT + TT, rhTT _ VALspace, BRANCH[endStk3, endStk3X],	c2;
endStk3:
	TOSH{chain} _ uChain, XLDisp, GOTO[donefv]	c3;
endStk3X:
	rhTT _ VALspaceHi,	c3;
	,	c1;
	GOTO[endStk3],	c2;

{***********************}
{	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:  ***********************}
{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,	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, LOOPHOLE[stw],	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;

	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, ReadXRefBr,	c3;

	MAR _ [rhRx, TT + 0], ReadBRANCH[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];

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,	c2;
	Rx _ rhRx _ MD, XwdDisp{XDirtyDisp}, DISP4[MaskTbl],	c3;

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

RedoWF2:	Ybus{pos+size} _ ib{size} - TOSH{-pos-1} - 1, YDisp, 	c2, at[PgDirty, 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[PgClean, 10, MaskRet];
	uTT _ TT, TT _ Q, CALL[WLMapFix], {will return to RedoWF}	c2, at[PgProt, 10, MaskRet];
	uTT _ TT, TT _ Q, CALL[WLMapFix], {will return to RedoWF}	c2, at[PgVacant, 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],
	uTOS _ TOS, 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 _ TOS{nil} _ 0,	c2;
	Rx _ Rx - 0F - 1, CarryBr, {decr n1, <0?}	c3;

	MAR _ [rhTT, TT - 1], BRANCH[VarOdd{n1=-1}, $],	c1;
	MDR _ TOS{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;
	TOS _ uTOS,	c3;

	MAR _ S _ [rhS, S + 1],	c1;
	MDR _ TOS, CANCELBR[$, 2], WriteOK,	c2;
	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[$, 2], WriteOK,	c2;
	TOS _ uTOS, GOTO[vmar],	c3;

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

vmar:
	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 }