DIRECTORY
Allocator USING [BlockSizeIndex, bsiEscape, EHeaderP, ExtendedHeader, HeaderP, LastAddress, logPagesPerQuantum, NHeaderP, NormalHeader, QuantumIndex, RefCount],
AllocatorOps USING [AddressToQuantumIndex, bsiToSize, EnterAndCallBack, quantumMap],
Atom,
Basics,
BackStop USING [Call],
BasicTime USING [Now],
Commander USING [CommandProc, Register],
CommandTool USING [ArgumentVector, Failed, Parse],
DebuggerSwap USING [CallDebugger],
HashTable,
IO,
PrintTV USING [PrintType],
RCMap,
RefTab,
Rope USING [Fetch, Length, Match, ROPE, RopeRep],
RTTypesBasicPrivate,
RuntimeError USING [UNCAUGHT],
SafeStorage USING [GetCanonicalType, GetReferentType, nullType, ReclaimCollectibleObjects, Type, TypeIndex],
SymTab,
VM,
ZCT USING [EnterAndCallBack, EnterRCOvAndCallBack];
ExamineStorage: CEDAR PROGRAM
IMPORTS AllocatorOps, Atom, Basics, BackStop, BasicTime, Commander, CommandTool, DebuggerSwap, IO, PrintTV, Rope, RTTypesBasicPrivate, RuntimeError, SafeStorage, VM, ZCT
SHARES HashTable, Rope
= BEGIN

LORA: TYPE = LIST OF REF ANY;
ROPE: TYPE = Rope.ROPE;
LOR: TYPE = LIST OF ROPE;
STREAM: TYPE = IO.STREAM;
Type: TYPE = SafeStorage.Type;
nullType: Type = SafeStorage.nullType;

minType: SafeStorage.Type _ SafeStorage.nullType;
maxType: SafeStorage.Type _ [LAST[SafeStorage.TypeIndex]];

allowF: BOOL _ TRUE;
allowNotF: BOOL _ TRUE;

allowOver: BOOL _ TRUE;
allowNotOver: BOOL _ TRUE;

minBsi: Allocator.BlockSizeIndex _ FIRST[Allocator.BlockSizeIndex];
maxBsi: Allocator.BlockSizeIndex _ LAST[Allocator.BlockSizeIndex];

minRC: NAT _ FIRST[Allocator.RefCount];
maxRC: NAT _ LAST[Allocator.RefCount];

typeDepth: NAT _ 3;
typeWidth: NAT _ 4;
typeVerbose: BOOL _ FALSE;
typeRank: TypeIndex _ 10;

lastSample: TypeCounts _ NIL;
FindBadGuysProc: Commander.CommandProc = TRUSTED {
out: STREAM = cmd.out;
switches: Switches _ ALL[FALSE];
argsProcessed: NAT _ 0;
argv: CommandTool.ArgumentVector _ CommandTool.Parse[cmd: cmd, starExpand: FALSE
! CommandTool.Failed => {msg _ errorMsg; GO TO failed}];

eachObject: InfoProc = TRUSTED {
header: Allocator.NormalHeader _ objectHP^;
SELECT TRUE FROM
type < minType => {};
type > maxType => {};
type > RTTypesBasicPrivate.MapTiTd.length => {};
header.blockSizeIndex < minBsi => {};
header.blockSizeIndex > maxBsi => {};
header.f AND NOT allowF => {};
NOT header.f AND NOT allowNotF => {};
header.rcOverflowed AND NOT allowOver => {};
NOT header.rcOverflowed AND NOT allowNotOver => {};
header.refCount < minRC => {};
header.refCount > maxRC => {};
ENDCASE => {
td: RTTypesBasicPrivate.PTypeDesc _ RTTypesBasicPrivate.MapTiTd[type];
IF badGuys = maxBadGuyIndex
THEN badGuysMissed _ badGuysMissed + 1
ELSE {
badGuysArray[badGuys] _ [objectHP, header];
badGuys _ badGuys + 1};
};
RETURN [TRUE];
};

badGuysArray: ARRAY [0..maxBadGuyIndex) OF BadGuy;
BadGuy: TYPE = RECORD [
addr: Allocator.NHeaderP,
header: Allocator.NormalHeader
];
badGuys: [0..maxBadGuyIndex] _ 0;
badGuysMissed: INT _ 0;
maxBadGuyIndex: NAT = 64;

EnumerateCollectableStorage[eachObject];

IF badGuys = 0 THEN {msg _ "No bad guys found.\n"; RETURN};

FOR i: [0..maxBadGuyIndex) IN [0..badGuys) DO
badGuy: BadGuy _ badGuysArray[i];
IO.PutF1[out, "At %bB: ", [cardinal[LOOPHOLE[badGuy.addr]]] ];
PrintHeader[out, @badGuy.header ];
IO.PutRope[out, "\n" ];
ENDLOOP;

IF badGuysMissed # 0 THEN
IO.PutF1[out, "Bad guys missed: %g\n", [integer[badGuysMissed]] ];

EXITS
failed => {result _ $Failure};
};

TakeHeapStatsProc: Commander.CommandProc = TRUSTED {
out: STREAM = cmd.out;
switches: Switches _ ALL[FALSE];
argsProcessed: NAT _ 0;
argv: CommandTool.ArgumentVector _ CommandTool.Parse[cmd: cmd, starExpand: FALSE
! CommandTool.Failed => {msg _ errorMsg; GO TO failed}];

new: TypeCounts _ lastSample;
old: TypeCounts _ lastSample;
tc: TypeCounts _ lastSample;

switches['g] _ TRUE;
switches['w] _ TRUE;

FOR i: NAT IN [1..argv.argc) DO
arg: ROPE _ argv[i];
IF Rope.Match["-*", arg] THEN {
switches _ ProcessSwitches[switches, arg];
LOOP;
};
ENDLOOP;

IF NOT switches['r] THEN {
new _ InitTypeCounts[];
IF switches['g] THEN
SafeStorage.ReclaimCollectibleObjects[suspendMe: TRUE, traceAndSweep: FALSE];
SampleTypeCounts[tc: new, includeFree: switches['f]];
IF switches['d] AND old # NIL THEN tc _ DeltaTypeCounts[old, new] ELSE tc _ new;
};
IF tc # NIL AND NOT switches['s] THEN {
PrintTypeCounts[tc, out];
IF switches['o] THEN PrintRank[tc: tc, out: out, highestN: typeRank, countObjects: TRUE];
IF switches['w] THEN PrintRank[tc: tc, out: out, highestN: typeRank, countObjects: FALSE];
};
lastSample _ IF switches['n] THEN NIL ELSE new;
EXITS
failed => {result _ $Failure};
};

HeapValidProc: Commander.CommandProc = TRUSTED {
out: STREAM = cmd.out;
switches: Switches _ ALL[FALSE];
argsProcessed: NAT _ 0;
argv: CommandTool.ArgumentVector _ CommandTool.Parse[cmd: cmd, starExpand: FALSE
! CommandTool.Failed => {msg _ errorMsg; GO TO failed}];

FOR i: NAT IN [1..argv.argc) DO
arg: ROPE _ argv[i];
IF Rope.Match["-*", arg] THEN {
switches _ ProcessSwitches[switches, arg];
LOOP;
};
ENDLOOP;
worldSwap _ switches['w];
EnumerateCollectableStorage[NIL];
EXITS
failed => {result _ $Failure};
};

FindCyclicTypesProc: Commander.CommandProc = TRUSTED {
out: STREAM = cmd.out;
switches: Switches _ ALL[FALSE];
argsProcessed: NAT _ 0;
argv: CommandTool.ArgumentVector _ CommandTool.Parse[cmd: cmd, starExpand: FALSE
! CommandTool.Failed => {msg _ errorMsg; GO TO failed}];

new: TypeCounts _ lastSample;
old: TypeCounts _ lastSample;
tc: TypeCounts _ lastSample;

switches['g] _ TRUE;
switches['w] _ TRUE;
FOR i: NAT IN [1..argv.argc) DO
arg: ROPE _ argv[i];
IF Rope.Match["-*", arg] THEN {
switches _ ProcessSwitches[switches, arg];
LOOP;
};
ENDLOOP;
IF NOT switches['r] THEN {
base: BasePtr = SetupBase[];
{ENABLE UNWIND => CleanupBase[base];
sawATrue, sawAFalse: BOOL _ FALSE;
Cyclic: UNSAFE PROC [nhp: Allocator.NHeaderP] RETURNS [cyclic: BOOL] --VertexTest-- = {
cyclic _ ReadFlags[base, nhp].cyclic;
IF cyclic THEN sawATrue _ TRUE ELSE sawAFalse _ TRUE;
};
IF switches['g] THEN
SafeStorage.ReclaimCollectibleObjects[];
EnumerateEdges[base: base, Startworthy: True, Transparent: True, IsGoal: False, ConsumeGoal: NIL, cumulative: TRUE];
new _ InitTypeCounts[];
SampleTypeCounts[tc: new, includeFree: FALSE, Filter: Cyclic];
IF switches['d] AND old # NIL THEN tc _ DeltaTypeCounts[old, new] ELSE tc _ new;
}--end base--;
CleanupBase[base];
};
IF NOT switches['s] THEN {
PrintTypeCounts[tc, out, "\n-- Only cyclic objects are counted --"];
IF switches['o] THEN 
PrintRank[tc: tc, out: out, highestN: typeRank, countObjects: TRUE];
IF switches['w] THEN 
PrintRank[tc: tc, out: out, highestN: typeRank, countObjects: FALSE];
};
lastSample _ IF switches['n] THEN NIL ELSE new;

EXITS
failed => {result _ $Failure};
};

True: PROC [nhp: Allocator.NHeaderP] RETURNS [BOOL] --VertexTest-- = {
RETURN [TRUE]};

False: PROC [nhp: Allocator.NHeaderP] RETURNS [BOOL] --VertexTest-- = {
RETURN [FALSE]};


TypeSet: TYPE = REF TypeSetPrivate;
TypeSetPrivate: TYPE = RECORD [members: PACKED SEQUENCE length: TypeIndex OF BOOL];

TypeList: TYPE = LIST OF Type;

FromList: PROC [list: TypeList] RETURNS [ts: TypeSet] = TRUSTED {
ts _ NEW [TypeSetPrivate[RTTypesBasicPrivate.MapTiTd.length+64]];
FOR ti: INT IN [0 .. ts.length) DO ts[ti] _ FALSE ENDLOOP;
FOR list _ list, list.rest WHILE list # NIL DO
type: Type = SafeStorage.GetCanonicalType[list.first];
ts[type] _ TRUE;
ENDLOOP;
};

HeaderSet: TYPE = REF HeaderSetPrivate;
HeaderSetPrivate: TYPE = RECORD [
length: INT _ 0,
headers: SEQUENCE size: NAT OF Allocator.NHeaderP
];

FindSome: PROC [goalType: Type, upTo: INT _ 5] RETURNS [headers: HeaderSet] = {
eachObject: UNSAFE PROC [type: Type, size: INT, object: Allocator.HeaderP, objectHP: Allocator.NHeaderP] RETURNS [continue: BOOLEAN _ TRUE] --InfoProc-- = TRUSTED {
IF goalType = type THEN {
headers[headers.length] _ objectHP;
headers.length _ headers.length + 1;
continue _ headers.length # headers.size;
};
};
headers _ NEW [HeaderSetPrivate[upTo]];
headers.length _ 0;
EnumerateCollectableStorage[eachObject];
};

aList: LORA = LIST[$Foo];
aRopeList: LOR = LIST["a rope"];
aPropList: Atom.PropList = Atom.PutPropOnList[NIL, $Foo, $bar];

basicBores: TypeList = LIST[
CODE[Rope.RopeRep],
SafeStorage.GetReferentType[aRopeList],
CODE[Atom.DottedPairNode],
SafeStorage.GetReferentType[aPropList],
SafeStorage.GetReferentType[aList]
];

moreBores: TypeList =
CONS[CODE[HashTable.TableRec],
CONS[CODE[HashTable.Seq],
CONS[CODE[HashTable.NodeRep],
CONS[CODE[SymTab.SymTabRep],
CONS[CODE[SymTab.Seq],
CONS[CODE[SymTab.NodeRep],
CONS[CODE[RefTab.RefTabRep],
CONS[CODE[RefTab.Seq],
CONS[CODE[RefTab.NodeRep],
basicBores]]]]]]]]];

ExamineRefs: PROC [goalList, transparentList: TypeList, log: STREAM, gcFirst, wordRank: BOOL _ TRUE, objectRank: BOOL _ FALSE] = TRUSTED {
goals: TypeSet = FromList[goalList];
transparents: TypeSet = FromList[transparentList];
tc: TypeCounts = InitTypeCounts[];
base: BasePtr = SetupBase[];
{ENABLE UNWIND => CleanupBase[base];
Startworthy: UNSAFE PROC [nhp: Allocator.NHeaderP] RETURNS [start: BOOL] --VertexTest-- = {
start _ NOT Transparent[nhp];
};
Transparent: UNSAFE PROC [nhp: Allocator.NHeaderP] RETURNS [is: BOOL] --VertexTest-- = {
is _ transparents[SafeStorage.GetCanonicalType[nhp.type]];
};
IsGoal: UNSAFE PROC [nhp: Allocator.NHeaderP] RETURNS [is: BOOL] --VertexTest-- = {
is _ goals[SafeStorage.GetCanonicalType[nhp.type]];
};
ConsumeGoal: UNSAFE PROC [startNHP, goalNHP: Allocator.NHeaderP] --GoalConsumer-- = {
size: LONG CARDINAL;
type: Type = startNHP.type;
IF goalNHP.blockSizeIndex = Allocator.bsiEscape THEN {
ehp: Allocator.EHeaderP _ LOOPHOLE[goalNHP + SIZE[Allocator.NormalHeader] - SIZE[Allocator.ExtendedHeader]];
SELECT ehp.sizeTag FROM
words =>  size _ ehp.extendedSize;
pages => size _ VM.WordsForPages[ehp.extendedSize];
ENDCASE => {Crash[goalNHP]; RETURN};
}
ELSE {
size _ AllocatorOps.bsiToSize[goalNHP.blockSizeIndex];
};
tc.objects _ tc.objects + 1;
tc.words _ tc.words + size;
IF type < tc.max THEN TRUSTED {
tcp: LONG POINTER TO TypeCount _ @tc[type];
IF tcp.objects = 0
THEN {
tcp.objects _ 1; tcp.words _ size; tc.types _ tc.types + 1;
}
ELSE {
tcp.objects _ tcp.objects + 1; tcp.words _ tcp.words + size;
};
};
};
IF gcFirst THEN SafeStorage.ReclaimCollectibleObjects[];
EnumerateEdges[base: base, Startworthy: Startworthy, Transparent: Transparent, IsGoal: IsGoal, ConsumeGoal: ConsumeGoal, cumulative: FALSE];
}--end base--;
CleanupBase[base];
PrintTypeCounts[tc, log];
IF objectRank THEN 
PrintRank[tc: tc, out: log, highestN: typeRank, countObjects: TRUE];
IF wordRank THEN 
PrintRank[tc: tc, out: log, highestN: typeRank, countObjects: FALSE];
};
Flags: TYPE = RECORD [
marked: BOOL _ FALSE,
stacked: BOOL _ FALSE,
cyclic: BOOL _ FALSE,
legal: BOOL _ FALSE
];
nullFlags: Flags = [];

FlagsArrayPtr: TYPE = LONG POINTER TO FlagsArray;
FlagsArray: TYPE = PACKED ARRAY FlagIndex OF Flags;

BasePtr: TYPE = LONG POINTER TO BaseArray;
BaseArray: TYPE = ARRAY BaseIndex OF FlagsArrayPtr;

FlagMod: NAT = 4096;
FlagIndex: TYPE = [0..FlagMod);
logFlagMod: NAT = 12;

BaseMod: NAT = 4096;
BaseIndex: TYPE = [0..BaseMod);

CyclicRef: UNSAFE PROC [base: BasePtr, ref: REF] RETURNS [BOOL] = UNCHECKED {
nhp: Allocator.NHeaderP = LOOPHOLE[ref, Allocator.NHeaderP] - SIZE[Allocator.NormalHeader];
RETURN [ReadFlags[base, nhp].cyclic];
};

ReadFlags: UNSAFE PROC [base: BasePtr, nhp: Allocator.NHeaderP] RETURNS [Flags] = UNCHECKED {
ln: Basics.LongNumber = LOOPHOLE[nhp];
ptr: FlagsArrayPtr = base[Basics.DoubleShiftRight[ln, logFlagMod+1].lo];
IF ln.lc >= Allocator.LastAddress THEN Crash[nhp];
IF ln.lo MOD 2 = 1 THEN Crash[nhp];
IF ptr = NIL THEN RETURN [nullFlags];
RETURN [ptr[(ln.lo / 2) MOD FlagMod]];
};

WriteFlags: UNSAFE PROC [base: BasePtr, nhp: Allocator.NHeaderP, flags: Flags] = UNCHECKED {
ln: Basics.LongNumber = LOOPHOLE[nhp];
xHi: NAT = Basics.DoubleShiftRight[ln, logFlagMod+1].lo;
ptr: FlagsArrayPtr _ base[xHi];
IF ln.lc >= Allocator.LastAddress THEN Crash[nhp];
IF ln.lo MOD 2 = 1 THEN Crash[nhp];
IF ptr = NIL THEN {
interval: VM.Interval _ VM.SimpleAllocate[VM.PagesForWords[ SIZE[FlagsArray] ]];
base[xHi] _ ptr _ VM.AddressForPageNumber[interval.page];
ptr^ _ ALL[nullFlags];
};
ptr[(ln.lo / 2) MOD FlagMod] _ flags;
};

SetupBase: UNSAFE PROC RETURNS [base: BasePtr] = UNCHECKED {
interval: VM.Interval _ VM.SimpleAllocate[VM.PagesForWords[ SIZE[BaseArray] ]];
base _ VM.AddressForPageNumber[interval.page];
base^ _ ALL[NIL];
};

CleanupBase: UNSAFE PROC [base: BasePtr] = UNCHECKED {
pages: NAT = VM.PagesForWords[ SIZE[FlagsArray] ];
FOR i: NAT IN BaseIndex DO
IF base[i] # NIL THEN {
page: VM.PageNumber = VM.PageNumberForAddress[base[i]];
base[i] _ NIL;
VM.Free[ [page, pages] ];
};
ENDLOOP;
VM.Free[ [VM.PageNumberForAddress[base], VM.PagesForWords[SIZE[BaseArray]] ]];
};

Switches: TYPE = PACKED ARRAY CHAR['a..'z] OF BOOL;

TypeIndex: TYPE = [0..LAST[SafeStorage.TypeIndex]-256];

LowRC: NAT = LAST[Allocator.RefCount]/4;
MidRC: NAT = LAST[Allocator.RefCount]/2;
HighRC: NAT = LAST[Allocator.RefCount];

TypeCounts: TYPE = REF TypeCountsRep;
TypeCountsRep: TYPE = RECORD [
types: INT _ 0,
objects: INT _ 0,
words: INT _ 0,
lowRC: ARRAY [0..LowRC] OF INT _ ALL[0],
midRC: INT _ 0,
highRC: INT _ 0,
overRC: INT _ 0,
inZCT: INT _ 0,
inZCT0: INT _ 0,
counts: SEQUENCE max: TypeIndex OF TypeCount
];

TypeCount: TYPE = RECORD [
objects: INT,
words: INT
];

TypeAccum: TYPE = REF TypeAccumRep;
TypeAccumRep: TYPE = RECORD [
SEQUENCE max: TypeIndex OF TypeAccumEntry
];
TypeAccumEntry: TYPE = RECORD [
type: TypeIndex _ 0,
count: INT _ 0
];

InitTypeCounts: PROC RETURNS [tc: TypeCounts] = TRUSTED {
index: TypeIndex _ RTTypesBasicPrivate.MapTiTd.length;
WHILE index > 0 DO
IF RTTypesBasicPrivate.MapTiTd[index-1] # NIL THEN EXIT;
index _ index-1;
ENDLOOP;
tc _ NEW[TypeCountsRep[index+64]];
FOR i: TypeIndex IN [0..index+64) DO
tc[i] _ [0, 0];
ENDLOOP;
};

SampleTypeCounts: PROC [tc: TypeCounts, includeFree: BOOL, Filter: VertexTest _ True] = TRUSTED {
eachObject: InfoProc = TRUSTED {
trueZero: BOOL _ FALSE;
IF NOT includeFree AND type = SafeStorage.nullType THEN RETURN [TRUE];
IF NOT Filter[objectHP] THEN RETURN [TRUE];
tc.objects _ tc.objects + 1;
tc.words _ tc.words + size;
IF type < tc.max THEN TRUSTED {
tcp: LONG POINTER TO TypeCount _ @tc[type];
IF tcp.objects = 0
THEN {
tcp.objects _ 1; tcp.words _ size; tc.types _ tc.types + 1;
}
ELSE {
tcp.objects _ tcp.objects + 1; tcp.words _ tcp.words + size;
};
IF type = SafeStorage.nullType THEN RETURN [TRUE];
};

SELECT TRUE FROM
objectHP.rcOverflowed => tc.overRC _ tc.overRC + 1;
ENDCASE =>
SELECT objectHP.refCount FROM
0 => {
tc.lowRC[0] _ tc.lowRC[0] + 1;
trueZero _ TRUE;
};
<= LowRC =>
tc.lowRC[objectHP.refCount] _ tc.lowRC[objectHP.refCount] + 1;
<= MidRC =>
tc.midRC _ tc.midRC + 1;
ENDCASE =>
tc.highRC _ tc.highRC + 1;

IF objectHP.inZCT THEN {
tc.inZCT _ tc.inZCT + 1;
IF trueZero THEN tc.inZCT0 _ tc.inZCT0 + 1;
};

continue _ TRUE;
};
EnumerateCollectableStorage[eachObject];
};

DeltaTypeCounts: PROC [old, new: TypeCounts] RETURNS [delta: TypeCounts] = {
delta _ NEW[TypeCountsRep[new.max]];
delta.types _ new.types - old.types;
delta.objects _ new.objects - old.objects;
delta.words _ new.words - old.words;
FOR i: [0..LowRC] IN [0..LowRC] DO
delta.lowRC[i] _ new.lowRC[i] - old.lowRC[i];
ENDLOOP;
delta.midRC _ new.midRC - old.midRC;
delta.highRC _ new.highRC - old.highRC;
delta.overRC _ new.overRC - old.overRC;
delta.inZCT _ new.inZCT - old.inZCT;
delta.inZCT0 _ new.inZCT0 - old.inZCT0;
FOR i: TypeIndex IN [0..new.max) DO
oldTypeCount: TypeCount _ IF i < old.max THEN old[i] ELSE [0, 0];
newTypeCount: TypeCount _ new[i];
delta[i] _ [
objects: newTypeCount.objects - oldTypeCount.objects,
words: newTypeCount.words - oldTypeCount.words];
ENDLOOP;
};

PrintTypeCounts: PROC [tc: TypeCounts, out: STREAM, msg: ROPE _ NIL] = {
IF msg # NIL THEN IO.PutRope[out, msg];
IO.PutF1[out, "\n-- Heap storage statistics (%g) --\n", [time[BasicTime.Now[]]] ];
IO.PutF[out, "  types: %g, objects: %g, words: %g", [integer[tc.types]], [integer[tc.objects]], [integer[tc.words]] ];
IF tc.objects > 0 AND tc.words > 0 THEN {
avg: INT _ (tc.words+tc.objects/2) / tc.objects;
IO.PutF1[out, "  (words/obj: %g)", [integer[avg]] ];
};
FOR i: NAT IN [0..LowRC] DO
IF i MOD 4 = 0
THEN IO.PutF[out, "\n  RC - %g: %g", [integer[i]], [integer[tc.lowRC[i]]] ]
ELSE IO.PutF[out, ", %g: %g", [integer[i]], [integer[tc.lowRC[i]]] ];
ENDLOOP;
IO.PutF[out, "\n  RC IN [%g..%g]: %g",
[integer[LowRC+1]], [integer[MidRC]], [integer[tc.midRC]] ];
IO.PutF[out, ", IN [%g..%g]: %g",
[integer[MidRC+1]], [integer[HighRC]], [integer[tc.highRC]] ];
IO.PutF1[out, ", overflow: %g\n", [integer[tc.overRC]] ];
IO.PutF[out, "  inZCT: %g, inZCT0; %g\n", [integer[tc.inZCT]], [integer[tc.inZCT0]] ];
};

PrintRank: PROC [tc: TypeCounts, out: STREAM, highestN: NAT _ 16, countObjects: BOOL] = {
IF highestN # 0 THEN {
highestAccum: TypeAccum _ NEW[TypeAccumRep[highestN]];
worstRank: TypeIndex _ highestN-1;
worstCount: INT _ 0;
IO.PutRope[out,
IF countObjects THEN "\n-- Rank by objects --\n" ELSE "\n-- Rank by words --\n"];
FOR i: NAT IN [0..highestN) DO
highestAccum[i] _ [0, 0];
ENDLOOP;
FOR type: TypeIndex IN [0..tc.max) DO
tCount: TypeCount _ tc[type];
count: INT _ ABS[IF countObjects THEN tCount.objects ELSE tCount.words];
IF count > worstCount THEN {
WHILE worstRank > 0 DO
IF count <= highestAccum[worstRank-1].count THEN EXIT;
highestAccum[worstRank] _ highestAccum[worstRank-1];
worstRank _ worstRank - 1;
ENDLOOP;
highestAccum[worstRank] _ [type, count];
worstRank _ highestN-1;
worstCount _ highestAccum[worstRank].count;
};
ENDLOOP;
FOR rank: NAT IN [0..highestN) DO
type: TypeIndex _ highestAccum[rank].type;
words: INT _ tc[type].words;
objects: INT _ tc[type].objects;
IF words = 0 AND objects = 0 THEN EXIT;
IO.PutF[out, "  rank %g, words: %g, objects: %g",
[integer[rank]], [integer[words]], [integer[objects]] ];
IO.PutF1[out, ", type: %bB\n    ", [cardinal[type]] ];
PrintType[out, type];
IO.PutRope[out, "\n"];
ENDLOOP;
};
};

PrintType: PROC [out: STREAM, type: TypeIndex] = {
innerPrint: PROC = {
PrintTV.PrintType[type: [type], put: out, depth: typeDepth, width: typeWidth, verbose: typeVerbose];
};
msg: ROPE _ NIL;
IF type = 0 THEN msg _ "(free)" ELSE msg _ BackStop.Call[innerPrint];
IF msg # NIL THEN IO.PutRope[out, msg];
};

ProcessSwitches: PROC [swIn: Switches, arg: ROPE] RETURNS [switches: Switches] = {
sense: BOOL _ TRUE;
switches _ swIn;
FOR index: INT IN [0..Rope.Length[arg]) DO
char: CHAR _ Rope.Fetch[arg, index];
SELECT char FROM
'- => LOOP;
'~ => {sense _ NOT sense; LOOP};
IN ['a..'z] => switches[char] _ sense;
IN ['A..'Z] => switches[char + ('a-'A)] _ sense;
ENDCASE;
sense _ TRUE;
ENDLOOP;
};

PrintHeader: PROC [out: STREAM, nhp: Allocator.NHeaderP] = TRUSTED {
IO.PutF1[out, "[inZCT: %g", [rope[IF nhp.inZCT THEN "TRUE" ELSE "FALSE"]] ];
IO.PutF1[out, ", maybeOnStack: %g", [rope[IF nhp.maybeOnStack THEN "TRUE" ELSE "FALSE"]] ];
IO.PutF1[out, "\n    bsi: %g", IF nhp.blockSizeIndex = Allocator.bsiEscape THEN [rope["bsiEscape"]] ELSE [cardinal[nhp.blockSizeIndex]] ];
IO.PutF1[out, ", f: %g", [rope[IF nhp.f THEN "TRUE" ELSE "FALSE"]] ];
IF nhp.f THEN {
td: RTTypesBasicPrivate.PTypeDesc _ RTTypesBasicPrivate.MapTiTd[nhp.type];
IF td.numberPackageRefs > nhp.refCount THEN {
IO.PutF1[out, " (prc: %g)", [integer[td.numberPackageRefs]] ];
};
};
IO.PutF1[out, ", refCount: %g", [cardinal[nhp.refCount]] ];
IF nhp.rcOverflowed THEN IO.PutRope[out, " (overflowed)" ];
IO.PutF1[out, "\n    typePad: %g", [cardinal[nhp.typePad]] ];
IO.PutF1[out, ", type: %g (", [cardinal[nhp.type]] ];
PrintType[out, nhp.type];
IO.PutRope[out, ")]" ];
};

InfoProc: TYPE = UNSAFE PROC [type: SafeStorage.Type, size: INT, object: Allocator.HeaderP, objectHP: Allocator.NHeaderP] RETURNS [continue: BOOLEAN _ TRUE];

EnumerateCollectableStorage: PROC [callBack: InfoProc _ NIL] = TRUSTED {
haveAllocatorLocked: PROC = TRUSTED {
haveRCOvLocked: PROC = TRUSTED {
haveZCTLocked: PROC = TRUSTED {
qx: Allocator.QuantumIndex _ FIRST[Allocator.QuantumIndex];
lag1: Allocator.NHeaderP _ NIL;
lag2: Allocator.NHeaderP _ NIL;
lag3: Allocator.NHeaderP _ NIL;
lag4: Allocator.NHeaderP _ NIL;
DO
hp: Allocator.HeaderP _ NIL;
blockSize: LONG CARDINAL _ 0;
WHILE NOT AllocatorOps.quantumMap[qx] DO
IF qx = LAST[Allocator.QuantumIndex] THEN RETURN;
qx _ qx + 1;
ENDLOOP;
hp _ Basics.DoubleShiftLeft[[lc[qx]], Allocator.logPagesPerQuantum+VM.logWordsPerPage].lp;
DO
start: Allocator.QuantumIndex _ qx;
nhp: Allocator.NHeaderP _ LOOPHOLE[hp];
IF LOOPHOLE[hp, LONG CARDINAL] >= Allocator.LastAddress THEN RETURN;
IF nhp.blockSizeIndex = Allocator.bsiEscape
THEN {
ehp: Allocator.EHeaderP _ LOOPHOLE[hp];
nhp _ nhp + (SIZE[Allocator.ExtendedHeader] - SIZE[Allocator.NormalHeader]);
SELECT ehp.sizeTag FROM
words =>  blockSize _ ehp.extendedSize;
pages => blockSize _ VM.WordsForPages[ehp.extendedSize];
ENDCASE => {Crash[nhp]; RETURN};
}
ELSE {
blockSize _ AllocatorOps.bsiToSize[nhp.blockSizeIndex];
};
IF blockSize = 0 THEN {Crash[nhp]; RETURN};
IF blockSize >= Allocator.LastAddress THEN {Crash[nhp]; RETURN};
IF Basics.LowHalf[blockSize] MOD 2 = 1 THEN {Crash[nhp]; RETURN};
IF Basics.LowHalf[blockSize] MOD VM.wordsPerPage = 0 THEN {
ln: Basics.LongNumber _ [lp[hp]];
IF ln.lo MOD VM.wordsPerPage # 0 THEN {Crash[nhp]; RETURN};
};
IF callBack # NIL THEN {
IF NOT callBack[nhp.type, blockSize, hp, nhp
! RuntimeError.UNCAUGHT => Crash[nhp]
] THEN RETURN;
IF foundNhp # NIL THEN {Crash[nhp]; RETURN};
};
hp _ hp + blockSize;
qx _ AllocatorOps.AddressToQuantumIndex[LOOPHOLE[hp]];
FOR qq: Allocator.QuantumIndex IN (start..qx) DO
IF NOT AllocatorOps.quantumMap[qq] THEN {Crash[nhp]; RETURN};
ENDLOOP;
IF qx = LAST[Allocator.QuantumIndex] THEN RETURN;
IF NOT AllocatorOps.quantumMap[qx] THEN EXIT;
lag4 _ lag3;
lag3 _ lag2;
lag2 _ lag1;
lag1 _ nhp;
ENDLOOP;
ENDLOOP;
};
ZCT.EnterAndCallBack[haveZCTLocked];
};
ZCT.EnterRCOvAndCallBack[haveRCOvLocked];
};
AllocatorOps.EnterAndCallBack[haveAllocatorLocked];
IF foundNhp # NIL THEN ERROR CrashError[foundNhp];
};

foundNhp: Allocator.NHeaderP _ NIL;
worldSwap: BOOL _ TRUE;

Crash: PROC [nhp: Allocator.NHeaderP] = TRUSTED {
foundNhp _ nhp;
IF worldSwap
THEN DebuggerSwap.CallDebugger["Kosher it's not!"L]
ELSE ERROR CrashError[nhp];
};

CrashError: ERROR [nhp: Allocator.NHeaderP] = CODE;

VertexTest: TYPE = UNSAFE PROC [nhp: Allocator.NHeaderP] RETURNS [BOOL];

GoalConsumer: TYPE = UNSAFE PROC [startNHP, goalNHP: Allocator.NHeaderP];

EnumerateEdges: UNSAFE PROC [base: BasePtr, Startworthy, Transparent, IsGoal: VertexTest, ConsumeGoal: GoalConsumer, cumulative: BOOL] = TRUSTED {
objects: INT _ 0;
countObject: InfoProc = {
pr: LONG POINTER _ objectHP+SIZE[Allocator.NormalHeader];
SELECT TRUE FROM
type = nullType => {};
type > RTTypesBasicPrivate.MapTiTd.length => {};
objectHP.refCount = 0 => {};
ENDCASE => {
rcmx: RCMap.Index = RTTypesBasicPrivate.MapTiRcmx[type];
SELECT rcmx FROM
FIRST[RCMap.Index], LAST[RCMap.Index] => {};
ENDCASE => {
eachRef: UNSAFE PROC [p: REF] = {
IF p # NIL THEN {
IF none THEN {
none _ FALSE;
WriteFlags[base, objectHP, [legal: TRUE]];
};
};
};
none: BOOL _ TRUE;
RTTypesBasicPrivate.MapRefs[pr, rcmx, eachRef];
};
objects _ objects + 1;
};
RETURN [TRUE];
};

stackSpace: VM.Interval;
EnumerateCollectableStorage[countObject];
stackSpace _ VM.SimpleAllocate[ VM.PagesForWords[ SIZE[Allocator.NHeaderP]*(objects+100) ]];
{ENABLE UNWIND => VM.Free[stackSpace];
stackStart: LONG POINTER TO Allocator.NHeaderP = VM.AddressForPageNumber[stackSpace.page];
stackEnd: LONG POINTER TO Allocator.NHeaderP = stackStart + SIZE[Allocator.NHeaderP]*(objects+99);
trace: InfoProc = {
ff: Flags _ ReadFlags[base, objectHP];
IF ff.legal AND NOT ff.marked AND Startworthy[objectHP] THEN {
ExploreFrom[objectHP, TRUE];
IF NOT cumulative THEN ExploreFrom[objectHP, FALSE];
};
RETURN [TRUE];
};

ExploreFrom: UNSAFE PROC [start: Allocator.NHeaderP, firstPass: BOOL] = {
Marked: PROC [flags: Flags] RETURNS [marked: BOOL] = CHECKED INLINE {marked _ flags.marked = firstPass};
Mark: PROC [ofl: Flags] RETURNS [nfl: Flags] = CHECKED INLINE {nfl _ ofl; nfl.marked _ firstPass};
stackP: LONG POINTER TO Allocator.NHeaderP _ stackStart;
stackP^ _ start;
DO
p: Allocator.NHeaderP _ stackP^;
type: Type = p.type;
rcmx: RCMap.Index = RTTypesBasicPrivate.MapTiRcmx[type];
eachRef: UNSAFE PROC [p: REF] = {
IF p # NIL THEN {
nhp: Allocator.NHeaderP _ LOOPHOLE[p, Allocator.NHeaderP] - SIZE[Allocator.NormalHeader];
ff: Flags _ ReadFlags[base, nhp];
IF Marked[ff] THEN {--we've seen it before
IF NOT firstPass THEN NULL--on second pass, don't worry about detecting cycles.
ELSE IF ff.stacked THEN {--It's in the current path, and thus is part of a cycle.
stackQ: LONG POINTER TO Allocator.NHeaderP _ stackP;
IF NOT ff.cyclic THEN {
ff.cyclic _ TRUE;
WriteFlags[base, nhp, ff];
};
DO
pp: Allocator.NHeaderP = stackQ^;
pf: Flags = ReadFlags[base, pp];
IF pp = nhp THEN EXIT;
IF stackQ = stackStart THEN EXIT;
IF pf.stacked AND NOT pf.cyclic THEN WriteFlags[base, pp, ff];
stackQ _ stackQ - SIZE[Allocator.NHeaderP];
ENDLOOP;
}
ELSE NULL--it's already queued to be traced, or has already been traced; in either case, nothing needs to be done about it here.
}
ELSE {--Never seen before
IF IsGoal[nhp] THEN ConsumeGoal[start, nhp];
IF ff.legal AND Transparent[nhp] THEN {
ff _ Mark[ff];
stackP _ stackP + SIZE[Allocator.NHeaderP];
IF stackP = stackEnd THEN Crash[nhp];
stackP^ _ nhp;
WriteFlags[base, nhp, ff];
};
};
};
};
pf: Flags _ ReadFlags[base, p];
IF NOT pf.legal THEN Crash[p];
pf.stacked _ TRUE;
pf _ Mark[pf];
WriteFlags[base, p, pf];
RTTypesBasicPrivate.MapRefs[p+SIZE[Allocator.NormalHeader], rcmx, eachRef];

DO
pp: Allocator.NHeaderP _ stackP^;
ff: Flags _ ReadFlags[base, pp];
IF NOT ff.stacked THEN EXIT;
ff.stacked _ FALSE;
WriteFlags[base, pp, ff];
IF stackP = stackStart THEN RETURN;
stackP _ stackP - SIZE[Allocator.NHeaderP];
ENDLOOP;


ENDLOOP;

}--end ExploreFrom--;
EnumerateCollectableStorage[trace];
}--end stackSpace--;
VM.Free[stackSpace];
}--end EnumerateEdges--;
Commander.Register[
key: "FindBadGuys",
proc: FindBadGuysProc,
doc: "{switch | item}*
Finds bad objects according to variables in ExamineStorage",
clientData: NIL,
interpreted: TRUE
];

Commander.Register[
key: "TakeHeapStats",
proc: TakeHeapStatsProc,
doc: "takes heap statistics
  Switches (with True/False defaults)
  -d: (F) take delta of stats from last time
  -f: (F) include free objects in counts
  -g: (T) GC once before taking stats
  -n: (F) no save of stats for next time
  -o: (F) show objects rank
  -r: (F) reprint only, don't take stats
  -s: (F) silent, don't print stats
  -w: (T) show words rank
",
clientData: NIL,
interpreted: TRUE
];

Commander.Register[
key: "FindCyclicTypes",
proc: FindCyclicTypesProc,
doc: "finds types with cyclic objects
  Switches (with True/False defaults)
  -d: (F) take delta of stats from last time
  -g: (T) GC once before taking stats
  -n: (F) no save of stats for next time
  -o: (F) show objects rank
  -r: (F) reprint only, don't take stats
  -s: (F) silent, don't print stats
  -w: (T) show words rank
",
clientData: NIL,
interpreted: TRUE
];

Commander.Register[
key: "ValidateHeap",
proc: HeapValidProc,
doc: "validates the heap
  Switches (with True/False defaults)
  -w: (F) world-swap debug on error
"
];

END.




ψExamineStorage.mesa
Copyright c 1985, 1986 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) April 3, 1986 3:53:42 pm PST
Spreitzer, June 9, 1986 6:09:41 pm PDT
Global variables for FindBadGuys
Global variables for TakeHeapStats
last sample for type statsistics
Command procedures
[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]
CommandObject = [in, out, err: STREAM, commandLine, command: ROPE, ...]
# of arguments processed
When parsing the command line, be prepared for failure.  The error is reported to the user
[type: SafeStorage.Type, size: INT, object: Allocator.HeaderP, objectHP: Allocator.NHeaderP] RETURNS [continue: BOOLEAN]
[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]
CommandObject = [in, out, err: STREAM, commandLine, command: ROPE, ...]
# of arguments processed
When parsing the command line, be prepared for failure.  The error is reported to the user
Future home of more intriguing options
We have to sample the new stats
We need a GC before taking the statistics
We have to print the stats
[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]
CommandObject = [in, out, err: STREAM, commandLine, command: ROPE, ...]
# of arguments processed
When parsing the command line, be prepared for failure.  The error is reported to the user
Future home of more intriguing options
[cmd: Handle] RETURNS [result: REF _ NIL, msg: ROPE _ NIL]
CommandObject = [in, out, err: STREAM, commandLine, command: ROPE, ...]
# of arguments processed
When parsing the command line, be prepared for failure.  The error is reported to the user
Future home of more intriguing options
We have to sample the new stats
We need a GC before taking the statistics
Interpreter procedures
First object for this type, so bump the type count
Previous objects for this type, just bump the counts
Bitmap utils
marked W is or has been in the list of things to trace.
stacked W is a member of the current path being traced.
On second pass, if any, the meaning is negated.
legal W contains a REF.
Sigh, we need to allocate a new goodie
Utilities
[type: SafeStorage.Type, size: INT, object: Allocator.HeaderP, objectHP: Allocator.NHeaderP] RETURNS [continue: BOOLEAN]
First object for this type, so bump the type count
Previous objects for this type, just bump the counts
Take stats on reference counts
Takes the difference in statistics between an old and a new sample.  We return a new object to avoid destroying the old and new stats objects.
Prints the type counts in a suitable narrow fashion.  Note that we have to contend with negative values for objects and words, since this routine also prints out deltas.
The words/object average makes sense (more or less)
This routine prints a type defensively.
Remember this guy!
This procedure enumerates all of the objects in the heap.  All interesting monitor locks are held while doing this.  Each object is verified as it is examined.  An optional callback procedure can examine each object as well.
Scan for the next start of a quantum run
hp must be on a page boundary!
There is a user routine to call.  The user can force a crash (soft or hard) by setting foundNhp.
[type: SafeStorage.Type, size: INT, object: Allocator.HeaderP, objectHP: Allocator.NHeaderP] RETURNS [continue: BOOLEAN]
type = CODE[ROPE] => {};
Immediately cull things that only refer forwards.
Worth enumerating
[type: SafeStorage.Type, size: INT, object: Allocator.HeaderP, objectHP: Allocator.NHeaderP] RETURNS [continue: BOOLEAN]
We also have to mark all objects that are in this cycle.
We want to trace through it.  Just mark it as being seen and push it on the stack.  Don't mark it as 'stacked' yet, since we are not yet tracing from it.
Now we have to scan through the stack for something that is on the stack but not yet enumerated (marked as 'stacked').  If we don't find such a thing, then we are done.
At this point we have stackP # intervalLimit and the flags indicate that we have not yet enumerated from this header.
Registration

key is the name of the command.  Registering the command under the "///Commands/" directory indicates that this command should be globally known and useful.  If no directory is given, the command is registered under the current working directory, which is the proper place for more specific commands.
key is the name of the command.  Registering the command under the "///Commands/" directory indicates that this command should be globally known and useful.  If no directory is given, the command is registered under the current working directory, which is the proper place for more specific commands.

Κ+•˜
headš
œ™Icodešœ
Οm
œ7™BL™0L™&L˜š
Οk	˜	Lšœ
žœ‘
˜ 
Lšœ
žœB˜TL˜Lš
œ˜Lšœ	žœ˜Lšœ
žœ˜Lšœ
žœ˜(Lšœžœ!˜2Lšœ
žœ˜"L˜
Lšžœ
˜Lšœžœ
˜Lš
œ˜L˜Lšœžœžœ˜1Lš
œ˜Lšœ
žœžœ˜Lšœžœ[˜lL˜Lšžœ
˜Lšžœ
žœ*˜3——šΟbœžœ
ž˜LšžœXžœAžœž˜©
Lšžœ˜Lšœž˜L˜Lšžœžœžœ
žœ
žœ
žœ
˜Lšžœžœžœ
˜Lš
žœžœžœ
žœ
žœ
˜Lšžœžœžœ
žœ
˜šœžœ˜Lš
œ&˜&—L˜—
head2š
œ ™ Lš
œ1˜1Lšœžœ˜:L˜Lšœžœžœ
˜Lšœžœžœ
˜L˜Lšœžœžœ
˜Lšœžœžœ
˜L˜Lšœ#žœ˜CLšœ#žœ˜BL˜Lšœžœžœ˜'Lšœžœžœ˜&L˜—š
œ"™"Lšœžœ˜Lšœžœ˜Lšœ
žœžœ
˜L˜L˜šœžœ
˜Lš
œ ™ ——™šœ)žœ˜2šœžœ
žœžœžœžœ
™:Lšœžœžœ™G—Lšœžœ˜Lšœžœ
žœ˜ šœžœ˜Lš
ϪѥStartOfExpansionI[cmd: 
Commander.Handle, starExpand: 
BOOL _ FALSE, switchChar: 
CHAR]šœKž˜PLšœ)žœ
žœ
˜8Lš
œZ™ZL˜—–| -- [type: SafeStorage.Type, size: INT, object: Allocator.HeaderP, objectHP: Allocator.NHeaderP] RETURNS [continue: BOOLEAN]šœžœ˜ Lš
Πckx™xLš
œ+˜+šžœ
žœ
ž˜Lš
œ˜Lš
œ˜Lš
œ0˜0Lš
œ%˜%Lš
œ%˜%Lšœ	žœ
žœ˜Lšžœ
žœ
žœ˜%Lšœžœ
žœ˜,Lšžœžœ
žœ˜3Lš
œ˜Lš
œ˜šžœ˜Lš
œF˜Fšžœ˜Lšžœ"˜&šžœ˜Lš
œ+˜+Lš
œ˜——Lš
œ˜——Lšžœžœ˜Lš
œ˜L˜—šœžœžœ˜2šœžœžœ˜Lš
œ˜Lš
œ˜L˜——Lš
œ!˜!Lšœžœ˜Lšœžœ˜L˜Lš
œ(˜(L˜Lšžœ
žœ žœ˜;L˜šžœžœž˜-Lš
œ!˜!Lšžœ"žœ˜>Lš
œ"˜"Lšžœ˜Lšžœ
˜L˜—šžœž˜Lšžœ@˜B—L˜š
ž˜Lš
œ˜—L˜L˜—šœ+žœ˜4šœžœ
žœžœžœžœ
™:Lšœžœžœ™G—Lšœžœ˜Lšœžœ
žœ˜ šœžœ˜Lš
œ™—–I[cmd: 
Commander.Handle, starExpand: 
BOOL _ FALSE, switchChar: 
CHAR]šœKž˜PLšœ)žœ
žœ
˜8Lš
œZ™ZL˜—Lš
œ˜Lš
œ˜Lš
œ˜L˜Lšœžœ
˜Lšœžœ
˜L˜šžœžœ
žœž˜Lšœžœ˜šžœžœ˜Lš
œ*˜*Lšžœ
˜L˜—Lš
œ&™&Lšžœ
˜—L˜šžœ
žœžœ˜Lš
œ™Lš
œ˜–9[suspendMe: 
BOOL _ TRUE, traceAndSweep: 
BOOL _ FALSE]šžœž˜Lš
œ)™)Lšœ1žœžœ˜M—Lš
œ5˜5Lš
žœžœžœ
žœ žœ
˜PL˜—š
žœžœ
žœ
žœžœ˜'Lš
œ™Lš
œ˜Lšžœžœ?žœ˜YLšžœžœ?žœ˜ZL˜—Lš	œ
žœžœ
žœ
žœ˜/š
ž˜Lš
œ˜—L˜L˜—šœ'žœ˜0šœžœ
žœžœžœžœ
™:Lšœžœžœ™G—Lšœžœ˜Lšœžœ
žœ˜ šœžœ˜Lš
œ™—–I[cmd: 
Commander.Handle, starExpand: 
BOOL _ FALSE, switchChar: 
CHAR]šœKž˜PLšœ)žœ
žœ
˜8Lš
œZ™ZL˜—šžœžœ
žœž˜Lšœžœ˜šžœžœ˜Lš
œ*˜*Lšžœ
˜L˜—Lš
œ&™&Lšžœ
˜—Lš
œ˜Lšœžœ˜!š
ž˜Lš
œ˜—Lš
œ˜L˜—šœ-žœ˜6šœžœ
žœžœžœžœ
™:Lšœžœžœ™G—Lšœžœ˜Lšœžœ
žœ˜ šœžœ˜Lš
œ™—–I[cmd: 
Commander.Handle, starExpand: 
BOOL _ FALSE, switchChar: 
CHAR]šœKž˜PLšœ)žœ
žœ
˜8Lš
œZ™ZL˜—Lš
œ˜Lš
œ˜Lš
œ˜L˜Lšœžœ
˜Lšœžœ
˜šžœžœ
žœž˜Lšœžœ˜šžœžœ˜Lš
œ*˜*Lšžœ
˜L˜—Lš
œ&™&Lšžœ
˜—šžœ
žœžœ˜Lš
œ™š
œ˜Lšœ
žœ
žœ˜$Lšœžœžœ
˜"šΟnœžœ
žœžœ
žœΟcœ˜WLš
œ%˜%Lš
žœžœžœ
žœ
žœ
˜5L˜—šžœž˜Lš
œ)™)Lš
œ(˜(—Lš
œ‘œ‘œ‘œ	‘œžœžœ˜tLš
œ˜Lšœ'žœ˜>Lš
žœžœžœ
žœ žœ
˜PLšœ
’œ
˜—Lš
œ˜L˜—šžœ
žœžœ˜Lš
œD˜Dšžœžœ
˜Lšœ>žœ˜D—šžœžœ
˜Lšœ>žœ˜E—L˜—Lš	œ
žœžœ
žœ
žœ˜/L˜š
ž˜Lš
œ˜—L˜L˜š
‘œžœžœžœ’œ˜FLšžœžœ˜L˜—š
‘œžœžœžœ’œ˜GLšžœžœ˜L˜—L˜——™Lšœ	žœžœ˜#Lš
œžœžœžœ
žœžœ
žœ˜SL˜Lšœ
žœžœ
žœ˜L˜š‘œžœžœžœ˜ALšœžœ9˜ALšžœžœ
žœžœ
žœ
žœ
˜:šžœžœžœ
ž˜.Lš
œ6˜6Lšœžœ
˜Lšžœ
˜—L˜—L˜Lšœžœžœ˜'šœžœžœ˜!Lšœžœ˜Lšœ	žœžœ
žœ˜1L˜L˜—š‘œžœžœžœ˜Ošœžœ
žœžœ;žœžœžœ’œžœ˜€
šžœžœ˜Lš
œ#˜#L˜$L˜)Lš
œ˜—Lš
œ˜—Lšœ
žœ˜'L˜Lš
œ(˜(L˜L˜—Lšœžœžœ˜Lšœžœžœ˜ Lšœ.žœ˜?L˜šœžœ
˜Lšžœ˜Lš
œ'˜'Lšžœ˜Lš
œ'˜'Lš
œ"˜"L˜—L˜š
œ˜Lšžœ
žœ˜Lšžœ
žœ˜Lšžœ
žœ˜Lšžœ
žœ˜Lšžœ
žœ
˜Lšžœ
žœ˜Lšžœ
žœ˜Lšžœ
žœ
˜Lšžœ
žœ˜Lš
œ˜—L˜š‘œžœ,žœžœžœžœžœžœ˜Š
L˜$Lš
œ2˜2Lš
œ"˜"š
œ˜Lšœ
žœ
žœ˜$š‘œžœ
žœžœ	žœ’œ˜[Lšœžœ˜L˜—š‘œžœ
žœžœžœ’œ˜XLš
œ:˜:L˜—š‘œžœ
žœžœžœ’œ˜SLš
œ3˜3L˜—š‘œžœ
žœ)’œ˜ULšœžœ
žœ
˜Lš
œ˜šžœ.žœ˜6Lšœžœžœžœ˜lšžœ
ž˜Lš
œ"˜"Lšœžœ!˜3Lšžœžœ˜$—Lš
œ
˜
—šžœ˜Lš
œ6˜6Lš
œ˜—Lš
œ˜Lš
œ˜šžœžœ
žœ˜Lšœžœ
žœ
žœ˜+šžœ˜šžœ˜Lš
œ2™2Lš
œ;˜;Lš
œ
˜
—šžœ˜Lš
œ4™4Lš
œ<˜<Lš
œ˜——L˜—L˜—Lšžœ	žœ)˜8Lšœ‘œ‘œ‘œ
‘œžœ˜Œ
Lšœ
’œ
˜—Lš
œ˜Lš
œ˜šžœžœ
˜Lšœ>žœ˜D—šžœ
žœ
˜Lšœ>žœ˜E—L˜——™šœžœžœ˜šœžœžœ
˜Lšœ
œ/™7—šœ	žœžœ
˜Lšœ
œ.™7L™/—Lšœžœžœ
˜šœžœž˜Lšœ
œ™—L˜Lš
œ˜L˜—Lš	œžœžœ
žœ
žœ˜1Lš	œžœžœ
žœžœ˜3L˜Lš	œ	žœžœ
žœ
žœ˜*Lšœžœžœžœ˜3L˜Lšœ	žœ˜Lšœžœ˜Lšœžœ˜L˜Lšœ	žœ˜Lšœžœ˜L˜š‘	œžœ
žœžœžœžœž	œ˜MLšœžœžœ˜[Lšžœ˜%L˜—L˜š
‘	œžœ
žœ*žœž	œ˜]Lšœžœ˜&Lš
œH˜HLšžœ žœ˜2Lšžœžœžœ˜#Lšžœžœ
žœ
žœ
˜%Lšžœžœ˜&L˜L˜—š‘
œžœ
žœ:ž	œ˜\Lšœžœ˜&Lšœžœ0˜8Lš
œ˜Lšžœ žœ˜2Lšžœžœžœ˜#šžœžœ
žœ˜Lš
œ&™&Lš	œ
žœžœžœžœ˜PLšœžœ%˜9Lšœžœ˜Lš
œ˜—Lšœžœ˜%L˜L˜—š
‘	œžœ
žœ
žœž	œ˜<Lš	œ
žœžœžœžœ˜OLšœžœ%˜.Lšœžœ
žœ˜L˜L˜—š‘œžœ
žœž	œ˜6Lšœžœžœžœ˜2šžœžœ
žœž˜šžœžœ
žœ˜Lšœžœžœ˜7Lšœ
žœ
˜Lšžœ˜L˜—Lšžœ
˜—Lšžœžœžœžœ˜NL˜L˜——š
œ	™	Lš
œ
žœžœ
žœ
žœ	žœ
žœ
˜3L˜Lšœžœžœ˜7L˜Lšœžœžœ˜(Lšœžœžœ˜(Lšœžœžœ˜'L˜Lšœžœžœ˜%šœžœžœ˜Lšœžœ˜Lšœ	žœ˜Lšœžœ˜Lš	œžœžœ
žœžœ˜(Lšœžœ˜Lšœžœ˜Lšœžœ˜Lšœžœ˜Lšœžœ˜Lšœžœžœ
˜,L˜L˜—šœžœžœ˜Lšœ	žœ
˜
Lšœž˜
L˜L˜—Lšœžœžœ˜#šœžœžœ˜Lšžœžœ˜)L˜—šœžœžœ˜L˜Lšœžœ˜L˜L˜—š‘œžœ
žœžœ˜9Lš
œ6˜6šžœž˜Lšžœ(žœ
žœ
žœ
˜8Lš
œ˜Lšžœ
˜—Lšœžœ˜"šžœžœž˜$Lš
œ˜Lšžœ
˜—L˜L˜—š‘œžœžœžœ˜a–| -- [type: SafeStorage.Type, size: INT, object: Allocator.HeaderP, objectHP: Allocator.NHeaderP] RETURNS [continue: BOOLEAN]šœžœ˜ Lš
 x™xLšœ
žœžœ
˜Lšžœ
žœ
žœžœ
žœžœ˜FLš
žœ
žœžœ
žœžœ˜+Lš
œ˜Lš
œ˜šžœžœ
žœ˜Lšœžœ
žœ
žœ˜+šžœ˜šžœ˜Lš
œ2™2Lš
œ;˜;Lš
œ
˜
—šžœ˜Lš
œ4™4Lš
œ<˜<Lš
œ˜——Lšžœžœ
žœžœ˜2L˜L˜—Lš
œ™šžœ
žœ
ž˜Lš
œ3˜3šžœ˜
šžœž˜š
œ˜Lš
œ˜Lšœžœ
˜L˜—š
œ˜Lš
œ>˜>—š
œ˜Lš
œ˜—šžœ˜
Lš
œ˜————L˜šžœžœ˜Lš
œ˜Lšžœ
žœ˜+L˜L˜—Lšœžœ
˜Lš
œ˜—Lš
œ(˜(L˜L˜—š‘œžœžœ˜LLš
œŽ
™Ž
Lšœžœ˜$Lš
œ$˜$Lš
œ*˜*Lš
œ$˜$šžœžœž˜"Lš
œ-˜-Lšžœ
˜—Lš
œ$˜$Lš
œ'˜'Lš
œ'˜'Lš
œ$˜$Lš
œ'˜'šžœžœž˜#Lšœžœ
žœžœ˜ALš
œ!˜!š
œ˜Lš
œ5˜5Lš
œ0˜0—Lšžœ
˜—L˜L˜—š
‘œžœžœžœžœ˜HLš
ϩ
™©
Lšžœžœ
žœ
žœ˜'LšžœP˜RLšžœt˜všžœžœžœ˜)Lš
œ3™3Lšœžœ(˜0Lšžœ2˜4L˜—šžœžœ
žœž˜šžœžœ˜Lšžœ
žœD˜KLšžœ
žœ>˜E—Lšžœ
˜—Lšžœa˜cLšžœ^˜`Lšžœ7˜9LšžœT˜VL˜L˜—š
‘	œžœžœžœžœ˜Yšžœžœ˜Lšœžœ˜6Lš
œ"˜"Lšœžœ˜šžœ
˜Lšžœžœžœ˜Q—šžœžœ
žœž˜Lš
œ˜Lšžœ
˜—šžœžœ
ž˜%Lš
œ˜Lšœžœžœ
žœžœžœ˜Hšžœžœ˜šžœž˜Lšžœ*žœ
žœ
˜6Lš
œ4˜4Lš
œ˜Lšžœ
˜—Lš
œ(˜(Lš
œ˜Lš
œ+˜+L˜—Lšžœ
˜—šžœžœ
žœž˜!Lš
œ*˜*Lšœžœ˜Lšœ	žœ˜ Lšžœžœ
žœ
žœ
˜'Lšžœh˜jLšžœ4˜6Lš
œ˜Lšžœ˜Lšžœ
˜—L˜—L˜L˜—š‘	œžœžœ˜2Lš
œ'™'šœžœ˜L–g[type: 
SafeStorage.Type, put: 
STREAM, depth: 
INT _ 4, width: 
INT _ 32, verbose: 
BOOL _ FALSE]š
œd˜dL˜—Lšœžœžœ
˜Lšžœ
žœžœ!˜ELšžœžœ
žœ
žœ˜'L˜L˜—š‘œžœžœžœ˜RLšœžœžœ
˜Lš
œ˜šžœžœ
žœž˜*Lšœžœ˜$šžœž˜Lšœžœ
˜Lšœžœžœ˜ Lšžœ$˜&Lšžœ.˜0Lšžœ
˜—Lšœžœ
˜
Lšžœ
˜—L˜—L˜š‘œžœžœžœ˜DLšžœ žœžœžœ
˜LLšžœ(žœžœžœ
˜[Lšžœžœ*žœžœ"˜Š
Lšžœžœžœžœ
˜Ešžœžœ˜Lš
œJ˜Jšžœ%žœ˜-Lš
œ™Lšžœ<˜>L˜—L˜—Lšžœ9˜;Lšžœžœ
žœ ˜;Lšžœ;˜=Lšžœ3˜5Lš
œ˜Lšžœ˜L˜L˜—š‘œžœžœ žœ;žœžœžœ˜
L˜—š‘œžœžœžœ˜HLš
œΰ
™ΰ
šŸœžœžœ˜%šŸœžœžœ˜ šŸ
œžœžœ˜Lšœžœ˜;Lšœžœ
˜Lšœžœ
˜Lšœžœ
˜Lšœžœ
˜š
ž˜Lšœžœ
˜Lšœžœ
žœ˜Lš
œ(™(šžœ
žœž˜(Lšžœžœžœ
žœ
˜1L˜Lšžœ
˜—LšœCžœ˜Zš
ž˜Lš
œ#˜#Lšœžœ˜'Lšžœ
žœžœ
žœžœ
žœ
˜Dšžœ)˜+šžœ˜Lšœžœ˜'Lšœ
žœžœ˜Lšžœ
ž˜Lš
œ'˜'Lšœžœ!˜8Lšžœžœ˜ —Lš
œ
˜
—šžœ˜Lš
œ7˜7Lš
œ˜——Lšžœžœžœ˜+Lšžœ$žœžœ˜@Lšžœžœžœžœ˜Ašžœžœ
žœžœ˜;Lš
œ™L˜!Lš
žœžœ
žœžœžœ˜;L˜—šžœžœ
žœ˜Lš
œ`™`šžœ
žœ&˜,Lšœžœ˜%Lšœžœ
žœ
˜—Lšžœžœ
žœžœ˜,L˜—Lš
œ˜Lšœ(žœ˜6šžœžœ
ž˜0Lšžœ
žœžœžœ˜=Lšžœ
˜—Lšžœžœžœ
žœ
˜1Lšžœ
žœžœ
žœ
˜-L˜L˜L˜L˜Lšžœ
˜—Lšžœ
˜—L˜—Lšžœ!˜$L˜—Lšžœ&˜)L˜—Lš
œ3˜3Lšžœžœ
žœ
žœ˜2L˜L˜—Lšœžœ
˜#Lšœžœžœ
˜L˜š‘œžœžœ˜1Lš
œ˜šžœ
˜Lšžœ/˜3Lšžœ
žœ˜—L˜L˜—šœžœžœ
˜3L˜—šœžœžœ
žœžœžœ˜HL˜—šœžœžœ
žœ)˜IL˜—š‘œžœ
žœ+‘œ‘œžœžœ˜’
L–| -- [type: SafeStorage.Type, size: INT, object: Allocator.HeaderP, objectHP: Allocator.NHeaderP] RETURNS [continue: BOOLEAN]šœ	žœ˜š
œ˜Lš
 x™xLšœžœ
žœžœ˜9šžœ
žœ
ž˜Lš
œ˜Lšœžœ
žœ™Lš
œ0˜0Lš
œ˜šžœ˜Lš
œ1™1Lš
œ8˜8šžœž˜Lšžœžœ˜,šžœ˜Lš
œ™šœ	žœ
žœžœ˜!šžœžœ
žœ˜šžœžœ˜Lšœžœ
˜
Lšœ#žœ˜*Lš
œ˜—L˜—L˜—Lšœžœžœ
˜Lš
œ/˜/L˜——Lš
œ˜L˜——Lšžœžœ˜Lš
œ˜L˜—Lšœžœ
˜Lš
œ)˜)šœ
žœžœžœ&˜\Lšœ
žœ
žœžœ˜&Lš	œžœ
žœ
žœžœ'˜ZLš	œ
žœ
žœ
žœ#žœ"˜bš
œ˜Lš
 x™xLš
œ&˜&š
žœ
žœ
žœžœžœ˜>Lšœžœ˜Lšžœ
žœžœžœ˜4L˜—Lšžœžœ˜Lš
œ˜L˜—š‘œžœ
žœ(žœ˜ILš‘œžœžœ
žœžœ
žœ%˜hLš
‘œžœžœžœ
žœ%˜bLšœžœ
žœ
žœ!˜8Lš
œ˜š
ž˜Lš
œ ˜ Lš
œ˜Lš
œ8˜8šœ	žœ
žœžœ˜!šžœžœ
žœ˜Lšœžœžœ˜YLš
œ!˜!šžœžœ’˜*Lšžœ
žœžœ
ž’5˜Ošžœ
žœžœ’8˜QLšœžœ
žœ
žœ˜4šžœ
žœžœ˜Lšœžœ
˜Lš
œ˜L˜—Lš
œ8™8š
ž˜Lš
œ!˜!Lš
œ ˜ Lšžœ
žœ
žœ
˜Lšžœžœ
žœ
˜!Lšžœžœ
žœžœ˜>Lšœžœ˜+Lšžœ
˜—L˜
—Lšžœ
ž’w˜€
L˜
—šžœ’˜Lšžœ
žœ˜,šžœ
žœžœ˜'Lš
Ϫ
™™
L˜Lšœžœ˜+Lšžœžœ˜%Lš
œ˜Lš
œ˜L˜—Lš
œ˜—L˜—L˜—Lš
œ˜Lšžœ
žœ
žœ
˜Lšœ
žœ
˜L˜Lš
œ˜Lšœžœ)˜KL˜Lš
Ϭ
™¨
š
ž˜Lš
œ!˜!Lš
œ ˜ Lšžœ
žœžœ
žœ
˜Lšœ
žœ
˜Lš
œ˜Lšžœžœ
žœ
˜#Lšœžœ˜+Lšžœ
˜—L˜Lš
œu™uL˜Lšžœ
˜L˜—Lšœ
’œ
˜—Lš
œ#˜#Lšœ
’œ
˜—Lšžœ˜Lšœ
’œ
˜——™L™–x[key: 
ROPE, proc: 
Commander.CommandProc, doc: 
ROPE _ NIL, clientData: 
REF ANY _ NIL, interpreted: 
BOOL _ TRUE]š
œ˜š
œ˜LšΟoœ©™¬—Lš
œ˜Lš
œS˜SLšœžœ
˜Lšœ
ž˜Lš
œ˜L˜—–x[key: 
ROPE, proc: 
Commander.CommandProc, doc: 
ROPE _ NIL, clientData: 
REF ANY _ NIL, interpreted: 
BOOL _ TRUE]š
œ˜š
œ˜Lš£œ©™¬—Lš
œ˜Lš
œμ˜μLšœžœ
˜Lšœ
ž˜Lš
œ˜L˜—–x[key: 
ROPE, proc: 
Commander.CommandProc, doc: 
ROPE _ NIL, clientData: 
REF ANY _ NIL, interpreted: 
BOOL _ TRUE]š
œ˜Lš
œ˜Lš
œ˜Lš
œΝ˜ΝLšœžœ
˜Lšœ
ž˜Lš
œ˜L˜—–x[key: 
ROPE, proc: 
Commander.CommandProc, doc: 
ROPE _ NIL, clientData: 
REF ANY _ NIL, interpreted: 
BOOL _ TRUE]š
œ˜Lš
œ˜Lš
œ˜Lš
œd˜dLš
œ˜——L˜Lšžœ
˜L˜š
œ˜L™——…—j€¨