<> <> <> <> <> DIRECTORY Allocator USING [bsiEscape, ExtendedHeader, HeaderP, LastAddress, logPagesPerQuantum, NHeaderP, NormalHeader, QuantumIndex, wordsPerQuantum], AllocatorOps USING [AddressToQuantumIndex, BlockSize, EnterAndCallBack, IsValidRef, NHPToREF, quantumMap, REFToNHP, Reset, TAndSFreeObject], AMBridge USING [TVForReferent, TVToLC], AMModelContextImpl USING [GFContextRec], AMTypes USING [Class, Error, Index, IndexToTV, IsComputed, IsNil, IsOverlaid, NComponents, Referent, TypeClass, TV, TVType, UnderClass, UnderType, Variant], Basics USING [BITAND, CARD, DoubleShiftLeft, LowHalf], CircularGarbageTraceAndSweep USING [APNodes, maxNReferers], Collector USING [EstablishTAndSProc], DebuggerSwap USING [CallDebugger], List USING [Reverse], LoadState USING [Acquire, ConfigID, EnumerateAllModules, GlobalFrameToType, local, ModuleIndex, ModuleToGlobalFrame, Release], PrincOps USING [GlobalFrameHandle, logWordsPerPage, wordsPerPage], Process USING [MsecToTicks, Pause], RCMap USING [nullIndex], RCMicrocodeOps USING [ASSIGNREF, OnZ, RCOverflowOccurred, RCUnderflowOccurred, ZCTFull], Rope USING [RopeRep], RTFrameHeapSnapshot USING [AcquireFrameHeapSnapshot, MapUncountedBodies, ReleaseFrameHeapSnapshot], RTTypesBasicPrivate USING [MapRefs, MapTiRcmx, NumberPackageRefs], RTTypesPrivate USING [TypedVariableRec], SafeStorage USING [GetReferentType, nullType, ReclaimCollectibleObjects, Type, WaitForCollectorDone], UnsafeStorage USING [GetSystemUZone], VM USING [AddressForPageNumber, Free, PageNumberForAddress, SimpleAllocate], ZCT USING [EnterAndCallBack, EnterRCOvAndCallBack, InnerHandleRCOverflow, InnerHandleRCUnderflow, RCOvReset, zct, zctBlockWords]; CircularGarbageTraceAndSweepImpl: PROGRAM IMPORTS AllocatorOps, AMBridge, AMTypes, Basics, Collector, DebuggerSwap, List, LoadState, Process, RCMicrocodeOps, RTFrameHeapSnapshot, RTTypesBasicPrivate, SafeStorage, UnsafeStorage, VM, ZCT EXPORTS CircularGarbageTraceAndSweep SHARES AMModelContextImpl, Rope = BEGIN OPEN Allocator; CARD: TYPE = Basics.CARD; Type: TYPE = SafeStorage.Type; nullType: Type = SafeStorage.nullType; <> nRetainedObjects: CARD _ 0; <> rpa: ARRAY [0..maxNRPIndex] OF LONG POINTER _ ALL[NIL]; maxNRPIndex: CARDINAL = 20; nextRpaIndex: CARDINAL _ 0; destructiveTestEnabled: BOOL _ FALSE; < do a second TandS without the stack scan, then punt>> findingCircularGarbage: BOOL _ FALSE; < remember stuff found; don't reclaim it>> circularGarbageObject: TYPE = RECORD[ put: INT _ 0, max: INT _ 0, item: SEQUENCE size: CARDINAL OF NHeaderP ]; circularGarbageSeq: LONG POINTER TO circularGarbageObject _ NIL; typedVariableType: Type; listOfGFContextRecType: Type; ropeRepType: Type; refStackChain: RefStack _ NIL; refStackFree: RefStack _ NIL; nRefsPushed: INT _ 0; rememberRopes: BOOL; <> objectsSeen: CARD _ 0; objectsReclaimed: CARD _ 0; objectsKept: CARD _ 0; objectsGarbage: CARD _ 0; nGlobalFrames: CARD _ 0; nRCGlobalFrames: CARD _ 0; nLocalFrames: CARD _ 0; <> SuspectSeen: SIGNAL = CODE; suspect: LONG POINTER TO UNSPECIFIED _ LOOPHOLE[LONG[-1]]; forgiving: BOOL _ TRUE; <> <> forgivingLog: ForgivingLog _ NIL; forgivingLogCount: INT _ 0; forgivingLogIndex: [0..ForgivingLogEntries) _ 0; <> ForgivingLogPages: NAT = 4; ForgivingLog: TYPE = LONG POINTER TO ForgivingLogRep; ForgivingLogRep: TYPE = ARRAY [0..ForgivingLogEntries) OF ForgivingLogEntry; ForgivingLogEntry: TYPE = RECORD [ nhp: Allocator.NHeaderP, header: Allocator.NormalHeader ]; ForgivingLogEntries: NAT = (ForgivingLogPages*PrincOps.wordsPerPage)/SIZE[ForgivingLogEntry]; <> RefStackRep: TYPE = RECORD [ next: RefStack _ NIL, size: CARDINAL _ 0, max: CARDINAL _ RefStackMax, refs: SEQUENCE COMPUTED CARDINAL OF LONG POINTER ]; RefStack: TYPE = LONG POINTER TO RefStackRep; RefStackPages: NAT = 4; RefStackMax: NAT = (PrincOps.wordsPerPage*RefStackPages - (SIZE[RefStackRep])) / (SIZE[LONG POINTER]); <> <> suspectRef: LONG POINTER _ NIL; -- a LOOPHOLE'd REF APNodes: TYPE = CircularGarbageTraceAndSweep.APNodes; suspectReferers: REF APNodes _ NEW[APNodes _ ALL[NIL]]; maxNReferers: NAT = CircularGarbageTraceAndSweep.maxNReferers; nSuspectReferers: NAT _ 0; AIPNodes: TYPE = ARRAY [0..maxNInnerReferers) OF NHeaderP; innerReferers: REF AIPNodes _ NEW[AIPNodes _ ALL[NIL]]; maxNInnerReferers: NAT = 50; nInnerReferers: NAT _ 0; gfhToSuspectRef: PrincOps.GlobalFrameHandle _ NIL; suspectRefFoundInLocalFrame: BOOL _ FALSE; circularStructureFound: BOOL _ FALSE; <> REFToNHP: PUBLIC PROC[ref: REF ANY] RETURNS[Allocator.NHeaderP] = { RETURN[AllocatorOps.REFToNHP[ref]]; }; NHPToREF: PUBLIC PROC[nhp: Allocator.NHeaderP] RETURNS[REF ANY] = { RETURN[AllocatorOps.NHPToREF[nhp]]; }; WhoPointsToRef: PUBLIC PROC [ref: REF, cycleLimit: NAT _ 20] RETURNS [ referers: LIST OF REF _ NIL, gfh: PrincOps.GlobalFrameHandle, foundInLocalFrame, foundInCircularStructure: BOOL, cycles: NAT _ 0] = { nhp: NHeaderP; referersAPNodes: REF APNodes; nhp _ AllocatorOps.REFToNHP[ref]; [referersAPNodes, gfh, foundInLocalFrame, foundInCircularStructure, cycles] _ WhoPointsTo[nhp, cycleLimit]; FOR index: INT IN [0..maxNReferers) DO IF referersAPNodes[index] = NIL THEN EXIT; referers _ CONS[AllocatorOps.NHPToREF[referersAPNodes[index]], referers]; referers _ List.Reverse[referers]; ENDLOOP; RETURN ; }; WhoPointsTo: PUBLIC PROC [nhp: NHeaderP, cycleLimit: NAT _ 20] RETURNS [ referers: REF APNodes, gfh: PrincOps.GlobalFrameHandle, foundInLocalFrame, foundInCircularStructure: BOOL, cycles: NAT _ 0] = { <> FOR i: NAT IN [0..maxNReferers) DO suspectReferers[i] _ NIL ENDLOOP; suspectReferers[0] _ nhp; nSuspectReferers _ 1; FOR i: NAT IN [0..maxNInnerReferers) DO innerReferers[i] _ NIL ENDLOOP; nInnerReferers _ 0; gfhToSuspectRef _ NIL; suspectRefFoundInLocalFrame _ FALSE; circularStructureFound _ FALSE; UNTIL gfhToSuspectRef # NIL OR circularStructureFound OR suspectRefFoundInLocalFrame OR nSuspectReferers > 1 OR nSuspectReferers = 0 OR cycles = cycleLimit DO suspectRef _ LOOPHOLE[AllocatorOps.NHPToREF[suspectReferers[0]], LONG POINTER]; FOR i: NAT IN [0..maxNReferers) DO suspectReferers[i] _ NIL ENDLOOP; nSuspectReferers _ 0; SafeStorage.ReclaimCollectibleObjects[suspendMe: TRUE, traceAndSweep: TRUE]; cycles _ cycles + 1; ENDLOOP; suspectRef _ NIL; RETURN[ referers: suspectReferers, gfh: gfhToSuspectRef, foundInLocalFrame: suspectRefFoundInLocalFrame, foundInCircularStructure: circularStructureFound, cycles: cycles]; }; <<>> InitFindCircularGarbage: PROC [nObjects: CARDINAL, uZone: UNCOUNTED ZONE, reportRopes: BOOL] = { incrCollectCnt: INT _ 0; incrWordsReclaimed: INT _ 0; lastWordsReclaimed: INT _ LAST[INT]; UNTIL (incrCollectCnt > 20) OR (incrWordsReclaimed >= lastWordsReclaimed AND incrCollectCnt > 3) DO SafeStorage.ReclaimCollectibleObjects[suspendMe: TRUE]; incrWordsReclaimed _ SafeStorage.WaitForCollectorDone[].wordsReclaimed; Process.Pause[Process.MsecToTicks[100]]; lastWordsReclaimed _ incrWordsReclaimed; incrCollectCnt _ incrCollectCnt + 1; ENDLOOP; findingCircularGarbage _ TRUE; objectsGarbage _ 0; rememberRopes _ reportRopes; typedVariableType _ CODE[RTTypesPrivate.TypedVariableRec]; listOfGFContextRecType _ CODE [RECORD[first: AMModelContextImpl.GFContextRec, rest: LIST OF AMModelContextImpl.GFContextRec]]; ropeRepType _ CODE[Rope.RopeRep]; circularGarbageSeq _ uZone.NEW[circularGarbageObject[nObjects]]; circularGarbageSeq.max _ nObjects; SafeStorage.ReclaimCollectibleObjects[suspendMe: TRUE, traceAndSweep: TRUE]; }; FindCircularGarbageTypes: PUBLIC PROC [nObjects: CARDINAL, reportRopes: BOOL _ TRUE] RETURNS [ nGarbage, nSeen: INT, garbage: LIST OF Type _ NIL] = { <> uZone: UNCOUNTED ZONE = UnsafeStorage.GetSystemUZone[]; InitFindCircularGarbage [nObjects: nObjects, uZone: uZone, reportRopes: reportRopes]; FOR index: INT _ circularGarbageSeq.put, index-1 UNTIL index <= 0 DO garbage _ CONS[circularGarbageSeq[index-1].type, garbage]; circularGarbageSeq[index-1] _ NIL; ENDLOOP; uZone.FREE[@circularGarbageSeq]; circularGarbageSeq _ NIL; findingCircularGarbage _ FALSE; nGarbage _ objectsGarbage; nSeen _ objectsSeen; }; FindCircularGarbage: PUBLIC PROC [nObjects: CARDINAL, reportRopes: BOOL _ TRUE] RETURNS [ nGarbage, nSeen: INT, garbage: LIST OF REF _ NIL] = { <> uZone: UNCOUNTED ZONE = UnsafeStorage.GetSystemUZone[]; InitFindCircularGarbage [nObjects: nObjects, uZone: uZone, reportRopes: reportRopes]; FOR index: INT _ circularGarbageSeq.put, index-1 UNTIL index <= 0 DO garbage _ CONS[AllocatorOps.NHPToREF[circularGarbageSeq[index-1]], garbage]; circularGarbageSeq[index-1] _ NIL; ENDLOOP; uZone.FREE[@circularGarbageSeq]; circularGarbageSeq _ NIL; findingCircularGarbage _ FALSE; nGarbage _ objectsGarbage; nSeen _ objectsSeen; }; FindConnectedComponent: PUBLIC PROC [rootObject: REF ANY, nObjects: CARDINAL, reportRopes: BOOL _ TRUE] RETURNS [ allOnList: BOOL _ TRUE, countReturned: INT _ 1, circularObjects: LIST OF REF _ NIL ] = { <> putAREF: PROC [itemToPut: REF, ItemTV: AMTypes.TV] RETURNS [tooMany: BOOL _ FALSE] = { isADup: PROC [itemREF: REF] RETURNS [dup: BOOL _ FALSE] = { FOR l: LIST OF REF _ circularObjects, l.rest UNTIL l = NIL DO IF l.first = itemREF THEN RETURN[TRUE]; ENDLOOP; }; IF ~isADup[itemToPut] AND ~AMTypes.IsNil[ItemTV] THEN { IF countReturned >= nObjects THEN RETURN[TRUE]; lastItem.rest _ CONS[itemToPut, NIL]; lastItem _ lastItem.rest; countReturned _ countReturned + 1; }; }; putList: PROC [node: AMTypes.TV] RETURNS [tooMany: BOOL _ FALSE] = { WHILE node # NIL DO elem: AMTypes.TV; elemREF: REF; elemLC: LONG CARDINAL; elem _ AMTypes.IndexToTV[node, 2]; IF node = NIL THEN EXIT; IF reportRopes OR AMTypes.TVType[elem] # ropeRepType THEN { elemLC _ AMBridge.TVToLC[elem]; elemREF _ LOOPHOLE[elemLC]; IF putAREF[elemREF, elem] THEN RETURN[TRUE]; }; node _ AMTypes.Referent[AMTypes.IndexToTV[node, 2]]; ENDLOOP; }; doRecord: PROC [recordTV: AMTypes.TV] RETURNS [tooMany: BOOL _ FALSE] = { currentType: SafeStorage.Type; underClassCurrentType: AMTypes.Class; currentType _ AMTypes.TVType[recordTV]; underClassCurrentType _ AMTypes.UnderClass[currentType]; IF underClassCurrentType = record OR underClassCurrentType = structure THEN { components: AMTypes.Index; components _ AMTypes.NComponents[currentType]; FOR index: AMTypes.Index IN [1..components] DO underTypeAndClass: PROC [type: Type] RETURNS [under: Type, class: AMTypes.Class] = { under _ type; WHILE (class _ AMTypes.TypeClass[under]) = definition DO under _ AMTypes.UnderType[under]; ENDLOOP; }; refIsOK: BOOL _ TRUE; itemTV: AMTypes.TV; itemType: SafeStorage.Type; itemUnderType: SafeStorage.Type; itemClass: AMTypes.Class; itemREF: REF; itemTV _ AMTypes.IndexToTV[recordTV, index]; itemType _ AMTypes.TVType[itemTV]; [itemUnderType, itemClass] _ underTypeAndClass[itemType]; SELECT itemClass FROM ref => { itemLC: LONG CARDINAL; IF ~reportRopes AND itemType = ropeRepType THEN LOOP; itemLC _ AMBridge.TVToLC[itemTV]; < {refIsOK _ FALSE; CONTINUE;}];>> IF refIsOK THEN { itemREF _ LOOPHOLE[itemLC]; IF putAREF[itemREF, itemTV] THEN RETURN[TRUE]; }; }; list => { IF AMTypes.IsNil[itemTV] THEN LOOP; IF putList[AMTypes.Referent[itemTV]] THEN RETURN [TRUE]; }; union => { IF index = components THEN { IF ~AMTypes.IsOverlaid[itemUnderType] AND ~AMTypes.IsComputed[itemUnderType] THEN { variantTV: AMTypes.TV; variantTV _ AMTypes.Variant[itemTV]; IF doRecord[variantTV] THEN RETURN [TRUE]; }; }; }; ENDCASE; ENDLOOP; }; }; lastItem: LIST OF REF _ NIL; currentItem: LIST OF REF _ NIL; circularObjects _ CONS[rootObject, NIL]; lastItem _ circularObjects; ropeRepType _ CODE[Rope.RopeRep]; currentItem _ circularObjects; WHILE currentItem # NIL DO currentTV: AMTypes.TV; currentType: SafeStorage.Type; skipThisOne: BOOL _ FALSE; underClassCurrentType: AMTypes.Class; currentTV _ AMBridge.TVForReferent[ref: currentItem.first ! AMTypes.Error => {skipThisOne _ TRUE; CONTINUE;}]; -- error on ATOMs and ROPEs IF ~skipThisOne THEN { currentType _ AMTypes.TVType[currentTV]; underClassCurrentType _ AMTypes.UnderClass[currentType]; IF underClassCurrentType = record OR underClassCurrentType = structure THEN { IF doRecord[currentTV] THEN RETURN[FALSE, countReturned, circularObjects]; }; }; currentItem _ currentItem.rest; ENDLOOP; }; ActuallyDoIt: PROC [ignoreStack: BOOL _ FALSE] = { clearRC: PROC [nhp: NHeaderP] = { objectsSeen _ objectsSeen + 1; nhp.inZCT _ FALSE; nhp.maybeOnStack _ FALSE; <> nhp.refCount _ 0; nhp.rcOverflowed _ FALSE; }; <<>> <> objectsSeen _ 0; objectsKept _ objectsReclaimed _ 0; nRCGlobalFrames _ nGlobalFrames _ nLocalFrames _ 0; nRetainedObjects _ 0; nextRpaIndex _ 0; nRefsPushed _ 0; <> ZCT.zct.bsiToFreeList _ ALL[NIL]; AllocatorOps.Reset[]; <> ZCT.zct.markingDecrements _ FALSE; ZCT.zct.rp _ ZCT.zct.wp _ ZCT.zct.rp - Basics.BITAND[ Basics.LowHalf[LOOPHOLE[ZCT.zct.rp, CARD]], ZCT.zctBlockWords-1 ]; <> <> ZCT.RCOvReset[]; AllObjects[clearRC]; <> IF NOT ignoreStack THEN RTFrameHeapSnapshot.MapUncountedBodies[TraceLocalFrame]; [] _ LoadState.local.EnumerateAllModules[order: newestFirst, proc: TraceGlobalFrame]; <> UNTIL refStackChain = NIL DO TraceRefsInObject[LOOPHOLE[PopRef[], REF]] ENDLOOP; FreeRefStacks[]; <<>> <> <> AllObjects[visitOneObject]; IF objectsReclaimed + objectsKept # objectsSeen THEN ERROR; }; DoTraceAndSweepCollection: PROC = { haveAllocatorLocked: PROC = { <> haveRCOvLocked: PROC = { <> haveZCTLocked: PROC = { <> RTFrameHeapSnapshot.AcquireFrameHeapSnapshot[]; { ENABLE UNWIND => RTFrameHeapSnapshot.ReleaseFrameHeapSnapshot[]; ActuallyDoIt[ignoreStack: FALSE]; IF destructiveTestEnabled THEN { ActuallyDoIt[ignoreStack: TRUE]; DebuggerSwap.CallDebugger["destructive collection finished."]; }; RTFrameHeapSnapshot.ReleaseFrameHeapSnapshot[]; }; }; <> <> ZCT.EnterAndCallBack[haveZCTLocked]; }; <> <> ZCT.EnterRCOvAndCallBack[haveRCOvLocked]; }; <<>> <> <> LoadState.local.Acquire[exclusive]; <> AllocatorOps.EnterAndCallBack[haveAllocatorLocked ! UNWIND => LoadState.local.Release[]]; <> LoadState.local.Release[]; }; visitOneObject: PROC [nhp: NHeaderP] = { <> dummy: REF _ NIL; ref: REF = AllocatorOps.NHPToREF[nhp]; bumpRC: PROC [] = { RCMicrocodeOps.ASSIGNREF[rhs: ref, lhs: @dummy ! RCMicrocodeOps.RCOverflowOccurred => { ZCT.InnerHandleRCOverflow[ref]; RETRY}; ]; dummy _ NIL; }; header: Allocator.NormalHeader _ nhp^; <> IF findingCircularGarbage AND nhp.type = listOfGFContextRecType THEN { <<``LIST OF AMModelContextImpl.GFContextRec'' have some problem, probably due to some unsafety in the interpreter. Bump the reference count to avoid it.>> bumpRC[]; header _ nhp^; }; SELECT TRUE FROM NOT header.f AND NOT header.inZCT => { <> IF findingCircularGarbage AND nhp.type # nullType THEN { objectsGarbage _ objectsGarbage + 1; bumpRC[]; bumpRC[]; bumpRC[]; bumpRC[]; IF nhp.type # typedVariableType AND nhp.type # listOfGFContextRecType AND (nhp.type # ropeRepType OR rememberRopes) THEN { IF circularGarbageSeq.put < circularGarbageSeq.max THEN { circularGarbageSeq[circularGarbageSeq.put] _ nhp; circularGarbageSeq.put _ circularGarbageSeq.put + 1; }; }; header _ nhp^; <> } ELSE { objectsReclaimed _ objectsReclaimed + 1; AllocatorOps.TAndSFreeObject[nhp]; RETURN; }; }; header.f => { <> packageCount: NAT _ RTTypesBasicPrivate.NumberPackageRefs[nhp.type]; dummy: REF _ AllocatorOps.NHPToREF[nhp]; FOR i: CARDINAL IN [1..packageCount] DO IF nhp.refCount = 0 AND NOT nhp.rcOverflowed THEN { <> IF forgivingLog = NIL THEN forgivingLog _ VM.AddressForPageNumber[VM.SimpleAllocate[ForgivingLogPages].page]; forgivingLog[forgivingLogIndex] _ ForgivingLogEntry[nhp, header]; forgivingLogCount _ forgivingLogCount + 1; IF NOT forgiving THEN DebuggerSwap.CallDebugger["Unforgivable!"L]; IF forgivingLogIndex = ForgivingLogEntries-1 THEN forgivingLogIndex _ 0 ELSE forgivingLogIndex _ forgivingLogIndex + 1; EXIT; }; <> RCMicrocodeOps.ASSIGNREF[rhs: NIL, lhs: @dummy ! RCMicrocodeOps.RCUnderflowOccurred => { ZCT.InnerHandleRCUnderflow[dummy]; RETRY}]; ENDLOOP; header _ nhp^; <> }; ENDCASE; <> objectsKept _ objectsKept + 1; nhp.inZCT _ FALSE; IF header.refCount = 0 AND NOT header.rcOverflowed THEN { <> IF NOT header.f THEN { rpa[nextRpaIndex] _ LOOPHOLE[AllocatorOps.NHPToREF[nhp], LONG POINTER]; IF nextRpaIndex < maxNRPIndex THEN nextRpaIndex _ nextRpaIndex + 1; nRetainedObjects _ nRetainedObjects + 1; }; <> RCMicrocodeOps.OnZ[nhp ! RCMicrocodeOps.ZCTFull => DebuggerSwap.CallDebugger["TAndS disaster."]]; }; }; TraceLocalFrame: PROC [d: LONG DESCRIPTOR FOR ARRAY OF WORD] = { <> pa: LONG POINTER TO LONG POINTER = LOOPHOLE[BASE[d], LONG POINTER TO LONG POINTER]; nWords: CARDINAL = LENGTH[d]; nLocalFrames _ nLocalFrames + 1; IF nWords >= SIZE[REF] THEN FOR i: CARDINAL IN [0..nWords-SIZE[REF]] DO addr: LONG POINTER = (pa+i)^; IF addr # NIL AND AllocatorOps.IsValidRef[addr] THEN { <> ref: REF = LOOPHOLE[addr, REF]; nhp: Allocator.NHeaderP _ AllocatorOps.REFToNHP[ref]; IF suspectRef # NIL AND addr = suspectRef THEN suspectRefFoundInLocalFrame _ TRUE; IF NOT nhp.inZCT THEN { <> nhp.inZCT _ TRUE; IF RTTypesBasicPrivate.MapTiRcmx[SafeStorage.GetReferentType[ref]] # RCMap.nullIndex THEN PushRef[LOOPHOLE[ref, LONG POINTER]]; }; }; ENDLOOP; }; TraceGlobalFrame: PROC [configID: LoadState.ConfigID, moduleIndex: LoadState.ModuleIndex] RETURNS [stop: BOOL _ FALSE] = { gfh: PrincOps.GlobalFrameHandle = LoadState.local.ModuleToGlobalFrame[configID, moduleIndex]; <> <> type: Type _ LoadState.local.GlobalFrameToType[gfh]; procRef: PROC [ref: REF] = { SELECT LOOPHOLE[ref, LONG POINTER] FROM NIL => RETURN; suspectRef => gfhToSuspectRef _ gfh; ENDCASE; { <> nhp: Allocator.NHeaderP _ AllocatorOps.REFToNHP[ref]; dummy: REF _ NIL; IF NOT nhp.inZCT THEN { <> nhp.inZCT _ TRUE; IF RTTypesBasicPrivate.MapTiRcmx[SafeStorage.GetReferentType[ref]] # RCMap.nullIndex THEN PushRef[LOOPHOLE[ref, LONG POINTER]]; }; <> RCMicrocodeOps.ASSIGNREF[rhs: ref, lhs: @dummy ! RCMicrocodeOps.RCOverflowOccurred => { ZCT.InnerHandleRCOverflow[ref]; RETRY}; ]; }; }; nGlobalFrames _ nGlobalFrames + 1; IF type # nullType THEN { nRCGlobalFrames _ nRCGlobalFrames + 1; RTTypesBasicPrivate.MapRefs[LONG[gfh], RTTypesBasicPrivate.MapTiRcmx[type], procRef]; }; RETURN[FALSE]; }; TraceRefsInObject: PROC [container: REF] = { <> type: Type _ SafeStorage.GetReferentType[container]; refererPushed: BOOL _ FALSE; procRef: PROC [ref: REF] = { SELECT LOOPHOLE[ref, LONG POINTER] FROM NIL => RETURN; suspectRef => IF NOT refererPushed THEN { nhp: NHeaderP = AllocatorOps.REFToNHP[container]; refererPushed _ TRUE; IF nSuspectReferers < maxNReferers THEN { suspectReferers[nSuspectReferers] _ nhp; nSuspectReferers _ nSuspectReferers + 1; }; FOR i: NAT IN [0..nInnerReferers) DO IF nhp = innerReferers[i] THEN GO TO circular; ENDLOOP; IF NOT circularStructureFound AND nInnerReferers < maxNInnerReferers THEN { innerReferers[nInnerReferers] _ nhp; nInnerReferers _ nInnerReferers + 1; }; EXITS circular => circularStructureFound _ TRUE; }; ENDCASE; { <> nhp: Allocator.NHeaderP _ AllocatorOps.REFToNHP[ref]; dummy: REF _ NIL; IF NOT nhp.inZCT THEN { <> nhp.inZCT _ TRUE; IF RTTypesBasicPrivate.MapTiRcmx[SafeStorage.GetReferentType[ref]] # RCMap.nullIndex THEN PushRef[LOOPHOLE[ref, LONG POINTER]]; }; <> RCMicrocodeOps.ASSIGNREF[rhs: ref, lhs: @dummy ! RCMicrocodeOps.RCOverflowOccurred => { ZCT.InnerHandleRCOverflow[ref]; RETRY}; ]; }; }; DO oldNRefsPushed: INT = nRefsPushed; RTTypesBasicPrivate.MapRefs[ LOOPHOLE[container, LONG POINTER], RTTypesBasicPrivate.MapTiRcmx[type], procRef]; IF nRefsPushed-oldNRefsPushed # 1 THEN RETURN; container _ LOOPHOLE[PopRef[], REF]; type _ SafeStorage.GetReferentType[container]; refererPushed _ FALSE; ENDLOOP; }; AllObjects: PROC [visit: PROC [NHeaderP]] = { <> qi: QuantumIndex _ FIRST[QuantumIndex]; DO <> hp: HeaderP; blockSize: INT _ 0; UNTIL AllocatorOps.quantumMap[qi] DO IF qi = LAST[QuantumIndex] THEN RETURN; qi _ qi+1; ENDLOOP; <> FOR hp _ QuantumIndexToLP[qi], hp + blockSize WHILE LOOPHOLE[hp, CARD] < LastAddress AND AllocatorOps.quantumMap[LPToQuantumIndex[hp]] DO nhp: NHeaderP _ LOOPHOLE[hp]; IF nhp.blockSizeIndex = bsiEscape THEN nhp _ nhp + (SIZE[ExtendedHeader] - SIZE[NormalHeader]); blockSize _ AllocatorOps.BlockSize[hp]; visit[nhp]; ENDLOOP; IF LOOPHOLE[hp, CARD] >= LastAddress THEN RETURN; qi _ LPToQuantumIndex[hp]; ENDLOOP; }; logWordsPerQuantum: NAT = PrincOps.logWordsPerPage+Allocator.logPagesPerQuantum; <> LPToQuantumIndex: PROC [lp: LONG POINTER] RETURNS [QuantumIndex] = INLINE { RETURN[AllocatorOps.AddressToQuantumIndex[LOOPHOLE[lp]]]; }; QuantumIndexToLP: PROC [qi: QuantumIndex] RETURNS [LONG POINTER] = INLINE { RETURN [Basics.DoubleShiftLeft[ [pair[lo: qi, hi: 0]], logWordsPerQuantum].lp ]; }; PushRef: PROC [pref: LONG POINTER] = { <> stack: RefStack _ refStackChain; IF stack = NIL OR stack.size = stack.max THEN { <