-- 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["<>"]; 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["<<>>"]; 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["<<>>"]; { 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.