Oprava DoneMonitorSupport

vložil Radek Červinka 17. listopadu 2014 21:58

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.

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.


Nabízíme Delphi školení a konzultace na různá témata, primárně ve Vaší firmě.

Tagy: , ,

Praxe

Komentáře

18.11.2014 9:31:23 #

Fala

hledání řešení této chyby mě donutilo se důkladně podívat na thready. i když se mi to občas ještě kousne, musím říct, že se mi díky tomu podařila slušná optimalizace a zjednodušení celé aplikace.

Přepsání sysutils sice funguje, ale je to takové škaredé

Zkusím to implementovat.

Díky Radku

Fala

Komentování ukončeno

Naše nabídka

Partial English version.

MVP
Ing. Radek Červinka - Embarcadero MVP
profil na linkedin, Twitter:@delphicz

Nabízím placené poradenství a konzultace v oblasti programování a vývoje SW.
Dále nabízíme i vývoj speciálního software na zakázku.

Neváhejte nás kontaktovat (i ohledně reklamy nebo burzy práce).

Pokud chcete podpořit tento server libovolnou částkou, můžete použít PayPal. Moc děkuji.

Delphi Certified Developer

O Delphi.cz

Delphi je jediný moderní RAD nástroj podporující tvorbu nativních aplikací pro platformu Win32, Win64 , Mac OSX a na iPhone a Android (s výhledem na další platformy díky FireMonkey) na současném trhu (včetně Windows 8.1).

V současnosti je světová komunita přes dva miliónů vývojářů.

Delphi.cz je nezávislý portál pro uživatele Delphi. Portál není koncipován pro úplné začátečníky, i když i ti se zde nebudou nudit, ale spíše na programátory, kteří již něco znají a chtějí své znalosti dále rozvíjet a sledovat novinky.

Anketa

Poslední komentáře

Comment RSS