<> <> <> <> <> <> <> <> <<0: +INT 4: CONS>> <<1: +REAL 5: - REAL>> <<2: +REAL 6: - REAL>> <<3: REF 7: - INT>> <> <<>> DIRECTORY DragOps; DragonRC: MONITOR = BEGIN <> Word: TYPE = DragOps.Word; <> <<>> wordsPerPage: NAT = DragOps.wordsPerPage; unitsPerWord: NAT = 1; <> unitsPerPage: NAT = wordsPerPage/unitsPerWord; <> bytesPerPage: NAT = DragOps.bytesPerPage; bytesPerWord: NAT = DragOps.bytesPerWord; TaggedRef: TYPE = Word; TaggedRefPtr: TYPE = LONG POINTER TO TaggedRef; Tag: TYPE = MACHINE DEPENDENT {pInt, pReal1, pReal2, ref, cons, nReal5, nReal6, nInt}; TaggedRefParts: TYPE = MACHINE DEPENDENT RECORD[ tag: Tag _ pInt, highPad: HighPad _ 0, lowPad: LowPad _ 0, indexInPage: IndexInPage _ 0 ]; HighPad: TYPE = [0..LAST[CARD16]/8]; LowPad: TYPE = [0..LAST[CARD16]/wordsPerPage]; IndexInPage: TYPE = [0..wordsPerPage); CedarNil: TaggedRef = LOOPHOLE[LONG[0]]; LispNil: TaggedRef = LOOPHOLE[TaggedRefParts[ cons, LAST[HighPad], LAST[LowPad], LAST[IndexInPage] ]]; LowestCountedRef: TaggedRef = LOOPHOLE[TaggedRefParts[ref, 256, 0, 0]]; LowestUncountedRef: TaggedRef = LOOPHOLE[TaggedRefParts[ref, 0, 0, 0]]; ConsCellPtr: TYPE = LONG POINTER TO ConsCellRep; ConsCellRep: TYPE = MACHINE DEPENDENT RECORD [car, cdr: TaggedRef]; RefCountPtr: TYPE = LONG POINTER TO RefCountWord; RefCountWord: TYPE = MACHINE DEPENDENT RECORD[ type: [0..177777B] _ 0, -- (16 bits) type index finalizable: BOOL _ FALSE, -- (1 bit) TRUE iff finalization enabled for this object spare: BOOL _ FALSE, -- (1 bit) available for the taking sizeIndex: SizeIndex _ 0, -- (6 bits) gives size of object rcb: RefCountByte _ [] -- (8 bits) gives RC of object ]; <> SizeIndex: TYPE = [0..MaxSizeIndex]; MaxSizeIndex: CARDINAL = 77B; <> RefCountByte: TYPE = MACHINE DEPENDENT RECORD[ count: RefCount _ 0, -- (5 bits) the ref count onStack: BOOL _ FALSE, -- (1 bit) TRUE iff ref may be on stack over: BOOL _ FALSE, -- (1 bit) TRUE iff ref is present in RC overflow table inZCT: BOOL _ FALSE -- (1 bit) TRUE iff ref is on ZCT ]; <> <<>> RefCount: TYPE = [0..MaxRC]; MaxRC: CARDINAL = 37B; <> <<>> RefCountByteArray: TYPE = PACKED ARRAY [0..bytesPerWord) OF RefCountByte; RCBAptr: TYPE = LONG POINTER TO RefCountByteArray; LispPagePtr: TYPE = LONG POINTER TO LispPage; LispPage: TYPE = RECORD [ nextPage: LispPagePtr, <> nextFree: LispCellPtr, <> pageOwner: Word, <> padding: PACKED ARRAY [3*bytesPerWord..firstCellIndex) OF RefCountByte, <> rcBytes: PACKED ARRAY [firstCellIndex..cellsPerPage) OF RefCountByte, <> cells: ARRAY [firstCellIndex..cellsPerPage] OF LispCell ]; <> <<>> LispCellPtr: TYPE = LONG POINTER TO LispCell; LispCell: TYPE = RECORD [car, cdr: TaggedRef]; wordsPerCell: NAT = 2; cellsPerPage: NAT = wordsPerPage/wordsPerCell; bytesPerCell: NAT = bytesPerWord*wordsPerCell; firstCellIndex: NAT = cellsPerPage / bytesPerCell; <> <<>> collecting: BOOL _ FALSE; <> noTandS: INT _ 0; < 0 when the trace and sweep collector is disabled. noTandS = 0 when T and S is permitted.>> highestUncountedRef: TaggedRef _ LowestCountedRef; <> highestCons: TaggedRef _ LispNil; <> <> AssignRef: PROC [lhsP: TaggedRefPtr, rhs: TaggedRef] = { <<... is the most common RC primitive. It performs lhsP^ _ rhs, decrementing the RC of the object referenced by lhsP, and incrementing the RC of rhs. This operation must appear to be atomic to all fetches and to all other RC assignments. The RC for rhs or lhsP^ may be temporarily too high.>> <<>> <> <<>> lhs: TaggedRef _ lhsP^; IF lhs = rhs THEN RETURN; <> IncRC[rhs]; <> <<>> DecRC[ IF CStoreRef[lhsP, rhs, lhs] THEN lhs ELSE rhs, collecting ]; <> }; AssignNIL: PROC [lhsP: TaggedRefPtr] = { <<... performs lhsP^ _ NIL, decrementing the RC of the object referenced by lhsP. This operation must appear to be atomic to all fetches and to all other RC assignments. The RC for lhsP^ may be temporarily too high.>> <<>> lhs: TaggedRef _ lhsP^; IF lhs = CedarNil THEN RETURN; IF CStoreRef[lhsP, CedarNil, lhs] THEN DecRC[lhs, collecting]; <> }; InitRef: PROC [lhsP: TaggedRefPtr, rhs: TaggedRef] = { <<... performs an RC assignment as if the destination held NIL, which is checked. This is the kind of RC assignment used when a REF is assigned to a component of a newly allocated object. We do not need to use CStore, since no other process can have its mitts on the new object (the compiler had better be sure about this). We use InitRef instead of AssignRef for this special case because it is faster to do so.>> lhs: TaggedRef _ lhsP^; IF lhs # CedarNil THEN CRASH[]; IF rhs # CedarNil THEN { IncRC[rhs]; <> lhsP^ _ rhs; <> }; }; SwapRefs: PROC [lhsP: TaggedRefPtr, rhsP: TaggedRefPtr] = { <<... swaps the contents of lhsP^ and rhsP^ without normally altering the reference counts. The following intermediate states may be observed: {lhsP^ = CedarNil, lhsP^ = rhsP^, complete}. The reference count for lhsP^ or rhsP^ may be temporarily too high.>> DO lhs: TaggedRef = lhsP^; IF CStoreRef[lhsP, CedarNil, lhs] THEN DO <> rhs: TaggedRef = rhsP^; IF CStoreRef[rhsP, lhs, rhs] THEN { <> IF NOT CStoreRef[lhsP, rhs, CedarNil] THEN DecRC[rhs, collecting]; <> RETURN; }; ENDLOOP; ENDLOOP; }; <> GeneralCons: PROC [car, cdr: TaggedRef] RETURNS [new: TaggedRef] = { new _ ConsAllocSamePage[cdr]; IncRC[car]; IncRC[cdr]; LOOPHOLE[new, ConsCellPtr]^ _ [car, cdr]; }; ConsWithNil: PROC [car: TaggedRef] RETURNS [new: TaggedRef] = { new _ ConsAlloc[]; IncRC[car]; LOOPHOLE[new, ConsCellPtr]^ _ [car, LispNil]; }; TailCons: PROC [old: TaggedRef] RETURNS [new: TaggedRef] = { new _ ConsAllocSamePage[old]; IF IsACons[old] THEN AssignRef[LOOPHOLE[old, TaggedRefPtr]+SIZE[TaggedRef], new]; }; <> IncRC: PROC [tref: TaggedRef] = { SELECT TRUE FROM IsARef[tref] => DO rp: RefCountPtr = LOOPHOLE[tref, RefCountPtr] - SIZE[RefCountWord]; rc: RefCountWord = rp^; nrc: RefCountWord _ rc; c: RefCount = rc.rcb.count; IF c = MaxRC THEN {IncOver[tref]; nrc.rcb.count _ 0; nrc.rcb.over _ TRUE} ELSE nrc.rcb.count _ c + 1; nrc.rcb.onStack _ FALSE; IF CStoreRC[rp, nrc, rc] THEN RETURN; <> IF c = MaxRC THEN [] _ DecOver[tref]; ENDLOOP; IsACons[tref] => { parts: TaggedRefParts _ LOOPHOLE[tref, TaggedRefParts]; bx: [0..bytesPerWord) _ (parts.indexInPage / wordsPerCell) MOD bytesPerWord; parts.indexInPage _ parts.indexInPage / (cellsPerPage*bytesPerWord); DO rcba: RefCountByteArray = LOOPHOLE[parts, RCBAptr]^; nrcba: RefCountByteArray _ rcba; rcb: RefCountByte _ rcba[bx]; c: RefCount = rcb.count; IF c = MaxRC THEN {IncOver[tref]; rcb.count _ 0; rcb.over _ TRUE} ELSE rcb.count _ c + 1; rcb.onStack _ FALSE; nrcba[bx] _ rcb; IF CStoreRCBA[LOOPHOLE[parts, RCBAptr], nrcba, rcba] THEN RETURN; <> IF c = MaxRC THEN [] _ DecOver[tref]; ENDLOOP; }; ENDCASE; }; DecRC: PROC [tref: TaggedRef, duringCollection: BOOL] = { <> SELECT TRUE FROM IsARef[tref] => DO needZCT: BOOL _ FALSE; rp: RefCountPtr = LOOPHOLE[tref, RefCountPtr] - SIZE[RefCountWord]; rc: RefCountWord = rp^; nrc: RefCountWord _ rc; c: RefCount = rc.rcb.count; SELECT c FROM 0 => { IF NOT nrc.rcb.over THEN CRASH[]; nrc.rcb.count _ MaxRC; }; 1 => { IF NOT (nrc.rcb.over OR nrc.rcb.inZCT) THEN nrc.rcb.inZCT _ needZCT _ TRUE; nrc.rcb.count _ 0; }; ENDCASE => nrc.rcb.count _ c - 1; IF duringCollection THEN { nrc.rcb.onStack _ TRUE; IF NOT nrc.rcb.inZCT THEN nrc.rcb.inZCT _ needZCT _ TRUE; }; IF CStoreRC[rp, nrc, rc] THEN { <> IF needZCT THEN PutOnZCT[tref]; <> IF c = 0 THEN <> DecOver[tref]; RETURN }; <> ENDLOOP; IsACons[tref] => { parts: TaggedRefParts _ LOOPHOLE[tref, TaggedRefParts]; bx: [0..bytesPerWord) = (parts.indexInPage / wordsPerCell) MOD bytesPerWord; parts.indexInPage _ parts.indexInPage / (cellsPerPage*bytesPerWord); DO needZCT: BOOL _ FALSE; rcba: RefCountByteArray = LOOPHOLE[parts, RCBAptr]^; nrcba: RefCountByteArray _ rcba; rcb: RefCountByte _ rcba[bx]; c: RefCount = rcb.count; SELECT c FROM 0 => { IF NOT rcb.over THEN CRASH[]; rcb.count _ MaxRC; }; 1 => { IF NOT (rcb.over OR rcb.inZCT) THEN rcb.inZCT _ needZCT _ TRUE; rcb.count _ 0; }; ENDCASE => rcb.count _ c - 1; IF duringCollection THEN { rcb.onStack _ TRUE; IF NOT rcb.inZCT THEN rcb.inZCT _ needZCT _ TRUE; }; nrcba[bx] _ rcb; IF CStoreRCBA[LOOPHOLE[parts, RCBAptr], nrcba, rcba] THEN { <> IF needZCT THEN PutOnZCT[tref]; <> IF c = 0 THEN <> DecOver[tref]; RETURN }; <> ENDLOOP; }; ENDCASE; }; <> <> headOvTab: OvTab _ NIL; tailOvTab: OvTab _ NIL; freeOvTab: OvTab _ NIL; lockOvTab: INT _ 0; -- a dummy for the lock OvTab: TYPE = LONG POINTER TO OvTabRep; OvTabRep: TYPE = RECORD [ next: OvTab _ NIL, used: INT _ 0, -- the number of entries in this table; also the index of the next data slot to be used data: ARRAY [0..OvTabEntries) OF OvTabEntry ]; OvTabEntries: NAT = 250; OvTabEntry: TYPE = RECORD [tref: TaggedRef, count: NAT]; IncOver: ENTRY PROC [tref: TaggedRef] = { <> freeTab: OvTab; FOR ot: OvTab _ headOvTab, ot.next WHILE ot # NIL DO FOR i: NAT IN [0..ot.used) DO IF ot.data[i].tref = tref THEN { ot.data[i].count _ SUCC[ot.data[i].count]; RETURN; } ENDLOOP; <> IF freeTab = NIL AND ot.used < OvTabEntries THEN { freeTab _ ot; }; ENDLOOP; <> IF freeTab = NIL THEN { freeTab _ PermanentZone[].NEW[OvTabRep]; -- allocate a new OvTabRep; tailOvTab.next _ freeTab; tailOvTab _ freeTab; }; <> freeTab.data[freeTab.used] _ [tref, 1]; freeTab.used _ SUCC[freeTab.used]; }; DecOver: ENTRY PROC [tref: TaggedRef] = { <> FOR ot: OvTab _ headOvTab, ot.next WHILE ot # NIL DO FOR i: INT IN [0..ot.used) DO IF ot.data[i].tref = tref THEN { IF ot.data[i].count = 0 THEN { <> RETURN; }; ot.data[i].count _ PRED[ot.data[i].count]; RETURN; } ENDLOOP; ENDLOOP; <> }; CollectorOverflowProcessing: INTERNAL PROC [] ~ { <> FOR ot: OvTab _ headOvTab, ot.next WHILE ot # NIL DO i: INT _ 0; WHILE i < ot.used DO OPEN ote: ot.data[i]; IF ote.count = 0 THEN { rp: RefCountPtr = LOOPHOLE[ote.tref, RefCountPtr] - SIZE[RefCountWord]; rp^.rcb.over _ FALSE; IF rp^.rcb.count = 0 THEN InnerPutOnZCT[ote.tref]; <> ot.used _ PRED[ot.used]; IF ot.used # 0 THEN ot.data[i] _ ot.data[ot.used]; <> } ELSE i _ SUCC[i]; ENDLOOP; ENDLOOP; }; OverflowMonitorEntry: PROC = { NYI[]; }; OverflowMonitorExit: PROC = { NYI[]; }; <> <> headZ: ZctBlock _ NIL; <> headPtr: TaggedRefPtr _ NIL; headLim: TaggedRefPtr _ NIL; tailZ: ZctBlock; <> tailPtr: TaggedRefPtr _ NIL; tailLim: TaggedRefPtr _ NIL; freeZ: ZctBlock _ NIL; lockZ: INT _ 0; -- a dummy for the lock ZctBlock: TYPE = LONG POINTER TO ZctBlockRep; ZctBlockRep: TYPE = RECORD [ next: ZctBlock _ NIL, data: ARRAY [0..ZCTBlockEntries] OF TaggedRef ]; ZCTBlockEntries: NAT = 250; PutOnZCT: ENTRY PROC [tref: TaggedRef] = { <> InnerPutOnZCT[tref]; }; InnerPutOnZCT: INTERNAL PROC [tref: TaggedRef] = { <> IF tailPtr = tailLim THEN { <> AllocZctBlock[]; }; tailPtr^ _ tref; tailPtr _ SUCC[tailPtr]; }; AllocZctBlock: INTERNAL PROC ~ { <> IF freeZ = NIL THEN { <> freeZ _ PermanentZone[].NEW[ZctBlockRep]; freeZ.next _ NIL; }; freeZ.data _ ALL[CedarNil]; tailZ.next _ freeZ; tailZ _ freeZ; freeZ _ freeZ.next; tailPtr _ @tailZ.data[0]; tailLim _ @tailZ.data[ZCTBlockEntries]; }; FreeZctBlock: INTERNAL PROC ~ { <> IF headZ # tailZ THEN { newHeadZ: ZctBlock = headZ.next; headZ.next _ freeZ; freeZ _ headZ; headZ _ newHeadZ; headPtr _ @headZ.data[0]; headLim _ @headZ.data[ZCTBlockEntries]; } ELSE { headPtr _ tailPtr _ @tailZ.data[0]; headLim _ tailLim _ @tailZ.data[ZCTBlockEntries]; tailZ.data _ ALL[CedarNil]; }; }; InitZctBlocks: ENTRY PROC = { AllocZctBlock[]; headZ _ tailZ; headPtr _ tailPtr; headLim _ tailLim; }; ZctMonitorEntry: PROC = { NYI[]; }; ZctMonitorExit: PROC = { NYI[]; }; <> ConsAlloc: PROC RETURNS [TaggedRef _ LispNil] = { <> NYI[]; }; ConsAllocSamePage: PROC [tref: TaggedRef] RETURNS [TaggedRef _ LispNil] = { <> NYI[]; }; <> CRASH: PROC = {ERROR}; <> NYI: PROC = {ERROR}; <> CStoreRef: PROC [lhsP: TaggedRefPtr, new, old: TaggedRef] RETURNS [BOOL _ TRUE] = { NYI[]; }; CStoreRC: PROC [lhsP: RefCountPtr, new, old: RefCountWord] RETURNS [BOOL _ TRUE] = { NYI[]; }; CStoreRCBA: PROC [lhsP: RCBAptr, new, old: RefCountByteArray] RETURNS [BOOL _ TRUE] = { NYI[]; }; PermanentZone: PROC [] RETURNS [UNCOUNTED ZONE _ NIL] = { NYI[]; }; IsACons: PROC [tref: TaggedRef] RETURNS [BOOL _ TRUE] = { <> RETURN[LOOPHOLE[tref, TaggedRefParts].tag=cons]; }; IsARef: PROC [tref: TaggedRef] RETURNS [BOOL _ TRUE] = { <> RETURN[LOOPHOLE[tref, TaggedRefParts].tag=ref]; }; END.