<> <> <> <> DIRECTORY Allocator USING [NHeaderP], AllocatorOps USING [FreeObject, NHPToREF, PlausibleRef, REFToNHP], Basics USING [LongNumber, BITAND, BITOR], Collector USING [], -- EXPORTS only RCMapOps USING [GetBase], RCMap USING [Index, Base, nullIndex], RCMicrocodeOps USING [ReclaimedRef], Rope USING [RopeRep, ROPE], RTTypesBasicPrivate USING [DoFREEify, MapTiTd], SafeStorage USING [Type]; ReclaimerImpl: PROGRAM IMPORTS AllocatorOps, Basics, RCMapOps, RCMicrocodeOps, RTTypesBasicPrivate EXPORTS Collector SHARES Rope = BEGIN OPEN SafeStorage; PtrToRef: TYPE = LONG POINTER TO REF ANY; RefIndex: TYPE = NAT; <> rcmb: RCMap.Base = RCMapOps.GetBase[].base; checking: BOOL = FALSE; Reclaim: PUBLIC PROC [nhp: Allocator.NHeaderP] = { IF RTTypesBasicPrivate.MapTiTd[nhp.type].rcmx = RCMap.nullIndex THEN AllocatorOps.FreeObject[nhp] ELSE { ref: REF _ AllocatorOps.NHPToREF[nhp]; PAPtr: TYPE = LONG POINTER TO PASeq; <> PASeq: TYPE = RECORD [ SEQUENCE COMPUTED RefIndex OF Basics.LongNumber ]; prev: LONG POINTER TO Basics.LongNumber _ NIL; DO <> UNTIL ref = NIL DO <> head: Allocator.NHeaderP = AllocatorOps.REFToNHP[ref]; refType: Type _ head.type; nextx: CARDINAL _ 0; < >> <> <> first: REF _ NIL; <> FreeRef: PROC [r: REF] = {DoFreeRef[r]}; DoFreeRef: PROC [r: REF] = INLINE { IF r # NIL THEN { IF checking AND NOT AllocatorOps.PlausibleRef[LOOPHOLE[r]] THEN ERROR; r _ RCMicrocodeOps.ReclaimedRef[r]; SELECT TRUE FROM r = NIL => {}; first = NIL => first _ r; nextx = 0 => { LOOPHOLE[ref, PAPtr][0] _ MarkBackPointer[LOOPHOLE[prev]]; LOOPHOLE[ref, PAPtr][1] _ LOOPHOLE[r, Basics.LongNumber]; nextx _ 2; }; ENDCASE => { LOOPHOLE[ref, PAPtr][nextx] _ LOOPHOLE[r, Basics.LongNumber]; nextx _ nextx + 1; }; }; }; <<***Start this iteration of inner loop 1 Here***>> { rcmx: RCMap.Index; IF refType = CODE[Rope.RopeRep] THEN <> WITH t: LOOPHOLE[ref, Rope.ROPE] SELECT FROM text => GO TO none; node => refType _ WITH v: t SELECT FROM substr => CODE[Rope.RopeRep.node.substr], concat => CODE[Rope.RopeRep.node.concat], replace => CODE[Rope.RopeRep.node.replace], object => CODE[Rope.RopeRep.node.object] ENDCASE => ERROR; ENDCASE => ERROR; <> rcmx _ RTTypesBasicPrivate.MapTiTd[refType].rcmx; WITH rcmr: rcmb[rcmx] SELECT FROM null => {}; oneRef => DoFreeRef[(LOOPHOLE[ref, PtrToRef]+rcmr.offset)^]; simple => FOR i: CARDINAL IN [0..rcmr.length) DO IF rcmr.refs[i] THEN DoFreeRef[(LOOPHOLE[ref, PtrToRef]+i)^]; ENDLOOP; ref => DoFreeRef[LOOPHOLE[ref, PtrToRef]^]; ENDCASE => RTTypesBasicPrivate.DoFREEify[LOOPHOLE[ref, PtrToRef], rcmx, FreeRef]; EXITS none => {}; }; IF nextx = 0 THEN AllocatorOps.FreeObject[head] <> <<(no extra objects to remember to reclaim later)>> ELSE prev _ LOOPHOLE[@LOOPHOLE[ref, PAPtr][nextx - 1]]; <> <<(must remember to reclaim it later; use ref^ for storage)>> ref _ first; <> ENDLOOP; DO <> p: Basics.LongNumber; SELECT TRUE FROM prev = NIL => RETURN; <> IsBackPointer[p _ prev^] => { <> AllocatorOps.FreeObject[AllocatorOps.REFToNHP[LOOPHOLE[prev, REF]]]; prev _ LOOPHOLE[UnmarkBackPointer[p]]; <> }; ENDCASE => { ref _ LOOPHOLE[p, REF]; prev _ prev - SIZE[REF]; <> EXIT; <> }; ENDLOOP; ENDLOOP; }; }; IsBackPointer: PROC [ptr: Basics.LongNumber] RETURNS[BOOL] = INLINE { RETURN[Basics.BITAND[ptr.highbits, BackPointerMarkBit] # 0]; }; BackPointerMarkBit: CARDINAL = 100000B; <> MarkBackPointer: PROC[ptr: Basics.LongNumber] RETURNS[Basics.LongNumber] = INLINE { ptr.highbits _ Basics.BITOR[ptr.highbits, BackPointerMarkBit]; RETURN[ptr]; }; UnmarkBackPointer: PROC[ptr: Basics.LongNumber] RETURNS[Basics.LongNumber] = INLINE { BackPointerUnmarkMask: CARDINAL = BackPointerMarkBit - 1; ptr.highbits _ Basics.BITAND[ptr.highbits, BackPointerUnmarkMask]; RETURN[ptr]; }; END.