-- PTestQ.Mesa
-- last edited January 17, 1983 9:22 am by Paul Rovner

DIRECTORY
AMBridge,
AMTypes,
Ascii USING[CR, SP],
AtomsPrivate USING[AtomRec, GetAtom],
-- CedarInitPrivate USING[tty],
Convert USING[ValueToRope],
Inline USING[LowHalf],
IO USING [CreateViewerStreams, STREAM],
Process USING[Detach, Yield],
RandomInt USING[Init, Next],
Rope USING[ROPE, Length, Fetch],
RTMiniModel USING[AcquireIRInstance],
RTOS USING[MyLocalFrame],
RTStorageOps USING[NewObject, AssignRefNew],
RTTypesBasic USING[FinalizationQueue, NewFQ, nullType, FQNext, EstablishFinalization,
ReEstablishFinalization, refAnyType],
SafeStorage USING[NewZone, ReclaimCollectibleObjects, ReclamationReason, WaitForCollectorStart,
WaitForCollectorDone, TrimAllZones, TrimRootBase],
ShowTime USING[Microseconds, GetMark, Show],
TTY USING[Handle, PutChar, UserAbort], --TypeScript,
TTYIO USING[CreateTTYHandleFromStreams], --TypeScript,
UnsafeStorage USING[NewUZone, NewUObject, TrimUZone, GetSystemUZone, FreeUZone];

PTestQ: PROGRAM
IMPORTS AtomsPrivate, --CedarInitPrivate, --Convert, Inline, IO, Process, RandomInt, Rope, RTMiniModel,
RTOS, RTStorageOps, AMBridge, AMTypes, RTTypesBasic, SafeStorage,
  ShowTime, TTY--TypeScript--, TTYIO, UnsafeStorage
SHARES AtomsPrivate, RTTypesBasic

= BEGIN OPEN RTStorageOps, AMBridge, AMTypes, SafeStorage, UnsafeStorage;

TokenType: TYPE = {reserved, identifier, none};
TokenHandle: TYPE = REF Token;
InnerToken: TYPE =
RECORD[ innernext: TokenHandle ← NIL,
innertype: TokenType ← none,
innersize: CARDINAL ← 12,
innerxrefList: XRefHandle ← NIL
];

Token: TYPE =
RECORD[ next: TokenHandle ← NIL,
type: TokenType ← none,
xrefList: XRefHandle ← NIL,
innerToken: InnerToken ← [],
size: CARDINAL ← 0
];

VRecord: TYPE =
RECORD[ com1: TokenHandle ← NIL,
com2: TokenType ← none,
unionField: SELECT tag: * FROM
tag1 => [ref: REF ANY ← NIL],
tag2 => [card: CARDINAL ← 100],
ENDCASE
];

LineNumberRange: TYPE = [0..77777B];
Coord: TYPE = MACHINE DEPENDENT RECORD
[ defn: BOOLEAN,
ln: LineNumberRange
];
XRefHandle: TYPE = REF XRef;
XRef: TYPE =
RECORD[ next: XRefHandle ← NIL,
nRefs: CARDINAL ← 0,
coords: ARRAY [0..1] OF Coord ← ALL[[defn: FALSE, ln: 0]]
];


Foo: TYPE =
RECORD[ packageRef: REF Foo ← NIL, -- the package REF
name: STRING ← NIL,
next: REF Foo ← NIL
];

fooFQ: RTTypesBasic.FinalizationQueue ← RTTypesBasic.NewFQ[]; -- for Foo finalization
nFoosFinalized: CARDINAL ← 0; -- for Foo finalization

Signal: SIGNAL = CODE;
Error: ERROR = CODE;



ShortenLongCardinal: PROC[lc: LONG CARDINAL] RETURNS[CARDINAL] = { RETURN[Inline.LowHalf[lc]]};

oldTime: ShowTime.Microseconds ← ShowTime.GetMark[];

test: BOOLEAN ← FALSE;

in, out: IO.STREAM;

ttyHandle: TTY.Handle;

--TypeScript.TS ← (IF test THEN NIL ELSE TypeScript.Create[name: "Test.log", iconic: FALSE]);

WriteString: PROC[r: Rope.ROPE] =
{IF test THEN RETURN;
FOR i: INT IN [0..Rope.Length[r])
DO WriteChar[Rope.Fetch[r, i]];
ENDLOOP};

WriteChar: PROC [c: CHARACTER] =
{IF test THEN RETURN;
TTY.PutChar[ttyHandle, c]};

WriteLine: PROC[r: Rope.ROPE] =
{IF test THEN RETURN;
WriteString[r];
WriteChar[Ascii.CR]};

WriteDecimal: PROC[i: INTEGER] =
{IF test THEN RETURN;
WriteString[Convert.ValueToRope[[signed[signed: i]]]]};

ShowTheTime: PROC =
{ p: SAFE PROC[ch: CHARACTER] RETURNS [BOOLEAN] =
TRUSTED {WriteChar[ch]; RETURN[FALSE]};
ShowTime.Show[oldTime, p];
WriteLine[" seconds"]};

ShowDuration: PROC = BEGIN ShowTheTime[]; oldTime ← ShowTime.GetMark[] END;
SetClock: PROC = BEGIN oldTime ← ShowTime.GetMark[] END;

PrintTV: PROC[tv: TV, depth: CARDINAL ← 0] =
BEGIN
type: Type = TVType[tv];

SELECT TypeClass[type] FROM
union =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a union) Tag = "];
PrintTV[Tag[tv]];
THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["Variant = "];
PrintTV[Variant[tv], depth + 1];
};
definition =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a definition) = "];
WriteString[TypeToName[type]];
WriteLine[""];
PrintTV[Coerce[tv, UnderType[type]], depth + 1];
};
localFrame =>
{ pt: TV = Procedure[tv];
THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a local frame for "];
IF TypeClass[TVType[pt]] = program THEN
{ WriteString["the program named "]; WriteString[TVToName[pt]]; WriteLine[")"]; RETURN};
WriteString[TVToName[pt]];
WriteLine["): "];
IF EnclosingBody[tv] = NIL THEN
{ domainType: Type = Domain[TVType[pt]];
rangeType: Type = Range[TVType[pt]];
IF domainType # RTTypesBasic.nullType
  THEN {THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["Arguments:"];
FOR i: CARDINAL IN [1..NComponents[domainType]]
  DO
THROUGH [0..depth] DO WriteChar[Ascii.SP] ENDLOOP;
WriteString[IndexToName[domainType, i]];
WriteLine[": "];
PrintTV[Argument[tv, i], depth + 2];
ENDLOOP};
IF rangeType # RTTypesBasic.nullType
  THEN {THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["Results:"];
FOR i: CARDINAL IN [1..NComponents[rangeType]]
  DO
THROUGH [0..depth] DO WriteChar[Ascii.SP] ENDLOOP;
WriteString[IndexToName[rangeType, i]];
WriteLine[": "];
PrintTV[Result[tv, i], depth + 2];
ENDLOOP};
THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["Locals:"];
PrintTV[Locals[tv], depth + 1]}
ELSE { THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["EnclosingBody:"];
PrintTV[EnclosingBody[tv], depth + 1]};
};
globalFrame =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a global frame for "];
WriteString[TVToName[tv]];
WriteLine["): "];
PrintTV[Globals[tv], depth + 1];
};
nil=>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["(no value) "];
};
countedZone =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["(a countedZone) "];
};
uncountedZone =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["(an uncountedZone) "];
};
procedure =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a procedure named "];
WriteString[TVToName[tv]];
WriteLine[")"];
THROUGH [0..depth + 1] DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["Defined in the module named "];
WriteLine[TVToName[GlobalParent[tv]]];

THROUGH [0..depth + 1] DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["Its Domain..."];
IF Domain[type] = RTTypesBasic.nullType THEN WriteLine["no value"]
ELSE IF TypeClass[Domain[type]] = structure THEN WriteLine["a structure value"]
ELSE ERROR;
THROUGH [0..depth + 1] DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["Its Range..."];
IF Range[type] = RTTypesBasic.nullType THEN WriteLine["no value"]
ELSE IF TypeClass[Range[type]] = structure THEN WriteLine["a structure value"]
ELSE ERROR;
};
signal =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a signal named "];
WriteString[TVToName[tv]];
WriteLine[")"];
THROUGH [0..depth + 1] DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["Its Domain..."];
IF Domain[type] = RTTypesBasic.nullType THEN WriteLine["no value"]
ELSE IF TypeClass[Domain[type]] = structure THEN WriteLine["a structure value"]
ELSE ERROR;
THROUGH [0..depth + 1] DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["Its Range..."];
IF Range[type] = RTTypesBasic.nullType THEN WriteLine["no value"]
ELSE IF TypeClass[Range[type]] = structure THEN WriteLine["a structure value"]
ELSE ERROR;
};
error =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(an error named "];
WriteString[TVToName[tv]];
WriteLine[")"];
THROUGH [0..depth + 1] DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["Its Domain..."];
IF Domain[type] = RTTypesBasic.nullType THEN WriteLine["no value"]
ELSE IF TypeClass[Domain[type]] = structure THEN WriteLine["a structure value"]
ELSE ERROR;
};
structure =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["(a structure)"];
FOR i: CARDINAL IN [1..NComponents[type]] DO
THROUGH [0..depth] DO WriteChar[Ascii.SP] ENDLOOP;
WriteString[IndexToName[type, i]];
WriteLine[": "];
PrintTV[IndexToTV[tv, i], depth + 2];
ENDLOOP;
};
record =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["(a record)"];
FOR i: CARDINAL IN [1..NComponents[type]] DO
THROUGH [0..depth] DO WriteChar[Ascii.SP] ENDLOOP;
WriteString[IndexToName[type, i]];
WriteLine[": "];
PrintTV[IndexToTV[tv, i], depth + 2];
ENDLOOP;
};
ref =>
{ lc: LONG CARDINAL = TVToLC[tv];
THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a ref) = "];
IF lc = 0 THEN WriteString["NIL"] ELSE WriteLongOctal[lc];
WriteLine[""];
-- IF lc # 0 THEN PrintTV[Referent[tv], depth + 1];
};
list =>
{ lc: LONG CARDINAL = TVToLC[tv];
THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a list) = "];
IF lc = 0 THEN WriteString["NIL"] ELSE WriteLongOctal[lc];
WriteLine[""];
IF lc # 0 THEN PrintTV[Referent[tv], depth + 1];
};
pointer =>
{ lc: LONG CARDINAL = TVToLC[tv];
THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a POINTER) = "];
IF lc = 0 THEN WriteString["NIL"] ELSE WriteLongOctal[lc];
WriteLine[""];
};
longPointer =>
{ lc: LONG CARDINAL = TVToLC[tv];
THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a LONG POINTER) = "];
IF lc = 0 THEN WriteString["NIL"] ELSE WriteLongOctal[lc];
WriteLine[""];
};
character =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a CHAR) = '"];
WriteChar[TVToCharacter[tv]];
WriteLine[""]
};
cardinal =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a CARDINAL) = "];
WriteLongOctal[TVToLC[tv]];
WriteLine[""]
};
longCardinal =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a LONG CARDINAL) = "];
WriteLongOctal[TVToLC[tv]];
WriteLine[""]
};
unspecified =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(an UNSPECIFIED) = "];
WriteLongOctal[TVToLC[tv]];
WriteLine[""]
};
type =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["(A TYPE)"]
};
integer =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(an INTEGER, written as octal) = "];
WriteLongOctal[TVToLC[tv]];
WriteLine[""]
};
enumerated =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(an enumeration value) = "];
WriteString[TVToName[tv]];
WriteLine[""]
};
array =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["(an array)"];
FOR subscript: TV ← First[Domain[type]], Next[subscript] UNTIL subscript = NIL DO
PrintTV[subscript, depth + 1];
PrintTV[Apply[tv, subscript], depth + 2];
ENDLOOP;
};
sequence =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteString["(a sequence). Length (in octal) = "];
WriteLongOctal[LOOPHOLE[Length[tv], LONG CARDINAL]];
-- FOR subscript: TV ← First[Domain[type]], Next[subscript]
-- UNTIL TVToLC[subscript] = TVToLC[Length[tv]] DO
-- PrintTV[subscript, depth + 1];
-- PrintTV[Apply[tv, subscript], depth + 2];
-- ENDLOOP;
};
subrange => PrintTV[Coerce[tv, Ground[TVType[tv]]], depth];
opaque =>
{ THROUGH [0..depth) DO WriteChar[Ascii.SP] ENDLOOP;
WriteLine["(opaque)"];
};
ENDCASE => ERROR;
END;

WriteLongOctal: PROC[lc: LONG CARDINAL] =
BEGIN
WLC[lc];
WriteChar['B];
END;

-- Write Long Cardinal in Octal
WLC: PROC [info: LONG CARDINAL, width: CARDINAL ← 0] = BEGIN
Pair: TYPE = MACHINE DEPENDENT RECORD [low,high: CARDINAL];
temp: STRING ← [12];
pos: CARDINAL ← 0;
IF info = 0 THEN {temp[0] ← '0; pos ← 1};
WHILE info # 0 DO
low: CARDINAL ← LOOPHOLE[info MOD 8, Pair].low;
c: CHARACTER ← LOOPHOLE[LOOPHOLE['0 , CARDINAL] + low, CHARACTER];
info ← info / 8;
temp[pos] ← c;
pos ← pos + 1;
ENDLOOP;
IF width > pos THEN
THROUGH [0..width-pos) DO WriteChar[Ascii.SP]; ENDLOOP;
WHILE pos > 0 DO WriteChar[temp[pos ← pos - 1]]; ENDLOOP;
END;

WriteAtom: PROC[atom: ATOM] =
BEGIN
a: LONG POINTER TO AtomsPrivate.AtomRec = LOOPHOLE[atom];
IF Rope.Length[a.pName] = 0 THEN WriteString["<<NIL printName>>"];
FOR i: INT IN [0..Rope.Length[a.pName]) DO WriteChar[Rope.Fetch[a.pName, i]] ENDLOOP;
END;

nIterations: CARDINAL ← 0;

prefixedZone: ZONE ← NewZone[];

quantizedZone: ZONE ← NewZone[sr: quantized];

quantizedHeapZone: UNCOUNTED ZONE ← NewUZone[sr: quantized];

Proc: PROC =
{ DO
ref: REF ANY;
nObjects: INTEGER = 10;

IF stopPlease AND fooStopped THEN {procStopped ← TRUE; RETURN};
WriteLine[" ***Testing finalization..."];
THROUGH [1..nObjects]
DO foo: REF Foo ← NEW[Foo];
foo.packageRef ← foo;
foo ← NIL;
ENDLOOP;
nFoosFinalized ← 0;
[] ← ReclaimCollectibleObjects[suspendMe: TRUE];
THROUGH [1..100] DO Process.Yield[]; ENDLOOP;
IF nFoosFinalized = 0
THEN {WriteLine[" ***finalization failed."];
IF TTY.UserAbort[] THEN EXIT;
LOOP};
WriteLine[" ***finalization succeeded."];

WriteLine[" ***Testing NARROW..."];
ref ← NEW[Token];
ref ← NARROW[ref, REF Token];
WITH ref SELECT FROM
rt: REF Token => NULL;
ENDCASE => ERROR;
WriteLine[" ***Done testing NARROW."];

WriteLine[" ***Testing type canonicalization..."];
ref ← NEW[Token];
WITH ref SELECT FROM
refToken: REF Token => NULL;
ENDCASE => ERROR;
WriteLine[" ***Done testing type canonicalization."];

THROUGH [1..100] DO Process.Yield[]; ENDLOOP;
--IF FALSE THEN
EXIT;
ENDLOOP;
};


CollectorWatcher: PROC =
{ DO
ni, incarnation: CARDINAL;
reason: ReclamationReason;
wordsAllocated: LONG CARDINAL; -- since previous collection was initiated
objectsAllocated: LONG CARDINAL;
wordsReclaimed: LONG CARDINAL;
objectsReclaimed: LONG CARDINAL;

[incarnation, reason, wordsAllocated, objectsAllocated] ← WaitForCollectorStart[];
IF stopPlease THEN {cwStopped ← TRUE; RETURN};
WriteString[SELECT reason FROM
clientRequest => "[clientRequest",
clientNoTraceRequest => "[clientNoTraceRequest",
rcTableOverflow => "[rcTableOverflow",
allocationInterval => "[allocationInterval",
quantaNeeded => "[quantaNeeded",
clientTAndSRequest => "[clientTAndSRequest",
ENDCASE => ERROR];
WriteString[" Collection initiated after allocating "];
WriteLongOctal[wordsAllocated];
WriteString[" words, "];
WriteLongOctal[objectsAllocated];
WriteLine[" objects]"];
[ni, , wordsReclaimed, objectsReclaimed] ← WaitForCollectorDone[];
IF stopPlease THEN {cwStopped ← TRUE; RETURN};
IF ni # incarnation THEN WriteLine["<<<missed end of collection!! another intervened:>>>"];
WriteString["["];
WriteString[" Collection finished, "];
WriteLongOctal[wordsReclaimed];
WriteString[" words reclaimed, "];
WriteLongOctal[objectsReclaimed];
WriteLine[" objects reclaimed]"]
ENDLOOP};

fooFinalizer: PROCEDURE =
{ DO
rFoo: REF Foo;
IF stopPlease THEN {fooStopped ← TRUE; RETURN};
rFoo ← NARROW[RTTypesBasic.FQNext[fooFQ], REF Foo];
rFoo.packageRef ← NIL;
rFoo ← NIL;
nFoosFinalized ← nFoosFinalized + 1;
ENDLOOP};

stopPlease: BOOLEAN ← FALSE;
cwStopped: BOOLEAN ← FALSE;
procStopped: BOOLEAN ← FALSE;
fooStopped: BOOLEAN ← FALSE;

-- ******************** MAIN ********************
Main: PROC =
{dummyZone ← NIL; -- to test ZONE finalization (using breakpoints)

-- Process.Detach[FORK CollectorWatcher[]];
cwStopped ← TRUE;
-- RTStorageOps.DisableReferenceCounting[];

-- [] ← SetCollectionInterval[10000000B];
{RTTypesBasic.EstablishFinalization[CODE[Foo], 1, fooFQ ! ANY => GOTO out];
EXITS out => RTTypesBasic.ReEstablishFinalization[CODE[Foo], 1, fooFQ]};

Process.Detach[FORK fooFinalizer[]];
procStopped ← TRUE;
-- Process.Detach[FORK Proc[]];

[] ← RandomInt.Init[range: 4, seed: 12345];

DO -- BIG LOOP

IF NOT test THEN stopPlease ← TTY.UserAbort[];

IF stopPlease AND cwStopped AND procStopped AND fooStopped THEN {RETURN};

WriteString["<<<Iteration number "]; WriteDecimal[nIterations ← nIterations + 1]; WriteLine[">>>"];

{
IdentityRef: PROC [ref: REF ANY] RETURNS [REF] = {RETURN [ref]};

t: Type = IndexToType[Domain[TVType[TVForProc[IdentityRef]]], 1];

IF t # RTTypesBasic.refAnyType THEN ERROR;

IF TypeClass[UnderType[t]] # ref THEN ERROR;
};

{
B: TYPE = RECORD[a, b: BOOL];
refB: REF B ← NEW[B ← [FALSE, TRUE]];
BA: TYPE = ARRAY [0..3] OF B;
refBA: REF BA ← NEW[BA ← ALL[[FALSE, TRUE]]];
S: TYPE = RECORD[t: BOOL, seq: SEQUENCE ln: [0..2] OF B];
refS: REF S ← NEW[S[2]];

tv: TV ← TVForReferent[refBA];

trueTV: TV ← TVForReferent[NEW[BOOL← TRUE]];
falseTV: TV ← TVForReferent[NEW[BOOL← FALSE]];
zeroTV: TV ← TVForReferent[NEW[CARDINAL ← 0]];
oneTV: TV ← TVForReferent[NEW[CARDINAL ← 1]];

eltZero: TV ← Apply[tv, zeroTV];
eltZeroA: TV ← IndexToTV[eltZero, 1];
eltZeroB: TV ← IndexToTV[eltZero, 2];
sRecTV: TV ← TVForReferent[refS];
seqTV: TV ← IndexToTV[sRecTV, 2];
seqZTV: TV ← Apply[seqTV, zeroTV];
seqZaTV: TV ← IndexToTV[seqZTV, 1];
seqZbTV: TV ← IndexToTV[seqZTV, 2];


IF NOT TVEqual[IndexToTV[TVForReferent[refB], 1], falseTV] THEN ERROR;

IF NOT TVEqual[IndexToTV[TVForReferent[refB], 2], trueTV] THEN ERROR;

IF NOT TVEqual[eltZeroA, falseTV] THEN ERROR;

IF NOT TVEqual[eltZeroB, trueTV] THEN ERROR;

refS.t ← TRUE;
refS[0] ← [FALSE, TRUE];
refS[1] ← [TRUE, FALSE];

IF NOT TVEqual[IndexToTV[sRecTV, 1], trueTV] THEN ERROR;

IF NOT TVEqual[seqZTV, eltZero] THEN ERROR;

IF NOT TVEqual[seqZbTV, trueTV] THEN ERROR;

IF NOT TVEqual[seqZaTV, falseTV] THEN ERROR;

};

DO
WriteString[" ***Testing TrimRootBase..."];
-- [] ← ReclaimCollectibleObjects[];
[] ← ReclaimCollectibleObjects[];
TrimAllZones[];
WriteDecimal[TrimRootBase[]]; WriteLine[" Pilot spaces reclaimed."];

--IF FALSE THEN-- EXIT;
ENDLOOP;

-- Proc[];

DO
mouse: ATOM ← $Mouse;
str: Rope.ROPE ← "Mouse";
atom: ATOM ← AtomsPrivate.GetAtom[str];
CheckAtomType: PROC [r: REF ANY] = {
WITH r SELECT FROM
a: ATOM => {} -- OK
ENDCASE => ERROR};

WriteString[" ***Testing ATOM literals, types, NARROW..."];
IF atom # mouse THEN ERROR;
CheckAtomType [mouse];
CheckAtomType [atom];
WriteLine["Done."];
--IF FALSE THEN-- EXIT;
ENDLOOP;

DO
gftv: TV;
gfType: Type;
IF stopPlease THEN EXIT;
--IF TRUE THEN EXIT;

WriteString[" ***Testing RTTypes WRT TYPEs in global frames..."];
gftv ← Globals[GlobalParent[TVForProc[Main]]];
gfType ← TVType[gftv];
FOR i: CARDINAL IN [1..NComponents[gfType]] DO
t: Type ← IndexToType[gfType, i];
IF TypeClass[t] = type
THEN {tv: TV ← IndexToTV[gftv, i];
c: CARDINAL ← TVToCardinal[tv];
  IF FALSE THEN EXIT};
ENDLOOP;
WriteLine["Done."];
--IF FALSE THEN
EXIT;
ENDLOOP;

DO
X: PROC = {Y[]};
Y: PROC = {L: LIST OF REF Token ← CONS[NEW[Token], LIST[NEW[Token]]]; Z[]};
Z: PROC =
{ FOR t: TV ← TVForFrame[RTOS.MyLocalFrame[]], DynamicParent[t] UNTIL t = NIL DO
WriteLine["Next Frame:"];
PrintTV[t];
IF TypeClass[TVType[Procedure[t]]] = program THEN EXIT;
ENDLOOP;
};

IF stopPlease THEN EXIT;
--IF TRUE THEN EXIT;

PrintTV[TVForReferent[NEW[Token ← []]]];
PrintTV[TVForReferent[NEW[Foo ← []]]];
PrintTV[TVForReferent[NEW[XRef ← []]]];
PrintTV[TVForReferent[NEW[VRecord ← [unionField: tag2[]]]]];
PrintTV[TVForGFHReferent[GFHFromTV[GlobalParent[TVForProc[PrintTV]]]]];
X[];
--IF FALSE THEN
EXIT;
ENDLOOP;

DO
IF stopPlease THEN EXIT;
-- IF TRUE THEN EXIT;

WriteString[" ***Testing AcquireIRInstance..."];
PrintTV[RTMiniModel.AcquireIRInstance["IO"]];

--IF FALSE THEN
EXIT;
ENDLOOP;

DO
ra: REF ANY ← "FUBAR";

IF stopPlease THEN EXIT;
WriteString[" ***Testing text literal stuff..."];
WITH ra SELECT FROM
rt: REF TEXT => FOR i: CARDINAL IN [0..rt.length) DO WriteChar[rt[i]] ENDLOOP;
ENDCASE => ERROR;
WriteLine["...Done."];

--IF FALSE THEN-- EXIT;
ENDLOOP;

DO
Obj: TYPE = REF ANY;
prev: REF Obj ← NIL;
nObjects: INTEGER = 10000;

IF stopPlease THEN EXIT;
WriteString[" ***Allocating 50000 objects from quantizedZone..."];
SetClock[];
THROUGH [1..5] DO THROUGH [1..nObjects] DO IF stopPlease THEN EXIT; prev ← quantizedZone.NEW[Obj ← prev]; ENDLOOP; ENDLOOP;
prev ← NIL;
WriteString["taking "];
ShowDuration[];

-- [] ← RTStorageOps.PrivateReclaimCollectibleObjects[];
-- ShowDuration[];

--IF FALSE THEN-- EXIT;
ENDLOOP;

DO
Obj: TYPE = REF ANY;
prev: REF Obj ← NIL;
nObjects: INTEGER = 10000;

IF stopPlease THEN EXIT;
WriteString[" ***Allocating 50000 objects from prefixedZone..."];
SetClock[];
THROUGH [1..5] DO THROUGH [1..nObjects] DO IF stopPlease THEN EXIT; prev ← prefixedZone.NEW[Obj ← prev]; ENDLOOP; ENDLOOP;
prev ← NIL;
WriteString["taking "];
ShowDuration[];

-- [] ← RTStorageOps.PrivateReclaimCollectibleObjects[];
-- ShowDuration[];

--IF FALSE THEN-- EXIT;
ENDLOOP;

DO
Obj: TYPE = RECORD[next: REF ANY];
prev: REF Obj ← NIL;
sizes: ARRAY [0..4) OF CARDINAL = [2,4,7,12];
IF stopPlease THEN EXIT;
WriteString[" ***Allocating 10000 objects of random sizes..."];
SetClock[];
THROUGH [1..10000] DO
p: REF Obj ← NARROW[LOOPHOLE[NewObject[type: CODE[Obj], size: sizes[RandomInt.Next[]]], REF ANY]];
RTStorageOps.AssignRefNew[NIL, @p.next];
p.next ← prev;
prev ← p;
p ← NIL;
IF stopPlease THEN EXIT;
ENDLOOP;
prev ← NIL;
WriteString["taking "];
ShowDuration[];
-- WriteString[" ***Reclaiming..."];
-- [] ← RTStorageOps.PrivateReclaimCollectibleObjects[];
-- WriteString["taking "];
-- ShowDuration[];
--IF FALSE THEN-- EXIT;
ENDLOOP;

DO
Obj: TYPE = RECORD[next: LONG POINTER];
someObj: Obj ← [NIL];
sizes: ARRAY [0..4) OF CARDINAL = [2,4,7,12];

IF stopPlease THEN EXIT;
WriteString[" ***Allocating and Freeing 50000 NewUObject quantized objects of random sizes..."];
SetClock[];
THROUGH [1..50] DO
startP: LONG POINTER TO Obj ← NIL;
THROUGH [0..1000) DO
p: LONG POINTER TO Obj = NewUObject[size: sizes[RandomInt.Next[]], zone: quantizedHeapZone];
p.next ← startP;
startP ← p;
IF stopPlease THEN EXIT;
ENDLOOP;
UNTIL startP = NIL DO
p: LONG POINTER TO Obj ← startP;
startP ← p.next;
quantizedHeapZone.FREE[@p];
ENDLOOP;
IF stopPlease THEN EXIT;
ENDLOOP;
WriteString["taking "];
ShowDuration[];
TrimUZone[quantizedHeapZone];
--IF FALSE THEN-- EXIT;
ENDLOOP;

DO
Obj: TYPE = RECORD[next: LONG POINTER];
suz: UNCOUNTED ZONE = GetSystemUZone[];
someObj: Obj ← [NIL];
sizes: ARRAY [0..4) OF CARDINAL = [2,4,7,12];

IF stopPlease THEN EXIT;
WriteString[" ***Allocating and Freeing 50000 NewUObject prefixed objects of random sizes..."];
SetClock[];
THROUGH [1..50] DO
startP: LONG POINTER TO Obj ← NIL;
THROUGH [0..1000) DO
p: LONG POINTER TO Obj = NewUObject[size: sizes[RandomInt.Next[]], zone: suz];
p.next ← startP;
startP ← p;
IF stopPlease THEN EXIT;
ENDLOOP;
UNTIL startP = NIL DO
p: LONG POINTER TO Obj ← startP;
startP ← p.next;
suz.FREE[@p];
ENDLOOP;
IF stopPlease THEN EXIT;
ENDLOOP;
WriteString["taking "];
ShowDuration[];
TrimUZone[suz];
--IF FALSE THEN-- EXIT;
ENDLOOP;

ENDLOOP; -- BIG LOOP

}; -- end Main

OuterMain: PROC =
{Main[];
prefixedZone ← NIL;
quantizedZone ← NIL;
dummyZone ← NIL;
FreeUZone[quantizedHeapZone];
-- IF NOT test THEN TTY.Destroy[ttyHandle];
-- h ← NIL;
fooFQ ← [NIL]};



-- START HERE

dummyZone: ZONE ← NewZone[];
[in, out] ← IO.CreateViewerStreams["Test"];
ttyHandle ← TTYIO.CreateTTYHandleFromStreams[in, out]; -- ttyHandle ← CedarInitPrivate.tty;

OuterMain[];

END.