ich arbeite an einem Programm, welche größere Datenmengen mit mehreren Threads verarbeitet. Mir ist aufgefallen, dass die Performance sich verbessert, wenn man einen TThread nicht immer durch .free und .create laufen lässt, sondern ihn mittels RTLEventCreate, RtlEventSetEvent und RtlEventWaitFor immer wieder stoppt, neue Werte zuweist und wieder startet. Mr. Google hat mich vorher auf den folgenden Eintrag hier im Forum gelotst:
viewtopic.php?t=7415
So weit, so gut, wenn mir nur nicht das TThread.Terminate i. V. m. PRTLEvent eine Exception vom Typ "External: ACCESS VIOLATON" vor die Nase setzen würde. Ich habe mir daher eine Testanwendung geschrieben, um den Fehler zu suchen. Der Fehler liegt im TTestThread.Terminate, jedoch komm ich nicht drauf, warum ...
Hier der Code:
Code: Alles auswählen
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ComCtrls;
type
TTestThread = class(TThread)
ResumeEvent: PRTLEvent;
sName: string;
bIndex: byte;
iRun: LongWord;
cResult: cardinal;
public
constructor Create(bSuspended: boolean);
destructor Destroy; override;
procedure Terminate;
procedure ResumeWork;
procedure SetBusy;
procedure SetIdle;
function isBusy: boolean;
protected
procedure Execute; override;
private
bBusy: boolean;
end;
{ TForm1 }
TForm1 = class(TForm)
btnErstellen: TButton;
Button1: TButton;
btnLoeschen: TButton;
ComboBox1: TComboBox;
MehrmalsArbeiten: TButton;
Memo1: TMemo;
TreeView1: TTreeView;
procedure btnErstellenClick(Sender: TObject);
procedure btnLoeschenClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure MehrmalsArbeitenClick(Sender: TObject);
private
public
end;
var
Form1: TForm1;
lwNumCores: LongWord;
arrThreads: array of TTestThread;
arrRootNodes: array of TTreeNode;
arrRunNodes: array of TTreeNode;
arrResultNodes: array of TTreeNode;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.btnErstellenClick(Sender: TObject);
var
i: integer;
begin
//Anzahl der Prozessoren holen
lwNumCores := GetCPUCount;
//Länge des Thread-Array festlegen
SetLength(arrThreads, lwNumCores);
//Länge des Arrays mit den Root-Nodes festlegen
SetLength(arrRootNodes, lwNumCores);
//Lange des Arrays der Siblings festlegen
SetLength(arrRunNodes, lwNumCores);
SetLength(arrResultNodes, lwNumCores);
//Zeilen in Memo1 löschen
Memo1.Lines.Clear;
//Vom ersten bis zum letzten Thread ...
for i:=0 to (lwNumCores -1) do
begin
//Thread erstellen
arrThreads[i] := TTestThread.Create(false);
//Namen zuweisen
arrThreads[i].sName:='Thread '+ IntToStr(i);
//Index des Threads im Thread vermerken
arrThreads[i].bIndex:=i;
//Erstellen der Root-Nodes
arrRootNodes[i] := Treeview1.Items.Add(nil, arrThreads[i].sName);
//Erstellen der Siblings
arrRunNodes[i] := TreeView1.Items.AddChild(arrRootNodes[i], 'Thread '+ IntToStr(i) + '.iRun = 0');
arrResultNodes[i] := TreeView1.Items.AddChild(arrRootNodes[i], 'Thread '+ IntToStr(i) + '.cResult = 0');
end;
//Alle Nodes ausklappen
TreeView1.FullExpand;
end;
procedure TForm1.btnLoeschenClick(Sender: TObject);
var
i: integer;
begin
for i:=0 to lwNumCores do
begin
arrThreads[i].Terminate;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Lines.Clear;
end;
procedure TForm1.MehrmalsArbeitenClick(Sender: TObject);
var
i, j, k, l: integer;
cSum: LongWord;
sTemp: string;
begin
//Nervige Compilerwarnungen unterdrücken
cSum:=0; sTemp := '';
//Anzahl der Durchläufe einholen
i := (ComboBox1.ItemIndex + 1);
//Vom ersten bis zum letzten Durchlauf ...
for j:= 0 to (i-1) do
begin
//Den Durchlauf vermerken
Form1.Memo1.Lines.Add('------------- Durchlauf Nummer ' + IntToStr(j) + ' -------------');
//Vom ersten bis zum letzten Thread ...
for k:=0 to lwNumCores-1 do
begin
//arrThreads[k].SetBusy;
arrThreads[k].ResumeWork;
end;
//Eintritt in die Warteschleife vermerken
Form1.Memo1.Lines.Add('---- Betrete Warteschleife');
//Warten auf die Threads
for k:=0 to lwNumCores-1 do While (arrThreads[k].isBusy) do Application.ProcessMessages;
//Verlassen der Warteschleife vermerken
Form1.Memo1.Lines.Add('---- Verlasse Warteschleife');
//Mehrmaliger Durchlauf?
if (cSum > 0) then sTemp := sTemp + IntTostr(cSum) + ' + ';
//Addieren der Ergebnisse
for k:=0 to lwNumCores-1 do
begin
//Ergebnis des Threads aufaddieren
Inc(cSum, arrThreads[k].cResult);
//Als String in die Stringliste speichern
sTemp := sTemp + IntToStr(arrThreads[k].cResult) + ' + ';
end;
//Das letzte Plus entfernen
l := Length(sTemp); SetLength(sTemp, (l-3));
//Anhängen des Endergebnisses an den String
sTemp := sTemp + ' = ' + IntToStr(cSum);
//Ausgabe des Ergebnisses ins Memo
form1.Memo1.Lines.Add(sTemp);
//Variable wieder leeren
sTemp:='';
end;
end;
constructor TTestThread.Create(bSuspended: boolean);
begin
inherited Create(bSuspended);
ResumeEvent :=RTLEventCreate;
self.iRun:=0;
self.bBusy:=false;
FreeOnTerminate := true;
end;
destructor TTestThread.Destroy;
begin
RTLEventdestroy(ResumeEvent);
inherited Destroy;
end;
procedure TTestThread.Terminate;
begin
form1.Memo1.Lines.Add(self.sName + '.Terminate'); { #note : Löst eine "External: ACCESS VIOLATON" aus. Wird aber trotzdem ins Memo geschrieben. }
//muss hier hin, sonst wartet er beim Schließen ewig auf das Event...
RtlEventSetEvent(ResumeEvent); { #note : Löst eine "External: ACCESS VIOLATON" aus.}
inherited Terminate;
end;
procedure TTestThread.ResumeWork;
begin
self.SetBusy;
RtlEventSetEvent(ResumeEvent);
end;
procedure TTestThread.Execute;
begin
while not Terminated do
begin
//Wartestellung ausgeben
form1.Memo1.Lines.Add(self.sName + ' ist in Wartestellung.');
//Warten auf Event
RtlEventWaitFor(ResumeEvent);
//Durchlaufzähler bei Arbeit erhöhren
Inc(self.iRun);
//Arbeitsdurchlauf ausgeben
Form1.Memo1.Lines.Add(self.sName + ': Durchlauf : ' + IntToStr(self.iRun));
//Anzahl der Durchläufe im TreeView1 angeben
arrRunNodes[self.bIndex].Text:=self.sName + '.iRun = ' + IntToStr(self.iRun);
if not Terminated then
begin //Eine Zufallszahl speichern
self.cResult := 500 + Random(1000);
//Die Zufallszahl im TreeView anzeigen
arrResultNodes[self.bIndex].Text := self.sName + '.cResult = ' + IntToStr(self.cResult);
//Die Zufallszahl im Memo ausgeben
Form1.Memo1.Lines.Add(self.sName + '.cResult = ' + IntToStr(self.cResult));
end;
//Den Thread als unbeschäftigt markieren (sonst Endlosschleife!)
self.SetIdle;
end;
//Vermerken, falls TTestThread.Execute verlassen wird
Form1.Memo1.Lines.Add(self.sName + ': Procedur Execute wird verlassen.');
end;
//Der Thread ist beschäftig!
procedure TTestThread.SetBusy;
begin
Form1.Memo1.Lines.Add(self.sName + ' ist als "Beschäftigt" markiert');
self.bBusy:=true;
end;
//Der Thread ist unbeschäftigt in Warteschleife
procedure TTestThread.SetIdle;
begin
Form1.Memo1.Lines.Add(self.sName + ' ist als "Unbeschäftigt" markiert!');
self.bBusy:=false;
end;
//Ist der Thread beschäftigt?
function TTestThread.isBusy: boolean;
begin
result:=self.bBusy;
end;
end.
Ich wäre für jede Hilfe dankbar
. Falls jemand einen anderen Weg weis, einen Thread zu benutzen, ohne die Performance mittel .free und .create zu ruinieren, wäre ich ebenfalls sehr dankbar 
Verein
Links
