ReclaimFreePages.mesa
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) January 3, 1986 1:26:39 pm PST
ReclaimFreePages.Reclaim[] reclaims freeable quanta from the small object free lists. A freeable quantum is one that only holds free objects. Executing Reclaim[] holds the allocator lock for only small amounts of time, although it must not be allowed to run concurrently with the TraceAndSweep collector.
DIRECTORY
Allocator USING [BlockSizeIndex, bsiEscape, FNHeaderP, pagesPerQuantum, QuantumIndex, wordsPerQuantum],
AllocatorOps USING [AddressToQuantumIndex, bsiToSize, quantumMap],
Basics USING [LongNumber],
Commander USING [CommandProc, Register],
CommandTool USING [ArgumentVector, Failed, Parse],
Convert USING [Error, IntFromRope],
IO USING [PutFR1],
PrincOps USING [PageCount, PageNumber],
Process USING [Detach, Pause, SecondsToTicks],
SafeStorage USING [nullType, ReclaimCollectibleObjects, WaitForCollectorDone, WaitForCollectorStart],
VM USING [Free, PageCount, PageNumber],
ZCT USING [EnterAndCallBack, zct];
ReclaimFreePages:
PROGRAM
IMPORTS AllocatorOps, Commander, CommandTool, Convert, IO, SafeStorage, Process, VM, ZCT
= BEGIN
Types, constants, and global variables
BlockSizeIndex:
TYPE = Allocator.BlockSizeIndex;
bsiEscape: BlockSizeIndex = Allocator.bsiEscape;
CARD: TYPE = LONG CARDINAL;
QuantumIndex: TYPE = Allocator.QuantumIndex;
FNHeaderP: TYPE = Allocator.FNHeaderP;
wordsPerQuantum: CARDINAL = Allocator.wordsPerQuantum;
StatsRecord:
TYPE =
RECORD [
autoForked:
BOOL ←
FALSE,
TRUE if a command was used to call ForkHelper
helpWait: [0..60] ← 0,
the # of seconds to wait
sortAll:
INT ← 0,
the # of times sortAll was called
bsiSorts:
INT ← 0,
the # of bsi sorts we needed to perform
conflicts:
INT ← 0,
the # of times that a bsi's free list was added to while we were sorting that bsi
objects:
INT ← 0,
the total # of free objects left in lists after the sort (& prune)
avgFreeLength:
REAL ← 0.0,
objects/bsiSorts
totalPagesFreed:
INT ← 0
the total # of pages freed by this module
];
checking: BOOL ← TRUE;
helpEnabled: BOOL ← TRUE;
stats: REF StatsRecord ← NEW[StatsRecord];
ForkHelper:
PROC [seconds: [0..60] ← 10] = {
Forks a watching process that calls SortAll[TRUE] after a number of seconds followed by a GC.
Process.Detach[FORK HelperBase[seconds]];
};
HelperBase:
PROC [seconds: [0..60] ← 10] = {
stats.helpWait ← seconds;
WHILE helpEnabled
DO
Process.Pause[Process.SecondsToTicks[stats.helpWait]];
[] ← SafeStorage.WaitForCollectorStart[];
[] ← SafeStorage.WaitForCollectorDone[];
[] ← SortAll[TRUE];
ENDLOOP;
};
Reclaim:
PROC [nGCs:
NAT ← 1]
RETURNS [pagesFreed:
INT ← 0] = {
Causes a number of GCs, then reclaims all freeable quanta.
THROUGH [0..nGCs) DO SafeStorage.ReclaimCollectibleObjects[]; ENDLOOP;
RETURN [SortAll[TRUE]];
};
SortAll:
PROC [prune:
BOOL ←
FALSE]
RETURNS [pagesFreed:
INT ← 0] = {
SortAll sorts all of the free lists, optionally reclaiming the freeable quanta.
stats.sortAll ← stats.sortAll + 1;
FOR bsi: BlockSizeIndex
IN BlockSizeIndex
DO
pagesFreed ← pagesFreed + SortBsi[bsi, prune];
ENDLOOP;
};
SortBsi:
PROC [bsi: BlockSizeIndex, prune:
BOOL ←
FALSE]
RETURNS [pagesFreed:
INT ← 0] = {
SortBsi sorts the free list for the given block size, then optionally reclaims the freeable quanta.
inner1:
PROC = {
Capture the free list for this bsi. Alterations to this chain have been locked out.
head ← CaptureFreeChain[bsi];
};
inner2:
PROC = {
Install the sorted free list, merging with any newly freed entries. Alterations to this chain have been locked out. Supposedly few objects have been added to the free list since we last captured it.
newHead: FNHeaderP ← CaptureFreeChain[bsi];
IF newHead #
NIL
THEN {
stats.conflicts ← stats.conflicts + 1;
newHead ← SortFree[newHead];
head ← MergeFree[head, newHead];
};
ZCT.zct.bsiToFreeList[bsi] ← head;
head ← newHead;
};
head: FNHeaderP ← ZCT.zct.bsiToFreeList[bsi];
IF head #
NIL
THEN {
Sort the free list.
stats.bsiSorts ← stats.bsiSorts + 1;
ZCT.EnterAndCallBack[inner1];
IF checking THEN CheckValidity[head, bsi];
head ← SortFree[head];
IF prune
THEN {
IF checking THEN CheckValidity[head, bsi, TRUE];
[head, pagesFreed] ← PruneList[head];
};
CheckValidity[head, bsi, TRUE, TRUE];
ZCT.EnterAndCallBack[inner2];
stats.avgFreeLength ← stats.objects*1.0/stats.bsiSorts;
};
stats.totalPagesFreed ← stats.totalPagesFreed + pagesFreed;
};
CaptureFreeChain:
PROC [bsi: BlockSizeIndex]
RETURNS [head: FNHeaderP] =
INLINE {
Returns the free chain for the given block size. Assumes that the ZCT lock is held.
head ← ZCT.zct.bsiToFreeList[bsi];
ZCT.zct.bsiToFreeList[bsi] ← NIL;
};
CheckValidity:
PROC [head: FNHeaderP, bsi: BlockSizeIndex, sorted:
BOOL ←
FALSE, count:
BOOL ←
FALSE] = {
Checks some validity constraints on the free list. We assume that the free list must contain only objects with the given block size. If the list is supposed to be sorted, then we check for the list being in increasing address order.
FOR each: FNHeaderP ← head, each.nextFree
WHILE each #
NIL
DO
Validity check on the resulting list
next: FNHeaderP ← each.nextFree;
IF next = head THEN ERROR;
IF next = each THEN ERROR;
IF each.fnh.blockSizeIndex # bsi THEN ERROR;
IF each.fnh.type # SafeStorage.nullType THEN ERROR;
IF count THEN stats.objects ← stats.objects + 1;
IF sorted
THEN
Check for the list being sorted
IF next #
NIL
THEN
IF LOOPHOLE[each, CARD] >= LOOPHOLE[next, CARD] THEN ERROR;
ENDLOOP;
};
PruneList:
PROC [head: FNHeaderP]
RETURNS [new: FNHeaderP ←
NIL, pagesFreed:
INT ← 0] = {
Takes a free list and prunes it of entries that are on freeable pages, also freeing the pages. Returns the pruned free list and the number of pages freed.
free: FNHeaderP;
[new, free] ← SplitList[head];
IF free #
NIL
THEN {
each: FNHeaderP ← free;
lastQX: QuantumIndex ← AddressToQuantumIndex[each];
IF NOT OnQuantumBoundary[each] THEN ERROR;
WHILE each #
NIL
DO
link: FNHeaderP ← each.nextFree;
succ: FNHeaderP ← NextInAddress[each];
SELECT
TRUE
FROM
OnQuantumBoundary[succ] => {
We have scanned over a quantum's worth of free objects
succQX: QuantumIndex ← AddressToQuantumIndex[succ];
startPage: VM.PageNumber ← lastQX*Allocator.pagesPerQuantum;
pages: VM.PageCount ← (succQX-lastQX)*Allocator.pagesPerQuantum;
FOR qi: Allocator.QuantumIndex
IN [lastQX..succQX)
DO
We must clear these bits or T&S goes down the tubes.
AllocatorOps.quantumMap[qi] ← FALSE;
ENDLOOP;
VM.Free[[startPage, pages]];
pagesFreed ← pagesFreed + pages;
lastQX ← AddressToQuantumIndex[link];
IF NOT OnQuantumBoundary[link] THEN ERROR;
};
ENDCASE;
each ← link;
ENDLOOP;
};
};
SplitList:
PROC [head: FNHeaderP]
RETURNS [new, free: FNHeaderP] = {
Splits the given sorted list into two lists
new: the list of free objects that exist in the same quantum as at least one allocated object
free: the list of free objects that have no allocated objects in the same quantum
newTail: FNHeaderP ← new ← NIL;
freeTail: FNHeaderP ← free ← NIL;
each: FNHeaderP ← head;
WHILE each #
NIL
DO
IF OnQuantumBoundary[each]
THEN {
We can scan forward within the quantum sequence for adjacent objects.
lag: FNHeaderP ← each;
DO
scan: FNHeaderP ← NextInAddress[lag];
link: FNHeaderP ← lag.nextFree;
SELECT
TRUE
FROM
OnQuantumBoundary[scan] => {
We have found a quantum sequence full of free objects, so put all such objects onto the free chain.
IF freeTail = NIL THEN free ← each ELSE freeTail.nextFree ← each;
freeTail ← lag;
};
scan # link => {
The next object in the chain is not adjacent, so splice everything so far onto the new chain.
IF newTail = NIL THEN new ← each ELSE newTail.nextFree ← each;
newTail ← lag;
};
ENDCASE => {
We are still scanning within the quantum sequence
lag ← scan;
LOOP;
};
lag.nextFree ← NIL;
each ← link;
EXIT;
ENDLOOP;
}
ELSE {
This object can be linked onto the new chain.
next: FNHeaderP ← each.nextFree;
each.nextFree ← NIL;
IF newTail = NIL THEN new ← each ELSE newTail.nextFree ← each;
newTail ← each;
each ← next;
};
ENDLOOP;
};
NextInAddress:
PROC [fnp: FNHeaderP]
RETURNS [FNHeaderP] =
INLINE {
Returns the address just beyond the end of the given free object.
bsi: BlockSizeIndex ← fnp.fnh.blockSizeIndex;
len: CARDINAL ← AllocatorOps.bsiToSize[bsi];
RETURN [fnp+len];
};
OnQuantumBoundary:
PROC [head: FNHeaderP]
RETURNS [
BOOL] =
INLINE {
Returns TRUE iff the object is on a quantum boundary.
ln: Basics.LongNumber ← [lp[head]];
RETURN [(ln.lo MOD wordsPerQuantum) = 0];
};
AddressToQuantumIndex:
PROC [fnp: FNHeaderP]
RETURNS [QuantumIndex] =
INLINE {
Returns the quantum index for the given free object.
RETURN [AllocatorOps.AddressToQuantumIndex[LOOPHOLE[fnp]]];
};
Sorting functions
SortFree:
PROC [list: FNHeaderP]
RETURNS [FNHeaderP] = {
Sorts a free list into increasing address order. Uses an O(N log N) algorithm that uses O(log N) auxilliary storage (in local frames). Adapted from ListImpl.Sort.
innerSort:
PROC [head: FNHeaderP, max:
NAT]
RETURNS [new, next: FNHeaderP] = {
First, grab the first pair of elements off the head of the list and make sure that they are sorted. If there is only one element, we return it immediately. If there are only two elements in the list first sort them, then return them.
mid: FNHeaderP ← (new ← head).nextFree;
next ← NIL;
IF mid = NIL THEN RETURN;
next ← mid.nextFree;
IF
LOOPHOLE[new,
CARD] >
LOOPHOLE[mid,
CARD]
THEN {
The first two nodes are in the wrong order, so swap them, leaving new pointing at the lesser of the two, and mid pointing at the greater.
IF new = mid THEN ERROR;
mid.nextFree ← new; new ← mid; mid ← head;
};
mid.nextFree ← NIL;
IF next = NIL THEN RETURN;
Second, grab the second pair of elements off the list. We have already checked, and there is at least one.
next ← (mid ← next).nextFree;
IF next #
NIL
THEN {
There are two elements for the second pair, so we need to put them in order.
temp: FNHeaderP ← next;
next ← temp.nextFree;
temp.nextFree ← NIL;
IF
LOOPHOLE[mid,
CARD] >
LOOPHOLE[temp,
CARD]
THEN {
The first two nodes are in the wrong order, so swap them.
IF temp = mid THEN ERROR;
mid.nextFree ← NIL; temp.nextFree ← mid; mid ← temp}
};
Third, merge the two lead lists. If this exhausts the original list, then return.
new ← MergeFree[new, mid];
IF next = NIL THEN RETURN;
Finally, build up the tree by progressively building small lists and merging them into larger lists. The size doubles at each level. We start with new holding onto a list of 4 elements, and next holding onto the remainder of the list.
FOR depth:
NAT
IN [2..max)
DO
[mid, next] ← innerSort[next, depth];
new ← MergeFree[new, mid];
IF next = NIL THEN RETURN;
ENDLOOP;
};
IF list = NIL OR list.nextFree = NIL THEN RETURN [list];
RETURN [innerSort[list, 32].new];
};
MergeFree:
PROC [x,y: FNHeaderP]
RETURNS [new: FNHeaderP] = {
Merges two free lists (sorted in increasing address order). Adapted from ListImpl.Merge.
tail: FNHeaderP ← NIL;
Test for empty lists
IF x = NIL THEN RETURN [y];
IF y = NIL THEN RETURN [x];
new ← x;
IF
LOOPHOLE[x,
CARD] >
LOOPHOLE[y,
CARD]
THEN {new ← y; y ← x; x ← new};
Start from y, which we do by swapping x and y.
DO
We first assume that we have just appended from x, but need to advance x to the next element and check for emptiness. Once this is done we try to stay within x as long as the predicate allows.
DO
tail ← x; x ← x.nextFree;
IF x =
NIL
THEN {
IF tail = y THEN ERROR;
tail.nextFree ← y; RETURN};
IF LOOPHOLE[x, CARD] > LOOPHOLE[y, CARD] THEN EXIT;
ENDLOOP;
IF tail = y THEN ERROR;
tail.nextFree ← y;
We have just appended from y, so append to the list from y as long as reasonable.
DO
tail ← y; y ← y.nextFree;
IF y =
NIL
THEN {
IF tail = x THEN ERROR;
tail.nextFree ← x; RETURN};
IF LOOPHOLE[x, CARD] < LOOPHOLE[y, CARD] THEN EXIT;
ENDLOOP;
IF tail = x THEN ERROR;
tail.nextFree ← x;
ENDLOOP;
};
Initialization & commands
AutoReclaim: Commander.CommandProc =
TRUSTED {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
args: CommandTool.ArgumentVector ← CommandTool.Parse[cmd
! CommandTool.Failed => {msg ← errorMsg; GO TO failed}];
seconds: INT ← 64;
IF args.argc >= 2
THEN seconds ← Convert.IntFromRope[args[1]
! Convert.Error => {msg ← "illegal number"; GO TO failed}];
SELECT seconds
FROM
< 0 => seconds ← 0;
> 60 => seconds ← 60;
ENDCASE;
IF stats.autoForked
THEN {
stats.helpWait ← seconds;
msg ← IO.PutFR1["wait reset to %g seconds", [integer[seconds]] ];
}
ELSE {
stats.autoForked ← TRUE;
ForkHelper[seconds];
msg ← IO.PutFR1["forked with wait of %g seconds", [integer[seconds]] ];
};
EXITS failed => result ← $Failure;
};
ForceReclaim: Commander.CommandProc =
TRUSTED {
[cmd: Commander.Handle] RETURNS [result: REF ANY ← NIL, msg: ROPE ← NIL]
args: CommandTool.ArgumentVector ← CommandTool.Parse[cmd
! CommandTool.Failed => {msg ← errorMsg; GO TO failed}];
times: INT ← 1;
IF args.argc >= 2
THEN times ← Convert.IntFromRope[args[1]
! Convert.Error => {msg ← "illegal number"; GO TO failed}];
SELECT times
FROM
< 0 => times ← 0;
> 100 => times ← 100;
ENDCASE;
msg ← IO.PutFR1["%g pages reclaimed", [integer[Reclaim[times]]]];
EXITS failed => result ← $Failure;
};
Init:
PROC = {
Commander.Register[key: "AutoReclaimFreePages", proc: AutoReclaim, doc: "forks periodic free page reclaimer (optional argument of minimum seconds to wait)"];
Commander.Register[key: "ForceReclaimFreePages", proc: ForceReclaim, doc: "forces a free page reclamation (optional argument of # of GCs to perform first)"];
};
END.