IdThread.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801
  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. TIdThreadOptions = set of (itoStopped, itoReqCleanup, itoDataOwner, itoTag);
  148. TIdThread = class(TThread)
  149. protected
  150. {$IFDEF USE_OBJECT_ARC}
  151. // When ARC is enabled, object references MUST be valid objects.
  152. // It is common for users to store non-object values, though, so
  153. // we will provide separate properties for those purposes
  154. //
  155. // TODO; use TValue instead of separating them
  156. //
  157. FDataObject: TObject;
  158. FDataValue: PtrInt;
  159. {$ELSE}
  160. FData: TObject;
  161. {$ENDIF}
  162. FLock: TIdCriticalSection;
  163. FLoop: Boolean;
  164. FName: string;
  165. FStopMode: TIdThreadStopMode;
  166. FOptions: TIdThreadOptions;
  167. FTerminatingException: String;
  168. FTerminatingExceptionClass: TClass;
  169. FYarn: TIdYarn;
  170. //
  171. FOnException: TIdExceptionThreadEvent;
  172. FOnStopped: TIdNotifyThreadEvent;
  173. //
  174. {$IFDEF PLATFORM_CLEANUP_NEEDED}
  175. {$IFDEF MACOS}
  176. FObjCPool: Pointer;
  177. {$ENDIF}
  178. {$ENDIF}
  179. procedure AfterRun; virtual; //3* not abstract - otherwise it is required
  180. procedure AfterExecute; virtual;//5 not abstract - otherwise it is required
  181. procedure BeforeExecute; virtual;//1 not abstract - otherwise it is required
  182. procedure BeforeRun; virtual; //2* not abstract - otherwise it is required
  183. procedure Cleanup; virtual;//4*
  184. procedure DoException(AException: Exception); virtual;
  185. procedure DoStopped; virtual;
  186. procedure Execute; override;
  187. {$IFDEF PLATFORM_CLEANUP_NEEDED}
  188. procedure DoTerminate; override;
  189. {$ENDIF}
  190. function GetStopped: Boolean;
  191. function HandleRunException(AException: Exception): Boolean; virtual;
  192. procedure Run; virtual; abstract;
  193. class procedure WaitAllThreadsTerminated(AMSec: Integer = IdWaitAllThreadsTerminatedCount); {$IFDEF HAS_DEPRECATED}deprecated;{$ENDIF}
  194. public
  195. constructor Create(ACreateSuspended: Boolean = True;
  196. ALoop: Boolean = True; const AName: string = ''); virtual;
  197. destructor Destroy; override;
  198. procedure Start; {$IFDEF DEPRECATED_TThread_SuspendResume}reintroduce;{$ENDIF} virtual;
  199. procedure Stop; virtual;
  200. procedure Synchronize(Method: TThreadMethod); overload;
  201. {$IFDEF HAS_TThreadProcedure}
  202. procedure Synchronize(Method: TThreadProcedure); overload;
  203. {$ENDIF}
  204. // Here to make virtual
  205. procedure Terminate; virtual;
  206. procedure TerminateAndWaitFor; virtual;
  207. //
  208. {$IFDEF USE_OBJECT_ARC}
  209. property DataObject: TObject read FDataObject write FDataObject;
  210. property DataValue: PtrInt read FDataValue write FDataValue;
  211. {$ELSE}
  212. property Data: TObject read FData write FData;
  213. {$ENDIF}
  214. property Loop: Boolean read FLoop write FLoop;
  215. property Name: string read FName write FName;
  216. property ReturnValue;
  217. property StopMode: TIdThreadStopMode read FStopMode write FStopMode;
  218. property Stopped: Boolean read GetStopped;
  219. property Terminated;
  220. // TODO: Change this to be like TIdFiber. D6 implementation is not as good
  221. // as what is done in TIdFiber.
  222. property TerminatingException: string read FTerminatingException;
  223. property TerminatingExceptionClass: TClass read FTerminatingExceptionClass;
  224. //Represents the thread or fiber for the scheduler of the thread.
  225. property Yarn: TIdYarn read FYarn write FYarn;
  226. //
  227. property OnException: TIdExceptionThreadEvent read FOnException write FOnException;
  228. property OnStopped: TIdNotifyThreadEvent read FOnStopped write FOnStopped;
  229. end;
  230. TIdThreadWithTask = class(TIdThread)
  231. protected
  232. FTask: TIdTask;
  233. //
  234. procedure AfterRun; override;
  235. procedure BeforeRun; override;
  236. procedure Run; override;
  237. procedure DoException(AException: Exception); override;
  238. procedure SetTask(AValue: TIdTask);
  239. public
  240. // Defaults because
  241. // Must always create suspended so task can be set
  242. // And a bit crazy to create a non looped task
  243. constructor Create(
  244. ATask: TIdTask = nil;
  245. const AName: string = ''
  246. ); reintroduce; virtual;
  247. destructor Destroy; override;
  248. //
  249. // Must be writeable because tasks are often created after thread or
  250. // thread is pooled
  251. property Task: TIdTask read FTask write SetTask;
  252. end;
  253. TIdThreadClass = class of TIdThread;
  254. TIdThreadWithTaskClass = class of TIdThreadWithTask;
  255. var
  256. // GThreadCount should be in implementation as it is not needed outside of
  257. // this unit. However with D8, GThreadCount will be deallocated before the
  258. // finalization can run and thus when the finalization accesses GThreadCount
  259. // in TerminateAll an error occurs. Moving this declaration to the interface
  260. // "fixes" it.
  261. GThreadCount: TIdThreadSafeInteger = nil{$IFDEF HAS_DEPRECATED}{$IFDEF USE_SEMICOLON_BEFORE_DEPRECATED};{$ENDIF} deprecated{$ENDIF};
  262. implementation
  263. uses
  264. //facilitate inlining only.
  265. {$IFDEF DOTNET}
  266. {$IFDEF USE_INLINE}
  267. System.Threading,
  268. {$ENDIF}
  269. {$ENDIF}
  270. {$IFDEF USE_VCL_POSIX}
  271. Posix.SysSelect,
  272. Posix.SysTime,
  273. {$ENDIF}
  274. {$IFDEF VCL_XE3_OR_ABOVE}
  275. System.SyncObjs,
  276. System.Types,
  277. {$ENDIF}
  278. {$IFDEF PLATFORM_CLEANUP_NEEDED}
  279. {$IFDEF MACOS}
  280. Macapi.ObjCRuntime,
  281. {$ENDIF}
  282. {$IFDEF ANDROID}
  283. Androidapi.NativeActivity,
  284. {$ENDIF}
  285. {$ENDIF}
  286. IdSchedulerOfThread, IdScheduler,
  287. IdResourceStringsCore;
  288. {$I IdDeprecatedImplBugOff.inc}
  289. class procedure TIdThread.WaitAllThreadsTerminated(AMSec: Integer = IdWaitAllThreadsTerminatedCount);
  290. {$I IdDeprecatedImplBugOn.inc}
  291. begin
  292. {$I IdSymbolDeprecatedOff.inc}
  293. while AMSec > 0 do begin
  294. if GThreadCount.Value = 0 then begin
  295. Break;
  296. end;
  297. IndySleep(IdWaitAllThreadsTerminatedStep);
  298. AMSec := AMSec - IdWaitAllThreadsTerminatedStep;
  299. end;
  300. {$I IdSymbolDeprecatedOn.inc}
  301. end;
  302. procedure TIdThread.TerminateAndWaitFor;
  303. begin
  304. if FreeOnTerminate then begin
  305. raise EIdThreadTerminateAndWaitFor.Create(RSThreadTerminateAndWaitFor);
  306. end;
  307. Terminate;
  308. Start; //resume
  309. WaitFor;
  310. end;
  311. procedure TIdThread.BeforeRun;
  312. begin
  313. end;
  314. procedure TIdThread.AfterRun;
  315. begin
  316. end;
  317. procedure TIdThread.BeforeExecute;
  318. begin
  319. end;
  320. procedure TIdThread.AfterExecute;
  321. begin
  322. end;
  323. procedure TIdThread.Execute;
  324. begin
  325. // Must make this call from INSIDE the thread. The call in Create
  326. // was naming the thread that was creating this thread. :(
  327. //
  328. // RLebeau - no need to put this inside the try blocks below as it
  329. // already uses its own try..except block internally
  330. if Name = '' then begin
  331. Name := 'IdThread (unknown)'; {do not localize}
  332. end;
  333. SetThreadName(Name);
  334. {$IFDEF PLATFORM_CLEANUP_NEEDED}
  335. {$IFDEF MACOS}
  336. // Register the auto release pool
  337. FObjCPool := objc_msgSend(objc_msgSend(objc_getClass('NSAutoreleasePool'), sel_getUid('alloc')), sel_getUid('init'));
  338. {$ENDIF MACOS}
  339. {$ENDIF}
  340. try
  341. BeforeExecute;
  342. try
  343. while not Terminated do begin
  344. if Stopped then begin
  345. DoStopped;
  346. // It is possible that either in the DoStopped or from another thread,
  347. // the thread is restarted, in which case we dont want to restop it.
  348. if Stopped then begin // DONE: if terminated?
  349. if Terminated then begin
  350. Break;
  351. end;
  352. // Thread manager will revive us
  353. {$IFDEF DEPRECATED_TThread_SuspendResume}
  354. Suspended := True;
  355. {$ELSE}
  356. Suspend;
  357. {$ENDIF}
  358. if Terminated then begin
  359. Break;
  360. end;
  361. end;
  362. end;
  363. Include(FOptions, itoReqCleanup);
  364. try
  365. try
  366. try
  367. BeforeRun;
  368. if Loop then begin
  369. while not Stopped do begin
  370. try
  371. Run;
  372. except
  373. on E: Exception do begin
  374. if not HandleRunException(E) then begin
  375. Terminate;
  376. raise;
  377. end;
  378. end;
  379. end;
  380. end;
  381. end else begin
  382. try
  383. Run;
  384. except
  385. on E: Exception do begin
  386. if not HandleRunException(E) then begin
  387. Terminate;
  388. raise;
  389. end;
  390. end;
  391. end;
  392. end;
  393. finally
  394. AfterRun;
  395. end;
  396. except
  397. Terminate;
  398. raise;
  399. end;
  400. finally
  401. Cleanup;
  402. end;
  403. end;
  404. finally
  405. AfterExecute;
  406. end;
  407. except
  408. on E: Exception do begin
  409. FTerminatingExceptionClass := E.ClassType;
  410. FTerminatingException := E.Message;
  411. DoException(E);
  412. Terminate;
  413. end;
  414. end;
  415. end;
  416. {$IFDEF PLATFORM_CLEANUP_NEEDED}
  417. procedure TIdThread.DoTerminate;
  418. {$IFDEF ANDROID}
  419. var
  420. PActivity: PANativeActivity;
  421. {$ENDIF}
  422. begin
  423. try
  424. inherited;
  425. finally
  426. {$IFDEF MACOS}
  427. // Last thing to do in thread is to drain the pool
  428. objc_msgSend(FObjCPool, sel_getUid('drain')); {do not localize}
  429. {$ENDIF}
  430. {$IFDEF ANDROID}
  431. // Detach the NativeActivity virtual machine to ensure the proper release of JNI contexts attached to the current thread
  432. PActivity := PANativeActivity(System.DelphiActivity);
  433. PActivity^.vm^.DetachCurrentThread(PActivity^.vm);
  434. {$ENDIF}
  435. end;
  436. end;
  437. {$ENDIF}
  438. constructor TIdThread.Create(ACreateSuspended: Boolean; ALoop: Boolean; const AName: string);
  439. begin
  440. {$IFDEF DOTNET}
  441. inherited Create(True);
  442. {$ENDIF}
  443. FOptions := [itoDataOwner];
  444. if ACreateSuspended then begin
  445. Include(FOptions, itoStopped);
  446. end;
  447. FLock := TIdCriticalSection.Create;
  448. Loop := ALoop;
  449. Name := AName;
  450. //
  451. {$IFDEF DOTNET}
  452. if not ACreateSuspended then begin
  453. {$IFDEF DEPRECATED_TThread_SuspendResume}
  454. Suspended := False;
  455. {$ELSE}
  456. Resume;
  457. {$ENDIF}
  458. end;
  459. {$ELSE}
  460. //
  461. // Most things BEFORE inherited - inherited creates the actual thread and if
  462. // not suspended will start before we initialize
  463. inherited Create(ACreateSuspended);
  464. {$IFNDEF VCL_6_OR_ABOVE}
  465. // Delphi 6 and above raise an exception when an error occures while
  466. // creating a thread (eg. not enough address space to allocate a stack)
  467. // Delphi 5 and below don't do that, which results in a TIdThread
  468. // instance with an invalid handle in it, therefore we raise the
  469. // exceptions manually on D5 and below
  470. if (ThreadID = 0) then begin
  471. IndyRaiseLastError;
  472. end;
  473. {$ENDIF}
  474. {$ENDIF}
  475. // Last, so we only do this if successful
  476. {$I IdSymbolDeprecatedOff.inc}
  477. GThreadCount.Increment;
  478. {$I IdSymbolDeprecatedOn.inc}
  479. end;
  480. destructor TIdThread.Destroy;
  481. begin
  482. inherited Destroy;
  483. try
  484. if itoReqCleanup in FOptions then begin
  485. Cleanup;
  486. end;
  487. finally
  488. // RLebeau- clean up the Yarn one more time, in case the thread was
  489. // terminated after the Yarn was assigned but the thread was not
  490. // re-started, so the Yarn would not be freed in Cleanup()
  491. try
  492. IdDisposeAndNil(FYarn);
  493. finally
  494. // Protect FLock if thread was resumed by Start Method and we are still there.
  495. // This usually happens if Exception was raised in BeforeRun for some reason
  496. // And thread was terminated there before Start method is completed.
  497. FLock.Enter; try
  498. finally FLock.Leave; end;
  499. FreeAndNil(FLock);
  500. {$I IdSymbolDeprecatedOff.inc}
  501. GThreadCount.Decrement;
  502. {$I IdSymbolDeprecatedOn.inc}
  503. end;
  504. end;
  505. end;
  506. procedure TIdThread.Start;
  507. begin
  508. FLock.Enter; try
  509. if Stopped then begin
  510. // Resume is also called for smTerminate as .Start can be used to initially start a
  511. // thread that is created suspended
  512. if Terminated then begin
  513. Include(FOptions,itoStopped);
  514. end else begin
  515. Exclude(FOptions,itoStopped);
  516. end;
  517. {$IFDEF DEPRECATED_TThread_SuspendResume}
  518. Suspended := False;
  519. {$ELSE}
  520. Resume;
  521. {$ENDIF}
  522. {APR: [in past] thread can be destroyed here! now Destroy wait FLock}
  523. end;
  524. finally FLock.Leave; end;
  525. end;
  526. procedure TIdThread.Stop;
  527. begin
  528. FLock.Enter; try
  529. if not Stopped then begin
  530. case FStopMode of
  531. smTerminate: Terminate;
  532. smSuspend: {DO not suspend here. Suspend is immediate. See Execute for implementation};
  533. end;
  534. Include(FOptions, itoStopped);
  535. end;
  536. finally FLock.Leave; end;
  537. end;
  538. function TIdThread.GetStopped: Boolean;
  539. begin
  540. if Assigned(FLock) then begin
  541. FLock.Enter; try
  542. // Suspended may be True if checking stopped from another thread
  543. Result := Terminated or (itoStopped in FOptions) or Suspended;
  544. finally FLock.Leave; end;
  545. end else begin
  546. Result := True; //user call Destroy
  547. end;
  548. end;
  549. procedure TIdThread.DoStopped;
  550. begin
  551. if Assigned(OnStopped) then begin
  552. OnStopped(Self);
  553. end;
  554. end;
  555. procedure TIdThread.DoException(AException: Exception);
  556. begin
  557. if Assigned(FOnException) then begin
  558. FOnException(Self, AException);
  559. end;
  560. end;
  561. procedure TIdThread.Terminate;
  562. begin
  563. //this assert can only raise if terminate is called on an already-destroyed thread
  564. Assert(FLock<>nil);
  565. FLock.Enter; try
  566. Include(FOptions, itoStopped);
  567. inherited Terminate;
  568. finally FLock.Leave; end;
  569. end;
  570. type
  571. TIdYarnOfThreadAccess = class(TIdYarnOfThread)
  572. end;
  573. procedure TIdThread.Cleanup;
  574. var
  575. LScheduler: TIdScheduler;
  576. LList: TIdYarnList;
  577. begin
  578. Exclude(FOptions, itoReqCleanup);
  579. // RLebeau 9/20/2019: there is a race condition here with TIdScheduler.TerminateAllYarns().
  580. // Notify TIdScheduler of the Yarn being freed here, otherwise, a double free of the Yarn
  581. // can happen if TIdThread.Cleanup() and TIdSchedulerOfThread.TerminateYarn() try to destroy
  582. // the Yarn at the same time. TerminateYarn() destroys the Yarn inside the ActiveYarns lock,
  583. // so the destroy here needs to be done inside of the same lock...
  584. //IdDisposeAndNil(FYarn);
  585. if FYarn is TIdYarnOfThread then
  586. begin
  587. LScheduler := TIdYarnOfThreadAccess(FYarn).FScheduler;
  588. if Assigned(LScheduler) then
  589. begin
  590. LList := LScheduler.ActiveYarns.LockList;
  591. try
  592. // if the Yarn is still in the list, remove and destroy it now.
  593. // If not, assume TIdScheduler has already done so ...
  594. if LList.Remove(FYarn) <> -1 then begin
  595. IdDisposeAndNil(FYarn);
  596. end;
  597. finally
  598. LScheduler.ActiveYarns.UnlockList;
  599. end;
  600. end;
  601. end else
  602. begin
  603. // just free the Yarn normally and let it figure out what to do...
  604. // TODO: is special handling needed for TIdYarnOfFiber like above?
  605. IdDisposeAndNil(FYarn);
  606. end;
  607. if itoDataOwner in FOptions then begin
  608. // TODO: use IdDisposeAndNil() instead?
  609. FreeAndNil({$IFDEF USE_OBJECT_ARC}FDataObject{$ELSE}FData{$ENDIF});
  610. end;
  611. {$IFDEF USE_OBJECT_ARC}
  612. FDataValue := 0;
  613. {$ENDIF}
  614. end;
  615. function TIdThread.HandleRunException(AException: Exception): Boolean;
  616. begin
  617. // Default behavior: Exception is death sentence
  618. Result := False;
  619. end;
  620. procedure TIdThread.Synchronize(Method: TThreadMethod);
  621. begin
  622. inherited Synchronize(Method);
  623. end;
  624. {$IFDEF HAS_TThreadProcedure}
  625. procedure TIdThread.Synchronize(Method: TThreadProcedure);
  626. begin
  627. inherited Synchronize(Method);
  628. end;
  629. {$ENDIF}
  630. { TIdThreadWithTask }
  631. procedure TIdThreadWithTask.AfterRun;
  632. begin
  633. FTask.DoAfterRun;
  634. inherited AfterRun;
  635. end;
  636. procedure TIdThreadWithTask.BeforeRun;
  637. begin
  638. inherited BeforeRun;
  639. FTask.DoBeforeRun;
  640. end;
  641. procedure TIdThreadWithTask.DoException(AException: Exception);
  642. begin
  643. inherited DoException(AException);
  644. FTask.DoException(AException);
  645. end;
  646. constructor TIdThreadWithTask.Create(ATask: TIdTask; const AName: string);
  647. begin
  648. inherited Create(True, True, AName);
  649. FTask := ATask;
  650. end;
  651. destructor TIdThreadWithTask.Destroy;
  652. begin
  653. FreeAndNil(FTask);
  654. inherited Destroy;
  655. end;
  656. procedure TIdThreadWithTask.Run;
  657. begin
  658. if not FTask.DoRun then begin
  659. Stop;
  660. end;
  661. end;
  662. procedure TIdThreadWithTask.SetTask(AValue: TIdTask);
  663. begin
  664. if FTask <> AValue then begin
  665. FreeAndNil(FTask);
  666. FTask := AValue;
  667. end;
  668. end;
  669. {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
  670. type
  671. TIdThreadSafeIntegerAccess = class(TIdThreadSafeInteger);
  672. {$ENDIF}
  673. initialization
  674. // RLebeau 7/19/09: According to RAID #271221:
  675. //
  676. // "Indy always names the main thread. It should not name the main thread,
  677. // it should only name threads that it creates. This basically means that
  678. // any app that uses Indy will end up with the main thread named "Main".
  679. //
  680. // The IDE currently names it's main thread, but because Indy is used by
  681. // the dcldbx140.bpl package which gets loaded by the IDE, the name used
  682. // for the main thread always ends up being overwritten with the name
  683. // Indy gives it."
  684. //
  685. // So, DO NOT uncomment the following line...
  686. // SetThreadName('Main'); {do not localize}
  687. {$I IdSymbolDeprecatedOff.inc}
  688. GThreadCount := TIdThreadSafeInteger.Create;
  689. {$IFNDEF FREE_ON_FINAL}
  690. {$IFDEF REGISTER_EXPECTED_MEMORY_LEAK}
  691. IndyRegisterExpectedMemoryLeak(GThreadCount);
  692. IndyRegisterExpectedMemoryLeak(TIdThreadSafeIntegerAccess(GThreadCount).FCriticalSection);
  693. {$ENDIF}
  694. {$ENDIF}
  695. {$I IdSymbolDeprecatedOn.inc}
  696. finalization
  697. // This call hangs if not all threads have been properly destroyed.
  698. // But without this, bad threads can often have worse results. Catch 22.
  699. // TIdThread.WaitAllThreadsTerminated;
  700. {$IFDEF FREE_ON_FINAL}
  701. //only enable this if you know your code exits thread-clean
  702. {$I IdSymbolDeprecatedOff.inc}
  703. FreeAndNil(GThreadCount);
  704. {$I IdSymbolDeprecatedOn.inc}
  705. {$ENDIF}
  706. end.