<> <> <> <> <> <> <> <<0: +INT 4: CONS>> <<1: +REAL 5: - REAL>> <<2: +REAL 6: - REAL>> <<3: REF 7: - INT>> <> <<>> DIRECTORY DragOpsCross; DragonRC: PROGRAM = BEGIN <> Word: TYPE = DragOpsCross.Word; <> <<>> wordsPerPage: NAT = 1024; unitsPerWord: NAT = 1; <> unitsPerPage: NAT = wordsPerPage/unitsPerWord; <> bytesPerPage: NAT = bytesPerWord*wordsPerPage; bytesPerWord: NAT = 4; 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[CARDINAL]/8]; LowPad: TYPE = [0..LAST[CARDINAL]/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.>> <<>> <> <<>> DO lhs: TaggedRef _ lhsP^; IF lhs = rhs THEN RETURN; <> DisableTandS[]; IncRC[rhs]; <> <<>> IF CStoreRef[lhsP, rhs, lhs] THEN { <> DecRC[lhs, collecting]; EnableTandS[]; <> RETURN; }; <> DecRC[rhs, collecting]; EnableTandS[]; ENDLOOP; }; 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 { DisableTandS[]; IncRC[rhs]; <> lhsP^ _ rhs; <> EnableTandS[]; }; }; 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.>> DisableTandS[]; 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]; <> EnableTandS[]; RETURN; }; ENDLOOP; ENDLOOP; }; <> GeneralCons: PROC [car, cdr: TaggedRef] RETURNS [new: TaggedRef] = { DisableTandS[]; new _ ConsAllocSamePage[cdr]; IncRC[car]; IncRC[cdr]; LOOPHOLE[new, ConsCellPtr]^ _ [car, cdr]; EnableTandS[]; }; ConsWithNil: PROC [car: TaggedRef] RETURNS [new: TaggedRef] = { DisableTandS[]; new _ ConsAlloc[]; IncRC[car]; LOOPHOLE[new, ConsCellPtr]^ _ [car, LispNil]; EnableTandS[]; }; 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 rc.rcb.over THEN CRASH[]; nrc.rcb.over _ DecOver[tref]; nrc.rcb.count _ LAST[RefCount]; }; 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 GO TO doZct ELSE RETURN; IF c = 0 THEN IncOver[tref]; <> 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.over _ DecOver[tref]; 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 GO TO doZct ELSE RETURN; IF c = 0 THEN IncOver[tref]; <> ENDLOOP; }; ENDCASE; EXITS doZct => PutOnZct[tref]; }; <> <> 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, data: ARRAY [0..OvTabEntries] OF OvTabEntry ]; OvTabEntries: NAT = 250; OvTabEntry: TYPE = RECORD [tref: TaggedRef, count: INT]; IncOver: PROC [tref: TaggedRef] = { <> NYI[]; }; DecOver: PROC [tref: TaggedRef] RETURNS [BOOL _ FALSE] = { <> <> NYI[]; }; 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: PROC [tref: TaggedRef] = { <> <> ZctMonitorEntry[]; IF tailPtr = tailLim THEN { <> IF freeZ =NIL THEN { <> freeZ _ AllocZctBlock[]; freeZ.next _ NIL; }; tailZ.next _ freeZ; tailZ _ freeZ; freeZ _ freeZ.next; tailPtr _ @tailZ.data[0]; }; tailPtr^ _ tref; tailPtr _ tailPtr + SIZE[TaggedRef]; ZctMonitorExit[]; }; InitZctBlocks: PROC = { headZ _ tailZ _ AllocZctBlock[]; headPtr _ tailPtr _ @headZ.data[0]; headLim _ tailLim _ @headZ.data[ZCTBlockEntries]; }; AllocZctBlock: PROC RETURNS [new: ZctBlock _ NIL] = { IF freeZ = NIL THEN RETURN[PermanentZone[].NEW[ZctBlockRep]]; new _ freeZ; freeZ _ freeZ.next; new.next _ NIL; new.data _ ALL[CedarNil]; }; FreeZctBlock: PROC [zctb: ZctBlock] = { zctb.next _ freeZ; freeZ _ zctb; }; 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}; <> DisableTandS: PROC = {noTandS _ noTandS + 1}; EnableTandS: PROC = {noTandS _ noTandS - 1}; <> 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] = { <> NYI[]; }; IsARef: PROC [tref: TaggedRef] RETURNS [BOOL _ TRUE] = { <> NYI[]; }; END.