Автор: Vitaly Sergienko
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Быстрые списки.

Цепочка - односвязный список записей (record) фиксированной длины.
Пул цепочек позволяет быстро манипулировать с множеством цепочек.
Общая для всех цепочек конкретного пула память выделяется по мере
необходимости страницами через VirtualAlloc, т.е. без обращения к
менеджеру памяти (GetMem/FreeMem). Соответственно, освобождается
память сразу всего пула. Удобно использовать цепочки в качестве
рабочей памяти, когда нужно раскидать множество элементов по кучкам,
а также при реализации графов ( списки соседей узла ), деревьев
(списки детей узла). Большинство методов и функций написано на basm.

Зависимости: System
Автор:       Alex Konshin, akonshin@earthlink.net, Boston, USA
Copyright:   http://home.earthlink.net/~akonshin/index.htm
Дата:        30 декабря 2002 г.
***************************************************** }

// (c) Alex Konshin mailto:alexk@mtgroup.ru 08 Feb 1999

// 21 jun 2000 - bugfix PutValue
// all "uses" are removed

unit ChainPools;

interface

//uses

type

  PChainLink = ^TChainLink;
  PPChainLink = ^PChainLink;
  TChainLink = packed record
    FNext: PChainLink;
    FValue: LongInt;
  end;

  PPoolBuffer = ^TPoolBuffer;
  PPPoolBuffer = ^PPoolBuffer;
  TPoolBuffer = record
    FNextBuf: PPoolBuffer;
  end;

  TChainLinkCallBack = function(const Value: LongInt; const ALink: PChainLink;
    AParm: Pointer): Boolean;
  TScanChainCallBack = function(ALink: PChainLink; AParm: Pointer): Boolean of
    object;

  TChainPool = class
  protected
    FFirstBuffer: PPoolBuffer;
    FPLastBuffer: PPPoolBuffer;
    FRest: LongWord;
    FTop: PChar;
    FItemSize: Integer;
    function Allocate(const ASize: LongWord): Pointer;
  public
    FFreeChain: PChainLink;
    constructor Create(AItemSize: Integer = SizeOf(TChainLink));
    destructor Destroy; override;
    procedure FreeBuffers;
    // извлекаем из цепочки первый элемент (освобождается)
    function GetValue(var AAnchor: PChainLink): LongInt; virtual;
    // извлекаем из цепочки первый элемент (отсоединяется от цепочки)
    function GetFirstLink(var AAnchor: PChainLink): PChainLink; virtual;
    // извлекаем из цепочки последний элемент (освобождается)
    function GetLastValue(var AAnchor: PChainLink): LongInt; virtual;
    // извлекаем из цепочки последний элемент (отсоединяется от цепочки)
    function GetLastLink(var AAnchor: PChainLink): PChainLink; virtual;
    // вставка в начало без проверки на уникальность
    procedure PutValue(const Value: LongInt; var AAnchor: PChainLink); virtual;
    // вставка в конец с проверкой, False - значение уже существует
    function AddValue(const Value: LongInt; var AAnchor: PChainLink): Boolean;
      virtual;
    // вставка перед звеном, на которое ACallBackFunc выдаст True
    function InsertValue(const Value: LongInt; var AAnchor: PChainLink;
      ACallBackFunc: TChainLinkCallBack; AParm: Pointer = nil): PChainLink;
      virtual;
    // вставка в цепочку в порядке возврастания Value
    function InsertSorted(const Value: LongInt; var AAnchor: PChainLink):
      PChainLink; virtual;
    // удаление указанного значения //
    function RemoveValue(const Value: LongInt; var AAnchor: PChainLink): Boolean;
      virtual;
    // удаление указанного звена
    function RemoveLink(const ALink: PChainLink; var AAnchor: PChainLink):
      Boolean; virtual;
    // создает новый элемент, непривязанный к какой-либо цепочке
    function NewLink: PChainLink; // virtual;
    // освобождение элемента - перенос в список FFreeChain (элемент не должен принадлежать какой-либо цепочке)
    procedure FreeLink(const ALink: PChainLink); virtual;
    // освобождение цепочки
    procedure FreeChain(var AAnchor: PChainLink); virtual;
  end; { TChainPool }

  // вставка элемента в начало цепочки(элемент не должен принадлежать какой-либо цепочке)
procedure LinkTo(const ALink: PChainLink; var AAnchor: PChainLink);
// вставка элемента в конец цепочки(элемент не должен принадлежать какой-либо цепочке)
procedure Append(const ALink: PChainLink; var AAnchor: PChainLink);
function MoveFirstToChain(var AFrom, ATo: PChainLink): PChainLink;
function MoveChainLink(const Value: LongInt; var AAnchor, ATo: PChainLink):
  Boolean;
function AppendChainLink(const Value: LongInt; var AFromChain, AToChain:
  PChainLink): Boolean;
function LastChainLink(const AAnchor: PChainLink): PChainLink;
// проверяем наличие указанного значения в цепочке
function IsValueInChain(const Value: LongInt; AAnchor: PChainLink): Boolean;
// ищем элемент (остается в цепочке)
function FindValue(const Value: LongInt; AAnchor: PChainLink): PChainLink;
function FindAndUnlink(var AAnchor: PChainLink; ACallBackFunc:
  TScanChainCallBack; AParm: Pointer = nil): PChainLink;
function IndexOfValue(const Value: LongInt; AAnchor: PChainLink): LongInt;
// ищем ChainLink, на который AScanChainFunc выдаст True
function ScanChain(const AAnchor: PChainLink; AScanChainFunc:
  TScanChainCallBack; AParm: Pointer): PChainLink;
function ChainLinkByIndex(AAnchor: PChainLink; AIndex: Integer): PChainLink;
function ChainLinkCount(AAnchor: PChainLink): Integer;
// сравнение цепочек, результат =0, <0, >0, abs(result) = индекс несовпавшего элемента
function CompareChains(AFromChain, AToChain: PChainLink): LongInt;

//=============================================================
implementation

const
  MEM_COMMIT = $1000;
  MEM_DECOMMIT = $4000;
  MEM_RELEASE = $8000;
  PAGE_READWRITE = 4;

  kernel = 'kernel32.dll';

type
  DWORD = LongInt;
  BOOL = LongBool;

function VirtualAlloc(lpAddress: Pointer; dwSize, flAllocationType, flProtect:
  DWORD): Pointer; stdcall; external kernel name 'VirtualAlloc';

function VirtualFree(lpAddress: Pointer; dwSize, dwFreeType: DWORD): BOOL;
  stdcall; external kernel name 'VirtualFree';

//-------------------------------------------------------------
// вставка элемента (элемент не должен принадлежать какой-либо цепочке)

procedure LinkTo(const ALink: PChainLink; var AAnchor: PChainLink);
begin
  ALink^.FNext := AAnchor;
  AAnchor := ALink;
end;
//-------------------------------------------------------------
// вставка элемента в конец (элемент не должен принадлежать какой-либо цепочке)

procedure Append(const ALink: PChainLink; var AAnchor: PChainLink); assembler;
asm
@@FindLast:
  mov ecx,edx
  mov edx,[edx]
  test edx,edx
  jnz @@FindLast
  mov [eax],edx
  mov [ecx],eax
end;
//-------------------------------------------------------------
// перенос первого элемента в другую цепочку

function MoveFirstToChain(var AFrom, ATo: PChainLink): PChainLink; assembler;
asm
  mov ecx,[eax]
  test ecx,ecx
  jz @@Exit
  push edx
  mov edx,[ecx]
  mov [eax],edx
  pop edx
  mov eax,[edx]
  mov [ecx],eax
  mov [edx],ecx
@@Exit:
  mov eax,ecx
end;
//-------------------------------------------------------------

function MoveChainLink(const Value: LongInt; var AAnchor, ATo: PChainLink):
  Boolean; assembler;
asm
  push edi
  mov edi,eax
  jmp @@Start
@@Next:
  mov edx,eax
@@Start:
  mov eax,[edx]
  test eax,eax
  jz @@Done
  cmp edi,[eax].TChainLink.FValue
  jne @@Next
  mov edi,[eax]
  mov [edx],edi
  mov edi,[ecx]
  mov [eax],edi
  mov [ecx],eax
  mov eax,1
@@Done:
  pop edi
@@Exit:
end;
//-------------------------------------------------------------

function AppendChainLink(const Value: LongInt; var AFromChain, AToChain:
  PChainLink): Boolean; assembler;
asm
  push edi
  mov edi,eax
  jmp @@Start
@@Next:
  mov edx,eax
@@Start:
  mov eax,[edx]
  test eax,eax
  jz @@Done
  cmp edi,[eax].TChainLink.FValue
  jne @@Next
  mov edi,[eax]
  mov [edx],edi

@@FindLast:
  mov edx,ecx
  mov ecx,[ecx]
  test ecx,ecx
  jnz @@FindLast

  mov edi,[edx]
  mov [eax],edi
  mov [edx],eax
  mov eax,1
@@Done:
  pop edi
@@Exit:
end;
//-------------------------------------------------------------

function LastChainLink(const AAnchor: PChainLink): PChainLink; assembler;
asm
  mov edx,eax
  jmp @@Start
@@Next:
  mov eax,edx
  mov edx,[edx]
@@Start:
  test edx,edx
  jnz @@Next
@@Exit:
end;
//-------------------------------------------------------------

function ScanChain(const AAnchor: PChainLink; AScanChainFunc:
  TScanChainCallBack; AParm: Pointer): PChainLink;
var
  pNext: PChainLink;
begin
  pNext := AAnchor;
  while pNext <> nil do
  begin
    Result := pNext;
    pNext := pNext^.FNext;
    if AScanChainFunc(Result, AParm) then
      Exit;
  end;
  Result := nil;
end;
//-------------------------------------------------------------
// сравнение цепочек, результат =0, <0, >0, abs(result) = индекс несовпавшего элемента

function CompareChains(AFromChain, AToChain: PChainLink): LongInt; assembler;
asm
    mov ecx,1
    push esi
    mov esi,eax
@@loop:
    inc ecx
    test esi,esi
    jz @@1
    test edx,edx
    jz @@gt
    mov eax,[esi]
    sub eax,[edx]
    jz @@loop
    jc @@lt
    jmp @@gt

@@1:
    test edx,edx
    jz @@exit
@@lt:
    neg ecx
@@gt:
    mov eax,ecx
@@exit:
    pop esi
end;
//-------------------------------------------------------------

function IsValueInChain(const Value: LongInt; AAnchor: PChainLink): Boolean;
  assembler; // проверяем наличие указанного значения в цепочке
{
  while AAnchor<>nil do
  begin
    if AAnchor^.FValue=Value then
    begin
      Result := True;
      Exit;
    end;
    AAnchor := AAnchor^.FNext;
  end;
  Result := False;
}
asm
  test edx,edx
  jz @False
@loop:
  cmp eax,TChainLink[edx].FValue
  je @True
  mov edx,[edx]
  test edx,edx
  jnz @loop
@False:
  mov eax,0
  jmp @Exit
@True:
  mov eax,1
@Exit:
end;
//-------------------------------------------------------------

function FindValue(const Value: LongInt; AAnchor: PChainLink): PChainLink;
  assembler;
{ Result := AAnchor;
  while (Result<>nil)and(Result^.FValue<>Value) do Result := Result^.FNext;
}
asm
  xchg eax,edx
  test eax,eax
  jz @Exit
@loop:
  cmp edx,TChainLink[eax].FValue
  je @Exit
  mov eax,[eax]
  test eax,eax
  jnz @loop
@Exit:
end;
//-------------------------------------------------------------

function IndexOfValue(const Value: LongInt; AAnchor: PChainLink): LongInt;
asm
  test edx,edx
  jz @NotFound
  mov ecx,eax
  xor eax,eax
@loop:
  cmp ecx,TChainLink[edx].FValue
  je @Exit
  inc eax
  mov edx,[edx]
  test edx,edx
  jnz @loop
@NotFound:
  mov eax,-1
@Exit:
end;
//-------------------------------------------------------------
// Извлечение первого звена, для которого ACallBackFunc выдаст True
// Внимание! Найденный элемент отсоединяется от цепочки. Для присоединения к другой цепочке используйте LinkTo, для освобождения памяти - TChainPool.FreeLink

function FindAndUnlink(var AAnchor: PChainLink; ACallBackFunc:
  TScanChainCallBack; AParm: Pointer = nil): PChainLink; assembler;
var
  pParm: Pointer;
asm
  push edi
  push esi
  mov esi,eax // esi <= AAnchor
  mov eax,AParm
  mov pParm,eax
  mov edi,edx // edi <= ACallBackFunc
@NextLink:
  mov eax,[esi]
  mov edx,pParm
  call edi
  test eax,eax
  jnz @Unlink
  mov esi,[esi]
  test esi,esi
  jnz @NextLink
  xor eax,eax // для всех получили отказ
  jmp @Exit

@Unlink:
  mov eax,[esi]
  mov edx,[eax]
  mov [esi],edx
  mov dword ptr [eax],0
@Exit:
  pop esi
  pop edi
end;
//-------------------------------------------------------------

function ChainLinkByIndex(AAnchor: PChainLink; AIndex: Integer): PChainLink;
  assembler;
asm
  test eax,eax
  jz @Exit
  test edx,edx
  jz @Exit
@Next:
  mov eax,[eax]
  test eax,eax
  jz @Exit
  dec edx
  jnz @Next
@Exit:
end;
//-------------------------------------------------------------

function ChainLinkCount(AAnchor: PChainLink): Integer;
asm
  test eax,eax
  jz @Exit
  xor edx,edx
@Next:
  mov eax,[eax]
  inc edx
  test eax,eax
  jnz @Next
  mov eax,edx
@Exit:
end;

//==TChainPool===========================================================

constructor TChainPool.Create(AItemSize: Integer = SizeOf(TChainLink));
begin
  inherited Create;
  FPLastBuffer := @FFirstBuffer;
  FItemSize := AItemSize;
end;
//-------------------------------------------------------------

destructor TChainPool.Destroy;
begin
  FreeBuffers;
  inherited Destroy;
end;
//-------------------------------------------------------------

procedure TChainPool.FreeBuffers;
var
  pBuf: PPoolBuffer;
begin
  while FFirstBuffer <> nil do
  begin
    pBuf := FFirstBuffer;
    FFirstBuffer := FFirstBuffer^.FNextBuf;
    VirtualFree(pBuf, 0, MEM_RELEASE);
  end;
  FPLastBuffer := @FFirstBuffer;
  FFreeChain := nil;
  FRest := 0;
  FTop := nil;
end;
//-------------------------------------------------------------

function TChainPool.Allocate(const ASize: LongWord): Pointer;
var
  nSize: LongInt;
  pBuf: PPoolBuffer;
begin
  if FRest < ASize then
  begin
    nSize := (4095 + ASize + SizeOf(TPoolBuffer)) and (-4096);
    pBuf := PPoolBuffer(VirtualAlloc(nil, nSize, MEM_COMMIT, PAGE_READWRITE));
    if pBuf = nil then
      GetMem(pBuf, not 0);
        // raise Exception.Create('ChainPools: Out of memory'); - SysUtils required
    FPLastBuffer^ := pBuf;
    FPLastBuffer := @(pBuf^.FNextBuf);
    FTop := PChar(pBuf) + SizeOf(TPoolBuffer);
    FRest := nSize - SizeOf(TPoolBuffer);
  end;
  Dec(FRest, ASize);
  Result := FTop;
  Inc(FTop, ASize);
end;
//-------------------------------------------------------------

function TChainPool.AddValue(const Value: LongInt; var AAnchor: PChainLink):
  Boolean; assembler;
asm
  push edi
  push esi
  xor esi,esi
  mov edi,eax
  mov eax,[ecx]
  test eax,eax
  jz @@New
@@Compare:
  cmp edx,[eax].TChainLink.FValue
  je @@Done
  mov ecx,eax
  mov eax,[ecx]
  test eax,eax
  jnz @@Compare
@@New:
  inc esi
  push edx
  mov eax,edi
  mov edi,ecx
  call TChainPool.NewLink
  mov ecx,edi
@@Link:
  pop edx
  mov [eax].TChainLink.FValue,edx
  mov dword ptr [eax],0
  mov [ecx],eax
@@Done:
  mov eax,esi
  pop esi
  pop edi
end; {TChainPool.AddValue}
//-------------------------------------------------------------

procedure TChainPool.PutValue(const Value: LongInt; var AAnchor: PChainLink);
  assembler;
asm
  push edi
  mov edi,eax
  push edx
  push ecx
  call TChainPool.NewLink
  pop ecx
  pop edx
  mov TChainLink[eax].FValue,edx
  mov edx,[ecx]
  mov [eax],edx
  mov [ecx],eax
@@Done:
  pop edi
end; {TChainPool.PutValue}
//-------------------------------------------------------------
// Вставка перед звеном, на которое ACallBackFunc выдаст True
// Будет предложено также вставить в конец - будет вызов ACallBackFunc с ALink=nil
// TChainLinkCallBack = function ( const Value : LongInt; const ALink : PChainLink; AParm : Pointer ) : Boolean;

function TChainPool.InsertValue(const Value: LongInt; var AAnchor: PChainLink;
  ACallBackFunc: TChainLinkCallBack; AParm: Pointer = nil): PChainLink; assembler;
var
  pSelf: LongInt;
asm
  push edi
  push esi
  mov pSelf,eax
  mov edi,edx // edi <= Value
  mov esi,ecx // esi <= AAnchor
@NextLink:
  mov eax,edi // AValue
  mov edx,[esi]
  mov ecx,AParm
  call [ACallBackFunc]
  test eax,eax
  jnz @Insert
  mov esi,[esi]
  test esi,esi
  jnz @NextLink
  xor eax,eax // для всех получили отказ
  jmp @Exit

@Insert:
  mov eax,pSelf
  call TChainPool.NewLink
  mov TChainLink[eax].FValue,edi
  mov edx,[esi]
  mov [eax],edx
  mov [esi],eax
@Exit:
  pop esi
  pop edi
end; {TChainPool.InsertValue}
//-------------------------------------------------------------
// CallBack для InsertSorted

function ChainLinkAscending(const Value: LongInt; const ALink: PChainLink;
  AParm: Pointer): Boolean;
begin
  Result := (Value < ALink.FValue);
end;
// вставка в цепочку в порядке возврастания Value

function TChainPool.InsertSorted(const Value: LongInt; var AAnchor: PChainLink):
  PChainLink;
begin
  Result := InsertValue(Value, AAnchor, ChainLinkAscending);
end;
//-------------------------------------------------------------
// освобождение элемента - перенос в список FFreeChain (элемент не должен принадлежать какой-либо цепочке)

procedure TChainPool.FreeLink(const ALink: PChainLink);
begin
  ALink^.FNext := FFreeChain;
  FFreeChain := ALink;
end;
//-------------------------------------------------------------
// создает новый элемент, непривязанный к какой-либо цепочке

function TChainPool.NewLink: PChainLink;
asm
  mov ecx,TChainPool[eax].FFreeChain
  test ecx,ecx
  jz @Allocate
  mov edx,[ecx]
  mov TChainPool[eax].FFreeChain,edx
  push ecx
  mov edx,TChainPool[eax].FItemSize
  mov eax,ecx
  mov ecx,0
  call System.@FillChar
  pop eax
  jmp @Exit
@Allocate:
  mov edx,TChainPool[eax].FItemSize
  call TChainPool.Allocate
@Exit:
end;
//-------------------------------------------------------------

function TChainPool.GetValue(var AAnchor: PChainLink): LongInt; assembler;
asm
  mov ecx,[edx]
  test ecx,ecx
  jnz @@1
  xor eax,eax
  jmp @@Exit

@@1:
  push edi
  mov edi,[ecx]
  mov [edx],edi
  mov edi,[eax].TChainPool.FFreeChain
  mov [ecx],edi
  mov [eax].TChainPool.FFreeChain,ecx
  pop edi
  mov eax,[ecx].TChainLink.FValue
@@Exit:
end;
//-------------------------------------------------------------

function TChainPool.GetFirstLink(var AAnchor: PChainLink): PChainLink;
  assembler;
asm
  mov eax,[edx]
  test eax,eax
  jz @Empty
  mov ecx,[eax]
  mov [edx],ecx
  mov dword ptr[eax],0
@Empty:
end;
//-------------------------------------------------------------

function TChainPool.RemoveValue(const Value: LongInt; var AAnchor: PChainLink):
  Boolean; assembler;
asm
  test eax,eax
  jz @@Exit
  push edi
  mov edi,eax
  jmp @@Start
@@Next:
  mov ecx,eax
@@Start:
  mov eax,[ecx]
  test eax,eax
  jz @@Done
  cmp edx,TChainLink[eax].FValue
  jne @@Next
  mov edx,[eax] // FNext
  mov [ecx],edx
  mov edx,TChainPool[edi].FFreeChain
  mov [eax],edx
  mov TChainPool[edi].FFreeChain,eax
  mov eax,1
@@Done:
  pop edi
@@Exit:
end;
//-------------------------------------------------------------

function TChainPool.RemoveLink(const ALink: PChainLink; var AAnchor:
  PChainLink): Boolean; assembler;
asm
  test eax,eax
  jz @@Exit
  push edi
  mov edi,eax
  test edx,edx
  jz @@False
  test ecx,ecx
  jnz @@Start
@@False:
  xor eax,eax
  jmp @@Done

@@Next:
  mov ecx,eax
@@Start:
  mov eax,[ecx]
  test eax,eax
  jz @@Done
  cmp edx,eax
  jne @@Next
  mov eax,[edx]
  mov [ecx],eax
  mov eax,[edi].TChainPool.FFreeChain
  mov [edx],eax
  mov [edi].TChainPool.FFreeChain,edx
  mov eax,1
@@Done:
  pop edi
@@Exit:
end;
//-------------------------------------------------------------

function TChainPool.GetLastValue(var AAnchor: PChainLink): LongInt; assembler;
asm
  mov ecx,[edx]
  test ecx,ecx
  jnz @@Start
  xor eax,eax
  jmp @@Exit

@@Next:
  mov edx,ecx
  mov ecx,[edx]
@@Start:
  cmp dword ptr [ecx],0
  jnz @@Next
  mov dword ptr [edx],0
  mov edx,[eax].TChainPool.FFreeChain
  mov [ecx],edx
  mov [eax].TChainPool.FFreeChain,ecx
  mov eax,[ecx].TChainLink.FValue
@@Exit:
end;
//-------------------------------------------------------------

function TChainPool.GetLastLink(var AAnchor: PChainLink): PChainLink; assembler;
asm
  mov eax,[edx]
  test eax,eax
  jz @Empty
  mov ecx,[eax]
  test ecx,ecx
  jz @Finish
@@Next:
  mov edx,eax
  mov eax,ecx
  mov ecx,[eax]
  test ecx,ecx
  jnz @@Next
@Finish:
  mov dword ptr [edx],0
@Empty:
end;
//-------------------------------------------------------------

procedure TChainPool.FreeChain(var AAnchor: PChainLink); assembler;
asm
  test eax,eax
  jz @@Exit
  test edx,edx
  jz @@Exit
  add eax,offset(TChainPool.FFreeChain)
  mov ecx,[edx]
  xchg ecx,[eax]
  mov eax,[edx]
  mov dword ptr[edx],0
  test eax,eax
  jz @@Done
@@Next:
  mov edx,eax
  mov eax,[edx]
  test eax,eax
  jnz @@Next
@@Done:
  mov [edx],ecx
@@Exit:
end;

end.

Пример использования:

program Test;

{$APPTYPE CONSOLE}
uses
  ChainPools;

type
  PItem = ^TItem;
  TItem = packed record
    FNext: PItem;
    FValue: LongInt;
    FValue2: LongInt;
  end;

  // It is just a holder of method.
  // In real life use forms or other objects.
  TSomeClass = class
    function FindValue2(ALink: PChainLink; AParm: Pointer): Boolean;
  end;

function TSomeClass.FindValue2(ALink: PChainLink; AParm: Pointer): Boolean;
begin
  Result := PLongInt(AParm)^ = PItem(ALink)^.FValue2;
end;

var
  oChainPool: TChainPool;
  pFirst1: PItem; // pointer to the first item in chain 1
  pFirst2: PItem; // pointer to the first item in chain 2
  ptr: PItem;
  nValue: LongInt;
  i: Integer;
  oSomeObject: TSomeClass;
begin

  oSomeObject := TSomeClass.Create;

  pFirst1 := nil;
  pFirst2 := nil;
  oChainPool := TChainPool.Create(SizeOf(TItem));

  // Put some values in chain 1
  for i := 0 to 99 do
    oChainPool.AddValue(i, PChainLink(pFirst1));

  // Put some values in chain 2
  for i := 0 to 99 do
  begin
    ptr := PItem(oChainPool.NewLink);
    with ptr^ do
    begin
      // put here the code that fills in new item's fields.
      FValue := i;
      FValue2 := 100 - i;
    end;
    ChainPools.LinkTo(PChainLink(ptr), PChainLink(pFirst2));
  end;

  // Example for scanning chain.
  nValue := 30;
  ptr := PItem(ChainPools.ScanChain(PChainLink(pFirst2), oSomeObject.FindValue2,
    @nValue));
  if ptr = nil then
    WriteLn('Item is not found')
  else
    WriteLn('FValue = ', ptr^.FValue);

  // Scan chain
  ptr := pFirst2;
  while ptr <> nil do
  begin
    if ptr^.FValue2 = 30 then
    begin
      WriteLn('FValue = ', ptr^.FValue);
      Break;
    end;
    ptr := ptr^.FNext;
  end;

  // Destroy pool
  oChainPool.Free;

end.