IdThread.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.34 03/16/05 10:29:40 AM JSouthwell
  18. Added a default thread name to ease debugging of IdThreads.
  19. Rev 1.33 1/15/05 1:52:36 PM RLebeau
  20. Extra cleanup handling for the FYarn member
  21. Rev 1.32 1/6/2005 10:02:58 PM JPMugaas
  22. This should compile.
  23. Rev 1.31 1/6/05 2:33:04 PM RLebeau
  24. one more try...finally block, for Before/AfterExecute()
  25. Rev 1.29 1/5/05 5:31:08 PM RLebeau
  26. Added extra try..finally block to Execute() to free the FYarn member.
  27. Rev 1.28 6/9/2004 10:38:46 PM DSiders
  28. Fixed case for TIdNotifyThreadEvent.
  29. Rev 1.27 3/12/2004 7:11:02 PM BGooijen
  30. Changed order of commands for dotnet
  31. Rev 1.26 2004.03.01 5:12:44 PM czhower
  32. -Bug fix for shutdown of servers when connections still existed (AV)
  33. -Implicit HELP support in CMDserver
  34. -Several command handler bugs
  35. -Additional command handler functionality.
  36. Rev 1.25 2004.02.03 4:17:00 PM czhower
  37. For unit name changes.
  38. Rev 1.24 2004.01.22 5:59:12 PM czhower
  39. IdCriticalSection
  40. Rev 1.23 2003.12.28 2:33:16 PM czhower
  41. .Net finalization fix.
  42. Rev 1.22 2003.12.28 1:27:46 PM czhower
  43. .Net compatibility
  44. Rev 1.21 2003.10.24 12:59:20 PM czhower
  45. Name change
  46. Rev 1.20 2003.10.21 12:19:04 AM czhower
  47. TIdTask support and fiber bug fixes.
  48. Rev 1.19 10/15/2003 8:40:48 PM DSiders
  49. Added locaization comments.
  50. Rev 1.18 10/5/2003 3:19:58 PM BGooijen
  51. disabled some stuff for DotNet
  52. Rev 1.17 2003.09.19 10:11:22 PM czhower
  53. Next stage of fiber support in servers.
  54. Rev 1.14 2003.09.19 11:54:36 AM czhower
  55. -Completed more features necessary for servers
  56. -Fixed some bugs
  57. Rev 1.13 2003.09.18 4:43:18 PM czhower
  58. -Removed IdBaseThread
  59. -Threads now have default names
  60. Rev 1.12 12.9.2003 ã. 16:42:08 DBondzhev
  61. Fixed AV when exception is raised in BeforeRun and thread is terminated
  62. before Start is compleated
  63. Rev 1.11 2003.07.08 2:41:52 PM czhower
  64. Avoid calling SetThreadName if we do not need to
  65. Rev 1.10 08.07.2003 13:16:18 ARybin
  66. tiny opt fix
  67. Rev 1.9 7/1/2003 7:11:30 PM BGooijen
  68. Added comment
  69. Rev 1.8 2003.07.01 4:14:58 PM czhower
  70. Consolidation.
  71. Added Name, Loop
  72. Rev 1.7 04.06.2003 14:06:20 ARybin
  73. bug fix & limited waiting
  74. Rev 1.6 28.05.2003 14:16:16 ARybin
  75. WaitAllThreadsTerminated class method
  76. Rev 1.5 08.05.2003 12:45:10 ARybin
  77. "be sure" fix
  78. Rev 1.4 4/30/2003 4:53:26 PM BGooijen
  79. Fixed bug in Kylix where GThreadCount was not decremented
  80. Rev 1.3 4/22/2003 4:44:06 PM BGooijen
  81. changed Handle to ThreadID
  82. Rev 1.2 3/22/2003 12:53:26 PM BGooijen
  83. - Exceptions in the constructor are now handled better.
  84. - GThreadCount can't become negative anymore
  85. Rev 1.1 06.03.2003 11:54:24 ARybin
  86. TIdThreadOptions: is thread Data owner, smart Cleanup
  87. Rev 1.0 11/13/2002 09:01:14 AM JPMugaas
  88. 2002-03-12 -Andrew P.Rybin
  89. -TerminatingExceptionClass, etc.
  90. 2002-06-20 -Andrew P.Rybin
  91. -"Terminated Start" bug fix (FLock.Leave AV)
  92. -Wait All threads termination in FINALIZATION (prevent AV in WinSock)
  93. -HandleRunException
  94. 2003-01-27 -Andrew P.Rybin
  95. -TIdThreadOptions
  96. }
  97. unit IdThread;
  98. {
  99. 2002-03-12 -Andrew P.Rybin
  100. -TerminatingExceptionClass, etc.
  101. 2002-06-20 -Andrew P.Rybin
  102. -"Terminated Start" bug fix (FLock.Leave AV)
  103. -Wait All threads termination in FINALIZATION (prevent AV in WinSock)
  104. -HandleRunException
  105. 2003-01-27 -Andrew P.Rybin
  106. -TIdThreadOptions
  107. }
  108. interface
  109. {$I IdCompilerDefines.inc}
  110. // RLebeau: On OSX/iOS, an auto-release object pool should be used to clean up
  111. // Objective-C objects that are created within a thread. On Android, any thread
  112. // that uses Java objects will attach to the JVM and must be detached from the
  113. // JVM before terminating.
  114. //
  115. // All objects must be released before terminating/detaching the thread.
  116. //
  117. // This problem was fixed in TThread in RAD Studio XE6.
  118. //
  119. {$UNDEF PLATFORM_CLEANUP_NEEDED}
  120. {$IFDEF DCC}
  121. {$IFNDEF VCL_XE6_OR_ABOVE}
  122. {$IFDEF MACOS}
  123. {$DEFINE PLATFORM_CLEANUP_NEEDED}
  124. {$ENDIF MACOS}
  125. {$IFDEF ANDROID}
  126. {$DEFINE PLATFORM_CLEANUP_NEEDED}
  127. {$ENDIF}
  128. {$ENDIF}
  129. {$ELSE}
  130. // TODO: Does this need to be applied to FreePascal?
  131. {$ENDIF}
  132. uses
  133. Classes,
  134. IdGlobal, IdException, IdYarn, IdTask, IdThreadSafe, SysUtils;
  135. const
  136. IdWaitAllThreadsTerminatedCount = 1 * 60 * 1000;
  137. IdWaitAllThreadsTerminatedStep = 250;
  138. type
  139. EIdThreadException = class(EIdException);
  140. EIdThreadTerminateAndWaitFor = class(EIdThreadException);
  141. TIdThreadStopMode = (smTerminate, smSuspend);
  142. TIdThread = class;
  143. TIdExceptionThreadEvent = procedure(AThread: TIdThread; AException: Exception) of object;
  144. TIdNotifyThreadEvent = procedure(AThread: TIdThread) of object;
  145. TIdSynchronizeThreadEvent = procedure(AThread: TIdThread; AData: Pointer) of object;
  146. // Note: itoDataOwner doesn't make sense in DCC nextgen when AutoRefCounting is enabled...
  147. TIdThreadOption = (itoStopped, itoReqCleanup, itoDataOwner, itoTag);
  148. TIdThreadOptions = set of TIdThreadOption;
  149. TIdThread = class(TThread)
  150. protected
  151. {$IFDEF USE_OBJECT_ARC}
  152. // When ARC is enabled, object references MUST be valid objects.
  153. // It is common for users to store non-object values, though, so
  154. // we will provide separate properties for those purposes
  155. //
  156. // TODO; use TValue instead of separating them
  157. //
  158. FDataObject: TObject;
  159. FDataValue: PtrInt;
  160. {$ELSE}
  161. FData: TObject;
  162. {$ENDIF}
  163. FLock: TIdCriticalSection;
  164. FLoop: Boolean;
  165. FName: string;
  166. FStopMode: TIdThreadStopMode;
  167. FOptions: TIdThreadOptions;
  168. FTerminatingException: String;
  169. FTerminatingExceptionClass: TClass;
  170. FYarn: TIdYarn;
  171. //
  172. FOnException: TIdExceptionThreadEvent;
  173. FOnStopped: TIdNotifyThreadEvent;
  174. //
  175. {$IFDEF PLATFORM_CLEANUP_NEEDED}
  176. {$IFDEF MACOS}
  177. FObjCPool: Pointer;
  178. {$ENDIF}
  179. {$ENDIF}
  180. procedure AfterRun; virtual; //3* not abstract - otherwise it is required
  181. procedure AfterExecute; virtual;//5 not abstract - otherwise it is required
  182. procedure BeforeExecute; virtual;//1 not abstract - otherwise it is required
  183. procedure BeforeRun; virtual; //2* not abstract - otherwise it is required
  184. procedure Cleanup; virtual;//4*
  185. procedure DoException(AException: Exception); virtual;
  186. procedure DoStopped; virtual;
  187. procedure Execute; override;
  188. {$IFDEF PLATFORM_CLEANUP_NEEDED}
  189. procedure DoTerminate; override;
  190. {$ENDIF}
  191. function GetStopped: Boolean;
  192. function HandleRunException(AException: Exception): Boolean; virtual;
  193. procedure Run; virtual; abstract;
  194. class procedure WaitAllThreadsTerminated(AMSec: Integer = IdWaitAllThreadsTerminatedCount); {$IFDEF HAS_DEPRECATED}deprecated;{$ENDIF}
  195. public
  196. constructor Create(ACreateSuspended: Boolean = True;
  197. ALoop: Boolean = True; const AName: string = ''); virtual;
  198. destructor Destroy; override;
  199. procedure Start; {$IFDEF DEPRECATED_TThread_SuspendResume}reintroduce;{$ENDIF} virtual;
  200. procedure Stop; virtual;
  201. procedure Synchronize(Method: TThreadMethod); overload;
  202. {$IFDEF HAS_TThreadProcedure}
  203. procedure Synchronize(Method: TThreadProcedure); overload;
  204. {$ENDIF}
  205. // Here to make virtual
  206. procedure Terminate; virtual;
  207. procedure TerminateAndWaitFor; virtual;
  208. //
  209. {$IFDEF USE_OBJECT_ARC}
  210. property DataObject: TObject read FDataObject write FDataObject;
  211. property DataValue: PtrInt read FDataValue write FDataValue;
  212. {$ELSE}
  213. property Data: TObject read FData write FData;
  214. {$ENDIF}
  215. property Loop: Boolean read FLoop write FLoop;
  216. property Name: string read FName write FName;
  217. property ReturnValue;
  218. property StopMode: TIdThreadStopMode read FStopMode write FStopMode;
  219. property Stopped: Boolean read GetStopped;
  220. property Terminated;
  221. // TODO: Change this to be like TIdFiber. D6 implementation is not as good
  222. // as what is done in TIdFiber.
  223. property TerminatingException: string read FTerminatingException;
  224. property TerminatingExceptionClass: TClass read FTerminatingExceptionClass;
  225. //Represents the thread or fiber for the scheduler of the thread.
  226. property Yarn: TIdYarn read FYarn write FYarn;
  227. //
  228. property OnException: TIdExceptionThreadEvent read FOnException write FOnException;
  229. property OnStopped: TIdNotifyThreadEvent read FOnStopped write FOnStopped;
  230. end;
  231. TIdThreadWithTask = class(TIdThread)
  232. protected
  233. FTask: TIdTask;
  234. //
  235. procedure AfterRun; override;
  236. procedure BeforeRun; override;
  237. procedure Run; override;
  238. procedure DoException(AException: Exception); override;
  239. procedure SetTask(AValue: TIdTask);
  240. public
  241. // Defaults because
  242. // Must always create suspended so task can be set
  243. // And a bit crazy to create a non looped task
  244. constructor Create(
  245. ATask: TIdTask = nil;
  246. const AName: string = ''
  247. ); reintroduce; virtual;
  248. destructor Destroy; override;
  249. //
  250. // Must be writeable because tasks are often created after thread or
  251. // thread is pooled
  252. property Task: TIdTask read FTask write SetTask;
  253. end;
  254. TIdThreadClass = class of TIdThread;
  255. TIdThreadWithTaskClass = class of TIdThreadWithTask;
  256. var
  257. // GThreadCount should be in implementation as it is not needed outside of
  258. // this unit. However with D8, GThreadCount will be deallocated before the
  259. // finalization can run and thus when the finalization accesses GThreadCount
  260. // in TerminateAll an error occurs. Moving this declaration to the interface
  261. // "fixes" it.
  262. GThreadCount: TIdThreadSafeInteger = nil{$IFDEF HAS_DEPRECATED}{$IFDEF USE_SEMICOLON_BEFORE_DEPRECATED};{$ENDIF} deprecated{$ENDIF};
  263. implementation
  264. uses
  265. //facilitate inlining only.
  266. {$IFDEF DOTNET}
  267. {$IFDEF USE_INLINE}
  268. System.Threading,
  269. {$ENDIF}
  270. {$ENDIF}
  271. {$IFDEF USE_VCL_POSIX}
  272. Posix.SysSelect,
  273. Posix.SysTime,
  274. {$ENDIF}
  275. {$IFDEF VCL_XE3_OR_ABOVE}
  276. System.SyncObjs,
  277. System.Types,
  278. {$ENDIF}
  279. {$IFDEF PLATFORM_CLEANUP_NEEDED}
  280. {$IFDEF MACOS}
  281. Macapi.ObjCRuntime,
  282. {$ENDIF}
  283. {$IFDEF ANDROID}
  284. Androidapi.NativeActivity,
  285. {$ENDIF}
  286. {$ENDIF}
  287. IdSchedulerOfThread, IdScheduler,
  288. IdResourceStringsCore;
  289. {$I IdDeprecatedImplBugOff.inc}
  290. class procedure TIdThread.WaitAllThreadsTerminated(AMSec: Integer = IdWaitAllThreadsTerminatedCount);
  291. {$I IdDeprecatedImplBugOn.inc}
  292. begin
  293. {$I IdSymbolDeprecatedOff.inc}
  294. while AMSec > 0 do begin
  295. if GThreadCount.Value = 0 then begin
  296. Break;
  297. end;
  298. IndySleep(IdWaitAllThreadsTerminatedStep);
  299. AMSec := AMSec - IdWaitAllThreadsTerminatedStep;
  300. end;
  301. {$I IdSymbolDeprecatedOn.inc}
  302. end;
  303. procedure TIdThread.TerminateAndWaitFor;
  304. begin
  305. if FreeOnTerminate then begin
  306. raise EIdThreadTerminateAndWaitFor.Create(RSThreadTerminateAndWaitFor);
  307. end;
  308. Terminate;
  309. Start; //resume
  310. WaitFor;
  311. end;
  312. procedure TIdThread.BeforeRun;
  313. begin
  314. end;
  315. procedure TIdThread.AfterRun;
  316. begin
  317. end;
  318. procedure TIdThread.BeforeExecute;
  319. begin
  320. end;
  321. procedure TIdThread.AfterExecute;
  322. begin
  323. end;
  324. procedure TIdThread.Execute;
  325. begin
  326. // Must make this call from INSIDE the thread. The call in Create
  327. // was naming the thread that was creating this thread. :(
  328. //
  329. // RLebeau - no need to put this inside the try blocks below as it
  330. // already uses its own try..except block internally
  331. if Name = '' then begin
  332. Name := 'IdThread (unknown)'; {do not localize}
  333. end;
  334. SetThreadName(Name);
  335. {$IFDEF PLATFORM_CLEANUP_NEEDED}
  336. {$IFDEF MACOS}
  337. // Register the auto release pool
  338. FObjCPool := objc_msgSend(objc_msgSend(objc_getClass('NSAutoreleasePool'), sel_getUid('alloc')), sel_getUid('init'));
  339. {$ENDIF MACOS}
  340. {$ENDIF}
  341. try
  342. BeforeExecute;
  343. try
  344. while not Terminated do begin
  345. if Stopped then begin
  346. DoStopped;
  347. // It is possible that either in the DoStopped or from another thread,
  348. // the thread is restarted, in which case we dont want to restop it.
  349. if Stopped then begin // DONE: if terminated?
  350. if Terminated then begin
  351. Break;
  352. end;
  353. // Thread manager will revive us
  354. {$IFDEF DEPRECATED_TThread_SuspendResume}
  355. Suspended := True;
  356. {$ELSE}
  357. Suspend;
  358. {$ENDIF}
  359. if Terminated then begin
  360. Break;
  361. end;
  362. end;
  363. end;
  364. Include(FOptions, itoReqCleanup);
  365. try
  366. try
  367. try
  368. BeforeRun;
  369. if Loop then begin
  370. while not Stopped do begin
  371. try
  372. Run;
  373. except
  374. on E: Exception do begin
  375. if not HandleRunException(E) then begin
  376. Terminate;
  377. raise;
  378. end;
  379. end;
  380. end;
  381. end;
  382. end else begin
  383. try
  384. Run;
  385. except
  386. on E: Exception do begin
  387. if not HandleRunException(E) then begin
  388. Terminate;
  389. raise;
  390. end;
  391. end;
  392. end;
  393. end;
  394. finally
  395. AfterRun;
  396. end;
  397. except
  398. Terminate;
  399. raise;
  400. end;
  401. finally
  402. Cleanup;
  403. end;
  404. end;
  405. finally
  406. AfterExecute;
  407. end;
  408. except
  409. on E: Exception do begin
  410. FTerminatingExceptionClass := E.ClassType;
  411. FTerminatingException := E.Message;
  412. DoException(E);
  413. Terminate;
  414. end;
  415. end;
  416. end;
  417. {$IFDEF PLATFORM_CLEANUP_NEEDED}
  418. procedure TIdThread.DoTerminate;
  419. {$IFDEF ANDROID}
  420. var
  421. PActivity: PANativeActivity;
  422. {$ENDIF}
  423. begin
  424. try
  425. inherited;
  426. finally
  427. {$IFDEF MACOS}
  428. // Last thing to do in thread is to drain the pool
  429. objc_msgSend(FObjCPool, sel_getUid('drain')); {do not localize}
  430. {$ENDIF}
  431. {$IFDEF ANDROID}
  432. // Detach the NativeActivity virtual machine to ensure the proper release of JNI contexts attached to the current thread
  433. PActivity := PANativeActivity(System.DelphiActivity);
  434. PActivity^.vm^.DetachCurrentThread(PActivity^.vm);
  435. {$ENDIF}
  436. end;
  437. end;
  438. {$ENDIF}
  439. constructor TIdThread.Create(ACreateSuspended: Boolean; ALoop: Boolean; const AName: string);
  440. begin
  441. {$IFDEF DOTNET}
  442. inherited Create(True);
  443. {$ENDIF}
  444. FOptions := [itoDataOwner];
  445. if ACreateSuspended then begin
  446. Include(FOptions, itoStopped);
  447. end;
  448. FLock := TIdCriticalSection.Create;
  449. Loop := ALoop;
  450. Name := AName;
  451. //
  452. {$IFDEF DOTNET}
  453. if not ACreateSuspended then begin
  454. {$IFDEF DEPRECATED_TThread_SuspendResume}
  455. Suspended := False;
  456. {$ELSE}
  457. Resume;
  458. {$ENDIF}
  459. end;
  460. {$ELSE}
  461. //
  462. // Most things BEFORE inherited - inherited creates the actual thread and if
  463. // not suspended will start before we initialize
  464. inherited Create(ACreateSuspended);
  465. {$IFNDEF VCL_6_OR_ABOVE}
  466. // Delphi 6 and above raise an exception when an error occures while
  467. // creating a thread (eg. not enough address space to allocate a stack)
  468. // Delphi 5 and below don't do that, which results in a TIdThread
  469. // instance with an invalid handle in it, therefore we raise the
  470. // exceptions manually on D5 and below
  471. if (ThreadID = 0) then begin
  472. IndyRaiseLastError;
  473. end;
  474. {$ENDIF}
  475. {$ENDIF}
  476. // Last, so we only do this if successful
  477. {$I IdSymbolDeprecatedOff.inc}
  478. GThreadCount.Increment;
  479. {$I IdSymbolDeprecatedOn.inc}
  480. end;
  481. destructor TIdThread.Destroy;
  482. begin
  483. inherited Destroy;
  484. try
  485. if itoReqCleanup in FOptions then begin
  486. Cleanup;
  487. end;
  488. finally
  489. // RLebeau- clean up the Yarn one more time, in case the thread was
  490. // terminated after the Yarn was assigned but the thread was not
  491. // re-started, so the Yarn would not be freed in Cleanup()
  492. try
  493. IdDisposeAndNil(FYarn);
  494. finally
  495. // Protect FLock if thread was resumed by Start Method and we are still there.
  496. // This usually happens if Exception was raised in BeforeRun for some reason
  497. // And thread was terminated there before Start method is completed.
  498. FLock.Enter; try
  499. finally FLock.Leave; end;
  500. FreeAndNil(FLock);
  501. {$I IdSymbolDeprecatedOff.inc}
  502. GThreadCount.Decrement;
  503. {$I IdSymbolDeprecatedOn.inc}
  504. end;
  505. end;
  506. end;
  507. procedure TIdThread.Start;
  508. begin
  509. FLock.Enter; try
  510. if Stopped then begin
  511. // Resume is also called for smTerminate as .Start can be used to initially start a
  512. // thread that is created suspended
  513. if Terminated then begin
  514. Include(FOptions,itoStopped);
  515. end else begin
  516. Exclude(FOptions,itoStopped);
  517. end;
  518. {$IFDEF DEPRECATED_TThread_SuspendResume}
  519. Suspended := False;
  520. {$ELSE}
  521. Resume;
  522. {$ENDIF}
  523. {APR: [in past] thread can be destroyed here! now Destroy wait FLock}
  524. end;
  525. finally FLock.Leave; end;
  526. end;
  527. procedure TIdThread.Stop;
  528. begin
  529. FLock.Enter; try
  530. if not Stopped then begin
  531. case FStopMode of
  532. smTerminate: Terminate;
  533. smSuspend: {DO not suspend here. Suspend is immediate. See Execute for implementation};
  534. end;
  535. Include(FOptions, itoStopped);
  536. end;
  537. finally FLock.Leave; end;
  538. end;
  539. function TIdThread.GetStopped: Boolean;
  540. begin
  541. if Assigned(FLock) then begin
  542. FLock.Enter; try
  543. // Suspended may be True if checking stopped from another thread
  544. Result := Terminated or (itoStopped in FOptions) or Suspended;
  545. finally FLock.Leave; end;
  546. end else begin
  547. Result := True; //user call Destroy
  548. end;
  549. end;
  550. procedure TIdThread.DoStopped;
  551. begin
  552. if Assigned(OnStopped) then begin
  553. OnStopped(Self);
  554. end;
  555. end;
  556. procedure TIdThread.DoException(AException: Exception);
  557. begin
  558. if Assigned(FOnException) then begin
  559. FOnException(Self, AException);
  560. end;
  561. end;
  562. procedure TIdThread.Terminate;
  563. begin
  564. //this assert can only raise if terminate is called on an already-destroyed thread
  565. Assert(FLock<>nil);
  566. FLock.Enter; try
  567. Include(FOptions, itoStopped);
  568. inherited Terminate;
  569. finally FLock.Leave; end;
  570. end;
  571. type
  572. TIdYarnOfThreadAccess = class(TIdYarnOfThread)
  573. end;
  574. procedure TIdThread.Cleanup;
  575. var
  576. LScheduler: TIdScheduler;
  577. LList: TIdYarnList;
  578. begin
  579. Exclude(FOptions, itoReqCleanup);
  580. // RLebeau 9/20/2019: there is a race condition here with TIdScheduler.TerminateAllYarns().
  581. // Notify TIdScheduler of the Yarn being freed here, otherwise, a double free of the Yarn
  582. // can happen if TIdThread.Cleanup() and TIdSchedulerOfThread.TerminateYarn() try to destroy
  583. // the Yarn at the same time. TerminateYarn() destroys the Yarn inside the ActiveYarns lock,
  584. // so the destroy here needs to be done inside of the same lock...
  585. //IdDisposeAndNil(FYarn);
  586. if FYarn is TIdYarnOfThread then
  587. begin
  588. {$I IdObjectChecksOff.inc}
  589. LScheduler := TIdYarnOfThreadAccess(FYarn).FScheduler;
  590. {$I IdObjectChecksOn.inc}
  591. if Assigned(LScheduler) then
  592. begin
  593. LList := LScheduler.ActiveYarns.LockList;
  594. try
  595. // if the Yarn is still in the list, remove and destroy it now.
  596. // If not, assume TIdScheduler has already done so ...
  597. if LList.Remove(FYarn) <> -1 then begin
  598. IdDisposeAndNil(FYarn);
  599. end;
  600. finally
  601. LScheduler.ActiveYarns.UnlockList;
  602. end;
  603. end;
  604. end else
  605. begin
  606. // just free the Yarn normally and let it figure out what to do...
  607. // TODO: is special handling needed for TIdYarnOfFiber like above?
  608. IdDisposeAndNil(FYarn);
  609. end;
  610. if itoDataOwner in FOptions then begin
  611. // TODO: use IdDisposeAndNil() instead?
  612. FreeAndNil({$IFDEF USE_OBJECT_ARC}FDataObject{$ELSE}FData{$ENDIF});
  613. end;
  614. {$IFDEF USE_OBJECT_ARC}
  615. FDataValue := 0;
  616. {$ENDIF}
  617. end;
  618. function TIdThread.HandleRunException(AException: Exception): Boolean;
  619. begin
  620. // Default behavior: Exception is death sentence
  621. Result := False;
  622. end;
  623. procedure TIdThread.Synchronize(Method: TThreadMethod);
  624. begin
  625. inherited Synchronize(Method);
  626. end;
  627. {$IFDEF HAS_TThreadProcedure}
  628. procedure TIdThread.Synchronize(Method: TThreadProcedure);
  629. begin
  630. inherited Synchronize(Method);
  631. end;
  632. {$ENDIF}
  633. { TIdThreadWithTask }
  634. procedure TIdThreadWithTask.AfterRun;
  635. begin
  636. FTask.DoAfterRun;
  637. inherited AfterRun;
  638. end;
  639. procedure TIdThreadWithTask.BeforeRun;
  640. begin
  641. inherited BeforeRun;
  642. FTask.DoBeforeRun;
  643. end;
  644. procedure TIdThreadWithTask.DoException(AException: Exception);
  645. begin
  646. inherited DoException(AException);
  647. FTask.DoException(AException);
  648. end;
  649. constructor TIdThreadWithTask.Create(ATask: TIdTask; const AName: string);
  650. begin
  651. inherited Create(True, True, AName);
  652. FTask := ATask;
  653. end;
  654. destructor TIdThreadWithTask.Destroy;
  655. begin
  656. FreeAndNil(FTask);
  657. inherited Destroy;
  658. end;
  659. procedure TIdThreadWithTask.Run;
  660. begin
  661. if not FTask.DoRun then begin
  662. Stop;
  663. end;
  664. end;
  665. procedure TIdThreadWithTask.SetTask(AValue: TIdTask);
  666. begin
  667. if FTask <> AValue then begin
  668. FreeAndNil(FTask);
  669. FTask := AValue;
  670. end;
  671. end;
  672. {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
  673. type
  674. TIdThreadSafeIntegerAccess = class(TIdThreadSafeInteger);
  675. {$ENDIF}
  676. initialization
  677. // RLebeau 7/19/09: According to RAID #271221:
  678. //
  679. // "Indy always names the main thread. It should not name the main thread,
  680. // it should only name threads that it creates. This basically means that
  681. // any app that uses Indy will end up with the main thread named "Main".
  682. //
  683. // The IDE currently names it's main thread, but because Indy is used by
  684. // the dcldbx140.bpl package which gets loaded by the IDE, the name used
  685. // for the main thread always ends up being overwritten with the name
  686. // Indy gives it."
  687. //
  688. // So, DO NOT uncomment the following line...
  689. // SetThreadName('Main'); {do not localize}
  690. {$I IdSymbolDeprecatedOff.inc}
  691. GThreadCount := TIdThreadSafeInteger.Create;
  692. {$IFNDEF FREE_ON_FINAL}
  693. {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
  694. IndyRegisterExpectedMemoryLeak(GThreadCount);
  695. {$I IdObjectChecksOff.inc}
  696. IndyRegisterExpectedMemoryLeak(TIdThreadSafeIntegerAccess(GThreadCount).FCriticalSection);
  697. {$I IdObjectChecksOn.inc}
  698. {$ENDIF}
  699. {$ENDIF}
  700. {$I IdSymbolDeprecatedOn.inc}
  701. finalization
  702. // This call hangs if not all threads have been properly destroyed.
  703. // But without this, bad threads can often have worse results. Catch 22.
  704. // TIdThread.WaitAllThreadsTerminated;
  705. {$IFDEF FREE_ON_FINAL}
  706. //only enable this if you know your code exits thread-clean
  707. {$I IdSymbolDeprecatedOff.inc}
  708. FreeAndNil(GThreadCount);
  709. {$I IdSymbolDeprecatedOn.inc}
  710. {$ENDIF}
  711. end.