unit GarbageC;
//*******************************************************
// Class implementing a resizable array-based list with
// garbage collection.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
    Dialogs, SysUtils, Classes;

const
    GARBAGE_VALUE = #0; // A garbage entry.

type
    String10 = String[10];
    TGarbageListArray = array[1..100000000] of String10;
    PGarbageListArray = ^TGarbageListArray;
    TGarbageList = class(TObject)
        private
            List         : PGarbageListArray; // The array we will resize.
            NumItems     : Longint;           // The number of items used.
            NumAllocated : Longint;           // The number of items allocated.
            ShrinkWhen   : Longint;           // Shrink if m_NumItems < this.
            NumGarbage   : Longint;           // # garbage entries.
            MaxGarbage   : Longint;           // Garbage collect when NumGarbage > MaxGarbage.
            procedure ResizeList;
            procedure CollectGarbage;

        public
            destructor Destroy; override;
            procedure Add(value : String10);
            function Count : Longint;
            function AllocatedCount : Longint;
            function Item(index : Longint) : String10;
            procedure Remove(index : Longint);
    end;

implementation

// Free any allocated memory.
destructor TGarbageList.Destroy;
begin
    if (NumAllocated > 0) then FreeMem(List);
    inherited Destroy;
end;

// Add an item to the list.
procedure TGarbageList.Add(value : String10);
begin
    // Make sure there's room for the new item.
    if (NumItems >= NumAllocated) then ResizeList;
    NumItems := NumItems + 1;
    List^[NumItems] := value;
end;

// Return the number of items in the list.
function TGarbageList.Count : Longint;
begin
    Count := NumItems;
end;

// Return the number of items allocated.
function TGarbageList.AllocatedCount : Longint;
begin
    AllocatedCount := NumAllocated;
end;

// Return the value of an item in the list.
function TGarbageList.Item(index : Longint) : String10;
begin
    if ((index < 1) or (index > NumItems)) then
        raise ERangeError.CreateFmt(
            'Index %d out of bounds %d..%d',
            [index, 1, NumItems]);

    Item := List^[index];
end;

// Remove the last item from the list.
procedure TGarbageList.Remove(index : Longint);
begin
    if ((index < 1) or (index > NumItems)) then
        raise ERangeError.CreateFmt(
            'Index %d out of bounds %d..%d',
            [index, 1, NumItems]);

    if (List^[index] = GARBAGE_VALUE) then exit;
    List^[index] := GARBAGE_VALUE;
    NumGarbage := NumGarbage + 1;
    if (NumGarbage > MaxGarbage) then CollectGarbage;
end;

// Resize the list to have WANT_FREE_PERCENT unused
// entries. Set m_ShrinkWhen so we know to resize the
// array when the number of used entries is too small.
// Set this value to resize the array when there is more
// than twice the desired amount of memory free.
//
// Normally WANT_FREE_PERCENT and MIN_FREE would have
// values like .1 and 10. They are set to .5 and 1 to make
// it easy to see how the algorithm works. MIN_FREE must
// be at least 1.
procedure TGarbageList.ResizeList;
const
    WANT_FREE_PERCENT = 0.5; // Try for 50% free space.
    MIN_FREE = 1;            // Min unused space when resizing.
    CR = #13#10;
    CRCR = #13#10#13#10;
var
    want_free, new_size, i : Longint;
    new_array              : PGarbageListArray;
begin
    // See how big the array should be.
    want_free := Round(WANT_FREE_PERCENT * NumItems);
    if (want_free < MIN_FREE) then want_free := MIN_FREE;
    new_size := NumItems + want_free;

    // Resize the array preserving the old values.
    // Create a new array.
    GetMem(new_array, new_size * SizeOf(String10));

    // Copy the existing items into the new array.
    for i := 1 to NumItems do
        new_array^[i] := List^[i];

    // Free the previously allocated memory.
    if (NumAllocated > 0) then FreeMem(List);
    NumAllocated := new_size;

    // Make List point to the new memory.
    List := new_array;

    // Calculate ShrinkWhen. We resize the array if it
    // shrinks until NumItems < ShrinkWhen.
    ShrinkWhen := NumItems - want_free;

    // Collect garbage when there are more than want_free
    // garbage items in the list.
    MaxGarbage := want_free;

    // Comment the following when not testing.
    ShowMessage('Resizing.' + CRCR +
        'Allocated: ' + IntToStr(NumAllocated) + CR +
        'Used: ' + IntToStr(NumItems) + CR +
        'Unused: ' + IntToStr(want_free) + CR +
        'MaxGarbage: ' + IntToStr(MaxGarbage) + CR +
        'ShrinkWhen: ' + IntToStr(ShrinkWhen));
end;

procedure TGarbageList.CollectGarbage;
var
    i, good : Longint;
begin
    // Comment out for real applications.
    ShowMessage('Collecting garbage.');

    good := 1; // The first good item goes here.
    for i := 1 to NumItems do
    begin
        // If not garbage, move it to its new location.
        if (not (List^[i] = GARBAGE_VALUE)) then
        begin
            if (good <> i) then
                List^[good] := List^[i];
            good := good + 1;
        end;
    end;

    // This is where the last good item is.
    NumItems := good - 1;
    NumGarbage := 0;

    // See if we should resize the list.
    if (NumItems < ShrinkWhen) then ResizeList;
end;

end.
