<> <> <> <<>> <> 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 <> 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, <> helpWait: [0..60] _ 0, <> sortAll: INT _ 0, <> bsiSorts: INT _ 0, <> conflicts: INT _ 0, <> objects: INT _ 0, <> avgFreeLength: REAL _ 0.0, <> totalPagesFreed: INT _ 0 <> ]; checking: BOOL _ TRUE; helpEnabled: BOOL _ TRUE; stats: REF StatsRecord _ NEW[StatsRecord]; ForkHelper: PROC [seconds: [0..60] _ 10] = { <> 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] = { <> THROUGH [0..nGCs) DO SafeStorage.ReclaimCollectibleObjects[]; ENDLOOP; RETURN [SortAll[TRUE]]; }; SortAll: PROC [prune: BOOL _ FALSE] RETURNS [pagesFreed: INT _ 0] = { <> 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] = { <> inner1: PROC = { <> head _ CaptureFreeChain[bsi]; }; inner2: PROC = { <> 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 { <> 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 { <> head _ ZCT.zct.bsiToFreeList[bsi]; ZCT.zct.bsiToFreeList[bsi] _ NIL; }; CheckValidity: PROC [head: FNHeaderP, bsi: BlockSizeIndex, sorted: BOOL _ FALSE, count: BOOL _ FALSE] = { <> FOR each: FNHeaderP _ head, each.nextFree WHILE each # NIL DO <> 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 <> 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] = { <> 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] => { <> 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 <> 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] = { <> <> <> newTail: FNHeaderP _ new _ NIL; freeTail: FNHeaderP _ free _ NIL; each: FNHeaderP _ head; WHILE each # NIL DO IF OnQuantumBoundary[each] THEN { <> lag: FNHeaderP _ each; DO scan: FNHeaderP _ NextInAddress[lag]; link: FNHeaderP _ lag.nextFree; SELECT TRUE FROM OnQuantumBoundary[scan] => { <> IF freeTail = NIL THEN free _ each ELSE freeTail.nextFree _ each; freeTail _ lag; }; scan # link => { <> IF newTail = NIL THEN new _ each ELSE newTail.nextFree _ each; newTail _ lag; }; ENDCASE => { <> lag _ scan; LOOP; }; lag.nextFree _ NIL; each _ link; EXIT; ENDLOOP; } ELSE { <> 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 { <> bsi: BlockSizeIndex _ fnp.fnh.blockSizeIndex; len: CARDINAL _ AllocatorOps.bsiToSize[bsi]; RETURN [fnp+len]; }; OnQuantumBoundary: PROC [head: FNHeaderP] RETURNS [BOOL] = INLINE { <> ln: Basics.LongNumber _ [lp[head]]; RETURN [(ln.lo MOD wordsPerQuantum) = 0]; }; AddressToQuantumIndex: PROC [fnp: FNHeaderP] RETURNS [QuantumIndex] = INLINE { <> RETURN [AllocatorOps.AddressToQuantumIndex[LOOPHOLE[fnp]]]; }; <> SortFree: PROC [list: FNHeaderP] RETURNS [FNHeaderP] = { <> innerSort: PROC [head: FNHeaderP, max: NAT] RETURNS [new, next: FNHeaderP] = { <> mid: FNHeaderP _ (new _ head).nextFree; next _ NIL; IF mid = NIL THEN RETURN; next _ mid.nextFree; IF LOOPHOLE[new, CARD] > LOOPHOLE[mid, CARD] THEN { <> IF new = mid THEN ERROR; mid.nextFree _ new; new _ mid; mid _ head; }; mid.nextFree _ NIL; IF next = NIL THEN RETURN; <> next _ (mid _ next).nextFree; IF next # NIL THEN { <> temp: FNHeaderP _ next; next _ temp.nextFree; temp.nextFree _ NIL; IF LOOPHOLE[mid, CARD] > LOOPHOLE[temp, CARD] THEN { <> IF temp = mid THEN ERROR; mid.nextFree _ NIL; temp.nextFree _ mid; mid _ temp} }; <> new _ MergeFree[new, mid]; IF next = NIL THEN RETURN; <> 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] = { <> <<>> tail: FNHeaderP _ NIL; <> 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}; <> DO <> 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; <> 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; }; <> <<>> 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)"]; }; Init[]; END.