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