Entwickler-Ecke :: Thema anzeigen - Delegaten mit Delphi

Bergmann89 - Di 05.02.13 20:31
Titel: Delegaten mit Delphi

Hey Leute,

ich hab heute mal ein etwas spezielleres Problem. Und zwar bräuchte ich sowas ähnliches wie Delegaten (von C#) in Delphi. Der Hintergrund ist folgender: Ich habe einen ResourcenLoader, der asynchron Resourcen läd, die das Programm benötigt. Der ResourcenLoader bekommt ein Callback mit, mit dem das Objekt, das die Resource anfordert darüber informiert wird, dass die Resource geladen ist. Die Anfragen an den ResourcenLoader müssen nicht aus dem MainThread kommen, sondern können von jedem beliegen Thread abgesetzt werden. Nach dem asynchronen Laden wird das Callback aber im MainThread ausgeführt, da es mit Synchronize aufgerufen wurde. Ich hätte es gern, dass das Callback in dem Thread ausgeführt wird, der die Anfrage an den ResourcenLoader geschickt hat. Die Frage ist nun, wie man sowas am besten löst. Am liebsten hätt ich am Ende sowas wie SynchronizedCallback(const aThreadID: THandle; const aCallback: TCallback); Sodass ich im Thread nicht mehr synchronisieren muss.
Was auch noch gehen würde, aber nich so schön wäre, ist folgendes: Das Callback wird normal im MainThread ausgeführt, aber der Thread der die Resource angefordert, wird solange blockiert, wie der MainThread mit der Ausführung des Callbacks beschäftigt ist.
Ich weiß dass das Ganze ziemlich untypisch für Delphi ist, aber ich finde das Ganze in jedem Callback auf die normale Art und Weise zu synchronisieren wird sehr aufwendig, deshalb such ich nach Alternativen. Wäre super wenn mir da jmd nen kleinen Denkanstoß geben könnte :)

MfG & Thx Bergmann.

glotzer - Di 05.02.13 20:52

Hallo,

ich hätte da eine Idee: ich vermute mal, dass jeder der Threads eine Art Nachrichtenschleife hat. Du könntest also eine Nachricht an den Thread schicken mit dem Callback und den Parametern als Werten und dann in der Nachrichtenschleife den Callback ausführen.

Grüße
Glotzer

Bergmann89 - Di 05.02.13 21:04

Hey,

die Idee hatte ich auch schon. Da der Thread aber sehr komplex ist und nicht jedes Objekt weiß, das es in einem Thread läuft bräuchte ich ne globale Liste, in der die Threads verwaltet werden. In der kann der Loader dann nachsehen welcher Thread den Aufruf schickt und kann dann entsprechend eine Message abschicken. Das is ne Lösung, aber so richtig zufrieden bin ich damit noch nicht :/ Trotzdem danke für's Mitdenken :) Vlt fällt uns ja noch was besseres ein...

MfG Bergmann.

jaenicke - Di 05.02.13 23:06

Dafür gibt es in neueren Delphiversionen z.B. TThread.Queue:

Delphi-Quelltext

1:
2:
3:
4:

TThread.Queue(procedure
  begin
    ShowMessage('Mainthread: ' + IntToStr(GetCurrentThreadID));
  end);

Bei Delphi 7 musst du dir das selbst basteln. Ich würde mir dafür eine Ausführungsklasse basteln, von der dann spezielle Klassen für verschiedene Aufgaben abgeleitet sind. Dann packst du diese Objekte alle in eine globale Queue und arbeitest die aus dem Hauptthread heraus ab, z.B. in OnIdle (insbesondere bei Spielen ;-)).

Martok - So 10.02.13 04:41

jaenicke hat folgendes geschrieben :

Dafür gibt es in neueren Delphiversionen z.B. TThread.Queue

Das tut aber was anderes... was wir wollen, ist ja eigentlich eine Funktion in einem anderen Thread auszuführen - nicht zwingend im MainThread (bzw. praktisch nie im MainThread). Queue [http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/Classes_TThread_Queue@TThread@TThreadMethod.html] ist ja mehr Synchronize-ohne-Warten.

Anderes Anwendungsbeispiel:
Ein Thread macht alle Berechnungen, z.B. einer pro Welt-Teil ("Instance"). Ein weiterer Thread kümmert sich um Netzwerksockets. Wenn jetzt ein Paket kommt, ist das ja im Kontext des Netzwerkthreads. Wie kriege ich jetzt die Verarbeitung in den Kontext des Berechnungsthreads? Aktuelle beste Idee: alle Callbacks in eine Liste schreiben, und in jedem potenziell "ein-call-baren" Thread immer mal diese Liste pollen und Ereignisse abarbeiten. Ungelöste Probleme: wie macht man das waitable, und: meh, jeder Thread muss eine Loop werden.

jaenicke - So 10.02.13 09:09

Nein, das tut nix anderes, du kannst den Zielthread auch als Parameter angeben. Der Mainthread wird nur benutzt, wenn du keinen angibst. ;-)

Martok - So 10.02.13 17:34

jaenicke hat folgendes geschrieben :

Nein, das tut nix anderes, du kannst den Zielthread auch als Parameter angeben. Der Mainthread wird nur benutzt, wenn du keinen angibst. ;-)

Hm. Dann ist die Doku falsch, da steht nämlich, das wäre der QuellThread:

Zitat:

Queue causes the call specified by AMethod to be executed using the main thread, thereby avoiding multi-thread conflicts. The current thread is passed in the AThread parameter.

EDIT: laut Sourcecode ist es genauso wie dokumentiert. Das ist Synchronize, nur ohne Wait.

jaenicke - So 10.02.13 17:45

Hmm, vielleicht habe ich das auch verwechselt. :gruebel:
Vielleicht habe ich dafür auch einen Class Helper drin... Muss ich selbst nochmal schauen... :oops:

Martok - Mo 11.02.13 02:01

jaenicke hat folgendes geschrieben :

Vielleicht habe ich dafür auch einen Class Helper drin... Muss ich selbst nochmal schauen... :oops:

Wär schön, wenn du mal Zeit hättest :zustimm:

Ist ja an sich nicht weiter kompliziert: ein paar InterlockedExchange auf eine verkettete Liste pro Thread. Nur muss der Thread die halt pollen, was im MainThread CheckSynchronize() tut (TApplication.Idle()). Was dann wieder mit dem Warten-auf-Events verheiratet werden muss, was die Threads eigentlich normalerweise tun. Und das wird alles irgendwie leicht "unelegant".

Bergmann89 - Di 12.02.13 20:51

Heyho,

ich hab das Ganze jetzt mal umgesetzt. Erst hatte ich CriticalSections zum Synchronisieren drin, hab mich dann aber nochma mit Martok unterhalten und dann haben wir uns für SpinLocks entschieden, da das Projekt sehr zeitkritisch ist und wir so den ContextSwitch bei der CriticalSection umgehen können. Hier mal der entstandene Code:

Delphi-Quelltext

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:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:

unit uutlMessageThread;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, syncobjs;

type
  TutlMessage = class(TObject)
    ID: Cardinal;
    wParam: PtrInt;
    lParam: PtrInt;
    constructor Create(const aID: Cardinal; const aWParam, aLParam: PtrInt);
  end;

  TutlEventMessage = class(TutlMessage)
    Event: TEvent;
    constructor Create(const aID: Cardinal; const aWParam, aLParam: PtrInt);
    destructor Destroy; override;
  end;

  TutlMessageThread = class(TThread)
  private type
    TSingleLinkedListItem = class
      msg: TutlMessage;
      next: TSingleLinkedListItem;
    end;
  private
    fLocked: Cardinal;
    fFirst: TSingleLinkedListItem;
    fLast: TSingleLinkedListItem;
    procedure PushMsg(aMessage: TutlMessage);
    function PullMsg: TutlMessage;
    procedure ClearMessages;
    procedure LockMessages;
    procedure UnlockMessages;
  protected
    procedure ProgressMessages;
    procedure ProgressMessage(const aMessage: TutlMessage);
  public
    procedure PostMessage(const aID: Cardinal; const aWParam, aLParam: PtrInt);
    function SendMessage(const aID: Cardinal; const aWParam, aLParam: PtrInt; const aWaitTime: Cardinal = INFINITE): TWaitResult;

    constructor Create(CreateSuspended: Boolean; const StackSize: SizeUInt=DefaultStackSize);
    destructor Destroy; override;
  end;

  function utlPostMessage(const aThreadID: TThreadID; const aID: Cardinal; const aWParam, aLParam: PtrInt): Boolean;
  function utlSendMessage(const aThreadID: TThreadID; const aID: Cardinal; const aWParam, aLParam: PtrInt; const aWaitTime: Cardinal = INFINITE): TWaitResult;

implementation

uses
  uutlLogger, uutlCommonClasses;

type
  TutlMessageThreadListBase = specialize TutlKeyObjectList<TutlMessageThread, TThreadID>;
  TutlMessageThreadList = class(TutlMessageThreadListBase)
  protected
    function CompareKeys(const aKey1, aKey2: TThreadID): Integer; override;
  end;

var
  Threads: TutlMessageThreadList;

function utlPostMessage(const aThreadID: TThreadID; const aID: Cardinal;
  const aWParam, aLParam: PtrInt): Boolean;
var
  t: TutlMessageThread;
begin
  t := Threads[aThreadID];
  result := Assigned(t);
  if (result) then
    t.PostMessage(aID, aWParam, aLParam);
end;

function utlSendMessage(const aThreadID: TThreadID; const aID: Cardinal;
  const aWParam, aLParam: PtrInt; const aWaitTime: Cardinal): TWaitResult;
var
  t: TutlMessageThread;
begin
  t := Threads[aThreadID];
  if Assigned(t) then
    result := t.SendMessage(aID, aWParam, aLParam, aWaitTime)
  else
    result := wrError;
end;

function TutlMessageThreadList.CompareKeys(const aKey1, aKey2: TThreadID): Integer;
begin
  result := aKey1 - aKey2;
end;

constructor TutlMessage.Create(const aID: Cardinal; const aWParam, aLParam: PtrInt);
begin
  inherited Create;
  ID     := aID;
  wParam := aWParam;
  lParam := aLParam;
end;

constructor TutlEventMessage.Create(const aID: Cardinal; const aWParam, aLParam: PtrInt);
begin
  inherited Create(aID, aWParam, aLParam);
  Event  := TEvent.Create(nil, true, false, '');
end;

destructor TutlEventMessage.Destroy;
begin
  Event.SetEvent;
  FreeAndNil(Event);
  inherited Destroy;
end;

procedure TutlMessageThread.PushMsg(aMessage: TutlMessage);
begin
  LockMessages;
  try
    if not Assigned(fLast) then
      exit;
    fLast.next := TSingleLinkedListItem.Create;
    fLast.next.msg := aMessage;
    fLast := fLast.next;
  finally
    UnlockMessages;
  end;
end;

function TutlMessageThread.PullMsg: TutlMessage;
var
  old: TSingleLinkedListItem;
begin
  result := nil;
  LockMessages;
  try
    if not Assigned(fFirst) then
      exit;
    if Assigned(fFirst.next) then begin
      old := fFirst;
      fFirst := old.next;
      result := fFirst.msg;
      old.Free;
    end;
  finally
    UnlockMessages;
  end;
end;

procedure TutlMessageThread.ClearMessages;
var
  m: TutlMessage;
begin
  repeat
    m := PullMsg;
    if Assigned(m) then
      m.Free;
  until not Assigned(m);
end;

procedure TutlMessageThread.LockMessages;
var
  lock: Cardinal;
begin
  //SpinLock
  repeat
    lock := InterLockedExchange(fLocked, 1);
  until (lock = 0);
end;

procedure TutlMessageThread.UnlockMessages;
begin
  InterLockedExchange(fLocked, 0);
end;

procedure TutlMessageThread.ProgressMessages;
var
  i: Integer;
  m: TutlMessage;
begin
  repeat
    try
      m := PullMsg;
      if Assigned(m) then begin
        ProgressMessage(m);
        m.Free;
      end;
    except
      on e: Exception do begin
        utlLogger.Error(self, 'error while progressing message %s(ID: %d; wParam: %s; lParam: %s): %s - %s', [
          m.ClassName,
          m.ID,
          IntToHex(m.wParam, SizeOf(m.wParam) div 4),
          IntToHex(m.wParam, SizeOf(m.wParam) div 4),
          e.ClassName,
          e.Message]);
      end;
    end;
  until not Assigned(m);
end;

procedure TutlMessageThread.ProgressMessage(const aMessage: TutlMessage);
begin
//DUMMY
end;

procedure TutlMessageThread.PostMessage(const aID: Cardinal; const aWParam, aLParam: PtrInt);
var
  m: TutlMessage;
begin
  m := TutlMessage.Create(aID, aWParam, aLParam);
  PushMsg(m);
end;

function TutlMessageThread.SendMessage(const aID: Cardinal; const aWParam, aLParam: PtrInt;
  const aWaitTime: Cardinal): TWaitResult;
var
  m: TutlEventMessage;
begin
  m := TutlEventMessage.Create(aID, aWParam, aLParam);
  PushMsg(m);
  result := m.Event.WaitFor(aWaitTime);
end;

constructor TutlMessageThread.Create(CreateSuspended: Boolean; const StackSize: SizeUInt);
begin
  inherited Create(CreateSuspended, StackSize);
  fFirst     := TSingleLinkedListItem.Create;
  fLast      := fFirst;
  Threads.Add(ThreadID, self);
end;

destructor TutlMessageThread.Destroy;
begin
  Threads.Delete(ThreadID);
  LockMessages;
  try
    ClearMessages;
    FreeAndNil(fFirst);
    fLast := nil;
  finally
    UnlockMessages;
  end;
  inherited Destroy;
end;

initialization
  Threads := TutlMessageThreadList.Create(false);

finalization
  while Threads.Count > 0 do
    Threads.ItemsByID(Threads.Count-1).Free;
  FreeAndNil(Threads);

end.

Sieht da vlt jmd Probleme, hat Verbesserungsvorschläge oder Anmerkungen? Wir sind für jeden Tipp dankbar :)

MfG Bergmann