delphi - FastMM4 无效指针异常是 FastMM for Delphi 5 中的错误吗？

Question

在 Delphi 5 中，当 FastMM 处于事件状态时，在以下最小可重现代码中调用 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 中的错误，我可以解决它。而不是调用:

• 获取内存
• FreeMem

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

• SetLength(缓冲区，cb)
• SetLength(缓冲区, 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 allocates a memory block.

GetMemory allocates a block of the given Size on the heap, and returns the address of this memory. The bytes of the allocated buffer are not set to zero. To dispose of the buffer, use FreeMemory. If there is not enough memory available to allocate the block, an EOutOfMemory exception is raised.

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