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

Question

In Delphi 5, with FastMM active, the call to FreeMem in the following minimum-reproducible code triggers an Invalid Pointer Exception :

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.

The call to FreeMme fails with an EInvalidPointerException :

FreeMem({var}p); //error

The error will stop happening if:

• i stop using FastMM4
• i stop calling GetTokenInformation
• i call FreeMemory (rather than FreeMem )

I've reproduced the error on a fresh install of Delphi 5 on a freshly installed Windows 7 machine. FastMM4 v4.992.

• The error does not happen in Delphi 7
• The error does not happen in Delphi XE6

It's only:

• Delphi 5
• when using FastMM4

Workaround

If it is a bug in FastMM4, i can workaround it. Rather than calling:

• GetMemory
• FreeMem

I can manually allocate the buffer another way:

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

If it's not a bug in FastMM4, i'd like to fix the above code.

Using FreeMemory, rather than FreeMem, doesn't trigger the error

I was under the impression that FastMM takes over memory management, which is why i was surprised to discover:

• FreeMem({var}p); failed
• FreeMemory(p); works

Internally, FreeMem is implemented as a call to the memory manager. In this case the memory manager (FastMM) returns non-zero, causing the call to 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;

and the implementation of MemoryManager.FreeMem ends up being:

FastMM4.pas

function FastFreeMem(APointer: Pointer);

FreeMem takes a var pointer, FreeMemory takes a pointer

The implementation of FreeMemory is:

System.pas :

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

And SysFreeMem is implemented in:

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;

So it makes that sense that FreeMemory doesn't trigger the error; FreeMemory is not taken over by the memory manager.

I guess that is why FreeMemory is not the documented counterpart to GetMemory : ^🕗

Answer 1

FreeMem is not the documented way to free memory allocated with GetMemory - that's apparently an error in the old documentation that has since been corrected. From the documentation for System.GetMemory ( emphasis added):

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.

If you allocate the memory with GetMem , use FreeMem . If the allocation is done with GetMemory , use FreeMemory .