<> <> <> DIRECTORY Allocator USING[NHeaderP], AllocatorOps USING[ReferentType, REFToNHP], AtomPrivate, Process, RCMapOps USING[GetBase], RCMap USING[Index, Base], RecursivelyNIL, Rope USING[RopeRep], RTCommon USING[FetchField], RTTypesBasicPrivate USING[MapTiTd], SafeStorage USING[ReclaimCollectibleObjects, Type]; RecursivelyNILImpl: PROGRAM IMPORTS AllocatorOps, Process, RCMapOps, RTCommon, RTTypesBasicPrivate, SafeStorage EXPORTS RecursivelyNIL SHARES Rope = BEGIN rcmb: RCMap.Base = RCMapOps.GetBase[].base; lastREF: CARDINAL = 19; REFBlockRec: TYPE = RECORD [ prev: REFBlock _ NIL, next: REFBlock _ NIL, refs: ARRAY [0..lastREF] OF REF ANY _ ALL[NIL] ]; REFBlock: TYPE = REF REFBlockRec; phonyREFRec: TYPE = RECORD [ theREF: REF ANY _ NIL]; < ZCT Disaster). The internals of ROPEs are never processed. If a CheckProc is given, it is consulted every time a field is about to be NILed. If a TRUE is returned, the field is NILed and the previous REF is added to the processing. If FALSE is returned, the field is not NILed and the field's REF is not processed. A NIL checkProc means to always process.>> <> NILRef: PUBLIC PROC[root: REF ANY, checkProc: RecursivelyNIL.CheckProc _ NIL] = { pushBlock: REFBlock _ NIL ; pushBlockIndex: CARDINAL _ 0; currentRef: REF ANY; nilledRefs: INT _ 0 ; countForAbort: INT _ 0 ; phonyREF: REF phonyREFRec _ NEW[phonyREFRec]; ropeRepType: SafeStorage.Type = CODE[Rope.RopeRep]; atomRecType: SafeStorage.Type = CODE[AtomPrivate.AtomRec]; addRef: PROC [parentREF: REF ANY, refToAdd: REF ANY] RETURNS[NILit: BOOL _ TRUE] = INLINE { refToAddType: SafeStorage.Type = AllocatorOps.ReferentType[refToAdd]; IF refToAdd = NIL OR refToAddType = ropeRepType OR refToAddType = atomRecType THEN RETURN[FALSE]; IF checkProc # NIL AND ~checkProc[parentREF, AllocatorOps.ReferentType[parentREF], refToAdd, refToAddType] THEN RETURN[FALSE]; nilledRefs _ nilledRefs +1; IF nilledRefs > 2000 THEN { nilledRefs _ 0 ; SafeStorage.ReclaimCollectibleObjects[suspendMe: FALSE, traceAndSweep: FALSE] }; countForAbort _ countForAbort +1 ; IF countForAbort > 200 THEN { Process.CheckForAbort[]; }; IF pushBlock = NIL THEN pushBlock _ NEW[REFBlockRec]; IF pushBlockIndex > lastREF THEN { newBlock: REFBlock ; IF pushBlock.next = NIL THEN { newBlock _ NEW[REFBlockRec]; pushBlock.next _ newBlock } ELSE newBlock _ pushBlock.next; IF pushBlock # NIL THEN { newBlock.prev _ pushBlock; }; pushBlockIndex _ 0; pushBlock _ newBlock; }; pushBlock.refs[pushBlockIndex] _ refToAdd; pushBlockIndex _ pushBlockIndex + 1 ; }; popRef: PROC RETURNS [refPoped: REF ANY] = { IF pushBlockIndex = 0 THEN { IF pushBlock.prev = NIL THEN RETURN[NIL] ELSE { nowBlock: REFBlock _ pushBlock.prev; pushBlock.prev _ NIL; pushBlock _ nowBlock; pushBlockIndex _ lastREF; refPoped _ pushBlock.refs[pushBlockIndex]; pushBlock.refs[pushBlockIndex] _ NIL ; }; } ELSE { pushBlockIndex _ pushBlockIndex - 1; refPoped _ pushBlock.refs[pushBlockIndex]; pushBlock.refs[pushBlockIndex] _ NIL ; }; }; smashComponents: PROC[ref: REF ANY, ptr: LONG POINTER, rcmx: RCMap.Index] = { WITH rcmr: rcmb[rcmx] SELECT FROM null => NULL; oneRef => { IF addRef[ref, LOOPHOLE[ptr+rcmr.offset, LONG POINTER TO REF ANY]^] THEN { LOOPHOLE[phonyREF.theREF, LONG POINTER] _ LOOPHOLE[ptr+rcmr.offset, LONG POINTER TO LONG POINTER]^; -- copies the REF but does not change the reference count LOOPHOLE[ptr+rcmr.offset, LONG POINTER TO REF ANY]^ _ NIL ; -- NILs the REF to the object, but does not decrement the reference count=> reference count is now correct phonyREF.theREF _ NIL; -- nil the REF and decrement the reference count }; }; simple => FOR i: CARDINAL IN [0..rcmr.length) DO IF rcmr.refs[i] THEN { IF addRef[ref, LOOPHOLE[ptr+i, LONG POINTER TO REF ANY]^] THEN { LOOPHOLE[phonyREF.theREF, LONG POINTER] _ LOOPHOLE[ptr+i, LONG POINTER TO LONG POINTER]^; -- copies the REF but does not change the reference count LOOPHOLE[ptr+i, LONG POINTER TO REF ANY]^ _ NIL ; -- NILs the REF to the object, but does not decrement the reference count=> reference count is now correct phonyREF.theREF _ NIL; -- nil the REF and decrement the reference count }; }; ENDLOOP; ref => { IF addRef[ref, LOOPHOLE[ptr, LONG POINTER TO REF ANY]^] THEN { LOOPHOLE[phonyREF.theREF, LONG POINTER] _ LOOPHOLE[ptr, LONG POINTER TO LONG POINTER]^; -- copies the REF but does not change the reference count LOOPHOLE[ptr, LONG POINTER TO REF ANY]^ _ NIL ; -- NILs the REF to the object, but does not decrement the reference count=> reference count is now correct phonyREF.theREF _ NIL; -- nil the REF and decrement the reference count }; }; nonVariant => { FOR i: CARDINAL IN [0..rcmr.nComponents) DO smashComponents[ref, ptr + rcmr.components[i].wordOffset, rcmr.components[i].rcmi]; ENDLOOP; }; variant => { v: CARDINAL = RTCommon.FetchField[ptr + rcmr.fdTag.wordOffset, [bitFirst: rcmr.fdTag.bitFirst, bitCount: rcmr.fdTag.bitCount]]; smashComponents[ref, ptr, rcmr.variants[v]]; }; array => { FOR i: CARDINAL IN [0..rcmr.nElements) DO smashComponents[ref, ptr + i * rcmr.wordsPerElement, rcmr.rcmi]; ENDLOOP; }; sequence => { length: CARDINAL = RTCommon.FetchField[ptr+rcmr.fdLength.wordOffset, [bitFirst: rcmr.fdLength.bitFirst, bitCount: rcmr.fdLength.bitCount]]; smashComponents[ref, ptr, rcmr.commonPart]; FOR i: CARDINAL IN [0..length) DO smashComponents[ref, ptr + rcmr.dataOffset + i * rcmr.wordsPerElement, rcmr.rcmi]; ENDLOOP; }; ENDCASE => ERROR; }; currentRef _ root; WHILE currentRef # NIL DO <> i: INT _ 0 ; refType: SafeStorage.Type _ LOOPHOLE[AllocatorOps.ReferentType[currentRef], SafeStorage.Type]; nhp: Allocator.NHeaderP _ AllocatorOps.REFToNHP[currentRef]; rcmx: RCMap.Index = RTTypesBasicPrivate.MapTiTd[refType].rcmx; ptr: LONG POINTER = LOOPHOLE[currentRef, LONG POINTER]; IF ~nhp.f THEN smashComponents[currentRef, ptr, rcmx] ELSE {i _ i + 1}; currentRef _ popRef[]; ENDLOOP; pushBlock _ NIL; }; END. <> <> <> <> <<>> <<>>