[meta]Thread TThread Threads Synchronisation Suspend Resume GetMem CriticalSection CriticalSections Deadlock[/meta]
Hallo!
Vor einigen Monaten bin ich auf ein größeres Problem des TThread-Objektes im Zusammenhang mit der RTL gestoßen. Ruft man die Suspend-Methode des Threads auf, um seine Arbeit vorrübergehend zu unterbrechen, kann daraufhin das gesamte Programm einfrieren.
Es tritt dabei ein sog. Deadlock auf: Der Thread wartet darauf, dass er wieder geweckt wird, während der Hauptthread auf etwas wartet, das der wartende Thread beenden muss. In diesem Zustand reagiert die Applikation auf keine Anforderungen von außen mehr, es ist eingefroren.
Der Grund? Der Thread befindet sich in einer Critical Section, die vom Hauptthread auch betreten werden will, während der Thread schon schläft.
Critical Section? Was ist das? Eine Critical Section (CS) dient dazu, von mehreren Threads gemeinsam genutzte Ressourcen (z.B. ein Speicherbereich) zu verwalten. Vor dem Zugriff darauf ruft man EnterCriticalSection auf, danach LeaveCriticalSection. Über den Scheduler von Windows wird nun dafür gesorgt, dass sich niemals zwei Threads gleichzeitig in der selben CriticalSection befinden können, sondern erst darauf warten, dass sie wieder verlassen wird.
Nie gehört, benutze ich auch gar nicht. Doch! Die RTL benutzt intern bei jedem Aufruf von
GetMem und
FreeMem die Critical Section
heapLock (zu finden in getmem.inc) - und damit immer, wenn eine dynamische Variable reserviert oder freigegeben wird. Dazu gehören auch Strings.
Mein Beispielprojekt dazu erzeugt einfach einen Thread, der pausenlos GetMem und FreeMem aufruft. Per Knopfdruck lässt er sich suspenden und resumen, und per Knopfdruck lässt sich im Kontext des Hauptthreads ebenfalls GetMem und FreeMem aufrufen. Suspended man nun den Thread und ruft GetMem oder FreeMem auf, friert das Programm mit großer Wahrscheinlichkeit komplett ein. Zu folgender Unit wird nur ein Formular mit 4 Buttons benötigt (BtnSuspend, BtnResume, BtnGetMem, BtnFreeMem). Das komplette Projekt befindet sich auch im Anhang.
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117:
| unit Main;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TSomeThread = class(TThread) protected procedure Execute; override; end;
TForm1 = class(TForm) BtnSuspend: TButton; BtnResume: TButton; BtnGetMem: TButton; BtnFreeMem: TButton; procedure BtnSuspendClick(Sender: TObject); procedure BtnResumeClick(Sender: TObject); procedure BtnGetMemClick(Sender: TObject); procedure BtnFreeMemClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private FSomeThread: TSomeThread; FSomeMem: Pointer; end;
var Form1: TForm1;
implementation
{$R *.dfm}
procedure TSomeThread.Execute; var SomeMem: Pointer; begin inherited; while not Terminated do begin GetMem(SomeMem, 1024); Sleep(0); FreeMem(SomeMem, 1024); Sleep(0); end; end;
procedure TForm1.BtnSuspendClick(Sender: TObject); begin FSomeThread.Suspend; BtnSuspend.Enabled := False; BtnResume.Enabled := True; end;
procedure TForm1.BtnResumeClick(Sender: TObject); begin FSomeThread.Resume; BtnSuspend.Enabled := True; BtnResume.Enabled := False; end;
procedure TForm1.BtnGetMemClick(Sender: TObject); begin GetMem(FSomeMem, 1024); BtnGetMem.Enabled := False; BtnFreeMem.Enabled := True; end;
procedure TForm1.BtnFreeMemClick(Sender: TObject); begin FreeMem(FSomeMem); FSomeMem := nil; BtnGetMem.Enabled := True; BtnFreeMem.Enabled := False; end;
procedure TForm1.FormCreate(Sender: TObject); begin FSomeThread := TSomeThread.Create(True); FSomeThread.FreeOnTerminate := True; end;
procedure TForm1.FormDestroy(Sender: TObject); begin with FSomeThread do begin Terminate; if Suspended then Resume; WaitFor; end; if Assigned(FSomeMem) then FreeMem(FSomeMem); end;
end. |
Die Unit SuspdThread zur Lösung des Problems habe ich in den FAQ gepostet.
Moderiert von Tino: Topic aus Delphi Language (Object-Pascal) / CLX verschoben am Do 20.10.2005 um 15:58
Moderiert von Udontknow: Meta-Tags hinzugefügt.
In the beginning, the universe was created. This has made a lot of people very angry, and is generally considered to have been a bad move.