1{
2
3    libasync: Asynchronous event management
4    Copyright (C) 2001-2002 by
5      Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
6
7    Common implementation
8
9    See the file COPYING.FPC, included in this distribution,
10    for details about the copyright.
11
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15}
16
17type
18  PTimerData = ^TTimerData;
19  TTimerData = record
20    Next: PTimerData;
21    MSec: LongInt;
22    NextTick: Int64;
23    Callback: TAsyncCallback;
24    UserData: Pointer;
25    Periodic: Boolean;
26  end;
27
28  TCallbackTypes = set of (cbRead, cbWrite);
29
30
31{ An implementation unit has to implement the following fordward procedures,
32  and additionally asyncGetTicks }
33
34procedure InternalInit(Handle: TAsyncHandle); forward;
35
36procedure InternalFree(Handle: TAsyncHandle); forward;
37
38procedure InternalRun(Handle: TAsyncHandle; TimeOut: Int64); forward;
39
40procedure InternalInitIOCallback(Handle: TAsyncHandle; Data: PIOCallbackData;
41  InitData: Boolean; CallbackTypes: TCallbackTypes); forward;
42
43procedure InternalClearIOCallback(Handle: TAsyncHandle; IOHandle: LongInt;
44  CallbackTypes: TCallbackTypes); forward;
45
46
47
48function InitIOCallback(Handle: TAsyncHandle; IOHandle: LongInt;
49  ARead: Boolean; ReadCallback: TAsyncCallback; ReadUserData: Pointer;
50  AWrite: Boolean; WriteCallback: TAsyncCallback; WriteUserData: Pointer):
51  TAsyncResult;
52var
53  Data: PIOCallbackData;
54  NeedData: Boolean;
55  CallbackTypes: TCallbackTypes;
56begin
57  if (IOHandle < 0) or (IOHandle > MaxHandle) then
58  begin
59    Result := asyncInvalidFileHandle;
60    exit;
61  end;
62
63  NeedData := True;
64  Data := Handle^.Data.FirstIOCallback;
65  while Assigned(Data) do
66  begin
67    if Data^.IOHandle = IOHandle then
68    begin
69      if ARead then
70      begin
71        if Assigned(Data^.ReadCallback) then
72        begin
73          Result := asyncHandlerAlreadySet;
74          exit;
75        end;
76        Data^.ReadCallback := ReadCallback;
77        Data^.ReadUserData := ReadUserData;
78      end;
79      if AWrite then
80      begin
81        if Assigned(Data^.WriteCallback) then
82        begin
83          Result := asyncHandlerAlreadySet;
84          exit;
85        end;
86        Data^.WriteCallback := WriteCallback;
87        Data^.WriteUserData := WriteUserData;
88      end;
89      NeedData := False;
90      break;
91    end;
92    Data := Data^.Next;
93  end;
94
95  if NeedData then
96  begin
97    New(Data);
98    Data^.Next := Handle^.Data.FirstIOCallback;
99    Handle^.Data.FirstIOCallback := Data;
100    Data^.IOHandle := IOHandle;
101    if ARead then
102    begin
103      Data^.ReadCallback := ReadCallback;
104      Data^.ReadUserData := ReadUserData;
105    end else
106      Data^.ReadCallback := nil;
107    if AWrite then
108    begin
109      Data^.WriteCallback := WriteCallback;
110      Data^.WriteUserData := WriteUserData;
111    end else
112      Data^.WriteCallback := nil;
113  end;
114
115  CallbackTypes := [];
116  if ARead then
117    CallbackTypes := [cbRead];
118  if AWrite then
119    CallbackTypes := CallbackTypes + [cbWrite];
120  InternalInitIOCallback(Handle, Data, NeedData, CallbackTypes);
121
122  Handle^.Data.HasCallbacks := True;
123  Result := asyncOK;
124end;
125
126procedure CheckForCallbacks(Handle: TAsyncHandle);
127begin
128  if (Handle^.Data.HasCallbacks) and
129    (not Assigned(Handle^.Data.FirstIOCallback)) and
130    (not Assigned(Handle^.Data.FirstTimer)) then
131    Handle^.Data.HasCallbacks := False;
132end;
133
134
135procedure asyncInit(Handle: TAsyncHandle); cdecl;
136begin
137  InternalInit(Handle);
138end;
139
140procedure asyncFree(Handle: TAsyncHandle); cdecl;
141var
142  Timer, NextTimer: PTimerData;
143  IOCallback, NextIOCallback: PIOCallbackData;
144begin
145  InternalFree(Handle);
146
147  Timer := PTimerData(Handle^.Data.FirstTimer);
148  while Assigned(Timer) do
149  begin
150    NextTimer := Timer^.Next;
151    Dispose(Timer);
152    Timer := NextTimer;
153  end;
154
155  IOCallback := PIOCallbackData(Handle^.Data.FirstIOCallback);
156  while Assigned(IOCallback) do
157  begin
158    NextIOCallback := IOCallback^.Next;
159    Dispose(IOCallback);
160    IOCallback := NextIOCallback;
161  end;
162
163  Handle^.Data.NextIOCallback := nil;
164end;
165
166procedure asyncRun(Handle: TAsyncHandle); cdecl;
167var
168  Timer, NextTimer: PTimerData;
169  TimeOut, CurTime, NextTick: Int64;
170begin
171  if Handle^.Data.IsRunning then
172    exit;
173
174  Handle^.Data.DoBreak := False;
175  Handle^.Data.IsRunning := True;
176
177  // Prepare timers
178  if Assigned(Handle^.Data.FirstTimer) then
179  begin
180    CurTime := asyncGetTicks;
181    Timer := Handle^.Data.FirstTimer;
182    while Assigned(Timer) do
183    begin
184      Timer^.NextTick := CurTime + Timer^.MSec;
185      Timer := Timer^.Next;
186    end;
187  end;
188
189  while (not Handle^.Data.DoBreak) and Handle^.Data.HasCallbacks do
190  begin
191    Timer := Handle^.Data.FirstTimer;
192    if Assigned(Handle^.Data.FirstTimer) then
193    begin
194      // Determine when the next timer tick will happen
195      CurTime := asyncGetTicks;
196      NextTick := High(Int64);
197      Timer := Handle^.Data.FirstTimer;
198      while Assigned(Timer) do
199      begin
200        if Timer^.NextTick < NextTick then
201          NextTick := Timer^.NextTick;
202        Timer := Timer^.Next;
203      end;
204      TimeOut := NextTick - CurTime;
205      if TimeOut < 0 then
206        TimeOut := 0;
207    end else
208      TimeOut := -1;
209
210    InternalRun(Handle, TimeOut);
211
212    {if Handle^.Data.HighestHandle >= 0 then
213    begin
214      CurReadFDSet := PFDSet(Handle^.Data.FDData)[0];
215      CurWriteFDSet := PFDSet(Handle^.Data.FDData)[1];
216      AsyncResult := Select(Handle^.Data.HighestHandle + 1,
217        @CurReadFDSet, @CurWriteFDSet, nil, TimeOut);
218    end else
219      AsyncResult := Select(0, nil, nil, nil, TimeOut);
220
221    if (AsyncResult > 0) and not Handle^.Data.DoBreak then
222    begin
223      // Check for I/O events
224      Handle^.Data.CurIOCallback := Handle^.Data.FirstIOCallback;
225      while Assigned(Handle^.Data.CurIOCallback) do
226      begin
227        CurIOCallback := PIOCallbackData(Handle^.Data.CurIOCallback);
228        Handle^.Data.NextIOCallback := CurIOCallback^.Next;
229        if FD_IsSet(CurIOCallback^.IOHandle, CurReadFDSet) and
230          FD_IsSet(CurIOCallback^.IOHandle, PFDSet(Handle^.Data.FDData)[0]) and
231          Assigned(CurIOCallback^.ReadCallback) then
232        begin
233          CurIOCallback^.ReadCallback(CurIOCallback^.ReadUserData);
234          if Handle^.Data.DoBreak then
235            break;
236        end;
237
238        CurIOCallback := PIOCallbackData(Handle^.Data.CurIOCallback);
239        if Assigned(CurIOCallback) and
240          FD_IsSet(CurIOCallback^.IOHandle, CurWriteFDSet) and
241          FD_IsSet(CurIOCallback^.IOHandle, PFDSet(Handle^.Data.FDData)[1]) and
242          Assigned(CurIOCallback^.WriteCallback) then
243        begin
244          CurIOCallback^.WriteCallback(CurIOCallback^.WriteUserData);
245          if Handle^.Data.DoBreak then
246            break;
247        end;
248
249        Handle^.Data.CurIOCallback := Handle^.Data.NextIOCallback;
250      end;
251    end;}
252
253    if Assigned(Handle^.Data.FirstTimer) then
254    begin
255      // Check for triggered timers
256      CurTime := asyncGetTicks;
257      Timer := Handle^.Data.FirstTimer;
258      while Assigned(Timer) do
259      begin
260        if Timer^.NextTick <= CurTime then
261        begin
262          Timer^.Callback(Timer^.UserData);
263          NextTimer := Timer^.Next;
264          if Timer^.Periodic then
265            Inc(Timer^.NextTick, Timer^.MSec)
266          else
267            asyncRemoveTimer(Handle, Timer);
268          if Handle^.Data.DoBreak then
269            break;
270          Timer := NextTimer;
271        end else
272          Timer := Timer^.Next;
273      end;
274    end;
275
276  end;
277  Handle^.Data.CurIOCallback := nil;
278  Handle^.Data.NextIOCallback := nil;
279  Handle^.Data.IsRunning := False;
280end;
281
282procedure asyncBreak(Handle: TAsyncHandle); cdecl;
283begin
284  Handle^.Data.DoBreak := True;
285end;
286
287function asyncIsRunning(Handle: TAsyncHandle): Boolean; cdecl;
288begin
289  Result := Handle^.Data.IsRunning;
290end;
291
292function asyncAddTimer(
293  Handle: TAsyncHandle;
294  MSec: LongInt;
295  Periodic: Boolean;
296  Callback: TAsyncCallback;
297  UserData: Pointer
298  ): TAsyncTimer; cdecl;
299var
300  Data: PTimerData;
301begin
302  if not Assigned(Callback) then
303    exit;
304
305  New(Data);
306  Result := Data;
307  Data^.Next := Handle^.Data.FirstTimer;
308  Handle^.Data.FirstTimer := Data;
309  Data^.MSec := MSec;
310  Data^.Periodic := Periodic;
311  Data^.Callback := Callback;
312  Data^.UserData := UserData;
313  if Handle^.Data.IsRunning then
314    Data^.NextTick := asyncGetTicks + MSec;
315
316  Handle^.Data.HasCallbacks := True;
317end;
318
319procedure asyncRemoveTimer(
320  Handle: TAsyncHandle;
321  Timer: TASyncTimer); cdecl;
322var
323  Data, CurData, PrevData, NextData: PTimerData;
324begin
325  Data := PTimerData(Timer);
326  CurData := Handle^.Data.FirstTimer;
327  PrevData := nil;
328  while Assigned(CurData) do
329  begin
330    NextData := CurData^.Next;
331    if CurData = Data then
332    begin
333      if Assigned(PrevData) then
334        PrevData^.Next := NextData
335      else
336        Handle^.Data.FirstTimer := NextData;
337      break;
338    end;
339    PrevData := CurData;
340    CurData := NextData;
341  end;
342  Dispose(Data);
343  CheckForCallbacks(Handle);
344end;
345
346function asyncSetIOCallback(
347  Handle: TAsyncHandle;
348  IOHandle: LongInt;
349  Callback: TAsyncCallback;
350  UserData: Pointer): TAsyncResult; cdecl;
351begin
352  Result := InitIOCallback(Handle, IOHandle, True, Callback, UserData,
353    True, Callback, UserData);
354end;
355
356procedure asyncClearIOCallback(Handle: TAsyncHandle;
357  IOHandle: LongInt); cdecl;
358var
359  CurData, PrevData, NextData: PIOCallbackData;
360begin
361  CurData := Handle^.Data.FirstIOCallback;
362  PrevData := nil;
363  while Assigned(CurData) do
364  begin
365    NextData := CurData^.Next;
366    if CurData^.IOHandle = IOHandle then
367    begin
368      if Handle^.Data.CurIOCallback = CurData then
369        Handle^.Data.CurIOCallback := nil;
370      if Handle^.Data.NextIOCallback = CurData then
371        Handle^.Data.NextIOCallback := NextData;
372
373      InternalClearIOCallback(Handle, IOHandle, [cbRead, cbWrite]);
374
375      if Assigned(PrevData) then
376        PrevData^.Next := NextData
377      else
378        Handle^.Data.FirstIOCallback := NextData;
379      Dispose(CurData);
380      break;
381    end;
382    PrevData := CurData;
383    CurData := NextData;
384  end;
385  CheckForCallbacks(Handle);
386end;
387
388function asyncSetDataAvailableCallback(
389  Handle: TAsyncHandle;
390  IOHandle: LongInt;
391  Callback: TAsyncCallback;
392  UserData: Pointer): TAsyncResult; cdecl;
393begin
394  Result := InitIOCallback(Handle, IOHandle, True, Callback, UserData, False,
395    nil, nil);
396end;
397
398procedure asyncClearDataAvailableCallback(Handle: TAsyncHandle;
399  IOHandle: LongInt); cdecl;
400var
401  CurData, PrevData, NextData: PIOCallbackData;
402begin
403  CurData := Handle^.Data.FirstIOCallback;
404  PrevData := nil;
405  while Assigned(CurData) do
406  begin
407    NextData := CurData^.Next;
408    if CurData^.IOHandle = IOHandle then
409    begin
410      if Handle^.Data.CurIOCallback = CurData then
411        Handle^.Data.CurIOCallback := nil;
412      if Handle^.Data.NextIOCallback = CurData then
413        Handle^.Data.NextIOCallback := NextData;
414
415      InternalClearIOCallback(Handle, IOHandle, [cbRead]);
416
417      if Assigned(CurData^.WriteCallback) then
418        CurData^.ReadCallback := nil
419      else
420      begin
421        if Assigned(PrevData) then
422          PrevData^.Next := NextData
423        else
424          Handle^.Data.FirstIOCallback := NextData;
425        Dispose(CurData);
426      end;
427      break;
428    end;
429    PrevData := CurData;
430    CurData := NextData;
431  end;
432  CheckForCallbacks(Handle);
433end;
434
435function asyncSetCanWriteCallback(
436  Handle: TAsyncHandle;
437  IOHandle: LongInt;
438  Callback: TAsyncCallback;
439  UserData: Pointer): TAsyncResult; cdecl;
440begin
441  Result := InitIOCallback(Handle, IOHandle, False, nil, nil, True,
442    Callback, UserData);
443end;
444
445procedure asyncClearCanWriteCallback(Handle: TAsyncHandle;
446  IOHandle: LongInt); cdecl;
447var
448  CurData, PrevData, NextData: PIOCallbackData;
449begin
450  CurData := Handle^.Data.FirstIOCallback;
451  PrevData := nil;
452  while Assigned(CurData) do
453  begin
454    NextData := CurData^.Next;
455    if CurData^.IOHandle = IOHandle then
456    begin
457      if Handle^.Data.CurIOCallback = CurData then
458        Handle^.Data.CurIOCallback := nil;
459      if Handle^.Data.NextIOCallback = CurData then
460        Handle^.Data.NextIOCallback := NextData;
461
462      InternalClearIOCallback(Handle, IOHandle, [cbWrite]);
463
464      if Assigned(CurData^.ReadCallback) then
465        CurData^.WriteCallback := nil
466      else
467      begin
468        if Assigned(PrevData) then
469          PrevData^.Next := NextData
470        else
471          Handle^.Data.FirstIOCallback := NextData;
472        Dispose(CurData);
473      end;
474      break;
475    end;
476    PrevData := CurData;
477    CurData := NextData;
478  end;
479  CheckForCallbacks(Handle);
480end;
481
482
483