Nedávno jsem přišel na chybu (resp. nedokonalost) ve verzích kolem XE (jak zpátky nevím, ale opraveno kolem XE3 nebo XE4). Jedná se o problém při ukončování aplikace, kdy aplikace zůstane viset při uvolňování věcí ohledně TMonitor. Později jsem zjistil, že nejsem sám - aplikace zůstane viset pokud nejsou korektně uvolněny instance používající (myslím) TMonitor (např. ThreadList ale i jiné).
Pikantní je, že chyba se vyskytovala jen sem tam - problém vznikl (asi) při přidání mnoha nových komponent pro UI a nemám sílu a energii to nějak systémově řešit (jako např. navrhuje Uwe Raabe za pomocí trasování - DoneMonitor. Popis problému je několikrát popsán.
Chyba (možná spíše přílišný optimismus při implementaci) za normální situace nenastane.
Sysutils.pas - voláno ze sekce finalization
procedure DoneMonitorSupport;
procedure CleanStack(Stack: PEventItemHolder);
begin
….. nepodstatné
end;
procedure CleanEventList(var EventCache: array of TSyncEventItem);
var
I: Integer;
begin
for I := Low(EventCache) to High(EventCache) do
begin
repeat until InterlockedCompareExchange(EventCache[I].Lock, 1, 0) = 0;
DeleteSyncWaitObj(EventCache[I].Event);
end;
end;
begin
CleanStack(InterlockedExchangePointer(Pointer(EventCache), nil));
CleanStack(InterlockedExchangePointer(Pointer(EventItemHolders), nil));
CleanEventList(SyncEventCache);
end;
Všimněte si CleanEventList, kdy se pro každý Lock testuje zda je jeho počet referencí 0. Jinak se program neukončí. Což je optimistické chování.
Řešení jsou dvě:
- netestovat počet referencí
- testovat počet referencí jen po určitou dobu (toto řešení EMBT zvolilo v novějších verzích Delphi)
Problémem je, že se popsaný problém může začít projevovat až s cizí komponentou. Rozhodl jsem se pro run-time patch, který zamezí volání CleanEventList. Nikde jsem toto řešení neviděl v podobě unitu takže jsem si ho musel napsat sám (upravovat sysutils se mi nechtělo).
Problémem je, že DoneMonitor je privátní procedura, takže se musí nejprve v paměti najít. Nejbližší dostupná procedura je pro Delphi XE CheckWin32Version, která je o pár bytů vedle. Takže tuto metodu vezmu jako bázovou adresu a od ní zpět začnu vyhledávat sekvenci kterou obsahuje DoneMonitorSupport. Testováno pro XE.
unit uFixDoneMonitor;
interface
implementation
uses
SysUtils, Windows;
{
Runtime Patch for DoneMonitor bug in XE and other version,
fixed in XE4
For XE, other version need check base function address-> CheckWin32Version
Radek Cervinka, delphi.cz
}
//info http://stackoverflow.com/questions/14217735
procedure PatchDoneMonitor;
var
p:Pointer;
iRead, OldProtect: Cardinal;
iCheck : Integer;
b: byte;
begin
{
CleanEventList - Fixed in XE3 or XE4
SysUtils.pas.17269: CleanStack(InterlockedExchangePointer(Pointer(EventCache), nil));
0040E278 B87C5E4100 mov eax,$00415e7c
0040E27D 33D2 xor edx,edx
0040E27F E8CCCFFFFF call InterlockedExchangePointer
0040E284 E88FFFFFFF call CleanStack
SysUtils.pas.17270: CleanStack(InterlockedExchangePointer(Pointer(EventItemHolders), nil));
0040E289 B8805E4100 mov eax,$00415e80
0040E28E 33D2 xor edx,edx
0040E290 E8BBCFFFFF call InterlockedExchangePointer
0040E295 E87EFFFFFF call CleanStack
SysUtils.pas.17271: CleanEventList(SyncEventCache); <<< RET
0040E29A B87C5D4100 mov eax,$00415d7c
0040E29F BA1F000000 mov edx,$0000001f
0040E2A4 E89FFFFFFF call CleanEventList
SysUtils.pas.17272: end;
0040E2A9 C3 ret
}
p := @CheckWin32Version; // adr to start from, know public address
dec(NativeInt(p), 140); // move pointer back
iCheck := 40;
repeat
inc (NativeInt(p), 1);
ReadProcessMemory(GetCurrentProcess, p, @b, 1, iRead);
dec(iCheck);
until (b = $B8) or (iCheck = 0); // try to find mov EAX,
if b= $B8 then // mov EAX, xx
begin
// CleanEventList(SyncEventCache); -> RET
b := $C3; //RET
if VirtualProtect(p, 1, PAGE_EXECUTE_READWRITE, OldProtect) then
try
WriteProcessMemory(GetCurrentProcess, p, @b, 1, iRead);
finally
VirtualProtect(p, 1, OldProtect, OldProtect);
end;
end;
end;
initialization
PatchDoneMonitor;
end.
FIX: chybí zde pak FlushInstructionCache pro jistotu
Pokud se najde správná instrukce, jednoduše se nahradí volání za RET. Je to nečestné a nesportovní, ale vypadá to, že to funguje. Má někdo lepší nápad?
Chybu jsem nakonec našel na cizím počítači (u mne jsem ji nedokázal vyvolat) pomocí Remote debuggeru (dříve popsaný postup), kdy vytuhnutý proces jsem zastavil (pomocí Attach) a podle zásobníku našel volanou proceduru.
RSS