{File name dbMoreLisp.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],}GOTO[NewTypGo], 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;
NewTypGo:
MAR ← Q ← [TOS, TOSH + 0], CANCELBR[$], c1{, at[03,10,NewTypDisp]};
typ:
Rx ← Q, rhRx ← crhTypeTable, c2;
Rx ← Rx LRot8, L1 ← L1.DecOnly, c3;
IfEqual[typemsbit,0,,CauseError];
Rx ← Rx RShift1, SE←0, 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, ReadXRefBr, BRANCH[$, cadrUfn], c3;
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;
{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, 3], 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;
TOS ←Q, L3 ← L3.MPWait, c3;
TT ← uMaintPanel, CALL[WriteMPEntry], c1;
{"stop" key hard reset is 0 in bit 15}
{"undo" key down is 0 in bit 13}
{Key bits at 251H + IORegion }
MPWait7:
rhRx ←5{IORegionHigh}, c1, at[L3.MPWait,10,DoveMiscOut];
Rx ← 22, {middle 8 bits of IORegion} c2;
Rx ← Rx LRot8, c3;
Rx ← Rx + 51, c1;
,c2;
here: GOTO[here],c*;
raidLp1:
MAR ← [rhRx, Rx+0], DISP4[raidEnd, 0A] c1;
Noop , c2, at[0F, 10, raidEnd];
Xbus ← MD, XDisp, GOTO[raidLp1], c3;
Q ← 1, c2, at[0E, 10, raidEnd];
uWDC ← Q, L2←0,GOTO[raidLp1],{***} c3;
LabelToKeepMassHappy:
, c1;
, c2;
Rx ← {TeleRaidFXP}30'b, GOTO[PUNT], c3;
GOTO[stopEnd], c2, at[0A, 10, raidEnd];
GOTO[stopEnd], c2, at[0B, 10, raidEnd];
stopEnd:
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, %M}L2 ← L2.0, DISPNI[OpTable], c3;
{*******************************************************************}
@RCLK: opcode[167'b],
uTOSH ← TOSH,c1;
rhTT ← TOSH LRot0, c2;
Rx ← 0, c3;
Set[xT012Control, 43]; {** This SET is also in LispMiscDaybreak.mc **}
rhRio ← xT012Control, c1;
uTOS ← TOS, L3 ← L3.RCLK, c2;
CALL[ReadTimer], c3; {** ReadTimer is in LispMiscDaybreak.mc **}
TOS ← uTOS, c1, at[L3.RCLK, 10, DoveMiscOut];
TOSH ← uTOSH, c2;
rhTT ← TOSH LRot0, c3;
Map ← TT ← [rhTT, TOS], L0 ← L0.RedoClk,c1;
PC ← PC + PC16, L1 ← L1.DecOnly, c2;
Rx ← rhRx ← MD, XwdDisp{XDirtyDisp}, c3;
Q ← uClockHigh, DISP2[ClkMap], c1,at[L0.RedoClk,10,WMapFixCaller];
, c2, at[PgDirty, 4, ClkMap];
TT ← uClockLow, c3;
MAR ← [rhRx, TOS+1], L2 ← L2.0, c1;
MDR ← TT, CANCELBR[$, 2], WriteOK, c2;
, c3;
MAR ← [rhRx, TOS+0], c1;
MDR ← Q, IBDisp, c2;
TOSH ← uTOSH, L2 ← L2.0, DISPNI[OpTable],c3;
CALL[WLMapFix]{will return at RedoClk}, c2, at[PgClean, 4, ClkMap];
CALL[WLMapFix]{will return at RedoClk}, c2, at[PgProt, 4, ClkMap];
CALL[WLMapFix]{will return at RedoClk}, c2, at[PgVacant, 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, ReadXRefBr, c3;
{(V) fetch bound val}
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;
{(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, ReadXRefBr, c3;
{fvN: ntSize}{#this click could be eliminated possibly by testing for zero (vs ntSize)}
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], 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, 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;
{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, LOOPHOLE[stw{%M}], 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, 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];
{ 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[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:{not gone to} TT ← uTT, CANCELBR[RedoWF2, PgDirty], 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 }