mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-19 21:58:23 +02:00
104 lines
2.4 KiB
ObjectPascal
104 lines
2.4 KiB
ObjectPascal
{
|
|
$Id: header,v 1.1 2000/07/13 06:33:45 michael Exp $
|
|
This file is part of the Free Component Library (FCL)
|
|
Copyright (c) 1999-2000 by the Free Pascal development team
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
program Poolmm1;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
uses
|
|
Classes, SysUtils, pooledmm;
|
|
|
|
type
|
|
PMyRecord = ^TMyRecord;
|
|
TMyRecord = record
|
|
Next: PMyRecord;
|
|
Value1, Value2, Value3: integer;
|
|
end;
|
|
|
|
type
|
|
TMyRecordMemManager = class(TPooledMemManager)
|
|
protected
|
|
procedure FreeFirstItem; override;
|
|
public
|
|
procedure DisposeMyRecord(aMyRecord: PMyRecord);
|
|
function NewMyRecord: PMyRecord;
|
|
end;
|
|
|
|
procedure TMyRecordMemManager.FreeFirstItem;
|
|
var AMyRecord: PMyRecord;
|
|
begin
|
|
AMyRecord:=PMyRecord(FFirstFree);
|
|
PMyRecord(FFirstFree):=AMyRecord^.Next;
|
|
Dispose(AMyRecord);
|
|
{$push}{$R-}
|
|
inc(FFreedCount);
|
|
{$pop}
|
|
end;
|
|
|
|
procedure TMyRecordMemManager.DisposeMyRecord(AMyRecord: PMyRecord);
|
|
begin
|
|
if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
|
|
begin
|
|
// add AMyRecord to Free list
|
|
AMyRecord^.Next:=PMyRecord(FFirstFree);
|
|
PMyRecord(FFirstFree):=AMyRecord;
|
|
inc(FFreeCount);
|
|
end else begin
|
|
// free list full -> free the item
|
|
Dispose(AMyRecord);
|
|
{$push}{$R-}
|
|
inc(FFreedCount);
|
|
{$pop}
|
|
end;
|
|
dec(FCount);
|
|
end;
|
|
|
|
function TMyRecordMemManager.NewMyRecord: PMyRecord;
|
|
begin
|
|
if FFirstFree<>nil then begin
|
|
// take from free list
|
|
Result:=PMyRecord(FFirstFree);
|
|
PMyRecord(FFirstFree):=Result^.Next;
|
|
dec(FFreeCount);
|
|
end else begin
|
|
// free list empty -> create new item
|
|
New(Result);
|
|
{$push}{$R-}
|
|
inc(FAllocatedCount);
|
|
{$pop}
|
|
end;
|
|
FillChar(Result^, SizeOf(TMyRecord), 0);
|
|
inc(FCount);
|
|
end;
|
|
|
|
const
|
|
MyRecordMemManager: TMyRecordMemManager = nil;
|
|
|
|
var
|
|
MyRecord: PMyRecord;
|
|
begin
|
|
// init the manager for PMyRecord
|
|
MyRecordMemManager:=TMyRecordMemManager.Create;
|
|
MyRecordMemManager.MinimumFreeCount:=1000;
|
|
|
|
// allocate one record
|
|
MyRecord:=MyRecordMemManager.NewMyRecord;
|
|
|
|
// free the record
|
|
MyRecordMemManager.DisposeMyRecord(MyRecord);
|
|
|
|
// free the manager
|
|
MyRecordMemManager.Free;
|
|
end.
|
|
|