這個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 FreeMme失敗：

FreeMem({var}p); //error

如果出現以下錯誤，則錯誤將停止：

• 我停止使用FastMM4
• 我停止調用GetTokenInformation
• 我叫FreeMemory （而不是FreeMem ）

我在新安裝的Windows 7機器上重新安裝了Delphi 5的錯誤。 FastMM4 v4.992。

• 在Delphi 7中不會發生錯誤
• Delphi XE6中不會發生此錯誤

這只是：

• 德爾福5
• 使用FastMM4時

解決方法

如果它是FastMM4中的錯誤，我可以解決它。 而不是打電話：

• GetMemory
• 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不是記錄對口GetMemory： ^🕗

Answer 1

FreeMem不是用GetMemory分配的釋放內存的文檔化方法 - 這顯然是舊文檔中的錯誤，此后已被糾正。 從System.GetMemory的文檔 （ 重點添加）：

GetMemory分配一個內存塊。

GetMemory分配給定Size的塊，並返回該內存的地址。 分配的緩沖區的字節不設置為零。 要處理緩沖區，請使用FreeMemory 。 如果沒有足夠的可用內存來分配塊，則會EOutOfMemory異常。

如果分配與內存GetMem ，使用FreeMem 。 如果分配與完成GetMemory ，使用FreeMemory 。