*----------------------------------------------------------- Title[CedarOps.mc...May 11, 1984 4:14 PM...Willie-Sue]; * Cedar Allocator and Reference-Counting opcodes (version 5.0) *----------------------------------------------------------- * General notes: * 1. These opcodes as presently implemented are NOT restartable in the * face of write-protect faults. * 2. zct.wp is cached and is not stored in memory except when the microcode * is disabled. *----------------------------------------------------------- * Data structures -- from Allocator.mesa, ZCT.mesa, and Collector.mesa *----------------------------------------------------------- MC[microcodeVersion, 4]; * for Cedar 5.2 release * -- Header preceding allocated normal Cedar reference-counted objects. * -- 2 words long, and always even-word aligned. * NHeaderP: TYPE = LONG POINTER TO NormalHeader; * NormalHeader: TYPE = MACHINE DEPENDENT RECORD [ MSC[NH.rcWord, 0]; MC[NHR.inZCT, 100000]; * inZCT (0: 0..0): BOOLEAN, -- must be bit 0 MC[NHR.maybeOnStack, 40000]; * maybeOnStack (0: 1..1): BOOLEAN, -- must be bit 1 MC[NHR.blockSizeIndex, 37400]; * blockSizeIndex (0: 2..7): BlockSizeIndex, MC[NHR.finalizable, 200]; * finalizable (0: 8..8): BOOLEAN, MC[NHR.refCount, 176]; * refCount (0: 9..14): RefCount, MC[NHR.rcOverflowed, 1]; * rcOverflowed (0: 15..15): BOOLEAN, -- must be bit 15 MSC[NH.type, 1]; * -- type: SafeStorage.Type]; * Note: for compatibility with Cedar 4, the actual definition is: * typePad: (1: 0..1): [0..3] ← 0, MC[NHT.type, 37777]; * type (1: 2..15): SafeStorage.Type]; MC[sizeNH, 2]; * must be 2 * RefCount: TYPE = [0..77B]; * Microcode requires max value less than 200B MC[nullType, 0]; * nullType: SafeStorage.Type = [0]; -- must be zero * -- Header for free normal Cedar objects (the only kind this allocator deals with). * -- Following is a simplification of the variant record declaration in Allocator.mesa. * FNHeaderP: TYPE = LONG POINTER TO NormalFreeHeader; * NormalFreeHeader: TYPE = MACHINE DEPENDENT RECORD [ * * fnh (0): NormalHeader, MC[NFH.nextFree, 2]; * nextFree (2): FNHeaderP]; * Data structures (cont'd) * ZeroCountTable: TYPE = LONG POINTER TO ZCTObject; * ZCTObject: TYPE = MACHINE DEPENDENT RECORD [ MSC[ZCT.wp, 0]; * wp (0): LONG POINTER TO Allocator.NHeaderP, * rp (2): LONG POINTER TO Allocator.NHeaderP, * lastNP (4): LONG POINTER TO LONG POINTER, * pad (6: 0..14): [0..77777B], MSC[ZCT.markingDecrements, 6]; * markingDecrements (6: 15..15): BOOLEAN, MSC[ZCT.residueMask, 7]; * residueMask (7: 15..15): WORD, * unused1 (10B): ARRAY [10B..wordsPerPage) OF WORD, MC[ZCT.bsiToFreeList, 400]; * bsiToFreeList (wpp): BSIToFreeListObj, * unused2 (wpp+SIZE[BSIToFreeListObj]): ARRAY * [wpp+SIZE[BSIToFreeListObj]..2*wpp) OF WORD, MC[ZCT.bsiToSize, 1000]; * bsiToSize (2*wpp): BSIToSizeObj, * unused3 (2*wpp+SIZE[BSIToSizeObj]): ARRAY * [2*wpp+SIZE[BSIToSizeObj]..3*wpp) OF WORD, MC[ZCT.sizeToBSI, 1400]; * sizeToBSI (3*wpp): SizeToBSIObj, * unused4 (3*wpp+SIZE[SizeToBSIObj]): ARRAY * [3*wpp+SIZE[SizeToBSIObj]..5*wpp) OF WORD, MC[ZCT.fosTable, 2400]; * fosTable (5*wpp): FOSTableObject]; * wpp: CARDINAL = PrincOps.wordsPerPage; MC[zctBlockWords, 4000]; * zctBlockWords: INT = 8 * PrincOps.wordsPerPage; * SizeToBSIObj: TYPE = PACKED ARRAY [0..maxSmallBlockSize] OF BlockSizeIndex; * BSIToSizeObj: TYPE = ARRAY BlockSizeIndex OF CARDINAL; * BSIToFreeListObj: TYPE = ARRAY BlockSizeIndex OF FNHeaderP; MC[maxSmallBlockSize, 1076]; * maxSmallBlockSize: CARDINAL = 1076B; MC[maxBSI, 77]; * BlockSizeIndex: TYPE = [0..77B]; MC[bsiEscape, maxBSI]; * bsiEscape: BlockSizeIndex = LAST[BlockSizeIndex]; * -- Note: sizes do not include NormalHeader overhead (2 words) * FOSTableObject: TYPE = ARRAY FOSTableIndex OF FOSTableResidue; * FOSTableIndex: TYPE = [0..FOSTableLength); * FOSTableResidue: TYPE = CARDINAL; * -- except for fosWildCard and fosEmpty, FOSTableResidues will be in [0..3777B] * -- with a 24-bit virtual address and in [0..77777B] with a 28-bit VA. * MC[fosWildCard, 177777]; * fosWildCard: FOSTableResidue = 177777B; -- must be -1 MC[fosEmpty, 100000]; * fosEmpty: FOSTableResidue = 100000B; MC[FOSTableLength, 10000]; * FOSTableLength: CARDINAL = 10000B; *----------------------------------------------------------- * Trap parameter values -- from RCMicrocodeImpl.mesa *----------------------------------------------------------- MC[tpUnImplemented, 0]; MC[tpRCOverflowOccurred, 1]; MC[tpUCDisabled, 2]; MC[tpRCUnderflowOccurred, 3]; MC[tpZCTFull, 4]; MC[tpRCBug, 5]; MC[tpLookFurtherAtReclaimedRef, 6]; MC[tpNormalFreeListEmpty, 6]; *----------------------------------------------------------- * R registers *----------------------------------------------------------- Set[!RCRegs, !Region15]; * RMRegion[RCRegs] -- move to RegisterDefs someday SetRMRegion[RCRegs]; RVN[RCFlags]; * B0=1 => microcode enabled, 0 disabled * B15 = copy of zct.markingDecrements RVN[WPOffset]; * Write pointer, relative to WPBR RVN[RCWord]; * Contents of RC word at nhp↑ RV[ZCTBlockLink, Sub[zctBlockWords!, 2]]; * Offset of link cell in ZCTBlock RVN[RCTemp0]; RVN[RCTemp1]; RVN[RCTemp2]; RVN[RCTemp3]; RVN[RCresidue]; RVN[RCResMask]; * holds the Residue Mask from zct *----------------------------------------------------------- * Base registers -- move these to ADefs someday *----------------------------------------------------------- * Following 2 registers are an even/odd pair BR[ZCTBR, 6]; * pointer to ZCT BR[WPBR, 7]; * cached version of ZCT.wp * Following 2 registers are an even/odd pair and are IFU-addressable * BR[LPtr, 34]; * Defined in DMesaDefs BR[BR35, 35]; TopLevel; *----------------------------------------------------------- AllocateM: MiscTable[145], * Timing: 40 cycles normal, 46 max (+ MISC dispatch) *----------------------------------------------------------- * type: SafeStorage.Type = Pop[]; * size: CARDINAL = Pop[]; * IF ucDisabled THEN OpcodeTrap[tpUCDisabled]; RBase← RBase[RCRegs], StkP-2; MemBase← ZCTBR, RCFlags, Branch[RCDisabledTrap3, R>=0]; * IF size>maxSmallBlockSize THEN {PushLong[NIL]; RETURN}; T← HighByte[maxSmallBlockSize]; T← T OR (LowByte[maxSmallBlockSize]); PD← (Stack)-T-1; T← (Stack) RSH 1, * T← size/2 Branch[.+2, Carry']; T← Stack&+1← A0, Branch[PushT]; * bsi: BlockSizeIndex = zct.sizeToBSI[size]; * fnhp: FNHeaderP = zct.bsiToFreeList[bsi]; * nhp: NHeaderP = @fnhp.fnh; -- no-op (just a type conversion) * IF fnhp=NIL THEN OpcodeTrap[tpNormalFreeListEmpty]; T← T+(ZCT.sizeToBSI); * Fetch[@zct.sizeToBSI[size]]↑ Fetch← T, RCTemp2← RShift[ZCT.bsiToFreeList!, 1]C; T← MD, Stack&+1, Branch[.+2, R odd]; T← RSH[T, 10], Branch[.+2]; * Extract left (even) byte T← T AND (377C); * Extract right (odd) byte RCTemp2← ((RCTemp2)+T) LSH 1; * Index into double-word array T← (Fetch← RCTemp2)+1; * Fetch[@zct.bsiToFreeList[bsi]]↑ T← MD, Fetch← T; RCTemp0← T, MemBase← LPtr; RCTemp1← MD, PD← (BRLo← T) OR (MD); T← A0, BRHi← RCTemp1, Branch[NormalFreeListEmptyTrap, ALU=0]; * -- touch fnhp.nextFree to ensure it won't fault later * OnZ[nhp]; * nhp.maybeOnStack ← zct.markingDecrements; * nhp.type ← type; * Note that nhp is in RCTemp1,,RCTemp0 at this point. Fetch← T, T← NFH.nextFree; * Fetch RCword at nhp↑ RCWord← RCFlags; * nhp.maybeOnStack ← zct.markingDecrements RCWord← DPF[RCWord, 1, MaskPos[NHR.maybeOnStack!], MD]; Fetch← T, * Touch fnhp.nextFree before calling OnZCT T← RCTemp0, Call[OnZCT]; * Put on ZCT; update RCWord and return T=0 * No page faults are possible after here. T← (Store← T)+1, DBuf← RCWord; * Store updated RCWord at nhp↑ T← (Store← T)+1, DBuf← Stack&-1, * Store type at nhp.type Call[FetchGetsT]; * Fetch fnhp.nextFree * zct.bsiToFreeList[bsi] ← fnhp.nextFree; * fnhp.nextFree ← NIL; T← (Store← T)+1, DBuf← 0C, RCTemp3← MD, Call[FetchGetsT]; Store← T, DBuf← 0C; T← RCTemp3, MemBase← ZCTBR; RCTemp2← (Store← RCTemp2)+1, DBuf← T, T← MD; * Store[@zct.bsiToFreeList[bsi]] Store← RCTemp2, DBuf← T; * PushLong[NHPToRef[nhp]]; T← (RCTemp0)+(sizeNH); Stack&+1← T; T← A← RCTemp1, XorSavedCarry, Branch[PushT]; *----------------------------------------------------------- FreeM: MiscTable[146], * Timing: 23 + 1.25 * object size in words (+ MISC dispatch) *----------------------------------------------------------- * nhp: NHeaderP = PopLong[]; * IF ucDisabled THEN OpcodeTrap[tpUCDisabled]; RBase← RBase[RCRegs], StkP-2, Call[TrapIfRCDisabled]; * Sets MemBase← LPtr and loads BRHi T← A0, BRLo← Stack; * bsi: BlockSizeIndex = nhp.blockSizeIndex; * IF bsi=bsiEscape THEN {Push[FALSE]; RETURN}; * fnhp: FNHeaderP = LOOPHOLE[nhp]; -- no-op (just a type conversion) Fetch← T; * Fetch[@nhp.rcWord]↑ T← MD, MemBase← ZCTBR; RCTemp0← LDF[T, MaskSize[NHR.blockSizeIndex!], MaskPos[NHR.blockSizeIndex!]]; PD← (RCTemp0)#(bsiEscape); T← (RCTemp0)+(ZCT.bsiToSize), Branch[.+2, ALU#0]; Stack← A0, IFUNext0; * Just return FALSE * Zero[nhp+SIZE[NormalHeader], zct.bsiToSize[bsi]-SIZE[NormalHeader]]; Fetch← T, * Fetch[@zct.bsiToSize[bsi]]↑ RCTemp3← Add[sizeNH!, 40]C; RCTemp2← ID, T← MD, MemBase← LPtr; * RCTemp2← sizeNH RCTemp1← T-(sizeNH)-1; * On first iteration, do ((count-1) mod 20B)+1 words; * on subsequent iterations, do 20B words. * RCTemp1 = (remaining count)-1; RCTemp2 = current displacement; * RCTemp3 = current displacement + 40B (for PreFetches); * Carry=0 iff count is exhausted. FreeZMunch: T← (RCTemp1) AND (17C), * T ← (# words to do this iteration)-1 Branch[FreeZDone, Carry']; RCTemp3← PreFetch← RCTemp3, Carry20, * PreFetch 40B words ahead Branch[.+2, Reschedule']; StkP+1, Branch[MesaReschedTrap]; Cnt← T; RCTemp2← (Store← RCTemp2)+1, DBuf← 0C, Branch[., Cnt#0&-1]; RCTemp1← (RCTemp1)-T-1, Branch[FreeZMunch]; * Update count * No page faults are possible after here. * fnhp.fnh.type ← nullType; * fnhp.nextFree ← zct.bsiToFreeList[bsi]; * zct.bsiToFreeList[bsi] ← fnhp; * Push[TRUE]; FreeZDone: T← (RCTemp0)+(RCTemp0), MemBase← ZCTBR; * Indexing into double-word array T← T+(ZCT.bsiToFreeList), Call[FetchGetsT]; * Fetch[@zct.bsiToFreeList[bsi]]↑ -- low half RCTemp0← MD, T← (Store← T)+1, DBuf← Stack&+1, * Store[@zct.bsiToFreeList[bsi]]↑ ← fnhp Call[FetchGetsT]; * Same for high half RCTemp1← MD, Store← T, DBuf← Stack&-1, T← A0; Stack← T+1, MemBase← LPtr; * Stack← 1 (= TRUE) T← (Store← NH.type)+1, DBuf← T; * nhp.type ← nullType T← (Store← T)+1, DBuf← RCTemp0; * fnhp.nextFree ← ptr fetched from bsiToFreeList Store← T, DBuf← RCTemp1, IFUNext0; *----------------------------------------------------------- IFUR[ASSIGNREF, 2, L]; IFUR[ASSIGNREFNEW, 2, L]; * Timings: lhs↑ rhs min max (assuming no trap) * =NIL =NIL 11 11 * #NIL =NIL 27 43 * =NIL #NIL 25 25 * #NIL #NIL 31 47 (except 11 if lhs↑=rhs) *----------------------------------------------------------- * RCTemp0, RCTemp1: lnhp (= lhs-SIZE[NormalHeader]), arg to OnZCT * RCTemp2: (updated) header word at rnhp↑ * RCTemp3: alpha byte of opcode * RCWord: (updated) header word at lnhp↑ * ScratchBR: lhs * LPtr: lnhp * BR35: rnhp * Cnt is used as a flag: Cnt=0 means rhs=NIL. * lhs: LONG POINTER TO REF = PopLong[]+GetCodeByte[]; * rhs: REF = PopLong[]; * rrc: RefCount; * IF ucDisabled THEN OpcodeTrap[tpUCDisabled]; RBase← RBase[RCRegs]; PD← RCFlags, MemBase← ScratchBR, Branch[RCDisabledTrap1, R>=0]; * IF lhs↑=rhs THEN RETURN; * Overlapped with this test, load lhs into BR35 and save away lhs↑ in * RCTemp1,,RCTemp0. Also save the alpha byte in RCTemp3. BRHi← Stack&-1; BRLo← Stack&-2; T← (Fetch← ID)+1; * Fetch[lhs+alpha]↑ RCTemp3← (Fetch← T)-1, T← MD; PD← (Stack&+1)#T, Cnt← 1S; RCTemp0← T, MemBase← BR35, Branch[.+2, ALU#0]; PD← (BRHi← Stack&-1)#MD, Branch[.+2]; * Low halves equal, compare high * IF rhs#NIL THEN { * rnhp: NHeaderP = LOOPHOLE[rhs - SIZE[NormalHeader]]; * rrc ← rnhp.refCount; * IF rrc = LAST[RefCount] THEN OpcodeTrap[tpRCOverflowOccurred]}; PD← (BRHi← Stack&-1)-(Stack&-1)-1; T← (Stack&+1)-(sizeNH), * Convert REF to NHeaderP Branch[.+2, ALU#0]; * Complete ref equal test StkP-2, IFUNext0; * Equal, nothing to do T← Stack&-1, BRLo← T, Branch[.+3, Carry]; RCTemp1← MD, T← T-1, Branch[RHSNIL, ALU=0]; BRHi← T; RCTemp1← MD, Fetch← 0S; * Fetch[rnhp]↑ RCTemp2← LShift[1, MaskPos[NHR.refCount!]]C; RCTemp2← (RCTemp2)+MD, MemBase← LPtr; * Add 1 to ref count and see if it wraps PD← (RCTemp2) AND (NHR.refCount); RCTemp2← (RCTemp2) AND NOT (NHR.maybeOnStack), * Prepare for later update to rnhp↑ DblBranch[RCOverflowTrap, CheckLHS, ALU=0]; * ASSIGNREF (cont'd) * IF lhs↑#NIL THEN { * lnhp: NHeaderP = LOOPHOLE[lhs - SIZE[NormalHeader]]; * lrc: RefCount ← lnhp.refCount; * CheckForRCUnderflow[lnhp]; * IF lrc=1 AND ~nhp.rcOverflowed THEN OnZ[lnhp]; * lnhp.maybeOnStack ← zct.markingDecrements; * lnhp.refCount ← lrc-1}; RHSNIL: MemBase← LPtr; * This branch always goes to .+2 and is executed solely for its side-effect * of setting Cnt← 0. BRHi← RCTemp1, DblBranch[.+2, .+3, Cnt#0&-1]; * RCTemp2 remembers new value for RCWord at rnhp↑ if non-NIL (Cnt=0 if rhs=NIL); * Current MemBase = LPtr. lhs↑ was already fetched and saved in RCTemp1,,RCTemp0. CheckLHS: BRHi← RCTemp1; RCTemp0← T← (RCTemp0)-(sizeNH); * Convert REF to NHeaderP in RCTemp1,,RCTemp0 PD← RCTemp1, BRLo← T, Branch[.+3, Carry]; RCTemp1← (RCTemp1)-1, Branch[LHSNIL, ALU=0]; BRHi← RCTemp1; Fetch← 0S, T← RCFlags; * Fetch[lnhp]↑ RCWord← DPF[T, 1, MaskPos[NHR.maybeOnStack!], MD], * nhp.maybeOnStack ← zct.markingDecrements Call[CheckForRCUnderflow]; * Returns with ALU = decremented refCount T← A0, Branch[.+3, ALU#0]; * Branch if refCount not zero T← RCTemp0, Call[OnZCT]; * Put lnhp in ZCT and update flags in RCWord T← A0, branch[.+3]; branch[.+3, R Even], RCFlags; * test for markingDecrements T← RCTemp0, Call[OnZCT]; T← A0; nop; * placement Store← T, DBuf← RCWord, * Store[lnhp]↑ FlipMemBase, * MemBase← BR35 DblBranch[DoRCAssign, UpdateRHS, Cnt=0&-1]; * IF rhs#NIL THEN { * rnhp.refCount ← rrc+1; * rnhp.maybeOnStack ← FALSE}; * RCTemp2 contains rnhp↑ with refCount and maybeOnStack already updated. LHSNIL: MemBase← BR35, Branch[.+2, Cnt=0&-1]; * Skip if rhs=NIL UpdateRHS: Store← 0S, DBuf← RCTemp2; * lhs↑ ← rhs; DoRCAssign: T← RCTemp3, MemBase← ScratchBR; * Get back alpha T← (Store← T)+1, DBuf← Stack&+1; * Store low part of rhs Store← T, DBuf← Stack&-2, IFUNext0; * Store high part of rhs *----------------------------------------------------------- CreateRefM: MiscTable[143], * Timing: 15 cycles normal, 22 max (+ MISC dispatch) *----------------------------------------------------------- * nhp: NHeaderP = PopLong[]; * IF ucDisabled THEN OpcodeTrap[tpUCDisabled]; * nhp.maybeOnStack ← zct.markingDecrements; * OnZ[nhp]; RBase← RBase[RCRegs], StkP-2, Call[TrapIfRCDisabled]; * Sets MemBase← LPtr and loads BRHi T← BRLo← Stack&-1; Fetch← 0S, RCTemp0← T; * Fetch RCword T← RCFlags; RCWord← DPF[T, 1, MaskPos[NHR.maybeOnStack!], MD]; * nhp.maybeOnStack ← zct.markingDecrements T← RCTemp0, Call[OnZCT]; Store← 0S, DBuf← RCWord, IFUNext0; *----------------------------------------------------------- GetCanonicalReferentTypeM: MiscTable[72], * This implementation is compatible with both Cedar 4 and Cedar 5. * Timing: 5 cycles (+ MISC dispatch) *----------------------------------------------------------- * ref: REF = PopLong[]; * IF ref=NIL THEN {Push[nullType]; RETURN}; * nhp: NHeaderP = LOOPHOLE[ref - SIZE[NormalHeader]]; * Push[nhp.type]; StkP-2, MemBase← LPtr; PD← (BRLo← Stack) OR T; T← (BRHi← T)-T-1, Branch[.+2, ALU#0]; Stack← A0, IFUNext0; LongFetch← T, B← T, T← A0; * Fetch[@nhp.type]↑ -- know @nhp.type = ref-1 * For Cedar 4 compatibility, must mask off some high-order bits. Stack← DPF[T, Sub[20, MaskSize[NHT.type!]], MaskSize[NHT.type!], MD], IFUNext0; *----------------------------------------------------------- ReclaimableRefM: MiscTable[144], * Timing: 10 cycles min, 36 max (+ MISC dispatch) *----------------------------------------------------------- * nhp: NHeaderP = PopLong[]; * IF ucDisabled THEN OpcodeTrap[tpUCDisabled]; * Push[CheckReclaimable[nhp, FALSE]]; RBase← RBase[RCRegs], StkP-2, Call[TrapIfRCDisabled]; * Sets MemBase← LPtr and loads BRHi T← BRLo← Stack; Nop; * Placement Fetch← 0S, RCTemp0← T; * Fetch RCword RCWord← MD, * This may be updated by CheckReclaimable SCall[CheckReclaimable]; * Returns disposition in T Store← 0S, DBuf← RCWord; * +1: need to store RCWord back into nhp↑ Stack← T, IFUNext0; * +2: don't need to store; just return disposition *----------------------------------------------------------- ReclaimedRefM: MiscTable[140], * Timing: 16 cycles min, 43 max (+ MISC dispatch) *----------------------------------------------------------- * ref: REF = PopLong[]; * ans: REF; * IF ucDisabled THEN OpcodeTrap[tpUCDisabled]; * nhp: NHeaderP = LOOPHOLE[ref - SIZE[NormalHeader]]; * CheckForRCUnderflow[nhp]; RBase← RBase[RCRegs], StkP-2, Call[TrapIfRCDisabled]; * Sets MemBase← LPtr and loads BRHi T← (Stack)-(sizeNH); * Convert REF to NHeaderP RCTemp0← A0, BRLo← T, Branch[.+3, Carry]; RCTemp1← (RCTemp1)-1; * Had to borrow from high part BRHi← RCTemp1; Fetch← RCTemp0, RCTemp0← T; * Fetch rcWord RCWord← MD, Call[CheckForRCUnderflow]; * Decrements refCount * SELECT CheckReclaimable[nhp, TRUE] FROM * continue => ans ← NIL; * reclaimIt => ans ← ref; * finalizeIt => OpcodeTrap[tpLookFurtherAtReclaimedRef]; * ENDCASE; * nhp.refCount ← nhp.refCount-1; * PushLong[ans]; Call[CheckReclaimable]; * Returns T = ALU = disposition BDispatch← T, * Dispatch on disposition DispTable[1, 1, 1]; * Force CheckReclaimable always to return here T← RCWord; * Prepare to RCWord back into nhp↑ * Note that CheckReclaimable may have called OnZCT only if disposition = continue. * In particular, this means that if disposition = finalizeIt, no changes have * been made anywhere in memory, so it's OK to trap at that point. For the other * cases, we are now committed to finish the opcode. DispTable[3]; T← Stack&+1← Store← 0S, DBuf← T, * disposition = continue: Push[NIL] and exit Branch[PushT]; Store← 0S, DBuf← T, * disposition = reclaimIt: leave ref on stack StkP+1, IFUNext0; T← tpLookFurtherAtReclaimedRef, * disposition = finalizeIt: trap Branch[OpcodeTrap]; *----------------------------------------------------------- EnableMicrocodeM: MiscTable[141], *----------------------------------------------------------- * zct ← PopLong[]; * -- Load microcode registers * (currently zct, zct.wp, and zct.markingDecrements, zct.residueMask) * ucDisabled ← FALSE; * Push[CedarMicrocode.microcodeVersion --currently 4--]; (version change 10 May) * Note: since the header page of the ZCT is guaranteed to be resident, no precautions * need be taken to ensure restartability after page faults. RBase← RBase[RCRegs], StkP-1; MemBase← ZCTBR; BRHi← Stack&-1; * ZCTBR ← zct T← microcodeVersion; * version = 4 (10 May 84) Stack← T, BRLo← Stack; * Stack ← microcodeVersion * added 10 May 1984 (not being at all clever) Fetch← zct.residueMask; RCResMask← Md; T← NOT (Fetch← ZCT.markingDecrements); * T← small negative number RCFlags← DPF[T, 17, 1, MD]; * RCFlags[0] ← 1, * RCFlags[15] ← zct.markingDecrements T← (Fetch← ZCT.wp)+1; * Load zct.wp Fetch← T, WPOffset← MD, FlipMemBase; * Flip to WPBR T← (WPOffset) AND NOT (Sub[zctBlockWords!, 1]C); * Mask out WP offset bits WPOffset← (BRLo← T) XOR (WPOffset), T← MD; * BR← base, WPOffset← offset BRHi← T, IFUNext0; *----------------------------------------------------------- DisableMicrocodeM: MiscTable[142], *----------------------------------------------------------- * [] ← PopLong[]; -- DISCARD zct arg; assume it's the same as the one we already have * -- Dump any cached variable state (currently just zct.wp) * ucDisabled ← TRUE; * Note: since the ZCT is guaranteed to be resident, no precautions need be taken * to ensure restartability after page faults. T← A0, RBase← RBase[RCRegs], StkP-3; RCFlags← T+1, MemBase← WPBR; * RCFlags[0] ← 0, RCFlags word # 0 DummyRef← WPOffset, T← MD, * Compute WPBR+WPOffset FlipMemBase; * Flip to ZCTBR RCTemp0← 7777C; RCTemp0← (RCTemp0) AND (VAHi); * Damn hardware returns ones in VAHi[0:3] T← VALo; T← (Store← ZCT.wp)+1, DBuf← T; * Store in ZCT.wp Store← T, DBuf← RCTemp0, IFUNext0; * Can't fault since ZCT is resident * Subroutines *----------------------------------------------------------- CheckReclaimable: * Enter: RCTemp1,,RCTemp0 = LONG POINTER TO NormalHeader (nhp) * RCWord = contents of word at nhp↑, with refCount field decremented * if there is a decrement pending * Call: SCall[CheckReclaimable]; * Exit: Traps if need to put in ZCT and the ZCT is full; otherwise: * T = ALU = disposition (0=continue, 1=reclaim, 2=finalize) * MemBase either unchanged or set to LPtr (i.e., unchanged if it * was equal to LPtr at the time of the call) * Returns +1 if RCWord has been updated by this subroutine and needs to be stored * back into memory, +2 otherwise. * Clobbers T, RCTemp2 * Timing: continue, 2 or 3 cycles normally; 11 to 27 if need to put on ZCT; * 14 if reclaim or finalize *----------------------------------------------------------- Subroutine; * rc: RefCount ← nhp.refCount; * IF decrPending THEN rc ← rc-1; -- done by caller * IF rc#0 OR nhp.rcOverflowed OR nhp.inZCT THEN RETURN [continue]; PD← (RCWord) AND (OR[NHR.refCount!, NHR.rcOverflowed!]C), Branch[.+2, R>=0]; T← A0, RCFlags, Return[R<0]; * Return +2 always PD← (RCWord)+(RCWord), Branch[.+2, ALU=0]; T← A0, RCFlags, Return[R<0]; * Return +2 always * IF nhp.maybeOnStack OR FoundInFHSnapshot[nhp] THEN OnZ[nhp] * ELSE RETURN [IF nhp.finalizable THEN finalizeIt ELSE reclaimIt]; T← RCTemp0, Branch[.+2, ALU>=0]; * OnZCT if maybeOnStack (bit 1) Branch[OnZCTTail]; * Call OnZCT and return +1 * -- Expanded in-line: * FOSTableHash: PROC [nhp: NHeaderP] RETURNS [x: FosTableIndex, r: FOSTableResidue] = { * r ← BITOR[BITSHIFT[HighHalf[nhp], 3], BITSHIFT[LowHalf[nhp], -13]]; * u: FOSTableResidue ← BITAND[r, zct.residueMask]; * x ← BITAND[BITXOR[BITSHIFT[LowHalf[nhp], -1], u], FOSTableLength-1]}; * For a 28-bit address space, residue is 15 bits derived from high[4..15],,low[0..2]; * index is 12 bits derived from low[3..14] and hashed with the residue. * low[15] is ignored since REFs are always even. RCTemp2← LDF[T, 14, 1]; * log[FOSTableLength] bits of nhp T← RCY[RCTemp1, T, 15]; * residue ** added these two lines 11 May 1984 RCResidue← T; * we need this later T← T AND (RCResMask); RCTemp2← (RCTemp2) XOR T, MemBase← ZCTBR; * hash the index bits with residue RCTemp2← (RCTemp2) AND (Sub[FOSTableLength!, 1]C); * mod FOSTableLength * -- Expanded in-line: * FoundInFHSnapshot: PROC [nhp: NHeaderP] RETURNS [found: BOOLEAN ← FALSE] = { * index: FOSTableIndex; * residue, entry: FOSTableResidue; * [index, residue] ← FOSTableHash[nhp]; * entry ← zct.fosTable[index]; * RETURN[residue = BITAND[residue, entry]]}; RCTemp2← (RCTemp2)+(ZCT.fosTable); Fetch← RCTemp2; * Fetch[@zct.fosTable[index]]↑; T← RCResidue; T← T AND MD; * BITAND[residue, entry] PD← T XOR (RCResidue), MemBase← LPtr; * Compare residue with BITAND T← LDF[RCWord, 1, MaskPos[NHR.finalizable!]], Branch[.+2, ALU#0]; T← RCTemp0, Branch[OnZCTTail]; * residue = BITAND[residue, entry] T← T+1, RCFlags, Return[R<0]; * reclaimIt=1, finalizeIt=2; return +2 always * previous code * PD← NOT MD, Branch[.+2, ALU#0]; * T← RCTemp0, Branch[OnZCTTail]; * residue = entry * T← LDF[RCWord, 1, MaskPos[NHR.finalizable!]], Branch[.+2, ALU#0]; * T← RCTemp0, Branch[OnZCTTail]; * entry = fosWildCard * T← T+1, RCFlags, Return[R<0]; * reclaimIt=1, finalizeIt=2; return +2 always *----------------------------------------------------------- OnZCT: * Puts reference in Zero Count Table * Enter: RCTemp1,,T = LONG POINTER TO NormalHeader (nhp) * RCWord = contents of word at nhp↑ * Exit: Traps if the ZCT is full; otherwise: * RCWord updated but not stored back into memory * T = ALU = 0 (for the convenience of CheckReclaimable) * MemBase = LPtr * Timing: 7 cycles usually, 13 if need to chain to a new ZCT block. *----------------------------------------------------------- Subroutine; * wp: LONG POINTER TO NHeaderP; * IF nhp.inZCT THEN RETURN; * wp ← zct.wp; * wp↑ ← nhp; * wp ← wp+SIZE[LONG POINTER]; MemBase← WPBR, RCWord, DblBranch[AlreadyInZCT, PutInZCT, R<0]; * Test nhp.inZCT * Duplicate entry point: tail of CheckReclaimable OnZCTTail: MemBase← WPBR, RCWord, DblBranch[AlreadyInZCT, PutInZCT, R<0]; AlreadyInZCT: T← A0, MemBase← LPtr, Return; PutInZCT: T← (Store← WPOffset)+1, DBuf← T; * Store low half -- this can fault WPOffset← T← (Store← T)+1, DBuf← RCTemp1; * Store high half -- this cannot fault * IF BITAND[LowHalf[wp], zctBlockWords-1] = zctBlockWords-SIZE[LONG POINTER] THEN * IF (wp ← LOOPHOLE[wp↑]) = NIL THEN OpcodeTrap[tpZCTFull]; * nhp.inZCT ← TRUE; * zct.wp ← wp; PD← T XOR (ZCTBlockLink); RCWord← (RCWord) OR (NHR.inZCT), Branch[ZCTNotFull, ALU#0]; * This block is now full; attempt to follow link to next. If a trap occurs, the * cell into which we just stored will appear not to have been used. T← (Fetch← T)+1; WPOffset← (Fetch← T)-(3C), * Restore wp to original value in case we trap T← MD; PD← T OR MD; Branch[RCZCTFullTrap, ALU=0]; * Branch if it is NIL BRLo← T, T← MD; * Set new ZCT block base and reset offset BRHi← T, WPOffset← A0; ZCTNotFull: T← A0, MemBase← LPtr, Return; *----------------------------------------------------------- CheckForRCUnderflow: * Enter: RCWord = word containing RefCount to be checked * Exit: Traps if the RefCount has underflowed; otherwise: * RCWord = entire word with refCount decremented * ALU = value of refCount and rcOverflowed fields * Clobbers T * Timing: 3 cycles normally *----------------------------------------------------------- Subroutine; * IF nhp.refCount=0 THEN * IF nhp.rcOverflowed THEN OpcodeTrap[tpRCUnderflowed] ELSE OpcodeTrap[tpRCBug]; PD← (RCWord) AND (NHR.refCount); RCWord← (RCWord)-(LShift[1, MaskPos[NHR.refCount!]]C), * Decrement refCount Branch[RefCountZero, ALU=0]; PD← (RCWord) AND (OR[NHR.refCount!, NHR.rcOverflowed!]C), Return; RefCountZero: * Underflow if rcOverflowed, bug otherwise RCWord, DblBranch[RCUnderflowTrap, RCBugTrap, R odd]; *----------------------------------------------------------- FetchGetsT: *----------------------------------------------------------- Subroutine; PD← Fetch← T, Return, Global; *----------------------------------------------------------- TrapIfRCDisabled: * Enter: RBase = RCRegs * T = word to be loaded into high part of LPtr * Exit: Traps if RC microcode is disabled; otherwise: * MemBase = LPtr * BRHi = RCTemp1 = T at call * Timing: 2 cycles *----------------------------------------------------------- Subroutine; KnowRBase[RCRegs]; MemBase← LPtr, RCFlags, Branch[RCDisabledTrap2, R>=0]; RCTemp1← BRHi← T, Return; *----------------------------------------------------------- * Traps *----------------------------------------------------------- TopLevel; RCOverflowTrap: T← tpRCOverflowOccurred, Branch[OpcodeTrap]; RCDisabledTrap1: T← tpUCDisabled, Branch[OpcodeTrap]; RCDisabledTrap2: T← tpUCDisabled, Branch[OpcodeTrap]; RCDisabledTrap3: T← tpUCDisabled, Branch[OpcodeTrap]; RCUnderflowTrap: T← tpRCUnderflowOccurred, Branch[OpcodeTrap]; RCZCTFullTrap: T← tpZCTFull, Branch[OpcodeTrap]; RCBugTrap: T← tpRCBug, Branch[OpcodeTrap]; NormalFreeListEmptyTrap: T← tpNormalFreeListEmpty, Branch[OpcodeTrap]; *----------------------------------------------------------- * Needed for coordination *----------------------------------------------------------- RTSetup: MiscTable[63], Stack&-2; Stack← A0, IFUNext0; * not Implemented *----------------------------------------------------------- * ReadMap[vp] RETURNS[MapContents, HWFlags] * used to read all the available map entries *----------------------------------------------------------- RMapPrivate: MiscTable[70], Stack&-1; * ReadMap[cardinal] RBase← RBase[RTemp0]; Call[SetBRForPage]; RMap← RTemp0; Call[WaitForMap]; Stack&+1← T; T← Errors'; STack← T, IFUNext0; *----------------------------------------------------------- * ExtraMapBits[rp] RETURNS[bit, wordFromArray] *----------------------------------------------------------- ExtraMapBits: MiscTable[66], Stack&-1; * ExtraMapBits[realpage] Call[MapDirtyBit]; Stack&+1← T; T← Md; STack← T, IFUNext0; *----------------------------------------------------------- * Unused MISC opcodes *----------------------------------------------------------- MiscOpcodeUnimplemented[60]; * ReclaimedRef MiscOpcodeUnimplemented[61]; * ALTERCOUNT MiscOpcodeUnimplemented[62]; * ResetSTKBits MiscOpcodeUnimplemented[64]; * RcFinalizeCount MiscOpcodeUnimplemented[65]; * IsPiReclaimable * MiscOpcodeUnimplemented[66]; MiscOpcodeUnimplemented[67]; * CREATEREF * MiscOpcodeUnimplemented[70]; MiscOpcodeUnimplemented[73]; * AllocQNode MiscOpcodeUnimplemented[74]; * AllocPNode MiscOpcodeUnimplemented[75]; * FreeObject MiscOpcodeUnimplemented[76]; * FreeQNode MiscOpcodeUnimplemented[77]; * FreePNode MiscOpcodeUnimplemented[147]; * MiscOpcodeUnimplemented[150]; * MiscOpcodeUnimplemented[151]; * MiscOpcodeUnimplemented[152]; MiscOpcodeUnimplemented[153]; MiscOpcodeUnimplemented[154]; MiscOpcodeUnimplemented[155]; MiscOpcodeUnimplemented[156]; MiscOpcodeUnimplemented[157];