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中不会发生错误

只有：

Delphi 5
使用FastMM4时

解决方法

如果它是FastMM4中的错误，我可以解决它。而不是打电话：

GetMemory
FreeMem

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

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。

对于Delphi 5，此FastMM4无效指针异常是否是FastMM中的错误？

解决方法

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

FreeMem使用var指针，FreeMemory使用指针

1 个答案: