1{
2
3    libasync: Asynchronous event management
4    Copyright (C) 2001-2002 by
5      Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
6
7    Unix 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
17unit libasync;
18
19{$MODE objfpc}
20
21interface
22
23type
24
25  TAsyncData = record
26    IsRunning, DoBreak: Boolean;
27    HasCallbacks: Boolean;      // True as long as callbacks are set
28    FirstTimer: Pointer;
29    FirstIOCallback: Pointer;
30    CurIOCallback: Pointer;     // current callback being processed within 'run'
31    NextIOCallback: Pointer;    // next callback to get processed within 'run'
32    FDData: Pointer;
33    HighestHandle: LongInt;
34  end;
35
36{$INCLUDE libasynch.inc}
37
38
39
40implementation
41
42uses unixtype, baseunix, Unix;
43
44const
45  MaxHandle = SizeOf(TFDSet) * 8 - 1;
46
47type
48  PIOCallbackData = ^TIOCallbackData;
49  TIOCallbackData = record
50    Next: PIOCallbackData;
51    IOHandle: LongInt;
52    ReadCallback, WriteCallback: TAsyncCallback;
53    ReadUserData, WriteUserData: Pointer;
54    SavedHandleFlags: LongInt;
55  end;
56
57{$INCLUDE libasync.inc}
58
59
60
61procedure InternalInit(Handle: TAsyncHandle);
62begin
63  Handle^.Data.HighestHandle := -1;
64end;
65
66procedure InternalFree(Handle: TAsyncHandle);
67var
68  IOCallback: PIOCallbackData;
69begin
70  IOCallback := PIOCallbackData(Handle^.Data.FirstIOCallback);
71  while Assigned(IOCallback) do
72  begin
73    if (IOCallback^.SavedHandleFlags and Open_NonBlock) = 0 then
74      fpfcntl(IOCallback^.IOHandle, F_SetFl, IOCallback^.SavedHandleFlags);
75    IOCallback := IOCallback^.Next;
76  end;
77
78  if Assigned(Handle^.Data.FDData) then
79    FreeMem(Handle^.Data.FDData);
80end;
81
82procedure InternalRun(Handle: TAsyncHandle; TimeOut: Int64);
83var
84  AsyncResult: Integer;
85  CurReadFDSet, CurWriteFDSet: TFDSet;
86  CurIOCallback: PIOCallbackData;
87begin
88  if Handle^.Data.HighestHandle < 0 then
89    begin
90      // No I/O checks to do, so just wait...
91      repeat
92        AsyncResult := fpselect(0, nil, nil, nil, TimeOut)
93      until (AsyncResult<>-1) or (fpgeterrno<>ESysEINTR);
94    end
95  else
96  begin
97    CurReadFDSet := PFDSet(Handle^.Data.FDData)[0];
98    CurWriteFDSet := PFDSet(Handle^.Data.FDData)[1];
99    repeat
100      AsyncResult := fpselect(Handle^.Data.HighestHandle + 1,
101        @CurReadFDSet, @CurWriteFDSet, nil, TimeOut);
102    until (AsyncResult<>-1) or (fpgeterrno<>ESysEINTR);
103
104    if AsyncResult > 0 then
105    begin
106      // Check for I/O events
107      Handle^.Data.CurIOCallback := Handle^.Data.FirstIOCallback;
108      while Assigned(Handle^.Data.CurIOCallback) do
109      begin
110        CurIOCallback := PIOCallbackData(Handle^.Data.CurIOCallback);
111        Handle^.Data.NextIOCallback := CurIOCallback^.Next;
112        if (fpFD_ISSET(CurIOCallback^.IOHandle,CurReadFDSet) > 0) and
113           (fpFD_ISSET(CurIOCallback^.IOHandle, PFDSet(Handle^.Data.FDData)[0]) > 0) and
114          Assigned(CurIOCallback^.ReadCallback) then
115        begin
116          CurIOCallback^.ReadCallback(CurIOCallback^.ReadUserData);
117          if Handle^.Data.DoBreak then
118            break;
119        end;
120
121        CurIOCallback := PIOCallbackData(Handle^.Data.CurIOCallback);
122        if Assigned(CurIOCallback) and
123           (fpFD_ISSET(CurIOCallback^.IOHandle, CurWriteFDSet) > 0) and
124           (fpFD_ISSET(CurIOCallback^.IOHandle, PFDSet(Handle^.Data.FDData)[1]) > 0) and
125          Assigned(CurIOCallback^.WriteCallback) then
126        begin
127          CurIOCallback^.WriteCallback(CurIOCallback^.WriteUserData);
128          if Handle^.Data.DoBreak then
129            break;
130        end;
131
132        Handle^.Data.CurIOCallback := Handle^.Data.NextIOCallback;
133      end;
134    end;
135  end;
136end;
137
138procedure InternalInitIOCallback(Handle: TAsyncHandle; Data: PIOCallbackData;
139  InitData: Boolean; CallbackTypes: TCallbackTypes);
140var
141  i: LongInt;
142begin
143  if InitData then
144  begin
145    if not Assigned(Handle^.Data.FDData) then
146    begin
147      GetMem(Handle^.Data.FDData, SizeOf(TFDSet) * 2);
148      fpFD_ZERO(PFDSet(Handle^.Data.FDData)[0]);
149      fpFD_ZERO(PFDSet(Handle^.Data.FDData)[1]);
150    end;
151    if Data^.IOHandle > Handle^.Data.HighestHandle then
152      Handle^.Data.HighestHandle := Data^.IOHandle;
153  end;
154
155  Data^.SavedHandleFlags := fpfcntl(Data^.IOHandle, F_GetFl);
156  fpfcntl(Data^.IOHandle, F_SetFl, Data^.SavedHandleFlags or Open_NonBlock);
157
158  case Data^.IOHandle of
159    StdInputHandle:
160      i := Open_RdOnly;
161    StdOutputHandle, StdErrorHandle:
162      i := Open_WrOnly;
163    else
164      i := Data^.SavedHandleFlags and Open_Accmode;
165  end;
166
167  case i of
168    Open_RdOnly:
169      if cbRead in CallbackTypes then
170        fpFD_SET(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[0]);
171    Open_WrOnly:
172      if cbWrite in CallbackTypes then
173        fpFD_SET(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[1]);
174    Open_RdWr:
175      begin
176        if cbRead in CallbackTypes then
177          fpFD_SET(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[0]);
178        if cbWrite in CallbackTypes then
179          fpFD_SET(Data^.IOHandle, PFDSet(Handle^.Data.FDData)[1]);
180      end;
181  end;
182end;
183
184procedure InternalClearIOCallback(Handle: TAsyncHandle; IOHandle: LongInt;
185  CallbackTypes: TCallbackTypes);
186begin
187  if not Assigned(Handle) then
188    exit;
189
190  if cbRead in CallbackTypes then
191    fpFD_CLR(IOHandle, PFDSet(Handle^.Data.FDData)[0]);
192  if cbWrite in CallbackTypes then
193    fpFD_CLR(IOHandle, PFDSet(Handle^.Data.FDData)[1]);
194end;
195
196function asyncGetTicks: Int64; cdecl;
197var
198  Time: TimeVal;
199begin
200  fpGetTimeOfDay(@time,nil);
201  Result := Int64(Time.tv_Sec) * 1000 + Int64(Time.tv_USec div 1000);
202end;
203
204
205end.
206