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

 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.
