IdThread.pas 23 KB

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