{File name MoreLisp.mc Description: DandeLion Interlisp Emulator Author: Purcell Created: June 8, 1981 Charnley: 26-Aug-83 14:49:09 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} SetTask[0]; {******************************************************************* CAR 2%, CDR 2%, LISTP 1%, TYPEP 1%, DTEST, NTYPX % ? clicks *******************************************************************} {type table unpacked at 18000, same segment as map} MAR ← Q ← [TOS, TOSH + 0], CALL[typ], c1, opcode[4'b];{NTYPX} {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; {*******************************************************************} { MAR ← Q ← [TOS, TOSH + 0], CALL[typ{↑}], c1, opcode[3'b];{LISTP}} TT ← 03'b, CALL[NewTyp], c1, opcode[3'b];{LISTP} { 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 ← 5 + 0, c1, at[3,10, NewTypRet]; PC ← PC + 0, GOTO[typep3], c2; TT ← 05'b, CALL[NewTyp], c1, opcode[5'b];{TYPEP} { 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; {% reverse?} TOSH ← uTOSH, L2 ← L2.0, DISPNI[OpTable], c3; noL: TOS ← 0{nil}, L2 ← L2.0, DISPNI[OpTable], c3; listpretnil: L2Disp, c2; DISP4[listpdisp], c3; 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; {*******************************************************************} TT ← 06'b, CALL[NewTyp], c1, opcode[6'b];{DTEST} { 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; {?? {MAR ←} Rx ← Rx and (Rx LRot8), Xbus ← Rx LRot8, NZeroBr, c1; ??} Ybus ← Rx, NZeroBr, c1; Rx ← 6, BRANCH[$, notOK{, 1}], c2; Noop, c3; Noop, c1; IBDisp, c2; PC ← PC + 1, L2 ← L2.0, DISPNI[OpTable], c3; notOK: IB ← TT{type} LRot0, c3; PC ← PC - PC16, IBPtr←0, GOTO[ufn2], c1; {dtestMap: Q ← 8'd, GOTO[sink3], c2;{MP9008}} {*******************************************************************} car: TT ← 01'b, CALL[NewTyp], c1, opcode[1'b];{CAR} cdr: TT ← 02'b, CALL[NewTyp], c1, opcode[2'b];{CDR} { 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; Rx ← TT, NegBr, DISP4[NewTypDisp, 3], c3; MAR ← Q ← [TOS, TOSH + 0], CANCELBR[$], c1, at[03,10,NewTypDisp]; typ: Rx ← Q, rhRx ← MDSTYPEspaceReal, c2; Rx ← Rx LRot8, L1 ← L1.DecOnly, c3; Rx ← Rx RShift1, SE←1, c1; PC ← PC + PC16, L2Disp, c2; Q ← 0FF, DISP4[NewTypRet], c3; BRANCH[carcdrufn, listpretnil], c1, at[07,10,NewTypDisp]; BRANCH[carcdrufn, listpretnil], c1, at[0B,10,NewTypDisp]; BRANCH[carcdrufn, listpretnil], c1, at[0F,10,NewTypDisp]; carcdrufn: GOTO[ufn3], c2; MAR ← [rhRx, Rx], Rx ← 5 + 0, L0←L0.xRedoCdr, GOTO[cadr], c1, at[1,10, NewTypRet]; MAR ← [rhRx, Rx], Rx ← 5 + 0, L0←L0.xRedoCdr, GOTO[cadr], c1, at[2,10, NewTypRet]; cadr: rhTT ← TOSH LRot0, ZeroBr, c2; Q ← MD xor Rx, BRANCH[$, cadrN], c3; Map ← TT ← [rhTT, TOS], GOTO[cadr1], c1; cadrN: Map ← TT ← [rhTT, TOS], ZeroBr, c1; cadr1: Q ← Q - 1, PgCarryBr, BRANCH[$, tosNil], c2; cadr3: uTOSH ← TOSH, rhRx ← Rx ← MD, XRefBr, BRANCH[$, cadrUfn], c3; cadrH: MAR ← Q ← [rhRx, TOS], L2Disp, BRANCH[cadrMap, $], c1, at[L0.xRedoCdr, 10, RxMapFixCaller]; rhTT ← Rx LRot0, TT ← Q + 1, BRANCH[$, carTail, 0E], c2; Rx ← ~MD, XHDisp, c3; {****************cdr cases: cdrLoc, cdrIndLoc, indCell****************} cdrL: MAR ← [rhRx, TT], Rx{~,=} ← -Rx-1, CarryBr{0#MDhigh}, BRANCH[cdrInd, cdrDir, 2], LOOPHOLE[pci], c1; cdrInd: rhTOSH ← Rx LRot0, TOSH ← Rx LRot1, BRANCH[indCell, cdrIndLoc, 2], c2; cdrDir: TOSH ← ~Rx LRot8, CANCELBR[$, 3], c2; {Regs: TOSH{cdr}, uTOSH{tosH}, TOS{tos} cdrLoc TOSH{cdr}, rhTT{rhRx}, TT{Rx} cdrIndLoc rhTOSH{carH}, MD{car} indCell } cdrLoc: TOSH ← (TOSH and u7F) LShift1, ZeroBr, CANCELBR[$, 1], c3; MAR ← TOS ← [TOS, TOSH + 0], BRANCH[$, cdrNil, 2], c1;{rhTOS?%} TOSH ← uTOSH, L2 ← L2.0, IBDisp, c2; TOSH ← TOSH and 0FF, L2 ← L2.0, DISPNI[OpTable], c3; tosNil: Noop, CANCELBR[$, 1], c3; Noop, c1; cdrNil: TOS ← 0, L2 ← L2.0, IBDisp, c2; TOSH ← 0, L2 ← L2.0, DISPNI[OpTable], 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, 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, 10, dumb]; Q ← 9'd, GOTO[sink1], c3, at[2, 10, dumb];{MP9009} {**************** exceptions ****************} cadrMap: TT ← TOS, CANCELBR[RLxMapFix, 0F], {returns to cdrH} c2; cadrUfn: PC ← PC - PC16, CANCELBR[ufnX2, 1], c1; {******************************************************************* RAID ? % ? clicks *******************************************************************} {display function name in MP; wait for right shift} RAID: opcode[76'b],{3E} 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: Noop, c1; MPWait2: rhRx ← 41, Rx ← 41-1, c2; Rx{14000} ← Rx LRot8, c3; MAR ← [rhRx, 41+0], c1; Noop, c2; TT{saveMP} ← MD, c3; MAR ← [rhRx, 41+0], c1; MDR ← Q, c2; uTT{saveMP} ← TT, TT ← TT xor ~TT, NZeroBr, c3; {TESTING - - END OLD } {"stop" key hard reset} raidLp1: MAR ← [rhRx, 3E+0], BRANCH[raidEnd1, $, 2] c1; Noop , c2; Xbus ← MD, XDisp, c3; {"undo" key down} MAR ← [rhRx, 3E+0], BRANCH[StopK, $, 0B] c1; Noop , c2; Xbus ← MD, XLDisp, GOTO[raidLp1], c3; raidEnd1: rhRx ← nRhS, c2; Rx ← PV - 09, c3; MAR ← [rhRx, Rx+0], c1; Noop, c2; Rx{Alink} ← MD, c3; Rx ← Rx and ~1, c1; Rx ← Rx - 8, c2; Noop, c3; MAR ← [rhRx, Rx+0], c1; Noop, c2; TT{code lo} ← MD, c3; MAR ← [rhRx, Rx+1], c1; Noop, CANCELBR[$ ,2] c2; rhTT{code hi} ← MD, c3; Map ← [rhTT, TT+0], c1; Noop, c2; rhRx ← Rx ← MD, c3; MAR ← [rhRx, TT+5], c1; Noop, CANCELBR[$ ,2] c2; Q{fn name} ← MD, c3; {restore Rx to iopage for MP} Noop, c1; rhRx ← 41, Rx ← 41-1, c2; Rx{14000} ← Rx LRot8, c3; MAR ← [rhRx, 41+0], c1; MDR ← Q, c2; Noop, c3; {"undo" key up} raidLp2: MAR ← [rhRx, 3E+0], BRANCH[$, raidEnd2, 2] c1; Noop , c2; TT ← MD, XLDisp, GOTO[raidLp2], c3; raidEnd2: Ybus ← TT, YDisp, c2; BRANCH[Burdx, $, 0B], c3; raidEnd: MAR ← [rhRx, 41+0], CANCELBR[$, 0F], c1; MDR ← uTT{saveMP}, c2; L2←0, c3; Rx ← 1, c1; uWDC ← Rx, c2; Rx ← {TeleRaidFXP}30'b, GOTO[PUNT], c3; Burdx: MAR ← [rhRx, 41+0], CANCELBR[$, 0F], c1; MDR ← uTT{saveMP},L2←0, IBDisp, c2; IOPCtl ← 1, L2←0, DISPNI[OpTable], c3; StopK: TT ← UvCL, c2; rhTT ← UvChighL, c3; Map ← [rhTT, TT+0], c1; Noop, c2; rhRx ← Rx ← MD, c3; MAR ← [rhRx, TT+5], c1; Noop, CANCELBR[$ ,2] c2; Q{fn name} ← MD, c3; Noop, c1; rhRx ← 41, Rx ← 41-1, c2; Rx{14000} ← Rx LRot8, c3; MAR ← [rhRx, 41+0], c1; MDR ← Q, c2; Noop, c3; {"stop" key up} stopLp2: MAR ← [rhRx, 3E+0], BRANCH[$, stopEnd2, 0B] c1; Noop , c2; Xbus ← MD, XDisp, GOTO[stopLp2], c3; stopEnd2: Noop, c2; Noop, c3; MAR ← [rhRx, 41+0], c1; MDR ← uTT{saveMP}, c2; Noop, GOTO[Reset], c3; {******************************************************************* SUBRCALL ? % ? clicks *******************************************************************} {pop "b" items and push 1 item} SUBR: TT ← ib, L2←L2.0, c1, opcode[175'b];{7D} Ybus ← TT xor 12'b, {ZeroBr,} c2; Noop,{ BRANCH[$, Clock],} c3; Rx ← TT xor 0F{1C}, c1; Ybus ← Rx, ZeroBr{=0F{1C}}, c2; Noop, BRANCH[$, RaidS], c3; Rx ← TT xor 12{23}, GOTO[subrM], c1; subrM: Ybus ← Rx, ZeroBr{=12{23}}, c2; Noop, BRANCH[$, SETSCREENCOLOR], c3; Rx ← TT xor 20'b, c1; Ybus ← Rx, ZeroBr{=20'b}, c2; Noop, BRANCH[$, Pup], c3; Rx ← TT xor 15'b, c1; Ybus ← Rx, ZeroBr{=15'b}, c2; Noop, BRANCH[$, logout], c3; Rx ← TT xor 6{7}, c1; Ybus ← Rx, ZeroBr{=6{7}}, c2; Rx ← TT xor 9{21'b}, BRANCH[$, BackGround], c3; Ybus ← Rx, ZeroBr{=9{21'b}}, c1; Rx ← TT xor 13{44'b}, BRANCH[$, DspBout3], c2; Ybus ← Rx, ZeroBr{=13{44'b}}, c3; Rx ← ib, ZeroBr, BRANCH[$, ShowDisplay], c1; PC ← PC + 1, BRANCH[$, subrPush], c2; Rx ← (Rx -1) LShift1, SE←0, c3; Subrs: S ← S - Rx, c1; PC ← PC + PC16, L2←L2.0, {IBDisp,} 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 ← TT xor 12{23}, GOTO[subrM], c1;{error} {RaidS: Rx ← ib, ZeroBr, GOTO[NoopS2], c1;} DspBout3: Noop, c3; SETSCREENCOLOR: Rx ← ib, ZeroBr, GOTO[NoopS2], c1; Pup: Rx ← ib, ZeroBr, GOTO[NoopS2], c1; NoopS2: PC ← PC + 1, BRANCH[$, subrPush3], c2; Rx ← (Rx -1) LShift1, SE←0, c3; S ← S - Rx, c1; PC ← PC + PC16, L2←L2.0, IBDisp, c2; L2←L2.0, DISPNI[OpTable], c3; subrPush3: Noop, c3; MAR ← S ← [rhS, S + 1], GOTO[CopyRet], c1; logout: TT ← 55{password to mesa}, c1; uLispBootMsg ← TT, c2; Noop, c3; TT ← 0 RShift1, SE ← 1, c1; rhRx ← 41, Rx ← 41-1, c2; Rx{14000} ← Rx LRot8, c3; Off: MAR ← [rhRx, 5A+0], c1; MDR{8004} ← TT or 4, c2; Noop, GOTO[Off], c3; {*******************************************************************} BackGround: Rx ← ib, ZeroBr, c1; PC ← PC + 1, BRANCH[$, subrPushBG], c2; Rx ← (Rx -1) LShift1, SE←0, c3; S ← S - Rx, c1; PC ← PC + PC16, L2←L2.0, IBDisp, c2; L2←L2.0, DISPNI[OpTable], c3; subrPushBG: Noop, c3; MAR ← S ← [rhS, S + 1], GOTO[CopyRet], c1; {*******************************************************************} ShowDisplay: Rx ← 1 RRot1, rhRx ← 1, CANCELBR[$, 1], c2; Rx{4000} ← Rx RShift1, c3; Noop, {MAR ← [rhRx, 0EA+0],} c1; Noop, {MDR ← 45,} c2; S ← S - 2{(2 args -1)*2}, c3; MAR ← [rhRx, 0EB+0], c1; Noop{MDR ← 0},{wakeup} c2; TT ← 88, c3; MAR ← [rhRx, 0EC+0], c1; MDR ← 0{Q ← 41}, c2; TT ← TT LRot8, c3; MAR ← [rhRx, 0ED{0EF}+0], c1; MDR ← TT{88} or 22, c2; PC ← 1 + PC + PC16, c3; Noop, {MAR ← [rhRx, 0E9+0],} c1; Q ← 41, {MDR ← 0, IBDisp,} c2; DCtl←Q LRot0, L2 ← L2.0, DISPNI[OpTable], c3; {*******************************************************************} { Clock: PC ← PC + 1, L1 ← L1.Dec3, c1; uTOSH ← TOSH, Xbus ← ib{=1}, GOTO[Clock3], c2; } RCLK: L1 ← L1.DecOnly, c1, opcode[167'b]; {77} uTOSH ← TOSH, GOTO[Clock3], c2; Clock3: rhTT ← TOSH LRot0, c3; Map ← TT ← [rhTT, TOS], L0 ← L0.RedoClk, c1; PC ← PC + PC16, c2; Rx ← rhRx ← MD, XDirtyDisp, c3; at[L0.RedoClk,10,WMapFixCaller], Q ← uClockHigh, BRANCH[ClkMap,$,1], c1; TOSH ← RShift1 uClockBits, SE←0, c2; TT ← uClockLow, c3; MAR ← [rhRx, TOS+1], L2 ← L2.0, c1; MDR ← TOSH +TT, CANCELBR[$, 2], WriteOK, c2; Ybus ← TOSH +TT, CarryBr, c3; MAR ← [rhRx, TOS+0], BRANCH[ClkNoCar, ClkCar], c1; ClkNoCar: MDR ← Q, IBDisp, GOTO[reTosh], c2; ClkCar: MDR ← Q+1, IBDisp, GOTO[reTosh], c2; reTosh: TOSH ← uTOSH, L2 ← L2.0, DISPNI[OpTable], c3; ClkMap: CALL[WLMapFix]{will return at RedoClk}, c2; {*******************************************************************} {is this used? SClock: Noop, c1; uTOSH ← TOSH, c2; rhTT ← TOSH LRot0, c3; Map ← TT ← [rhTT, TOS], L0 ← L0.xRedoSClk, c1; PC ← PC + 1, L1 ← L1.DecDec, c2; Rx ← rhRx ← MD, XRefBr, c3; at[L0.xRedoSClk,10,RxMapFixCaller], MAR ← [rhRx, TOS+1], BRANCH[SClkMap,$], c1; Noop, CANCELBR[$, 2], c2; TT ← MD, L2 ← L2.0, c3; MAR ← [rhRx, TOS+0], c1; Noop, c2; Rx ← MD, c3; uClockHigh ← Rx, c1; uClockLow ← TT, IBDisp, L2 ← L2.0, c2; uClockBits ← 0, L2 ← L2.0, DISPNI[OpTable], c3; SClkMap: CANCELBR[RLxMapFix, 3]{will return at RedoSClk}, c2; is this used?} {***************************************************************************** BITBLT *****************************************************************************} {OLD: {CAUTION: there is a delicate sharing of .u+D by uTOS and UWidth; during faults UWidth is stored in TOS; at restart {BBpart} it is tested for nonZero and restorted}} {.u+2 thru .u+C must be preserved accross faults; in particular no bitBlt by fault handler} {TOS=0 if virgin BB call; else suspended with saved state on stack under TOS} {2 args one usually 0 in TOS; S points to ptr to BBtable} BITBLT: MAR ← [rhS, S+0], c1, opcode[166'b]; {UWidth}Ybus ← TOS, NZeroBr, c2; TOS ← MD, BRANCH[$, BBpart], c3; MAR ← S ← [rhS, S - 1], c1; S←S-1, CANCELBR[$, 2], c2; TOSH ← MD, c3; {S points to some stack entry that has nothing to do with BB} {BBInit vs BBInit1 differ on advacing PC} PC ← PC + 1{PC16}{1}{%?}{saveRegs does PC←PC-1}, c1; stackP ← 2, c2; Noop, c3; uPCCross ← TOSH xor ~TOSH,{uPCCross#uPCCrossL} c1; STK{UBitBltArg} ← TOS, pop, c2; rhMDS ← TOSH LRot0, GOTO[@BITBLT], c3; {@BITBLT returns directly to IBDispOnly; saves and restores L, G, PC} BBpart: {Q ← 166'b, GOTO[sink2], c1;} uPCCross ← TOSH xor ~TOSH,{uPCCross#uPCCrossL} c1; PC ← PC + 1{PC16}{1}{%?}{undone by saveRegs}, c2; stackP ← 0C{vestigial}, {GOTO[@BITBLT],} c3; {restore 12 uRegs from memory stack: u2 thru u0D } stackP ← 0D, c1; Rx ← 0C, c2; BBLp: Noop, c3; {Stack pointer points to full odd word } MAR ← S ← [rhS, S +0], c1; S ← S - 2, c2; TT ← MD, c3; Rx ← Rx - 1, ZeroBr, c1; STK ← TT, pop, BRANCH[BBLp, BBLpD], c2; BBLpD: stackP ← 0C{not vestigial}, GOTO[@BITBLT], c3; bbDummy: Noop, DISP4[ESC2n], c3; {@BITBLT returns to IBDispOnly normally or to SaveRegs if fault {or interrupt}} {interupts are temporarily disabled in BB} {S points to some stack entry that has nothing to do with BB} {if faulting save 12 uRegs to memory stack: u2 thru u0D } {then set TOSH,TOS to nonzero to indicate BB suspended (PFault saves TOS)} {at PFault TOS is nonzero and under that is saved regs } SaveRegs: {come here on pageFault}{{state held in stack (faults can't bitblt)}} rhTT ← uFaultParm1, c2; TT ← uFaultParm0, c3; {Stack pointer points to full odd word } {save 12 uRegs from memory stack: u2 thru u0D } stackP ← 02, c1; Rx ← 0C, c2; BBsLp: S{even empty} ← S{odd full} + 1, c3; MAR ← S ← [rhS, S +0], c1; MDR ← smallpl, c2; S ← S + 1, c3; MAR ← S ← [rhS, S +0], c1; MDR ← STK, push, c2; Noop, c3; Rx ← Rx - 1, ZeroBr, c1; BRANCH[BBsLp, BBsLpD], c2; BBsLpD: stackP ← 0C{not vestigial}, c3; BBFault: TOSH ← smallpl, c1; TOS ← 1{UWidth}{uTOS}, L1 ← L1.NoFixes{DecOnly?}, c2; stackP ← 0, GOTO[PFault], c3; {S points to some stack entry that has nothing to do with BB} {Normal BB returns undefined : set TOSH, TOS to any valid object (use smallpl)} {@BITBLT returns directly to IBDispOnly; saves and restores L{PV}, G{S}, PC} {stackP was set to zero by BB as we return here; any thing below .u+D is ok} IBDispOnly: {stackP ← 0} IBDisp, L2 ← L2.0, c2; TOSH ← smallpl, L2 ← L2.0, DISPNI[OpTable], c3; {***************************************************************************** MISC Input *****************************************************************************} MISC1: L2 ← L2.0, GOTO[Misc], c1, opcode[170'b]; MISC2: L2 ← L2.0, c1, opcode[171'b]; Misc: PC ← PC + 1, Xbus ← ib, XDisp, c2; uTOS ← TOS, DISP4[MiscDisp, 0C], c3; Misc0: Q ← 121'd, GOTO[sink2], c1, at[0C,10, MiscDisp];{MP9121} Misc3: Q ← 121'd, GOTO[sink2], c1, at[0F,10, MiscDisp];{MP9121} {***************************************************************************** INPUT Input *****************************************************************************} INPUT: Ybus ← TOS, YDisp, c1, at[0D,10, MiscDisp]; TOSH ← smallpl, IBDisp, DISP4[Inpt, 8], c2; Inpt: TOS ← EIData, L2 ← L2.0, DISPNI[OpTable], c3, at[8,10,Inpt]; TOS ← EStatus, L2 ← L2.0, DISPNI[OpTable], c3, at[9,10,Inpt]; TOS ← KIData, L2 ← L2.0, DISPNI[OpTable], c3, at[0A,10,Inpt]; TOS ← KStatus, L2 ← L2.0, DISPNI[OpTable], c3, at[0B,10,Inpt]; Q ← 120'd, GOTO[sink1], c3, at[0C,10,Inpt];{MP9120} TOS ← MStatus, L2 ← L2.0, DISPNI[OpTable], c3, at[0D,10,Inpt]; TOS ← KTest, L2 ← L2.0, DISPNI[OpTable], c3, at[0E,10,Inpt]; TOS ← PPort, L2 ← L2.0, DISPNI[OpTable], c3, at[0F,10,Inpt]; {***************************************************************************** OUTPUT Output *****************************************************************************} OUTPUT: MAR ← S ← [rhS, S + 0], Xbus ← uTOS, XDisp, c1, at[0E,10, MiscDisp]; S ← S - 2, DISP4[Outpt], c2; Outpt: IOPOData ← MD, GOTO[OutEnd], c3, at[0,10,Outpt]; IOPCtl ← MD, GOTO[OutEnd], c3, at[1,10,Outpt]; KOData ← MD, GOTO[OutEnd], c3, at[2,10,Outpt]; KCtl ← MD, GOTO[OutEnd], c3, at[3,10,Outpt]; EOData ← MD, GOTO[OutEnd], c3, at[4,10,Outpt]; EICtl ← MD, GOTO[OutEnd], c3, at[5,10,Outpt]; DCtl ← MD, GOTO[OutEnd], c3, at[6,10,Outpt]; TT ← MD, GOTO[OutSetBBTime], c3, at[7,10,Outpt]; TT ← MD, GOTO[OutSetOpt], c3, at[8,10,Outpt]; PCtl ← MD, GOTO[OutEnd], c3, at[9,10,Outpt]; TT ← MD, GOTO[OutMCtl], c3, at[0A,10,Outpt]; Q ← 120'd, GOTO[sink1], c3, at[0B,10,Outpt];{MP9120} EOCtl ← MD, GOTO[OutEnd], c3, at[0C,10,Outpt]; KCmd ← MD, GOTO[OutEnd], c3, at[0D,10,Outpt]; TT ← MD, GOTO[OutPPort], c3, at[0E,10,Outpt]; POData ← MD, GOTO[OutEnd], c3, at[0F,10,Outpt]; OutSetBBTime: uBBTime ← TT, GOTO[IB.nop], c1; OutEnd: Noop, GOTO[IB.nop], c1; OutPPort: PPort ← TT, GOTO[IB.nop], c1; OutSetOpt: uLispOptions ← TT, GOTO[IB.nop], c1; OutMCtl: MCtl ← TT, GOTO[IB.nop], c1; IB.nop: L2 ← L2.0, IBDisp, GOTO[DNI.nop], c2; {******************************************************************* 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], CANCELBR[$, 07], L1 ← L1.PopOnly, c1, at[L3.FVAR,10, fvCaller]; TOS ← uTOS, L0 ← L0.xRedoFV0, c2; Rx ← rhRx ← MD, XRefBr, c3; {(V) fetch bound val} RedoFV0: MAR ← [rhRx, TT + 1], BRANCH[fvMap0, $], c1, at[L0.xRedoFV0,10, RxMapFixCaller]; [] ← S xor uStkLimO, ZeroBranch, CANCELBR[$,2], c2; TOS ← MD, BRANCH[$, StkOvr2], L2Disp, c3; {Var4:} MAR ← [rhRx, TT + 0], BRANCH[fvPC1, fvPC2, 2], c1; fvPC1: PC ← PC + PC16, IBDisp, GOTO[fvEnd], L2 ← L2.0, c2; fvPC2: PC ← PC + 1, IBDisp, GOTO[fvEnd], L2 ← L2.0, c2; fvEnd: TOSH ← MD, L2 ← L2.0, DISPNI[OpTable], c3; StkOvr2: MAR ← [rhRx, TT + 0], BRANCH[fvPC1ov, fvPC2ov, 2], c1; fvPC1ov: PC ← PC + PC16, GOTO[fvEndov], L2 ← L2.0, c2; fvPC2ov: PC ← PC + 1, GOTO[fvEndov], L2 ← L2.0, c2; fvEndov: TOSH ← MD, GOTO[StackOverflow], c3; FVunfilled: TT ← UvCL, L3 ← L3.FVAR, CANCELBR[$,2], c2; rhTT ← UvChighL, CALL[FVLookUp], c3; fvMap0: TOSH ← uTOSH, CANCELBR[RLxMapFix, 3]{will return to RedoFV0}, c2; {******************************************************************* FREE VAR LOOKUP ? % ? clicks *******************************************************************} { look up variable in current frame; fill in binding pointer (chaining not implemented) on Entry: c1 uTOS restored to TOS if fault uTOSH restored to TOSH if fault PV current frame (point to PV region) Q {uChain} (odd) stack pointer to variable to be looked up (Pv + ib + 1) rhTT, TT virtual address of name table (usually function header) L3 caller's return link at[L3, 10, fvCaller] uses during subroutine: rhRx, Rx real address of name table PV frame extension pointers (point to PV region)(travel up alinks) uPV save local PV TOS used uChain TOSH{chain} rhTOSH nRhS {set once at odd time; must be left}{*} used with TOSH{chain} uName TOSH{name} ← [UvCL + T/2 {- UvCL.nlocals} + UvCL.fvaroffset] ntSize, offset, L0, L1 on Return: c1 preserves S, PV, PC, L2, uTOS, uTOSH smashes TOS, TOSH {but preserved in uTOS, uTOSH} rhTT, TT virtual address of free value @(chain) filled in binding pointer L1 binding type{fvStack, fvGlobal, fvUnbound} Dispatch pending on Fault: S ← S - 2, TOS ← uTOS, TOSH ← uTOSH } FVLookUp: {map header} Map ← [rhTT, TT], L0 ← L0.xRedoFV, c1; TOS{name} ← RShift1 (Q{chain} - PV - 1), SE←0, c2; Rx ← rhRx ← MD, XRefBr, c3; fvOff: {fvoffset from fn header} MAR ← [rhRx, TT + 7{fnh.nlfv}], BRANCH[fvMap, $], c1, at[L0.xRedoFV,10, RxMapFixCaller]; TT ← TT + TOS{name}, {PgCarryBr ok *} {BRANCH[$, FVLUfix1, 1],}CANCELBR[$, 2], c2; FVLUret1: 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{too late?%}, 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} Map ← [rhTT, TT], L0 ← L0.xRedoFVN, c1; TOS{mask} ← ~3, L1 ← L1.fixFV{maybe smashed}, c2; Rx ← rhRx ← MD, XRefBr, c3; {fvN: ntSize}{#this click could be eliminated possibly by testing for zero (vs ntSize)} RedoFVN: MAR ← Q ← [rhRx, TT + 6], BRANCH[fvMapN, $], c1, at[L0.xRedoFVN,10, RxMapFixCaller]; Rx ← Q + 2, CANCELBR[$, 2], c2; TOS{cnt} ← TOS{mask} and MD{ntSize}, GOTO[lookFor], c3; lookFor: {match?} MAR ← Rx ← [rhRx, Rx + 0], c1; Q{ntSize-1} ← TOS{cnt} - 1, {*}rhTOSH ← nRhS, GOTO[matJoin], c2; matLp: MAR ← Rx ← [rhRx, Rx + 0], c1, at[6, 10, Mat]; Ybus ← TOS{cnt} - 1, NegBr, c2; matJoin: TT ← TOSH{name} xor MD, BRANCH[$, newFrame], c3; {fvM1: match?} MAR ← Rx ← [rhRx, Rx + 1], L0 ← 0, c1; TT ← TT, ZeroBr, CANCELBR[$, 2], c2; TT ← TOSH{name} xor MD, BRANCH[$, Val0], c3; fvM2: {match?} MAR ← Rx ← [rhRx, Rx + 1], L0 ← 2, c1, at[0, 10, Mat]; TT ← TT, ZeroBr, CANCELBR[$, 2], c2; TT ← TOSH{name} xor MD, BRANCH[$, Val1], c3; {fvM3: match?} MAR ← Rx ← [rhRx, Rx + 1], L0 ← 4, c1, at[2, 10, Mat]; TT ← TT, ZeroBr, CANCELBR[$, 2], c2; TT ← TOSH{name} xor MD, BRANCH[$, Val2], c3; {fvM4: done?} Rx ← Rx + 1, c1, at[4, 10, Mat]; TT ← TT, ZeroBr, L0 ← 6, c2; TOS{cnt} ← TOS - 4, BRANCH[matLp, Val3], c3; {value; fvfound} {preserve Rx{realNames}, TOS{cnt}, TOSH{name}, Q{ntSize-1}} Val0: MAR ← [rhRx, Rx + Q{ntSize-1}], GOTO[Vtail], c1; Val1: MAR ← [rhRx, Rx + Q], GOTO[Vtail], c1; Val2: MAR ← [rhRx, Rx + Q], GOTO[Vtail], c1; Val3: MAR ← [rhRx, Rx + Q], GOTO[Vtail], c1; Vtail: rhTT ← STACKspace, CANCELBR[$, 2], c2; 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{TOSH{chain} ← uChain}, 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; {***********************} {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} + 0], BRANCH[fvRet2, $, 0E], c1; MDR ← TT ← TT + TOS{offset}, CANCELBR[donefv3, 2], WriteOK, c2; fvRet2: L3Disp, GOTO[fvRet3], 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[$, 2], WriteOK, c2; donefv3: Noop, c3; fvRet: {donefvlookup}{double up bindptr high} Q ← rhTT, c1; Rx ← Q, c2; Rx{rhTT LRot8} ← Rx LRot8, c3; MAR ← [rhTOSH, TOSH{chain} + 0], c1; MDR ← rhTT or Rx{rhTT LRot8}, L3Disp, c2; fvRet3: PV ← uPV, L1Disp, RET[fvCaller],{restore PV} c3; {********************** exceptions: ***********************} {trial faster inner loop?} { MAR ← [rhB, A], B ← Q, ZeroBr, c1;} { Ybus ← name xor Q, ZeroBr, BRANCH[$, done], c2;} { Q ← MD, BRANCH[$, match], c3;} {exceptions:} fvMap: uPV ← PV, CANCELBR[RLxMapFix, 3], L1 ← L1.fixFV,{return to RedoFV}, c2; fvMapN: CANCELBR[RLxMapFix, 3], L1 ← L1.fixFV,{return to RedoFVN} c2; fvFCross: PV ← PV - 0FF -1, CANCELBR[$, 1], c3; MAR ← PV ← [rhPV, PV + 0], GOTO[fvF2], c1; fvACross: PV ← PV - 0FF -1, c3; MAR ← PV ← [rhPV, PV + 0], GOTO[fvA2], c1; fvHCross: PV ← PV + 0FF + 1, CANCELBR[$, 0F], c3; MAR ← PV ← [rhPV, PV + 0], GOTO[fvH2], c1; fvFPCross: PV ← PV + 0FF + 1, CANCELBR[$, 0F], c3; MAR ← PV ← [rhPV, PV + 0], GOTO[fvFP2], c1; fvFix: TOSH ← uTOSH, L3Disp, c1, at[L1.fixFV,10,Fix]; TOS ← uTOS, DISP4[fvfixup], c2; PV ← uPV,{ GOTO[popFix],} c3,at[L3.FVAR,10,fvfixup]; S ← S - 2, GOTO[NoMoreFix], c1; PV ← uPV, GOTO[NoFixes], c3, at[L3.FVARg,10,fvfixup]; {******************************* FVAR← 4 clicks ?% *******************************} FVARg: opcode[143'b], MAR ← Q ← [rhPV, PV + ibNA + 1], L3 ← L3.FVARg, c1{, opcode[143'b]};{63} 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: TT ← TOS + ib, CarryBr, L1 ← L1.Dec3, c1, opcode[312'b];{CA} rhTT ← TOSH LRot0, BRANCH[$, GBrhnok], c2; GBcont: PC ← 1 + PC + PC16, c3; Map ← [rhTT,TT], L0 ← L0.xRedoGF, c1; Q{fd.pos} ← ibHigh{fd.pos}, L2 ← L2.0, c2; Rx ← rhRx ← MD, XRefBr, c3; RedoGF: MAR ← [rhRx, TT + 0], BRANCH[GFMap,$], c1, at[L0.xRedoGF,10, RxMapFixCaller]; Rx ← Q{fd.pos} + ib{fd.size} + 1, rhRx ← ib{fd.size}, c2; Rx ← MD{data}, Ybus ← Rx{shift}, YDisp, L2 ← L2.GFRet, c3; TT ← LRot1 Rx, DISP4[CycleMask], c1; {CycleMask Subroutine Here} GFRet: TOS ← TOS and TT, IBDisp, L2 ← L2.0, 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: MAR ← [rhS, S + 0], L1 ← L1.fixWF, c1, opcode[317'b];{CF} 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, 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, GOTO[joinWF], c2, at[L2.WFRet, 10, MaskRet]; RedoWF3: Ybus{pos+size} ← ib{size} - TOSH{-pos-1} - 1, YDisp, GOTO[joinWF], c2, at[L2.WFRetOdd, 10, MaskRet]; joinWF: 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; WFMap: uTT ← TT, TT ← Q, CALL[WLMapFix], {will return to RedoWF} c2, at[L2.WFRetMap, 10, MaskRet]; WFMapOdd: uTT ← TT, TT ← Q, CALL[WLMapFix], {will return to RedoWF} c2, at[L2.WFRetMapOdd, 10, MaskRet]; RedoWF: TT ← uTT, BRANCH[RedoWF2, RedoWF3], c1, at[L0.RedoWF,10, WMapFixCaller]; ufnWF: Rx ← 317'b, GOTO[ufn2incS] 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: uPCib ← PC, Rx{n1,n2} ← ib, ZeroBr, L2←L2.0, c1, opcode[21'b]; 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, CANCELBR[$, 2], WriteOK, 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[$, 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: MAR ← [rhS, S - 1], L3 ← 2, GOTO[nomark], c1, opcode[22'b]; 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 }