memmanager.pas

Delphi快速开发Web Server

      end;
    end;
	begin
  if FHead.Fragments>0 then
    begin
    if MinSize>MaxSize then MinSize:=MaxSize;
    Size_X:=MinSize+DS_DSize;

    Siz:=FFree.isearch_ge(Size_X,Loc);
    if Siz>=Size_X then
      begin
      Block:=Loc;
      FE_BlockSize:=Siz;

      Dec(FHead.UnusedSize,FE_BlockSize);
      DelFreeBlock(Block);

      if FE_BlockSize>=MaxSize+DS_DSize+Min_MemFreeBlockSize then
        begin
        Size:=MaxSize;
        Size_X:=Size+DS_DSize;
        SetBlockIsFree(Block+Size_X,FE_BlockSize-Size_X);
        end
      else
        begin
        Size_X:=FE_BlockSize;
        Size:=Size_X-DS_DSize;
        if Size>MaxSize then Size:=MaxSize;
        end;
      myBlock.BlockSize:=Size;
      myBlock.Unused:=Size_X-Size-DS_DSize;
      SetBlockIsUsed(Block,myBlock);
      Result:=Block+DS_DSize;
      end
    else
      Result:=GetTheBlock;
    end
  else
    Result:=GetTheBlock;
	end;

(* GLOBAL METHODS *)

function tHeap_Manager.GetTotalSize:cardinal;
  begin
  Result:=FHead.TotalSize;
  end;

function tHeap_Manager.GetUnusedSize:cardinal;
  begin
  Result:=FHead.UnusedSize;
  end;

function tHeap_Manager.GetBufferSize:cardinal;
  begin
  Result:=FSS_Size-FHead.TotalSize;
  end;

function tHeap_Manager.GetTotalFree:cardinal;
  begin
  Result:=GetBufferSize+GetUnusedSize;
  end;

function tHeap_Manager.GetFragmentCount:cardinal;
  begin
  Result:=FHead.Fragments;
  end;

function tHeap_Manager.GetBlock(Size:cardinal):pointer;
  var
    Block:cardinal;
	begin
	Block:=GetFirstFreeBlock(Size,Size,Size);
  if Block>0 then Result:=Addr(FSS^[Block]) else Result:=nil;
	end;

function tHeap_Manager.FreeBlock(Loc:pointer):cardinal;
	var
		FD:tHeapDataBlockHeader;
    Block:cardinal;
	begin
  if (cardinal(Loc)<FSS2) or
     (cardinal(Loc)>=FSS2+FSS_Size) then
    begin
    Result:=0;
    Exit;
    end;

  Block:=cardinal(Loc)-cardinal(FSS)+1;

	Dec(Block,DS_DSize);
	CheckDataBlock(Block,FD);
 	SetBlockIsFree(Block,FD.BlockSize+DS_DSize+FD.Unused);

  Result:=FD.BlockSize;
	end;

function tHeap_Manager.isBlock(Loc:pointer):boolean;
  begin
  Result:=(cardinal(Loc)>=FSS2) and
          (cardinal(Loc)<FSS2+FSS_Size);
  end;

function tHeap_Manager.BlockSize(Loc:pointer):cardinal;
  var
    FD:tHeapDataBlockHeader;
    Block:cardinal;
	begin
  Block:=cardinal(Loc)-cardinal(FSS2)+1;
 	CheckDataBlock(Block-DS_DSize,FD);
  Result:=FD.BlockSize;
	end;

{ tMem_Manager }

function roundto(a,b:cardinal):cardinal;
  begin
  Result:=(a+(b-1)) div b  * b;
  end;

constructor tMem_Manager.Create(UseSysGetMem:boolean);
  begin
  inherited Create;
  Total_Alloc:=0;
  Total_AddrSpace:=0;
  HeapInfo:=StdHeap_Info;
  NumHeaps:=0;
  end;

destructor tMem_Manager.Destroy;
  begin
  Clear;
  inherited;
  end;

function tMem_Manager.Clear:boolean;
  begin
  while NumHeaps>0 do
    begin
    MM[NumHeaps].Free;
    Dec(NumHeaps);
    end;
  Result:=True;
  end;

function tMem_Manager.GetBufferSize(Heap: byte): cardinal;
  var
    a:cardinal;
  begin
  if Heap=0 then
    begin
    Result:=0;
    for a:=1 to NumHeaps do
      Result:=Result+MM[a].GetBufferSize;
    end
  else if Heap<=NumHeaps then
    Result:=MM[Heap].GetBufferSize
  else
    Result:=0;
  end;

function tMem_Manager.GetTotalFree(Heap: byte): cardinal;
  var
    a:cardinal;
  begin
  if Heap=0 then
    begin
    Result:=0;
    for a:=1 to NumHeaps do
      Result:=Result+MM[a].GetTotalFree;
    end
  else if Heap<=NumHeaps then
    Result:=MM[Heap].GetTotalFree
  else
    Result:=0;
  end;

function tMem_Manager.GetFragmentCount(Heap: byte): cardinal;
  var
    a:cardinal;
  begin
  if Heap=0 then
    begin
    Result:=0;
    for a:=1 to NumHeaps do
      Result:=Result+MM[a].GetFragmentCount;
    end
  else if Heap<=NumHeaps then
    Result:=MM[Heap].GetFragmentCount
  else
    Result:=0;
  end;

function tMem_Manager.GetTotalSize(Heap: byte): cardinal;
  var
    a:cardinal;
  begin
  if Heap=0 then
    begin
    Result:=0;
    for a:=1 to NumHeaps do
      Result:=Result+MM[a].GetTotalSize;
    end
  else if Heap<=NumHeaps then
    Result:=MM[Heap].GetTotalSize
  else
    Result:=0;
  end;

function tMem_Manager.GetUnusedSize(Heap: byte): cardinal;
  var
    a:cardinal;
  begin
  if Heap=0 then
    begin
    Result:=0;
    for a:=1 to NumHeaps do
      Result:=Result+MM[a].GetUnusedSize;
    end
  else if Heap<=NumHeaps then
    Result:=MM[Heap].GetUnusedSize
  else
    Result:=0;
  end;

function tMem_Manager.Free_Mem(p: pointer): boolean;
  var
    a,b:cardinal;
    TMM:tHeap_Manager;
  begin
  if p=nil then
    Result:=True
  else
    begin
    Result:=False;
    for a:=NumHeaps downto 1 do
      begin
      if MM[a].isBlock(p) then
        begin
        Total_Alloc := Total_Alloc - MM[a].FreeBlock(p);
        if NumHeaps>1 then // using NumHeaps>1 instead of NumHeaps<=0 will leave at least one heap block open, to speed up memory allocation.
          begin
          if (HeapInfo.free and (HeapInfo.freeany or (a=NumHeaps))) and
             (MM[a].GetTotalSize=0) then
            begin
            Total_AddrSpace := Total_AddrSpace - MM[a].FSS_Size;
            MM[a].Free;
            if NumHeaps>a then
              for b:=a+1 to NumHeaps do
                MM[b-1]:=MM[b];
            Dec(NumHeaps);
            end
          else if HeapInfo.organize then
            begin
            b:=a;
            while (b<NumHeaps) and
                  (MM[b].GetBufferSize>MM[b+1].GetBufferSize) do
              begin
              TMM:=MM[b]; MM[b]:=MM[b+1]; MM[b+1]:=TMM;
              Inc(b);
              end;
            end;
          end;
        Result:=True;
        Break;
        end;
      end;
    end;
  end;

function tMem_Manager.Get_Mem(size: cardinal): pointer;
  var
    a,mbsize:cardinal;
    TMM:tHeap_Manager;
  begin
  Result:=nil;

  if Size<=0 then Exit;
  Size:=roundto(Size,HeapInfo.alloc);

  a:=1;
  while a<=NumHeaps do
    begin
    Result:=MM[a].GetBlock(Size);
    if Result<>nil then
      begin
      if HeapInfo.organize then
        while (a>1) and
              (MM[a-1].GetBufferSize>MM[a].GetBufferSize) do
          begin
          TMM:=MM[a]; MM[a]:=MM[a-1]; MM[a-1]:=TMM;
          Dec(a);
          end;
      Break;
      end
    else
      Inc(a);
    end;

  if (Result=nil) and (NumHeaps<MaxHeaps) then
    begin
    mbsize:=roundto(size+MinAllocUnit,HeapInfo.blocksize*HeapAllocUnit);
    if mbsize<HeapInfo.minsize*HeapAllocUnit then
      mbsize:=HeapInfo.minsize*HeapAllocUnit;
    try
      MM[NumHeaps+1]:=tHeap_Manager.Create(mbsize,HeapInfo.pool,HeapInfo.sysmem);
    except
      Exit; // Out of Memory
      end;
    Inc(NumHeaps);
    Total_AddrSpace := Total_AddrSpace + MM[NumHeaps].FSS_Size;

    Result:=MM[NumHeaps].GetBlock(roundto(Size,HeapInfo.alloc));
    if HeapInfo.organize and (Result<>nil) then
      begin
      a:=NumHeaps;
      while (a>1) and
            (MM[a-1].GetBufferSize>MM[a].GetBufferSize) do
        begin
        TMM:=MM[a]; MM[a]:=MM[a-1]; MM[a-1]:=TMM;
        Dec(a);
        end;
      end;
    end;

  Total_Alloc := Total_Alloc + size;
  end;

function tMem_Manager.Check_Mem(P: Pointer):cardinal;
  var
    a:cardinal;
  begin
  Result:=0;
  for a:=1 to NumHeaps do
    if MM[a].isBlock(p) then
      begin
      Result:=MM[a].BlockSize(p);
      Break;
      end;
  end;

end.