home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga MA Magazine 1998 #6
/
amigamamagazinepolishissue1998.iso
/
coders
/
collector
/
colltest.mod
< prev
next >
Wrap
Text File
|
1995-04-15
|
8KB
|
299 lines
(* Simple test module for Collector and CollectorS *)
MODULE CollTest;
IMPORT
(* $IF Debug *) Debug, (* $END *)
io, Random, NoGuru,
(* $IF Collector *)
c:Collector;
(* $ELSE *)
c:CollectorS;
(* $END *)
TYPE
ElemP = POINTER TO Elem;
Elem = RECORD
(c.Element)
nr : LONGINT; (* creation count, 0 for 'deleted' elements *)
ref : ElemP; (* a reference out *)
END;
VAR
rootType : SHORTINT;
elemType : SHORTINT;
elemNr : LONGINT;
root : ARRAY 200 OF ElemP;
elem : ARRAY 200 OF ElemP;
tmp1, tmp2 : ElemP;
i, j : INTEGER;
count : INTEGER;
nRoot : INTEGER;
nElem : INTEGER;
PROCEDURE newElem () : c.ElementP;
VAR p : ElemP;
BEGIN
NEW(p);
RETURN p;
END newElem;
PROCEDURE (this : ElemP) mark *;
BEGIN
IF (this.nr # 0) & (this.ref # NIL) THEN
c.Mark(this.ref);
END;
END mark;
PROCEDURE (this : ElemP) free * () : INTEGER;
BEGIN
(* Non-Root or deleted Root elements may be freed *)
IF ~(c.Root IN this.ecFlags) OR (this.nr = 0) THEN
this.ref := NIL;
RETURN c.enlist;
(* Note that the pointer in the global root[] or elem[]
** should be removed here as well.
*)
END;
RETURN c.keep;
END free;
PROCEDURE NewElem (type : SHORTINT) : ElemP;
VAR p : ElemP;
BEGIN
p := c.New(type)(Elem);
INC(elemNr);
p.nr := elemNr;
p.ref := NIL;
RETURN p;
END NewElem;
PROCEDURE FreeRoot;
VAR i : LONGINT;
BEGIN
FOR i := 0 TO LEN(root)-1 DO
IF root[i] # NIL THEN
root[i].nr := 0;
root[i] := NIL;
END;
END;
END FreeRoot;
BEGIN
elemNr := 0;
rootType := c.RegisterType(newElem, TRUE, 100);
elemType := c.RegisterType(newElem, FALSE, 100);
Random.PutSeed(31415926);
(* Simplest case: GC if nothing is there *)
IF c.GC(0) THEN END;
(* GC after allocating a few Root elements with crossreferences *)
root[0] := NewElem(rootType);
root[1] := NewElem(rootType);
root[2] := NewElem(rootType);
root[3] := NewElem(rootType);
root[1].ref := root[3];
c.Check(root[1], root[3]);
IF c.GC(0) THEN END;
(* 'Delete' the root elements, then GC again *)
FreeRoot;
IF c.GC(0) THEN END;
(* Return the memory collected to the system *)
c.ShortenLists(0);
(* Now lets play with referenced and unreferenced non-root objects
*)
elem[0] := NewElem(elemType); (* A floating loop *)
elem[1] := NewElem(elemType);
elem[2] := NewElem(elemType);
elem[0].ref := elem[2];
c.Check(elem[0], elem[2]);
elem[3] := NewElem(elemType); (* This is just unreferenced *)
elem[4] := NewElem(elemType); (* A sequence of two elements *)
elem[5] := NewElem(elemType);
elem[5].ref := elem[4];
c.Check(elem[5], elem[4]);
root[0] := NewElem(rootType); (* Get a hold on the sequence *)
root[0].ref := elem[5]; (* enforce a second run through the non-roots *)
c.Check(root[0], elem[5]);
(* Let just the referenced elements survive *)
IF c.GC(0) THEN END;
(* Now return all *)
FreeRoot;
IF c.GC(0) THEN END;
(* Now check if the interleaving of referencing and garbage collection
** succeeds.
** First the setup...
*)
elem[0] := NewElem(elemType);
root[0] := NewElem(rootType);
root[0].ref := elem[0];
c.Check(root[0], elem[0]);
(* The GC comes from the end, our references will be built from the
** beginning.
*)
FOR i := 1 TO 3 DO
elem[i] := NewElem(elemType);
elem[i].ref := root[0].ref;
c.Check(elem[i], elem[i].ref);
root[0].ref := elem[i];
c.Check(root[0], elem[i]);
IF c.GC(4) THEN END;
END;
(* Now, what would be wrong with this test code instead?
** FOR i := 1 TO 3 DO
** elem[i] := NewElem(elemType);
** elem[i-1].ref := elem[i];
** c.Check(elem[i], elem[i].ref);
** IF c.GC(4) THEN END;
** END;
** After a call to GC() the content of elem[i-1] might have gone away.
** In this case it doesn't because all elements are chained, but that's
** just this case.
** There is a lesson here to learn: between two calls of GC() we may
** just use the elements we trace ourself down from a root element,
** or we allocate ourself.
** It is therefore a good idea to NIL all the 'weak' pointers to an element
** in the free() method of that very element.
*)
IF c.GC(0) THEN END;
(* Cleanup again *)
FreeRoot;
IF c.GC(0) THEN END;
io.WriteLn;
io.WriteInt(c.gcReqT, 1); io.WriteString(" elements requested so far, ");
io.WriteInt(c.gcFreeT, 1); io.WriteString(" retrieved : ");
IF (c.gcFreeT = 16) & (c.gcReqT = 16) THEN
io.WriteString("correct.\n");
ELSE
io.WriteString("wrong, should be both 16.\n");
END;
io.WriteLn;
(* If you finaly come here, you can relax: the collector is functional.
** Now let's see how responsive it is..
** (You don't really want to single-step this part, believe me).
*)
FOR i := 1 TO (* $IF Debug *) 5 (* $ELSE *) 10 (* $END *) DO
io.WriteString("Loop "); io.WriteInt(i, 2); io.WriteString(": ");
nRoot := 0;
nElem := 0;
count := 0;
WHILE (nRoot < 200) & (nElem < 200) DO
INC(count);
tmp1 := NIL;
tmp2 := NIL;
IF (Random.RND(100) < 50) & (nRoot < 200) THEN
root[nRoot] := NewElem(rootType);
INC(nRoot);
END;
IF (Random.RND(100) < 50) & (nRoot < 200) THEN
root[nRoot] := NewElem(rootType);
INC(nRoot);
END;
IF (Random.RND(100) < 50) & (nElem < 200) THEN
elem[nElem] := NewElem(elemType);
tmp1 := elem[nElem];
INC(nElem);
END;
IF (Random.RND(100) < 50) & (nElem < 200) THEN
elem[nElem] := NewElem(elemType);
tmp2 := elem[nElem];
END;
IF (tmp1 # NIL) & (nRoot > 0) THEN
j := Random.RND(nRoot);
IF root[j].nr # 0 THEN
root[j].ref := tmp1;
c.Check(root[j], tmp1);
END;
END;
IF (tmp2 # NIL) & (nRoot > 0) THEN
j := Random.RND(nRoot);
IF root[j].nr # 0 THEN
root[j].ref := tmp2;
c.Check(root[j], tmp2);
END;
END;
j := Random.RND(300);
IF j < nRoot THEN
root[j].nr := 0;
END;
j := Random.RND(300);
IF j < nRoot THEN
root[j].nr := 0;
END;
j := Random.RND(300);
IF j < nRoot THEN
root[j].ref := NIL;
END;
j := Random.RND(300);
IF j < nRoot THEN
root[j].ref := NIL;
END;
j := Random.RND(300);
IF (j < nRoot) & (root[j].nr # 0) & (root[j].ref # NIL) THEN
tmp1 := root[j].ref;
j := Random.RND(nRoot);
IF root[j].nr # 0 THEN
root[j].ref := tmp1;
c.Check(root[j], tmp1);
END;
END;
j := Random.RND(300);
IF (j < nRoot) & (root[j].nr # 0) & (root[j].ref # NIL) THEN
tmp1 := root[j].ref;
j := Random.RND(nRoot);
IF root[j].nr # 0 THEN
root[j].ref := tmp1;
c.Check(root[j], tmp1);
END;
END;
IF c.GC(20) THEN
io.WriteInt(count, 1); io.WriteString(", ");
END;
END;
FreeRoot;
IF c.GC(0) THEN END;
io.WriteLn;
END;
(* Ensure a complete GC *)
IF c.GC(0) THEN END;
io.WriteLn;
io.WriteInt(c.gcRuns, 1); io.WriteString(" GCs completed in ");
io.WriteInt(c.gcCallsT, 1); io.WriteString(" calls.\n");
io.WriteInt(c.gcReqT, 1); io.WriteString(" elements requested, ");
io.WriteInt(c.gcFreeT, 1); io.WriteString(" retrieved.\n");
io.WriteInt(c.gcExaT, 1); io.WriteString(" elements examined\n");
END CollTest.