ReallocMem有严重问题？

Question

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TForm1 = class(TForm)
    btnBigMem: TButton;
    btnSmallMem: TButton;
    btn1: TButton;
    procedure btnBigMemClick(Sender: TObject);
    procedure btnSmallMemClick(Sender: TObject);
    procedure btn1Click(Sender: TObject);
  private
    FList: TList;
    procedure ClearList;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;var
  Form1: TForm1;implementationconst
  RepeatCount = 5000;
  
{$R *.dfm}procedure TForm1.AfterConstruction;
begin
  inherited;
  FList := TList.Create;
end;procedure TForm1.BeforeDestruction;
begin
  inherited;
  FList.Free;
end;procedure TForm1.btnBigMemClick(Sender: TObject);
var
  i: Integer;
  tmp, p: Pointer;
begin
  tmp := nil;
  for i := 1 to RepeatCount do
  begin
    //GlobalReAllocPtr(FData, i * SizeOf(Pointer), HeapAllocFlags);//换这个就没问题
    ReallocMem(tmp, i * SizeOf(Pointer));
    GetMem(p, 4);
    FList.Add(p);
  end;
  FreeMem(tmp);
end;procedure TForm1.btnSmallMemClick(Sender: TObject);
var
  i: Integer;
  tmp, p: Pointer;
begin
  tmp := nil;
  for i := 1 to RepeatCount do
  begin
    ReallocMem(tmp, i * SizeOf(Pointer));
  end;  for i := 1 to RepeatCount do
  begin
    GetMem(p, 4);
    FList.Add(p);
  end;  FreeMem(tmp);
end;procedure TForm1.ClearList;
var
  i: Integer;
  p: Pointer;
begin
  for i := 0 to FList.Count - 1 do
  begin
    p := FList[i];
    FreeMem(p);
  end;
  FList.Clear;
end;procedure TForm1.btn1Click(Sender: TObject);
begin
  ClearList;
end;end.//第1次执行btnBigMemClick之后内存暴涨50M,
//而同样程序启动后，执行btnSmallMemClick，内存几乎没有变化//此问题影响到SetLength和TObject.Create,因为都是用到了类似的内存分配机制

Answer 1

procedure TForm1.btnSmallMemClick(Sender: TObject);
var
  i: Integer;
  tmp, p: Pointer;
begin
  tmp := nil;
  for i := 1 to RepeatCount do
  begin
  ReallocMem(tmp, i * SizeOf(Pointer));
  end;  for i := 1 to RepeatCount do
  begin
  GetMem(p, 4);
  FList.Add(p);
  end;  FreeMem(tmp);
end;
---------------释放tmp时 用 FreeMemory来释放，感觉P也没释放，

Answer 2

执行btnSmallMemClick本来就没问题

Answer 3

const
  RepeatCount = 5000;

Answer 4

(Delphi)New,Getmem,ReallocMem联系与区别
procedure New(var P: Pointer);   {为一个指针变量分配内存，会自动计算指针所指数据结构需要空的空间大小}procedure GetMem(var P: Pointer; Size: Integer); {分配一个指定大小的内存块（连续），并用P指向它}procedure ReallocMem(var P: Pointer; Size: Integer); {重新分配指定大小内存块，参数P必须是nil或者指向一个由GetMem, AllocMem, 或 ReallocMem分配的内存变量，其分配的内存是连续的，会把前面已有的数据移到新分配的内存中去}通常采用New分配内存比较好.一、New和GetMem都可以为指针类型动态分配内存，并且Delphi不会对由此分配的内存进行管理，即必须有相应的代码对其进行释放，否则内存将“丢失”，直到应用程序结束。   
  二、New分配的内存必须由Dispose来释放；GetMem分配的内存必须由FreeMem来释放；   
  三、New根据指针类型来自动计算需要分配的内存尺寸；GetMem必须指定尺寸；   
    
  因此，对于类型指针，一般用New和Dispose来进行管理；对于内存尺寸随机的指针（典型地如PChar），一般用GetMem和FreeMem来进行管理。从另一方面来说，在很多时候用哪一对例程都可以进行动态内存管理。 

Answer 5

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  end;var
  Form1: TForm1;
implementation{$R *.dfm}Type
  TMyRec = record     {定义结构; 记住该结构的大小是 12 个字节}
    name: string[8];
    age : Word;       {虽然 Word 是 2 字节大小; 但因按 4 字节对齐, 它占用 4 字节}
  end;
  PMyRec = ^TMyRec;   {定义结构指针}var
  pr: PMyRec;procedure TForm1.FormCreate(Sender: TObject);
const
  str = '地址: %d; 姓名: %s';
begin
  {申请 3 个 TMyRec 结构大小的内存}
  //GetMem(pr, SizeOf(TMyRec) * 3);
  ReallocMem(pr, SizeOf(TMyRec) * 3); {这一句也可以用上一行代替}  {赋值}
  pr.name := '张三';
  pr.age := 11;  Inc(pr);
  pr.name := '李四';
  pr.age := 22;  Inc(pr);
  pr.name := '王五';
  pr.age := 33;  {显示三个结构的地址与信息; 地址应该是连续的(相间 12 字节)}
  Dec(pr, 2);
  ShowMessage(Format(str, [Integer(pr), pr.name])); {地址: 15278504; 姓名: 张三}
  Inc(pr);
  ShowMessage(Format(str, [Integer(pr), pr.name])); {地址: 15278516; 姓名: 李四}
  Inc(pr);
  ShowMessage(Format(str, [Integer(pr), pr.name])); {地址: 15278528; 姓名: 王五}  {重新申请内存, 要 5 个结构大小, 并给 2 个新的结构赋值}
  Dec(pr, 2);
  ReallocMem(pr, SizeOf(TMyRec) * 5);  Inc(pr, 3);
  pr.name := '马六';
  pr.age := 44;  Inc(pr);
  pr.name := '孙七';
  pr.age := 55;  {显示相关信息; 会发现地址虽然还是连续的, 但已经和上面不同!}
  Dec(pr, 4);
  ShowMessage(Format(str, [Integer(pr), pr.name])); {地址: 14875920; 姓名: 张三}
  Inc(pr);
  ShowMessage(Format(str, [Integer(pr), pr.name])); {地址: 14875932; 姓名: 李四}
  Inc(pr);
  ShowMessage(Format(str, [Integer(pr), pr.name])); {地址: 14875944; 姓名: 王五}
  Inc(pr);
  ShowMessage(Format(str, [Integer(pr), pr.name])); {地址: 14875956; 姓名: 马六}
  Inc(pr);
  ShowMessage(Format(str, [Integer(pr), pr.name])); {地址: 14875968; 姓名: 孙七}  Dec(pr, 4);
  FreeMem(pr, SizeOf(TMyRec) * 5); {也可以用 FreeMem 清理 ReallocMem 申请的内存}
end;end.

Answer 6

应该不是 单一的问题ReallocMem  和 getmem 单独使用都没问题，但联合起来分配的话，就出现释放不了 tem的问题

Answer 7

这个很正常，原因是产生了大量的内存碎片。把 for i := 1 to RepeatCount do
换成 for i := RepeatCount downto 1 do
再看看测试结果看来需要深入理解Delphi的内存分配机制。

Answer 8

你的这个问题，应该是内存碎片造成的，在 btnBigMemClick 过程中，你可以测试一下，每次为Tmp分配的内存的位置，是不是每次都紧挨着p，如果是，那就说明，每次为tmp分配了一块内存，紧接着为p在后面分配了一块大小是4的内存，当循环再次进入的时候，重新分配内存，但是在已经空闲的内存中，没有足够大的内存来满足当前tmp的分配，因此必须新开辟一块内存，然后为tmp分配。这样，循环下来，到处都是内存碎块，这些碎片还不能被释放，因为每个碎片后面都紧跟着一个 4 字节大小的内存是被你实际分配的。windows是按照页的方式管理内存的，每一页的大小是固定的，在这一页中，只要有一块内存正在被你使用，那么这页内存就不能被释放，因此，你的 btnBigMemClick 函数造成所有的页都被系统保留下来，虽然每一页上实际使用的内存很少。
始终是重复这样的操作，直到循环结束，这时候，你消耗和很大一块虚拟内存，注意是消耗不是实际被你使用了，仅仅是被你占有了。所以说，要尽量避免反复申请、释放内存，这样会造成大量的碎片。不信你可以接着试试在调用 btnBigMemClick 后再调用内存分配函数，循环 RepeatCount * 10 次，每次分配个4字节大小的内存，肯定不会导致实际内存的增加。
而采用 btnSmallMemClick 的方式，tmp 在每次分配的时候，都是向后增加，不够了就再次调入一个内存页，因此不会出现内存碎片。

Answer 9

刚刚上面有一点错误，就是 p 的位置，不一定与tmp挨着，因为如果前面的碎片区域足够 p 用，那么就可以在碎片区域为 p 分配空间。

Answer 10

非常感谢你回了这么多，其中你提到的“尽量避免反复申请、释放内存”，这是众所周知的，但这些代码仅仅是我测试代码，因为在实际项目中遇到了类似的问题，经过返回跟踪，才提取这些测试代码，实际中倒只有反复增加分配内存，就是ReallocMem+GetMem，与FreeMem无关，VCL中常被使用的动态数组和对象创建都是用这2个函数，如果大量穿插调用，就会产生该问题。如果如此大量调用不可避免，还是希望得到一些挽救的方法。

Answer 11

2006以前的 delphi 吧？用 FastMM

Answer 12

其实这不是什么大问题，你给的测试程序比较极端，那就是：新开辟的内存大小不断在增加，这就导致已经释放的零散的内存不能满足你的内存申请的需要，所以才会不断调入新的内存页，在实际的使用中，内存的申请，其大小基本上是大小都有，如果在空闲的内存空间中有足够的大小，就会先使用空闲的内存而不会调入新的页。不过，问题还是存在的，所以在实际使用中，尽量避免频繁改变需要使用内存申请的变量的值。
比如
for i := 0 to 100
begin
  s := s + 'a'
end;
这就不是什么好的写法，正确的方式应该是
setlength(s, 101);
for i := 0 to 100
begin
  s[i + 1] := 'a';
end;当然，这也仅仅是为了说明问题而已，没有什么实际的应用价值

Answer 13

确实如此，我是d6, 用了fastMM 4.84就没有这个现象了