{********************************************************

 SlavaNap source code.

 Copyright 2001,2002 by SlavaNap development team
 Released under GNU General Public License

 Latest version is available at
 http://www.slavanap.org

**********************************************************

 Unit: memory_manager

 This unit contains lists of allocated items. The idea
 of this unit is to reduce number of AllocMem/FreeMem
 calls by reusing same object. Instead of freing object
 i'm putting it to list of available objects and next
 time object of that type needs to be allocated instead
 of allocating it i use old object.

*********************************************************}
unit memory_manager;

interface

uses
 Windows, Classes2, SysUtils, constants, md5, blcksock, winsock, Graphics,
 slavastrings, class_cmdlist, class_cmdexlist, stypes, class_doublecmdlist;

{$I defines.pas}

procedure ExpireLists;
function  CreateTBitmap: TBitmap;
procedure FreeTBitmap(bmp: TBitmap);
function  CreateTIcon: TIcon;
procedure FreeTIcon(icon: TIcon);
function  CreateList: TMyList;
procedure FreeList(list: TMyList);
function  CreateStringList: TMyStringList;
procedure FreeStringList(list: TMyStringList);
function  CreateDoubleCmdList: TNapDoubleCmdList;
procedure FreeDoubleCmdList(list: TNapDoubleCmdList);

var
 // for debug:
 count_napdoublecmdlist,
 count_napdoublecmdlist_max: Integer;
 count_napdoublecmdlist_items,
 count_napdoublecmdlist_items_max: Integer;

implementation

uses vars, share;

{$IFNDEF DISABLE_MEMORY_MANAGER}
var
 total_strings: Integer;
 total_lists: Integer;
 list_lists: TMyList;
 list_strings: TMyList;
 list_doublecmdlist: TMyList;
{$ENDIF}

function  CreateTBitmap: TBitmap;
begin
 Result:=TBitmap.Create;
end;

procedure FreeTBitmap(bmp: TBitmap);
begin
 bmp.Free;
end;

function  CreateTIcon: TIcon;
begin
 Result:=TIcon.Create;
end;

procedure FreeTIcon(icon: TIcon);
begin
 icon.Free;
end;

function  CreateList: TMyList;
begin
{$IFNDEF DISABLE_MEMORY_MANAGER}
 if list_lists.count>0 then
 begin
  Result:=list_lists.Items[list_lists.count-1];
  list_lists.Delete(list_lists.count-1);
 end
 else
 begin
{$ENDIF}
  Result:=TMyList.Create;
{$IFNDEF DISABLE_MEMORY_MANAGER}
  inc(total_lists);
 end;
{$ENDIF}
end;

procedure FreeList(list: TMyList);
begin
{$IFNDEF DISABLE_MEMORY_MANAGER}
 if not running then
 begin
{$ENDIF}
   list.Free;
{$IFNDEF DISABLE_MEMORY_MANAGER}
   dec(total_lists);
   exit;
 end;
 list.Clear;
 list_lists.Add(list);
{$ENDIF}
end;

function  CreateStringList: TMyStringList;
begin
{$IFNDEF DISABLE_MEMORY_MANAGER}
 if list_strings.count>0 then
 begin
  Result:=list_strings.Items[list_strings.count-1];
  list_strings.Delete(list_strings.count-1);
 end
 else
 begin
{$ENDIF}
  Result:=TMyStringList.Create;
{$IFNDEF DISABLE_MEMORY_MANAGER}
  inc(total_strings);
 end;
{$ENDIF}
end;

procedure FreeStringList(list: TMyStringList);
begin
{$IFNDEF DISABLE_MEMORY_MANAGER}
 if not running then
 begin
{$ENDIF}
   list.Free;
{$IFNDEF DISABLE_MEMORY_MANAGER}
   dec(total_strings);
   exit;
 end;
 list.Clear;
 list.Duplicates:=dupAccept;
 list.Sorted:=false;
 list_strings.Add(list);
{$ENDIF}
end;

function  CreateDoubleCmdList: TNapDoubleCmdList;
begin
{$IFNDEF DISABLE_MEMORY_MANAGER}
 if list_doublecmdlist.count>0 then
 begin
  Result:=list_doublecmdlist.Items[list_doublecmdlist.count-1];
  list_doublecmdlist.Delete(list_doublecmdlist.count-1);
 end
 else
{$ENDIF}
  Result:=TNapDoubleCmdList.Create;
end;

procedure FreeDoubleCmdList(list: TNapDoubleCmdList);
begin
{$IFNDEF DISABLE_MEMORY_MANAGER}
 if not running then
 begin
{$ENDIF}
   list.Free;
{$IFNDEF DISABLE_MEMORY_MANAGER}
   exit;
 end;
 list.Clear;
 list_doublecmdlist.Add(list);
{$ENDIF}
end;

procedure ExpireLists;
{$IFNDEF DISABLE_MEMORY_MANAGER}
var
 bmp: TBitmap;
 icon: TIcon;
 lst: TMyList;
 str: TMyStringList;
{$ENDIF}
begin
 exit;
{$IFNDEF DISABLE_MEMORY_MANAGER}
 ExpireShareLists;
 ExpireCmdExLists;
 ExpireDoubleCmdLists;
 ExpireCmdLists;
 if list_lists.count>200 then
 while (list_lists.count * 2) > total_lists do
 try
   lst:=list_lists.Items[list_lists.count-1];
   list_lists.Delete(list_lists.count-1);
   lst.Free;
   dec(total_lists);
  except
   exit;
 end;
 if list_strings.count>1000 then
 while (list_strings.count * 2) > total_strings do
 try
   str:=list_strings.items[list_strings.count-1];
   list_strings.delete(list_strings.count-1);
   str.Free;
   dec(total_strings);
   except
   exit;
 end;
 if list_doublecmdlist.count>500 then
 while (list_doublecmdlist.count * 2) > count_napdoublecmdlist do
 try
  TNapDoubleCmdList(list_doublecmdlist.items[list_doublecmdlist.count-1]).Free;
  list_doublecmdlist.Delete(list_doublecmdlist.count-1);
  except
   exit;
 end;
{$ENDIF}
end;

procedure ClearAllLists;
{$IFNDEF DISABLE_MEMORY_MANAGER}
var
 i: Integer;
{$ENDIF}
begin
{$IFNDEF DISABLE_MEMORY_MANAGER}
 ExpireCmdLists;
 for i:=0 to list_lists.count-1 do
 try
  TMyList(list_lists.items[i]).Free;
  except
   exit;
 end;
 total_lists:=0;
 list_lists.Clear;
 for i:=0 to list_strings.count-1 do
 try
  TMyStringList(list_strings.items[i]).Free;
  except
   exit;
 end;
 total_strings:=0;
 list_strings.Clear;
 for i:=0 to list_doublecmdlist.count-1 do
 try
  TNapDoubleCmdList(list_doublecmdlist.items[i]).Free;
  except
   exit;
 end;
{$ENDIF}
end;

initialization
begin
 count_napdoublecmdlist:=0;
 count_napdoublecmdlist_max:=0;
 count_napdoublecmdlist_items:=0;
 count_napdoublecmdlist_items_max:=0;
{$IFNDEF DISABLE_MEMORY_MANAGER}
 total_lists:=0;
 total_strings:=0;
 list_lists:=TMyList.Create;
 list_strings:=TMyList.Create;
 list_doublecmdlist:=TMyList.Create;
{$ENDIF}
end;

finalization
begin
 ClearAllLists;
{$IFNDEF DISABLE_MEMORY_MANAGER}
 list_lists.Free;
 list_strings.Free;
 list_doublecmdlist.Free;
{$ENDIF}
end;

end.
