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