-- 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 May 27, 1982 4:41 pm 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],
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};
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
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] =
{ 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;
};
-- return all quanta lying entirely within a free block
TrimPrefixedZone: ENTRY PROC[zn: PZone] =
{ 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)
OR (suffixLn > 0) AND (suffixLn < MinBlockSize) THEN LOOP;
-- forget it if fragments would be created
-- (NOTE could do better: internal quanta may be releaseable)
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.