-- ZoneCleanupImpl.Mesa -- last edited February 6, 1981 9:13 AM by Willie-Sue Haugeland -- last edit by Russ Atkinson, 17-Jul-81 14:12:24 -- last edited February 25, 1983 10:19 am by Paul Rovner DIRECTORY Inline, -- also for implicit imports RTBases USING[BaseOverhead], RTBasic USING[Pointer], RTFlags USING[checking, clearing], RTMicrocode USING[LONGZERO], RTQuanta USING[QuantumSizeMOD, LASTAddress, QuantumIndex, QuantumSize, QuantumCount], RTStorageOps USING[NotImplemented], Runs USING[Run], SafeStorage USING[], -- EXPORTs only UnsafeStorage USING[], -- EXPORTs only RTZones; ZoneCleanupImpl: MONITOR -- protects zones LOCKS zn.LOCK USING zn: PZone IMPORTS Inline, RTMicrocode, RTQuanta, RTStorageOps, RTZones EXPORTS SafeStorage, UnsafeStorage = BEGIN OPEN RTBasic, RTMicrocode, RTQuanta, RTZones; checking: BOOLEAN = FALSE; -- RTFlags.checking; -- Exported procedures (public) EraseZone: PUBLIC PROC[zone: ZONE] = BEGIN ERROR RTStorageOps.NotImplemented["EraseZone"]; -- zn: Zone = zone; -- WITH zn: zn SELECT FROM -- quantum => EraseQuantumZone[LOOPHOLE[@zn, QuantumZone]]; -- mixed => EraseMixedZone[LOOPHOLE[@zn, MixedZone]]; -- ENDCASE; END; TrimZone: PUBLIC SAFE PROC[zone: ZONE] = TRUSTED { WITH zn: LOOPHOLE[zone, PZone] SELECT FROM quantized => {TrimQuantizedZone[@zn]}; prefixed => {MergePrefixedZone[@zn]; TrimPrefixedZone[@zn]}; ENDCASE}; MergeUZone: PUBLIC PROC[zone: UNCOUNTED ZONE] = { WITH zn: LOOPHOLE[zone, LONG POINTER TO PZone]^ SELECT FROM prefixed => MergePrefixedZone[@zn]; ENDCASE}; TrimUZone: PUBLIC PROC[zone: UNCOUNTED ZONE] = { WITH zn: LOOPHOLE[zone, LONG POINTER TO PZone]^ SELECT FROM quantized => {TrimQuantizedZone[@zn]}; prefixed => {MergePrefixedZone[@zn]; TrimPrefixedZone[@zn]}; ENDCASE}; MergeAllPrefixedZones: PUBLIC SAFE PROC = TRUSTED { maxZi: ZoneIndex = GetZiNext[] - 1; FOR i: ZoneIndex IN [1..maxZi] DO zn: Zone = MapZiZn[i]; IF zn # NIL AND zn.sr = prefixed THEN MergePrefixedZone[LOOPHOLE[zn]]; ENDLOOP}; TrimAllZones: PUBLIC SAFE PROC = TRUSTED { FOR i: ZoneIndex IN [1..GetZiNext[] - 1] DO IF MapZiZn[i] # NIL THEN TrimZone[LOOPHOLE[MapZiZn[i]]]; ENDLOOP}; -- Internal procedures for quantum zones EraseQuantizedZone: PROC[zn: QuantizedZone] = -- *** dummy for now {NULL}; TrimQuantizedZone: ENTRY PROC[zn: PZone] = BEGIN ENABLE UNWIND => NULL; qzn: PQuantizedZone = LOOPHOLE[zn]; FOR i: CARDINAL IN [0..qzn.mAsz] DO -- for each subzone sz: SubZone = @qzn.pAsz[i]; size: LONG CARDINAL = sz.size; pSzFl: FreeList = @sz.fl; NodeProc: TYPE = PROC[ ptr: LONG POINTER TO LONG UNSPECIFIED, q: QuantumIndex, size: LONG CARDINAL, unlinkProc: PROC]; MapFl: PROC[procNode: NodeProc] = BEGIN -- Apply procNode to each node on a free list. flPrev: FreeList _ pSzFl; fl: FreeList; Unlink: PROC = { flPrev^ _ fl^; fl _ flPrev}; UNTIL (fl _ flPrev^) = NIL DO procNode[fl, MapPtrQ[fl], size, Unlink]; flPrev _ fl; ENDLOOP; END; -- Count the number of occupied words in each quantum as follows. -- Quanta with only one free node so far are linked on flOne. -- Quanta with more than one free node are linked on flMore, where -- the first node in the quantum is a QCounter and its successor -- is the link to the next such quantum's QCounter. QCounter: TYPE = MACHINE DEPENDENT RECORD [ empty: BOOLEAN _ FALSE, -- true iff this quantum is known empty count: [0..LAST[CARDINAL]/2], -- so empty + count fits in 1 word. -- limit should be QuantumSize. count of occupied words link: INTEGER -- should be (-QuantumSize..QuantumSize) -- self-relative link: points to a cell which contains a PQCounter ]; PQCounter: TYPE = LONG POINTER TO QCounter; PPQCounter: TYPE = LONG POINTER TO PQCounter; flOne: FreeList _ NIL; flMore: PQCounter _ NIL; FindOnOne: PROC[q: QuantumIndex] RETURNS[fl: FreeList] = BEGIN -- always deletes from flOne if successful flPrev: FreeList _ @flOne; UNTIL (fl _ flPrev^) = NIL DO IF MapPtrQ[fl] = q THEN BEGIN flPrev^ _ fl^; RETURN[fl]; END; flPrev _ fl; ENDLOOP; RETURN[NIL]; END; FindOnMore: PROC[q: QuantumIndex] RETURNS[flNext: PPQCounter] = BEGIN -- moves to head of flMore if successful flPrev: PPQCounter _ @flMore; pqc: PQCounter; UNTIL (pqc _ flPrev^) = NIL DO flNext _ LOOPHOLE[pqc+pqc.link]; IF MapPtrQ[pqc] = q THEN BEGIN IF pqc # flMore THEN BEGIN flPrev^ _ flNext^; -- delink here flNext^ _ flMore; -- insert at head flMore _ pqc; END; RETURN[flNext]; END; flPrev _ flNext; ENDLOOP; RETURN[NIL]; END; -- First pass, accumulate amount of occupied space in each quantum AccumNode: NodeProc = -- binds ptr, q, size, unlinkProc BEGIN fl: FreeList; qsize: CARDINAL = QuantumSize - (IF q = zn.qFirst THEN RTBases.BaseOverhead ELSE 0); IF size > qsize/2 THEN -- only one (free) node in this quantum BEGIN nq: QuantumCount = MapSizeNq[size]; unlinkProc[]; ReturnQuanta[zn, q, nq]; RETURN; END; IF FindOnMore[q] # NIL THEN -- found node is now head of flMore BEGIN flMore.count _ flMore.count - LOOPHOLE[size, Inline.LongNumber].lowbits; RETURN; END; unlinkProc[]; IF (fl _ FindOnOne[q]) # NIL THEN BEGIN IF size > qsize/3 THEN -- only two (free) nodes in this quantum BEGIN ReturnQuanta[zn, q, 1]; RETURN; END; fl^ _ LOOPHOLE[flMore]; -- move node from flOne to flMore flMore _ LOOPHOLE[ptr]; flMore^ _ [count: QuantumSize-LOOPHOLE[size, Inline.LongNumber].lowbits*2, link: Inline.LowHalf[fl]-Inline.LowHalf[ptr]]; RETURN; END; ptr^ _ flOne; -- first free node encountered in quantum flOne _ ptr; END; -- Second pass, free vacant quanta ReturnNode: NodeProc = -- binds ptr, q, size, unlinkProc BEGIN flNext: PPQCounter; IF (flNext _ FindOnMore[q]) # NIL THEN -- moves found node to head of flMore BEGIN empty: BOOLEAN _ flMore.empty; IF flMore.count < size THEN {empty _ flMore.empty _ TRUE}; -- quantum is returnable IF empty THEN unlinkProc[]; -- remove node from the free list flMore.count _ flMore.count+LOOPHOLE[size, Inline.LongNumber].lowbits; IF flMore.count = QuantumSize-(size + size) THEN -- last visit to this quantum BEGIN fl: FreeList _ LOOPHOLE[flMore]; flMore _ flNext^; -- removes node from flMore IF empty THEN ReturnQuanta[zn, q, 1] -- free the quantum ELSE -- return the flMore entry to the freelist BEGIN LOOPHOLE[flNext, FreeList]^ _ ptr^; ptr^ _ fl; fl^ _ LOOPHOLE[flNext, FreeList]; END; END; END; END; -- Finally, the driver IF SIZE[FreeList] < SIZE[QCounter] THEN ERROR; -- minimum free block size constraint IF IsSubZoneVacant[sz] THEN LOOP; MapFl[AccumNode]; MapFl[ReturnNode]; WHILE flMore # NIL DO -- return the flMore list to the free list fl1: FreeList _ LOOPHOLE[flMore]; fl2: FreeList _ LOOPHOLE[flMore+flMore.link]; flMore _ LOOPHOLE[fl2^]; fl1^ _ fl2; fl2^ _ pSzFl^; pSzFl^ _ fl1; ENDLOOP; IF flOne # NIL THEN -- return flOne list to freelist BEGIN fl: FreeList _ flOne; UNTIL fl^ = NIL DO fl _ fl^ ENDLOOP; fl^ _ pSzFl^; pSzFl^ _ flOne; END; ENDLOOP; -- for each subzone IF qzn.qNext # 0 THEN {ReturnQuanta[zn, qzn.qNext, qzn.qLast - qzn.qNext]; qzn.qNext _ qzn.qLast _ 0}; END; -- Internal procedures for heap zones ErasePrefixedZone: PROC[zn: PPrefixedZone] = {NULL}; -- *** dummy for now -- merge adjacent free blocks by scanning the free list MergePrefixedZone: ENTRY PROC[zn: PZone] = { ENABLE UNWIND => NULL; pzn: PPrefixedZone = LOOPHOLE[zn]; pfnFirst: PFreeNode _ @pzn.fnd; pfn: PFreeNode _ pfnFirst; UNTIL (pfn _ pfn.pfnNext) = pfnFirst DO pfnLength: LongNodeSize = NodeLength[pfn]; pfnEndpfn: PNode _ pfn + pfnLength; IF LOOPHOLE[pfnEndpfn, LONG CARDINAL] > LASTAddress THEN LOOP; IF MapPtrZf[LOOPHOLE[pfnEndpfn, Pointer]] = [prefixed[zi: zn.zi]] THEN { WITH pfnEnd: pfnEndpfn SELECT FROM free => -- next guy is free, merge it with pfn { newLength: LongNodeSize = pfnLength + NodeLength[@pfnEnd]; IF checking THEN {IF pfn.pfnNext.pfnPrev # pfn OR pfn.pfnPrev.pfnNext # pfn OR pfnEnd.pfnNext.pfnPrev # @pfnEnd OR pfnEnd.pfnPrev.pfnNext # @pfnEnd OR pfnLength < MinBlockSize OR NodeLength[@pfnEnd] < MinBlockSize THEN ERROR}; pfnEnd.pfnNext.pfnPrev _ pfnEnd.pfnPrev; pfnEnd.pfnPrev.pfnNext _ pfnEnd.pfnNext; IF RTFlags.clearing -- keep free objects clear THEN [] _ LONGZERO[@pfnEnd, SIZE[free NodeHeader]]; pfn.SizeLo _ LOOPHOLE[newLength, MDRLongNodeSize].lnsLo; pfn.SizeHi _ LOOPHOLE[newLength, MDRLongNodeSize].lnsHi; IF checking THEN CheckFreeChain[pfn]; pfn _ pfn.pfnPrev; }; ENDCASE; }; ENDLOOP; pzn.pfn _ pzn.fnd.pfnNext; }; CheckFreeChain: PROC [head: PFreeNode] = { p: PFreeNode _ head; IF p.pfnPrev.pfnNext # p THEN ERROR; DO next: PFreeNode _ p.pfnNext; IF next.pfnPrev # p THEN ERROR; p _ next; IF p = head THEN RETURN; ENDLOOP; }; EnumerateAllObjects: PROC[visit: PROC[REF]] = { -- this proc visits all non-free objects in a prefixed zone FOR zi: CARDINAL IN [0..MapZiZn.length) DO zone: PZone _ LOOPHOLE[MapZiZn[zi]]; IF zone = NIL THEN LOOP; IF zone.linkage.tag # collectible THEN LOOP; ObjectsInPrefixedZone[zone, visit]; ENDLOOP; }; ObjectsInPrefixedZone: ENTRY PROC [zn: PZone, visit: PROC[REF]] = { -- this proc visits all non-free objects in a prefixed zone ENABLE UNWIND => NULL; WITH z: zn SELECT FROM prefixed => -- look at all of the objects, both allocated and freed FOR r: Runs.Run _ z.runs, r.rnNext UNTIL r = NIL DO lim: PNode = LOOPHOLE[LONG[r.iTo] * RTQuanta.QuantumSize]; -- iTo not included ptr: PNode _ LOOPHOLE[LONG[r.iFrom] * RTQuanta.QuantumSize]; WHILE ptr # lim DO -- look at each object in the run size: LONG CARDINAL = NodeLength[ptr]; ref: REF _ LOOPHOLE[ptr + sizeNd]; IF RTFlags.checking AND size = 0 THEN ERROR; IF ptr.state # free THEN visit[ref]; IF RTFlags.checking AND size # NodeLength[ptr] THEN ERROR; -- oops, something changed! ptr _ ptr + size; ENDLOOP ENDLOOP; ENDCASE => ERROR; }; -- return all quanta lying entirely within a free block TrimPrefixedZone: ENTRY PROC[zn: PZone] = { ENABLE UNWIND => NULL; pzn: PPrefixedZone = LOOPHOLE[zn]; pfn: PFreeNode _ @pzn.fnd; UNTIL (pfn _ pfn.pfnNext) = @pzn.fnd DO -- foreach free block IF NodeLength[pfn] >= QuantumSize THEN { -- quick rejection if there can't be at least one wholly contained quantum qFirst: QuantumIndex _ MapPtrQ[pfn+(QuantumSize-1)]; qNext: QuantumIndex _ MapPtrQ[pfn+NodeLength[pfn]]; IF qNext > qFirst THEN -- if there is at least one wholly contained quantum { n: CARDINAL = QuantumSizeMOD[LOOPHOLE[pfn, LONG CARDINAL]]; -- nonsense because compiler can't know this MOD yields a short result prefixLn: CARDINAL _ (IF n = 0 THEN 0 ELSE QuantumSize-n); pfnEnd: PFreeNode = LOOPHOLE[pfn+NodeLength[pfn]]; -- not a free node suffixLn: CARDINAL _ QuantumSizeMOD[LOOPHOLE[pfnEnd, LONG CARDINAL]]; -- nonsense ditto tpfn: PFreeNode; -- Retain residual blocks before and after entire quanta IF (prefixLn > 0) AND (prefixLn < MinBlockSize) THEN {IF (qFirst _ qFirst + 1) = qNext THEN LOOP; prefixLn _ prefixLn + QuantumSize}; IF (suffixLn > 0) AND (suffixLn < MinBlockSize) THEN {IF (qNext _ qNext - 1) = qFirst THEN LOOP; suffixLn _ suffixLn + QuantumSize}; -- forget it if fragments would be created tpfn _ DelinkFreeNode[pfn]; IF prefixLn # 0 THEN AddBlock[pfn, prefixLn, @pzn.fnd]; IF suffixLn # 0 THEN AddBlock[pfnEnd-suffixLn, suffixLn, @pzn.fnd]; -- Finally, release the quanta ReturnQuanta[zn, qFirst, qNext-qFirst]; pfn _ tpfn; -- prepare for next iteration (new blocks may or may not be processed) }; -- if there is at least one wholly contained quantum }; ENDLOOP; pzn.pfn _ pzn.fnd.pfnNext; }; DelinkFreeNode: PROC[pfn: PFreeNode] RETURNS[pfnPrev: PFreeNode] = INLINE BEGIN pfnNext: PFreeNode = pfn.pfnNext; pfnNext.pfnPrev _ pfnPrev _ pfn.pfnPrev; pfnPrev.pfnNext _ pfnNext; END; END.