home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / collector / colltest.mod < prev    next >
Text File  |  1995-04-15  |  8KB  |  299 lines
  1. (* Simple test module for Collector and CollectorS *)
  2.  
  3. MODULE CollTest;
  4.  
  5. IMPORT
  6.   (* $IF Debug *) Debug, (* $END *)
  7.   io, Random, NoGuru,
  8.   (* $IF Collector *)
  9.     c:Collector;
  10.   (* $ELSE *)
  11.     c:CollectorS;
  12.   (* $END *)
  13.  
  14. TYPE
  15.   ElemP = POINTER TO Elem;
  16.  
  17.   Elem = RECORD
  18.     (c.Element)
  19.     nr  : LONGINT;  (* creation count, 0 for 'deleted' elements *)
  20.     ref : ElemP;    (* a reference out *)
  21.   END;
  22.  
  23. VAR
  24.   rootType : SHORTINT;
  25.   elemType : SHORTINT;
  26.   elemNr   : LONGINT;
  27.   root     : ARRAY 200 OF ElemP;
  28.   elem     : ARRAY 200 OF ElemP;
  29.   tmp1, tmp2 : ElemP;
  30.   i, j     : INTEGER;
  31.   count    : INTEGER;
  32.   nRoot    : INTEGER;
  33.   nElem    : INTEGER;
  34.  
  35. PROCEDURE newElem () : c.ElementP;
  36. VAR p : ElemP;
  37. BEGIN
  38.   NEW(p);
  39.   RETURN p;
  40. END newElem;
  41.  
  42.  
  43. PROCEDURE (this : ElemP) mark *;
  44. BEGIN
  45.   IF (this.nr # 0) & (this.ref # NIL) THEN
  46.     c.Mark(this.ref);
  47.   END;
  48. END mark;
  49.  
  50.  
  51. PROCEDURE (this : ElemP) free * () : INTEGER;
  52. BEGIN
  53.     (* Non-Root or deleted Root elements may be freed *)
  54.   IF ~(c.Root IN this.ecFlags) OR (this.nr = 0) THEN
  55.     this.ref := NIL;
  56.     RETURN c.enlist;
  57.     (* Note that the pointer in the global root[] or elem[]
  58.     ** should be removed here as well.
  59.     *)
  60.   END;
  61.   RETURN c.keep;
  62. END free;
  63.  
  64.  
  65. PROCEDURE NewElem (type : SHORTINT) : ElemP;
  66. VAR p : ElemP;
  67. BEGIN
  68.   p := c.New(type)(Elem);
  69.   INC(elemNr);
  70.   p.nr := elemNr;
  71.   p.ref := NIL;
  72.   RETURN p;
  73. END NewElem;
  74.  
  75.  
  76. PROCEDURE FreeRoot;
  77. VAR i : LONGINT;
  78. BEGIN
  79.   FOR i := 0 TO LEN(root)-1 DO
  80.     IF root[i] # NIL THEN
  81.       root[i].nr := 0;
  82.       root[i] := NIL;
  83.     END;
  84.   END;
  85. END FreeRoot;
  86.  
  87.  
  88. BEGIN
  89.   elemNr := 0;
  90.   rootType := c.RegisterType(newElem, TRUE, 100);
  91.   elemType := c.RegisterType(newElem, FALSE, 100);
  92.   Random.PutSeed(31415926);
  93.  
  94.   (* Simplest case: GC if nothing is there *)
  95.   IF c.GC(0) THEN END;
  96.  
  97.   (* GC after allocating a few Root elements with crossreferences *)
  98.   root[0] := NewElem(rootType);
  99.   root[1] := NewElem(rootType);
  100.   root[2] := NewElem(rootType);
  101.   root[3] := NewElem(rootType);
  102.   root[1].ref := root[3];
  103.   c.Check(root[1], root[3]);
  104.   IF c.GC(0) THEN END;
  105.  
  106.   (* 'Delete' the root elements, then GC again *)
  107.   FreeRoot;
  108.   IF c.GC(0) THEN END;
  109.  
  110.   (* Return the memory collected to the system *)
  111.   c.ShortenLists(0);
  112.  
  113.   (* Now lets play with referenced and unreferenced non-root objects
  114.   *)
  115.   elem[0] := NewElem(elemType); (* A floating loop *)
  116.   elem[1] := NewElem(elemType);
  117.   elem[2] := NewElem(elemType);
  118.   elem[0].ref := elem[2];
  119.   c.Check(elem[0], elem[2]);
  120.   elem[3] := NewElem(elemType); (* This is just unreferenced *)
  121.   elem[4] := NewElem(elemType); (* A sequence of two elements *)
  122.   elem[5] := NewElem(elemType);
  123.   elem[5].ref := elem[4];
  124.   c.Check(elem[5], elem[4]);
  125.   root[0] := NewElem(rootType); (* Get a hold on the sequence *)
  126.   root[0].ref := elem[5];       (* enforce a second run through the non-roots *)
  127.   c.Check(root[0], elem[5]);
  128.  
  129.   (* Let just the referenced elements survive *)
  130.   IF c.GC(0) THEN END;
  131.  
  132.   (* Now return all *)
  133.   FreeRoot;
  134.   IF c.GC(0) THEN END;
  135.  
  136.   (* Now check if the interleaving of referencing and garbage collection
  137.   ** succeeds.
  138.   ** First the setup...
  139.   *)
  140.   elem[0] := NewElem(elemType);
  141.   root[0] := NewElem(rootType);
  142.   root[0].ref := elem[0];
  143.   c.Check(root[0], elem[0]);
  144.  
  145.   (* The GC comes from the end, our references will be built from the
  146.   ** beginning.
  147.   *)
  148.   FOR i := 1 TO 3 DO
  149.     elem[i]     := NewElem(elemType);
  150.     elem[i].ref := root[0].ref;
  151.     c.Check(elem[i], elem[i].ref);
  152.     root[0].ref := elem[i];
  153.     c.Check(root[0], elem[i]);
  154.     IF c.GC(4) THEN END;
  155.   END;
  156.  
  157.     (* Now, what would be wrong with this test code instead?
  158.     **   FOR i := 1 TO 3 DO
  159.     **     elem[i]       := NewElem(elemType);
  160.     **     elem[i-1].ref := elem[i];
  161.     **     c.Check(elem[i], elem[i].ref);
  162.     **     IF c.GC(4) THEN END;
  163.     **   END;
  164.     ** After a call to GC() the content of elem[i-1] might have gone away.
  165.     ** In this case it doesn't because all elements are chained, but that's
  166.     ** just this case.
  167.     ** There is a lesson here to learn: between two calls of GC() we may
  168.     ** just use the elements we trace ourself down from a root element,
  169.     ** or we allocate ourself.
  170.     ** It is therefore a good idea to NIL all the 'weak' pointers to an element
  171.     ** in the free() method of that very element.
  172.     *)
  173.  
  174.   IF c.GC(0) THEN END;
  175.  
  176.   (* Cleanup again *)
  177.   FreeRoot;
  178.   IF c.GC(0) THEN END;
  179.  
  180.  
  181.   io.WriteLn;
  182.   io.WriteInt(c.gcReqT, 1); io.WriteString(" elements requested so far, ");
  183.   io.WriteInt(c.gcFreeT, 1); io.WriteString(" retrieved : ");
  184.   IF (c.gcFreeT = 16) & (c.gcReqT = 16) THEN
  185.     io.WriteString("correct.\n");
  186.   ELSE
  187.     io.WriteString("wrong, should be both 16.\n");
  188.   END;
  189.   io.WriteLn;
  190.  
  191.   (* If you finaly come here, you can relax: the collector is functional.
  192.   ** Now let's see how responsive it is..
  193.   ** (You don't really want to single-step this part, believe me).
  194.   *)
  195.  
  196.   FOR i := 1 TO (* $IF Debug *) 5 (* $ELSE *) 10 (* $END *) DO
  197.     io.WriteString("Loop "); io.WriteInt(i, 2); io.WriteString(": ");
  198.  
  199.     nRoot := 0;
  200.     nElem := 0;
  201.     count := 0;
  202.  
  203.     WHILE (nRoot < 200) & (nElem < 200) DO
  204.       INC(count);
  205.       tmp1 := NIL;
  206.       tmp2 := NIL;
  207.       IF (Random.RND(100) < 50) & (nRoot < 200) THEN
  208.         root[nRoot] := NewElem(rootType);
  209.         INC(nRoot);
  210.       END;
  211.       IF (Random.RND(100) < 50) & (nRoot < 200) THEN
  212.         root[nRoot] := NewElem(rootType);
  213.         INC(nRoot);
  214.       END;
  215.       IF (Random.RND(100) < 50) & (nElem < 200) THEN
  216.         elem[nElem] := NewElem(elemType);
  217.         tmp1 := elem[nElem];
  218.         INC(nElem);
  219.       END;
  220.       IF (Random.RND(100) < 50) & (nElem < 200) THEN
  221.         elem[nElem] := NewElem(elemType);
  222.         tmp2 := elem[nElem];
  223.       END;
  224.  
  225.       IF (tmp1 # NIL) & (nRoot > 0) THEN
  226.         j := Random.RND(nRoot);
  227.         IF root[j].nr # 0 THEN
  228.           root[j].ref := tmp1;
  229.           c.Check(root[j], tmp1);
  230.         END;
  231.       END;
  232.       IF (tmp2 # NIL) & (nRoot > 0) THEN
  233.         j := Random.RND(nRoot);
  234.         IF root[j].nr # 0 THEN
  235.           root[j].ref := tmp2;
  236.           c.Check(root[j], tmp2);
  237.         END;
  238.       END;
  239.  
  240.       j := Random.RND(300);
  241.       IF j < nRoot THEN
  242.         root[j].nr := 0;
  243.       END;
  244.       j := Random.RND(300);
  245.       IF j < nRoot THEN
  246.         root[j].nr := 0;
  247.       END;
  248.  
  249.       j := Random.RND(300);
  250.       IF j < nRoot THEN
  251.         root[j].ref := NIL;
  252.       END;
  253.       j := Random.RND(300);
  254.       IF j < nRoot THEN
  255.         root[j].ref := NIL;
  256.       END;
  257.  
  258.       j := Random.RND(300);
  259.       IF (j < nRoot) & (root[j].nr # 0) & (root[j].ref # NIL) THEN
  260.         tmp1 := root[j].ref;
  261.         j := Random.RND(nRoot);
  262.         IF root[j].nr # 0 THEN
  263.           root[j].ref := tmp1;
  264.           c.Check(root[j], tmp1);
  265.         END;
  266.       END;
  267.       j := Random.RND(300);
  268.       IF (j < nRoot) & (root[j].nr # 0) & (root[j].ref # NIL) THEN
  269.         tmp1 := root[j].ref;
  270.         j := Random.RND(nRoot);
  271.         IF root[j].nr # 0 THEN
  272.           root[j].ref := tmp1;
  273.           c.Check(root[j], tmp1);
  274.         END;
  275.       END;
  276.  
  277.       IF c.GC(20) THEN
  278.         io.WriteInt(count, 1); io.WriteString(", ");
  279.       END;
  280.     END;
  281.  
  282.     FreeRoot;
  283.     IF c.GC(0) THEN END;
  284.     io.WriteLn;
  285.   END;
  286.  
  287.   (* Ensure a complete GC *)
  288.  
  289.   IF c.GC(0) THEN END;
  290.  
  291.   io.WriteLn;
  292.   io.WriteInt(c.gcRuns, 1); io.WriteString(" GCs completed in ");
  293.   io.WriteInt(c.gcCallsT, 1); io.WriteString(" calls.\n");
  294.   io.WriteInt(c.gcReqT, 1); io.WriteString(" elements requested, ");
  295.   io.WriteInt(c.gcFreeT, 1); io.WriteString(" retrieved.\n");
  296.   io.WriteInt(c.gcExaT, 1); io.WriteString(" elements examined\n");
  297.  
  298. END CollTest.
  299.