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