IdFiberWeaverThreaded.pas 3.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 56072: IdFiberWeaverThreaded.pas
  11. {
  12. Rev 1.4 6/11/2004 8:39:56 AM DSiders
  13. Added "Do not Localize" comments.
  14. }
  15. {
  16. { Rev 1.3 2004-04-23 19:46:52 Mattias
  17. { TTempThread now uses WaitForFibers instead of sleep
  18. }
  19. {
  20. { Rev 1.2 2004.04.22 11:45:18 PM czhower
  21. { Bug fixes
  22. }
  23. {
  24. { Rev 1.1 2004.02.09 9:16:40 PM czhower
  25. { Updated to compile and match lib changes.
  26. }
  27. {
  28. { Rev 1.0 2004.02.03 12:38:54 AM czhower
  29. { Move
  30. }
  31. {
  32. { Rev 1.2 2003.10.21 12:19:22 AM czhower
  33. { TIdTask support and fiber bug fixes.
  34. }
  35. {
  36. { Rev 1.1 2003.10.19 4:38:32 PM czhower
  37. { Updates
  38. }
  39. unit IdFiberWeaverThreaded;
  40. interface
  41. uses
  42. Classes,
  43. IdFiberWeaverInline,
  44. IdThread, IdSchedulerOfThread, IdFiberWeaver, IdFiber;
  45. type
  46. TTempThread = class(TIdThread)
  47. protected
  48. FFiberWeaver: TIdFiberWeaverInline;
  49. //
  50. procedure AfterRun; override;
  51. procedure BeforeRun; override;
  52. procedure Run; override;
  53. end;
  54. TIdFiberWeaverThreaded = class(TIdFiberWeaver)
  55. protected
  56. FThreadScheduler: TIdSchedulerOfThread;
  57. FTempThread: TTempThread;
  58. //
  59. procedure InitComponent; override;
  60. public
  61. procedure Add(
  62. AFiber: TIdFiber
  63. ); override;
  64. destructor Destroy;
  65. override;
  66. published
  67. property ThreadScheduler: TIdSchedulerOfThread read FThreadScheduler
  68. write FThreadScheduler;
  69. end;
  70. implementation
  71. uses
  72. SysUtils;
  73. { TTempThread }
  74. procedure TTempThread.AfterRun;
  75. begin
  76. inherited;
  77. FreeAndNil(FFiberWeaver);
  78. end;
  79. procedure TTempThread.BeforeRun;
  80. begin
  81. inherited;
  82. //TODO: Make this pluggable at run time? depends where threads come
  83. //from - merge to scheduler? Base is in IdFiber though....
  84. FFiberWeaver := TIdFiberWeaverInline.Create(nil);
  85. FFiberWeaver.FreeFibersOnCompletion := True;
  86. end;
  87. procedure TTempThread.Run;
  88. begin
  89. //TODO: Temp hack
  90. if FFiberWeaver.HasFibers then begin
  91. FFiberWeaver.ProcessInThisThread;
  92. end else begin
  93. //Sleep(50);
  94. FFiberWeaver.WaitForFibers(50);
  95. end;
  96. end;
  97. { TIdFiberWeaverThreaded }
  98. procedure TIdFiberWeaverThreaded.Add(AFiber: TIdFiber);
  99. begin
  100. FTempThread.FFiberWeaver.Add(AFiber);
  101. end;
  102. destructor TIdFiberWeaverThreaded.Destroy;
  103. begin
  104. // is only created at run time
  105. if FTempThread <> nil then begin
  106. FTempThread.TerminateAndWaitFor;
  107. FreeAndNil(FTempThread);
  108. end;
  109. inherited;
  110. end;
  111. procedure TIdFiberWeaverThreaded.InitComponent;
  112. begin
  113. inherited;
  114. if not (csDesigning in ComponentState) then begin
  115. FTempThread := TTempThread.Create(False, True, 'TIdSchedulerOfFiber Temp'); {do not localize}
  116. end;
  117. end;
  118. end.