(* (* $VER: CollectorS 1.0 (10-Feb-94) Copyright © by Lars Düning *) *)

MODULE CollectorS;

(*---------------------------------------------------------------------------
** Allocation and garbage-collection of elemental objects.
**
** Copyright © 1993-1994 by Lars Düning  -  All rights reserved.
** Permission granted for non-commercial use.
**---------------------------------------------------------------------------
** The GC is a variant of Dijkstra's incremental update collector as
** described in:
**   Paul R. Wilson: Uniprocessor Garbage Collection Techniques
**   1992 International Workshop on Memory Management
**   Springer-Verlag, Lecture Notes
** This implementation imposes a rather small memory overhead, but may need
** several runs for a full gc.
**---------------------------------------------------------------------------
** Oberon-2: Amiga-Oberon v3.10, F. Siebert / A+L AG
**---------------------------------------------------------------------------
** [lars] Lars Düning; Am Wendenwehr 25; D-38114-Braunschweig;
**                     Germany; Tel. 49-531-345692
**---------------------------------------------------------------------------
** 07-Feb-94 [lars] Derived from Collector, using a scheme with lower
**                  memory overhead.
** 09-Feb-94 [lars] Option 'Statistics' dropped; enforced collection.
** 10-Feb-94 [lars] 'Rootness' is now part of the element type.
**                  'gcReqT' added.
** 10-Feb-94 [lars] actual
**---------------------------------------------------------------------------
*)

(* $StackChk- $OvflChk- *)

IMPORT
  (* $IF Debug *) Debug, (* $END *)
  SYSTEM;

(*-------------------------------------------------------------------------*)

TYPE
  ElementP  *= POINTER TO Element;
  FreeDataP *= POINTER TO FreeData;
  FreeElemP *= POINTER TO FreeElem;

TYPE

  (* Base structure of an collectable element
  ** The color of an element is solely determined by the ring it is part of.
  *)
  Element *= RECORD
    next     : ElementP;  (* next element; NIL for unchained elements *)
    ecType  -: SHORTINT;  (* type of this element *)
    ecFlags *: SHORTSET;  (* color and other flags *)
  END;

CONST  (* Element.ecFlags *)
  Black *= 0;  (* Color 'black', must be 1-White *)
  White *= 1;  (* Color 'white', must be 1-Black *)
  Grey  *= 2;  (* Color 'grey' *)
  Root  *= 6;  (* set for members of the root set *)
  Base  *= 7;  (* Baseelement of a ring *)

TYPE

  (* A freed element
  ** The size of this record must be equal to that of Element!
  *)

  FreeElem = RECORD
    next : FreeElemP;  (* next element in free chain *)
    age  : INTEGER;    (* # of GC pass freeing this element *)
  END;

  (* A Freelist entry for one ecType
  *)
  FreeData *= STRUCT
    list    -: FreeElemP;                (* List of free elements *)
    new     -: PROCEDURE () : ElementP;  (* Allocator procedure *)
    root    -: BOOLEAN;                  (* Flag is these elements are 'Root' *)
    max     -: LONGINT;                  (* Max number of elements to hold *)
    nrList  -: LONGINT;                  (* Current number of held elements *)
    nrReq   -: LONGINT;  (* Total count of requests for a new Element *)
    nrRecyc -: LONGINT;  (* Count of Element requests served from the free list *)
    nrFreed -: LONGINT;  (* Total count of Element freed *)
  END;

  FreeListP *= POINTER TO ARRAY OF FreeData;

VAR
  black -: INTEGER; (* Actual colors *)
  white -: INTEGER;

  nrTypes -: SHORTINT;  (* Number of registered ecTypes *)

  freelist -: FreeListP;  (* All Freelists *)

    (* Rings of the normal element set
    ** During GC:
    **   black : processed and referenced
    **   dark  : not grey: processed, but unreferenced
    **           grey    : processed and referenced
    **   white : not grey: unprocessed and/or unreferenced
    **           grey    : referenced, but not processed yet
    **
    ** After GC:
    **   black : alive elements
    **   dark  : possibly dead elements (the non-grey ones)
    **   white : dead elements
    **
    ** During Sweeping:
    **   black : empty
    **   dark  : possible dead elements left to sweep
    **   white : alive elements from previous run, and new elements
    *)
  nBlack   : ElementP;  (* ring of the black elements *)
  nDark    : ElementP;  (* ring of the dark elements *)
  nWhite   : ElementP;  (* ring of the white element *)
  nrNormal : LONGINT;   (* Number of normal elements *)
  nGotGrey : BOOLEAN;   (* TRUE if there are greyed white elements *)

    (* Pointers of the root element set
    ** During GC:
    **   black : processed and referenced
    **   dark  : not grey: processed, but unreferenced
    **           grey    : processed and referenced
    **   white : not grey: unprocessed, mostly unreferenced
    **           grey    : unprocessed yet, but referenced
    **
    ** After GC:
    **   black : alive elements
    **   dark  : possibly dead elements (the non-grey ones)
    **   white : dead elements
    **
    ** During Sweeping:
    **  black  : empty
    **  dark   : possible dead elements left to sweep
    **  white  : alive elements from previous run, and new elements.
    *)
  rBlack   : ElementP;  (* ring of black root elements *)
  rDark    : ElementP;  (* ring of dark root elements *)
  rWhite   : ElementP;  (* ring of white root elements *)
  nrRoot   : LONGINT;   (* Number of root elements *)

    (* Used by the GC *)
  sweeping -: BOOLEAN;  (* GC state: false: marking, true: sweeping *)
  gcRuns  -: LONGINT;   (* Count of GC runs *)
  gcCalls -: LONGINT;   (* Calls to GC() during this run *)

    (* And for my curiosity... *)
  gcReqT   -: LONGINT;  (* Total number of elements requested *)
  gcFreeT  -: LONGINT;  (* Total number of elements freed by GC so far *)
  gcExaT   -: LONGINT;  (* Total number of elements examinated by GC so far *)
  gcCallsT -: LONGINT;  (* Total count of calls to GC() *)

    (* ..and to build those numbers... *)
  gcFree -: LONGINT;  (* Actual number of elements freed this GC-run *)
  gcExa  -: LONGINT;  (* Actual number of elements examinated this GC-run *)

(*=========================================================================
**
**                             E L E M E N T
**
**=========================================================================*)

(*-------------------------------------------------------------------------*)
PROCEDURE (this : ElementP) mark *;

(* Mark all elements which are referenced by this element as grey.
**
** Argument:
**   this: the referencing element.
**
** The element itself is marked by the collector.
*)

BEGIN
  (* Nothing to do as default. *)
END mark;

(*-------------------------------------------------------------------------*)
CONST (* Returnvalues of this.free() *)
  keep    *= 0;
  enlist  *= 1;
  dispose *= 2;

PROCEDURE (this : ElementP) free * () : INTEGER;

(* Let an unreferenced element clean up itself.
**
** Argument:
**   this: the now unreferenced element.
**
** Result:
**   keep   : the element is still alive, keep it.
**   enlist : put the element into its freelist.
**   dispose: deallocate the element.
**
** The result determines the action done by the collector.
*)

BEGIN
  RETURN enlist;
END free;

(*=========================================================================*)

(*-------------------------------------------------------------------------*)
PROCEDURE ResizeFreelist (count : SHORTINT);

(* (Re)Allocate 'count' entries in 'freelist'.
**
** Argument:
**   count : the new size of the freelist.
**
** Existing entries are copied; it is not possible to shrink the freelist.
*)

VAR
  oldCount : SHORTINT;
  i        : SHORTINT;
  newlist  : FreeListP;
BEGIN
  IF (freelist # NIL) & (count <= LEN(freelist^)) THEN RETURN; END;
  IF freelist # NIL THEN
    oldCount := nrTypes;
  ELSE
    oldCount := 0;
  END;
  NEW(newlist, count);
  FOR i := 0 TO oldCount-1 DO
    newlist[i] := freelist[i];
  END;
  FOR i := oldCount TO count-1 DO
    newlist[i].list := NIL;
    newlist[i].new  := NIL;
    newlist[i].max  := 0;
    newlist[i].root := FALSE;
    newlist[i].nrList := 0;
    newlist[i].nrReq   := 0;
    newlist[i].nrRecyc := 0;
    newlist[i].nrFreed := 0;
  END;
  (* $IFNOT GarbageCollector *)
    IF freelist # NIL THEN
      DISPOSE(freelist);
    END;
  (* $END *)
  freelist := newlist;
END ResizeFreelist;

(*-------------------------------------------------------------------------*)
PROCEDURE RegisterType * ( new    : PROCEDURE() : ElementP
                         ; isRoot : BOOLEAN
                         ; max    : LONGINT
                         ) : SHORTINT;

(* Register a new collectable type.
**
** Arguments:
**   new : the procedure to allocate a record of that type.
**   isRoot : TRUE if these elements are member of the root set.
**   max : the max number of records to hold in the freelist.
**
** Result:
**   The ecType number for the registered type.
*)

BEGIN
  ResizeFreelist(nrTypes+1);
  freelist[nrTypes].new := new;
  freelist[nrTypes].max := max;
  freelist[nrTypes].root := isRoot;
  INC(nrTypes);
  RETURN nrTypes-1;
END RegisterType;

(*-------------------------------------------------------------------------*)
PROCEDURE New * (type : SHORTINT) : ElementP;

(* Return an element of the given type.
**
** Arguments:
**   type   : the type number for the requested element.
**
** Result:
**   A pointer to the new element.
**
** The element is allocated either from the freelist, or using the 'new'
** procedure. It is entangled into the collector lists, either in
** the normalset, or if .root is TRUE, in the rootset.
*)

VAR
  freep : FreeDataP;
  rc : ElementP;
BEGIN
  freep := SYSTEM.VAL(FreeDataP, SYSTEM.ADR(freelist[type]));
  INC(freep.nrReq);
  INC(gcReqT);
  IF freep.list # NIL THEN
    rc := SYSTEM.VAL(ElementP, freep.list);
    freep.list := freep.list.next;
    rc.next := NIL;
    DEC(freep.nrList);
    INC(freep.nrRecyc);
  ELSE
    rc := freep.new();
  END;
  IF rc # NIL THEN
    rc.ecType := type;
    (* === Entangle(rc, isRoot); === *)
      rc.ecFlags := SHORTSET{white};
      IF freep.root THEN
        INCL(rc.ecFlags, Root);
        rc.next     := rWhite.next;
        rWhite.next := rc;
        INC(nrRoot);
      ELSE
        rc.next     := nWhite.next;
        nWhite.next := rc;
        INC(nrNormal);
      END;
    (* ====== *)
  END;
  RETURN rc;
END New;

(*-------------------------------------------------------------------------*)
PROCEDURE Allocate * (type : SHORTINT) : ElementP;

(* Return an element of the given type.
**
** Arguments:
**   type   : the type number for the requested element.
**
** Result:
**   A pointer to the new element.
**
** The element is allocated either from the freelist, or using the 'new'
** procedure. It is NOT entangled into the collector lists.
** Use it with care!
*)

VAR
  freep : FreeDataP;
  rc : ElementP;
BEGIN
  freep := SYSTEM.VAL(FreeDataP, SYSTEM.ADR(freelist[type]));
  INC(freep.nrReq);
  IF freep.list # NIL THEN
    rc := SYSTEM.VAL(ElementP, freep.list);
    freep.list := freep.list.next;
    rc.next := NIL;
    DEC(freep.nrList);
    INC(freep.nrRecyc);
  ELSE
    rc := freep.new();
    IF rc # NIL THEN
      rc.ecType := type;
      rc.next := NIL;
    END;
  END;
  rc.ecFlags := SHORTSET{};
  RETURN rc;
END Allocate;

(*-------------------------------------------------------------------------*)
PROCEDURE Free * (elem : ElementP; prev : ElementP; dealloc : BOOLEAN);

(* Remove an element from the active ring.
**
** Arguments:
**   elem    : the element to remove.
**   prev    : the element preceeding 'elem', or NIL.
**   dealloc : flag if the element should be deallocated.
**
** The element is removed from its ring (if any) and added to the freelist
** of its type, unless 'dealloc' is false, then it is deallocated.
*)

VAR
  freep : FreeDataP;
  felp  : FreeElemP;
BEGIN
  IF elem.next # NIL THEN
    IF Base IN elem.ecFlags THEN RETURN; END;
    IF Root IN elem.ecFlags THEN DEC(nrRoot);
                            ELSE DEC(nrNormal);
    END;
  (* === Detangle(elem) === *)
    IF prev = NIL THEN
      prev := elem.next;
      WHILE prev.next # elem DO
        prev := prev.next;
      END;
    END;
    prev.next := elem.next;
    elem.next := NIL;
  (* ====== *)
  END;
  freep := SYSTEM.VAL(FreeDataP, SYSTEM.ADR(freelist[elem.ecType]));
  INC(freep.nrFreed);
  IF dealloc OR (freep.nrList >= freep.max) THEN
    (* $IFNOT GarbageCollector *)
      DISPOSE(elem);
    (* $ELSE *)
      elem := NIL;
    (* $END *)
  ELSE
    felp := SYSTEM.VAL(FreeElemP, elem);
    felp.next := freep.list;
    freep.list := felp;
    felp.age := SHORT(gcRuns);
    INC(freep.nrList);
  END;
END Free;

(*-------------------------------------------------------------------------*)
PROCEDURE ShortenLists * (age : INTEGER);

(* Remove old elements from the freelists.
**
** Argument:
**   age : the age in GC runs an element needs to stay in the lists.
**
** Elements older than 'age' GC runs are deallocated; with an 'age' of 0
** causing the deallocation of all elements.
*)

VAR
  freep      : FreeDataP;
  i          : SHORTINT;
  count      : LONGINT;
  this, prev : FreeElemP;
BEGIN
  age := SHORT(gcRuns-age);  (* get min gc-run# *)
  FOR i := 0 TO nrTypes-1 DO
    IF freelist[i].list # NIL THEN
      freep := SYSTEM.VAL(FreeDataP, SYSTEM.ADR(freelist[i]));
      prev := NIL;
      this := freep.list;
      WHILE this.age > age DO
        prev := this;
        this := this.next;
      END;
      IF this # NIL THEN
        count := freep.nrList;
        IF prev = NIL THEN freep.list := NIL;
                      ELSE prev.next := NIL;
        END;
        REPEAT
          prev := this; this := this.next;
          (* $IFNOT GarbageCollector *)
            DISPOSE(prev);
          (* $ELSE *)
            prev := NIL;
          (* $END *)
          DEC(count);
        UNTIL this = NIL;
        freep.nrList := count;
      END;
    END;
  END;
END ShortenLists;

(*-------------------------------------------------------------------------*)
PROCEDURE Mark * (this : ElementP);

(* Color an element grey.
**
** Argument:
**   this : the element to shade grey.
**
** The element 'elem' is colored grey (meaning "referenced but unprocessed")
** if it is not black.
**
** This function is to be called by the .mark()-methods during GC, and
** by Check() (in fact it is inlined by Check()).
**
** Inlining this procedure is advisable.
*)

BEGIN
  IF (this # NIL) & ~(black IN this.ecFlags) THEN
    INCL(this.ecFlags, Grey);
  END;
END Mark;

(*-------------------------------------------------------------------------*)
PROCEDURE Check * (this, elem : ElementP);

(* Check and possibly recolor an element after referencing.
**
** Argument:
**   this : the element 'elem' was assigned to.
**   elem : the element referenced.
**
** The element 'elem' is colored grey (meaning "referenced but unprocessed")
** if referenced by non-white elements.
**
** This function is to be called if 'elem' was just referenced
** by 'this' element.
**
** Inlining this procedure is advisable.
*)

BEGIN
  IF   (this # NIL)
     & (this.ecFlags * SHORTSET{Root, black, Grey} # SHORTSET{})
     & (elem # NIL)
     & (elem.ecFlags * SHORTSET{black, Grey} # SHORTSET{})
  THEN
    INCL(elem.ecFlags, Grey);
  END;
END Check;

(*-------------------------------------------------------------------------*)
PROCEDURE GC * (steps : LONGINT) : BOOLEAN;

(* Perform a garbage collection - one step of a full run.
**
** Argument:
**   steps : total number of steps (calls) the GC shall need.
**           A value < 2 enforces a completing/full run.
**
** Result:
**   TRUE if the GC is complete.
**
** Perform one step (or a completing/complete run) of the Mark-and-Sweep-GC
** for the elements.
** The procedure loops either over n elements or until the end of one run.
** 'n' is derived from the number of existing elements divided by the
** given number of 'steps' to do.
** If the GC is complete, a call to ShortenLists() should be done.
**
** Note that a 'complete' GC does not necessarily mean that all unreferenced
** memory has been returned already IF referenced normal elements
** are blindly colored grey even when already black.
** This is especially true if the GC was just completing a previous GC
**
** It is not guaranteed that an incremental GC really needs just 'steps'
** calls to complete.
*)

VAR
  todo     : LONGINT;
  prev     : ElementP;
  elem     : ElementP;
  elem2    : ElementP;
  rc       : INTEGER;
  fullRun  : BOOLEAN;
BEGIN
  INC(gcCalls);

    (* In case of 'fullRun's, the exact number of elements to do
    ** can't be predicted, so just loop until done.
    *)

  IF (steps < 2) THEN
    todo := 1;
    fullRun := TRUE;
  ELSE
    todo := (nrRoot+3*nrNormal) DIV steps + 1;
    fullRun := FALSE;
  END;

  (*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ** Mark all referenced elements
  *)

  IF ~sweeping THEN

    (* ------ Walk through the unprocessed white rootset elements ------ *)

    IF rWhite.next # rWhite THEN

      prev := rWhite;
      elem := rWhite.next;

      WHILE (elem # rWhite) & (todo > 0) DO
        INC (gcExa);
        elem.mark;
        IF Grey IN elem.ecFlags THEN
          EXCL(elem.ecFlags, Grey);
          EXCL(elem.ecFlags, white);
          INCL(elem.ecFlags, black);
          prev := elem;
          elem := elem.next;
        ELSE
            (* Requeue as Dark *)
          elem2 := elem.next;
          prev.next := elem.next;
          elem.next := rDark.next;
          rDark.next := elem;
          elem := elem2;
        END;

        IF ~fullRun THEN DEC (todo); END;
      END;

      (* ...now all elements of white might have gone into the dark ring.
      ** If not, define those up to 'prev' as black.
      *)

      IF (rWhite.next # rWhite) & (prev # rWhite) THEN
        prev.next := rBlack.next;
        rBlack.next := rWhite.next;
        rWhite.next := elem;
      END;

      (* No need to reloop through them - all depending elements have
      ** been marked unconditionally anyway.
      *)

      IF todo < 1 THEN RETURN FALSE; END;
    END;

    (* ------ Loop over the white normal elements ------ *)

    REPEAT

      (* --- Walk through the unprocessed grey normal elements --- *)

      IF nWhite.next # nWhite THEN

        prev := nWhite;
        elem := nWhite.next;

        WHILE (elem # nWhite) & (todo > 0) DO
          INC (gcExa);
          IF Grey IN elem.ecFlags THEN
            elem.mark;
            EXCL(elem.ecFlags, Grey);
            EXCL(elem.ecFlags, white);
            INCL(elem.ecFlags, black);
            prev := elem;
            elem := elem.next;
            nGotGrey := TRUE;
          ELSE
              (* Requeue as Dark *)
            elem2 := elem.next;
            prev.next := elem.next;
            elem.next := nDark.next;
            nDark.next := elem;
            elem := elem2;
          END;
          IF ~fullRun THEN DEC (todo); END;
        END;

        (* ...now all elements of white might have gone into the dark ring.
        ** If not, define those up to 'prev' as black.
        ** If not, define them as black.
        *)

        IF (nWhite.next # nWhite) & (prev # nWhite) THEN
          prev.next := nBlack.next;
          nBlack.next := nWhite.next;
          nWhite.next := elem;
        END;

        IF todo < 1 THEN RETURN FALSE; END;

      END;

      (* --- Requeue possibly 'grey' white elements --- *)

      IF (nWhite.next = nWhite) & nGotGrey THEN
        elem   := nWhite;
        nWhite := nDark;
        nDark  := elem;

        nGotGrey := FALSE;
      END;

    UNTIL nWhite.next = nWhite;

    (* ------ Mark done, now setup for sweeping. ------ *)

    sweeping := TRUE;
    white := black;
    black := 1-white;

    (* Requeue the alive elements into the 'white' ring.
    ** The dead ones are already in the 'dark' ring.
    *)

    elem   := nWhite;
    nWhite := nBlack;
    nBlack := elem;

    (* Requeue the alive rootset elements into the 'white' ring.
    ** The possibly dead ones are alread in the 'dark' ring.
    *)
    elem   := rWhite;
    rWhite := rBlack;
    rBlack := elem;

  END; (* IF ~sweeping *)

  (*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ** Sweep the unreferenced objects.
  *)

  (* ------ Try to free all unreferenced objects from normal set ------ *)

  IF nDark.next # nDark THEN

    prev := nDark;
    elem := nDark.next;

    WHILE (elem # nDark) & (todo > 0) DO
      (* Dark elements should not be marked 'grey' after their processing
      ** but take care if it happens...
      *)
      IF Grey IN elem.ecFlags THEN
        rc := keep;
      ELSE
        rc := elem.free();
      END;

      IF rc = keep THEN
        elem.ecFlags := SHORTSET{white};
        prev := elem;
        elem := elem.next;
      ELSE
        elem2 := elem.next;
        Free(elem, prev, rc = dispose);
        INC (gcFree);
        elem := elem2;
      END;

      IF ~fullRun THEN DEC (todo); END;
    END;

    (* ...now all elements of dark might have been freed.
    ** If not, requeue those up to 'prev' as white.
    *)

    IF (nDark.next # nDark) & (prev # nDark) THEN
      prev.next := nWhite.next;
      nWhite.next := nDark.next;
      nDark.next := elem;
    END;

    IF todo < 1 THEN RETURN FALSE; END;

  END;

  (* ------ Try to free all unreferenced objects from root set ------ *)

  IF rDark.next # rDark THEN

    prev := rDark;
    elem := rDark.next;

    WHILE (elem # rDark) & (todo > 0) DO
      (* Dark elements may be marked 'grey' after their processing
      ** so take care for them.
      *)
      IF Grey IN elem.ecFlags THEN
        rc := keep;
      ELSE
        rc := elem.free();
      END;

      IF rc = keep THEN
        elem.ecFlags := SHORTSET{Root,white};
        prev := elem;
        elem := elem.next;
      ELSE
        elem2 := elem.next;
        Free(elem, prev, rc = dispose);
        INC (gcFree);
        elem := elem2;
      END;

      IF ~fullRun THEN DEC (todo); END;
    END;

    (* ...now all elements of dark might have been freed.
    ** If not, requeue those up to 'prev' as white.
    *)

    IF (rDark.next # rDark) & (prev # rDark) THEN
      prev.next := rWhite.next;
      rWhite.next := rDark.next;
      rDark.next := elem;
    END;

    IF todo < 1 THEN RETURN FALSE; END;
  END;

  (*- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ** Prepare for a new run of the GC
  *)

  INC(gcRuns);

  INC(gcCallsT, gcCalls); gcCalls := 0;
  INC(gcFreeT, gcFree); gcFree := 0;
  INC(gcExaT , gcExa ); gcExa := 0;

  sweeping := FALSE;
  nGotGrey := FALSE;


  (* If we arrive here, the GC is complete *)

  RETURN TRUE;
END GC;

(*=========================================================================*)

BEGIN
  black := Black; white := White;
  nrTypes := 0;

  freelist := NIL;
  ResizeFreelist(20);  (* Reserve an initial amount of entries *)

    (* Init rootset
    *)
  NEW(rWhite);
  rWhite.next := rWhite;
  rWhite.ecFlags := SHORTSET{Root, Base};
  NEW(rDark);
  rDark.next := rDark;
  rDark.ecFlags := SHORTSET{Root, Base};
  NEW(rBlack);
  rBlack.next := rBlack;
  rBlack.ecFlags := SHORTSET{Root, Base};

  nrRoot := 0;

    (* Init normalset
    *)
  NEW(nBlack);
  nBlack.next := nBlack;
  nBlack.ecFlags := SHORTSET{Base};
  NEW(nDark);
  nDark.next := nDark;
  nDark.ecFlags := SHORTSET{Base};
  NEW(nWhite);
  nWhite.next := nWhite;
  nWhite.ecFlags := SHORTSET{Base};

  nrNormal := 0;
  nGotGrey := FALSE;

  sweeping := FALSE;

  gcRuns := 0;
  gcReqT := 0;
  gcCallsT := 0; gcCalls := 0;
  gcFreeT  := 0; gcExaT  := 0;
  gcFree   := 0; gcExa   := 0;
END CollectorS.

(***************************************************************************)