В 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)
Я воспроизвел ошибкуна свежей установке Delphi 5 на недавно установленной машине Windows 7.FastMM4 v4.992.
- Ошибка не возникает в Delphi 7
- Ошибка не возникает в Delphi XE6
Это только:
- Delphi 5
- при использовании FastMM4
Обходной путь
Если это ошибка в FastMM4, я могу ее обойти.Вместо вызова:
Я могу вручную выделить буфер другим способом:
- 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 принимает указатель на переменную, 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 : ?
