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

Question

在 Delphi 5 中，FastMM 处于活动状态时，在以下 最小可重现代码 中调用 FreeMem 会触发 Invalid指针异常:

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.

在Delphi7
在Delphi XE6

只有：

Delphi 5
使用 FastMM4 时

解决方法

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

获取内存
FreeMem

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

SetLength(缓冲区, cb)
SetLength(缓冲区, 0)

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

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

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

FreeMem({var}p);失败
FreeMemory(p); 有效

在内部，FreeMem 实现为对内存管理器的调用。在这种情况下，内存管理器 (FastMM) returns 非零，导致调用 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.

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

Is this FastMM4 Invalid Pointer Exception a bug in FastMM for Delphi 5?

delphi

delphi-5

fastmm

解决方法

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

FreeMem 取一个 var 指针，FreeMemory 取一个指针