这个 FastMM4 无效指针异常是 Delphi 5 的 FastMM 中的一个错误吗？

Question

在激活 FastMM 的 Delphi 5 中，在以下最小可重现代码中对FreeMem 的调用会触发无效指针异常：

program Project1;
{$APPTYPE CONSOLE}

uses
  FastMM4,
  SysUtils,
  Windows;

procedure Main;
var
    token: THandle;
    returnLength: Cardinal;
    p: Pointer;
begin
    OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, {out}token);

    //Get the size of the buffer required.
    //It's normally going to be 38 bytes. We'll use 16KB to eliminate the possibility of buffer overrun
//  Windows.GetTokenInformation(token, TokenUser, nil, 0, {var}returnLength);
    p := GetMemory(16384); //GetMemory(returnLength);

    Windows.GetTokenInformation(token, TokenUser, p, 1024, {var}returnLength);

    FreeMem({var}p); //FreeMem is the documented way to free memory allocated with GetMemory.
//  FreeMemory(p); //FreeMemory is the C++ compatible version of FreeMem.
end;

begin
    Main;
end.

对 FreeMme 的调用失败并返回 EInvalidPointerException：

FreeMem({var}p); //error

如果出现以下情况，错误将停止发生：

• 我停止使用 FastMM4
• 我不再打电话给GetTokenInformation
• 我打电话给FreeMemory （而不是FreeMem）

我已经在新安装的 Windows 7 机器上重新安装 Delphi 5 时重现了该错误。 FastMM4 v4.992。

• Delphi 7 中不会发生该错误
• Delphi XE6 不会出现该错误

只是：

• 德尔福5
• 使用 FastMM4 时

解决方法

如果它是 FastMM4 中的错误，我可以解决它。而不是调用：

• 获取内存
• 免费内存

我可以通过另一种方式手动分配缓冲区：

• SetLength(buffer, cb)
• SetLength(buffer, 0)

如果不是 FastMM4 的错误，我想修复上面的代码。

使用 FreeMemory，而不是 FreeMem，不会触发错误

我的印象是 FastMM 接管了内存管理，这就是为什么我惊讶地发现：

• FreeMem({var}p); 失败
• FreeMemory(p); 工作

在内部，FreeMem 被实现为对内存管理器的调用。在这种情况下，内存管理器 (FastMM) 返回非零值，导致调用 reInvalidPtr：

System.pas

procedure _FreeMem;
asm
        TEST    EAX,EAX
        JE      @@1
        CALL    MemoryManager.FreeMem
        OR      EAX,EAX
        JNE     @@2
@@1:    RET
@@2:    MOV     AL,reInvalidPtr
        JMP     Error
end;

MemoryManager.FreeMem 的实现最终是：

FastMM4.pas

function FastFreeMem(APointer: Pointer);

FreeMem 接受一个 var 指针，FreeMemory 接受一个指针

FreeMemory的实现是：

System.pas：

function FreeMemory(P: Pointer): Integer; cdecl;
begin
  if P = nil then
    Result := 0
  else
    Result := SysFreeMem(P);
end;

而 SysFreeMem 实现于：

GetMem.inc：

function SysFreeMem(p: Pointer): Integer;
// Deallocate memory block.
label
  abort;
var
  u, n : PUsed;
  f : PFree;
  prevSize, nextSize, size : Integer;
begin
  heapErrorCode := cHeapOk;

  if not initialized and not InitAllocator then begin
    heapErrorCode := cCantInit;
    result := cCantInit;
    exit;
  end;

  try
    if IsMultiThread then EnterCriticalSection(heapLock);

    u := p;
    u := PUsed(PChar(u) - sizeof(TUsed)); { inv: u = address of allocated block being freed }
    size := u.sizeFlags;
    { inv: size = SET(block size) + [block flags] }

    { validate that the interpretation of this block as a used block is correct }
    if (size and cThisUsedFlag) = 0 then begin
      heapErrorCode := cBadUsedBlock;
      goto abort;
    end;

    { inv: the memory block addressed by 'u' and 'p' is an allocated block }

    Dec(AllocMemCount);
    Dec(AllocMemSize,size and not cFlags - sizeof(TUsed));

    if (size and cPrevFreeFlag) <> 0 then begin
      { previous block is free, coalesce }
      prevSize := PFree(PChar(u)-sizeof(TFree)).size;
      if (prevSize < sizeof(TFree)) or ((prevSize and cFlags) <> 0) then begin
        heapErrorCode := cBadPrevBlock;
        goto abort;
      end;

      f := PFree(PChar(u) - prevSize);
      if f^.size <> prevSize then begin
        heapErrorCode := cBadPrevBlock;
        goto abort;
      end;

      inc(size, prevSize);
      u := PUsed(f);
      DeleteFree(f);
    end;

    size := size and not cFlags;
    { inv: size = block size }

    n := PUsed(PChar(u) + size);
    { inv: n = block following the block to free }

    if PChar(n) = curAlloc then begin
      { inv: u = last block allocated }
      dec(curAlloc, size);
      inc(remBytes, size);
      if remBytes > cDecommitMin then
        FreeCurAlloc;
      result := cHeapOk;
      exit;
    end;

    if (n.sizeFlags and cThisUsedFlag) <> 0 then begin
      { inv: n is a used block }
      if (n.sizeFlags and not cFlags) < sizeof(TUsed) then begin
        heapErrorCode := cBadNextBlock;
        goto abort;
      end;
      n.sizeFlags := n.sizeFlags or cPrevFreeFlag
    end else begin
      { inv: block u & n are both free; coalesce }
      f := PFree(n);
      if (f.next = nil) or (f.prev = nil) or (f.size < sizeof(TFree)) then begin
        heapErrorCode := cBadNextBlock;
        goto abort;
      end;
      nextSize := f.size;
      inc(size, nextSize);
      DeleteFree(f);
      { inv: last block (which was free) is not on free list }
    end;

    InsertFree(u, size);
abort:
    result := heapErrorCode;
  finally
    if IsMultiThread then LeaveCriticalSection(heapLock);
  end;
end;

因此，FreeMemory 不会触发错误是有道理的； FreeMemory 不会被内存管理器接管。

我想这就是为什么FreeMemory is not the documented counterpart to GetMemory: ^????

Answer 1

FreeMem 不是释放由GetMemory 分配的内存的记录方法 - 这显然是旧文档中的一个错误，现已更正。来自documentation for System.GetMemory（强调添加）：

GetMemory 分配一个内存块。

GetMemory 在堆上分配给定大小的块，并返回此内存的地址。分配的缓冲区的字节未设置为零。 要释放缓冲区，请使用FreeMemory。如果没有足够的可用内存来分配块，则会引发EOutOfMemory 异常。

如果您使用GetMem 分配内存，请使用FreeMem。如果分配是使用GetMemory 完成的，请使用FreeMemory。