From f13b9aa406132085931a37bc3a0a57912b64c572 Mon Sep 17 00:00:00 2001 From: florian Date: Mon, 6 Oct 2003 17:06:55 +0000 Subject: [PATCH] * applied Johannes Berg's patch for exception handling in threads --- fcl/freebsd/thread.inc | 14 ++++++++++++-- fcl/inc/classesh.inc | 7 ++++++- fcl/linux/thread.inc | 14 ++++++++++++-- fcl/netbsd/thread.inc | 14 ++++++++++++-- fcl/netware/thread.inc | 14 ++++++++++++-- fcl/openbsd/thread.inc | 14 ++++++++++++-- fcl/os2/thread.inc | 14 ++++++++++++-- fcl/win32/thread.inc | 14 ++++++++++++-- 8 files changed, 90 insertions(+), 15 deletions(-) diff --git a/fcl/freebsd/thread.inc b/fcl/freebsd/thread.inc index 806016b498..48bc0b17aa 100644 --- a/fcl/freebsd/thread.inc +++ b/fcl/freebsd/thread.inc @@ -164,7 +164,11 @@ var FreeThread: Boolean; Thread : TThread absolute args; begin - Thread.Execute; + try + Thread.Execute; + except + Thread.FFatalException := TObject(AcquireExceptionObject); + end; FreeThread := Thread.FFreeOnTerminate; Result := Thread.FReturnValue; Thread.FFinished := True; @@ -193,6 +197,7 @@ begin if FSuspended then Suspend; FThreadID := FHandle; IsMultiThread := TRUE; + FFatalException := nil; end; @@ -207,6 +212,8 @@ begin {$ifdef ver1_0}kill({$else}fpkill({$endif}FHandle, SIGKILL); dec(FStackPointer,FStackSize); Freemem(pointer(FStackPointer),FStackSize); + FFatalException.Free; + FFatalException := nil; inherited Destroy; RemoveThread(self); end; @@ -316,7 +323,10 @@ end; { $Log$ - Revision 1.11 2003-09-20 14:51:42 marco + Revision 1.12 2003-10-06 17:06:55 florian + * applied Johannes Berg's patch for exception handling in threads + + Revision 1.11 2003/09/20 14:51:42 marco * small v1_0 fix Revision 1.10 2003/09/20 12:38:29 marco diff --git a/fcl/inc/classesh.inc b/fcl/inc/classesh.inc index f212071ec1..d3f641e214 100644 --- a/fcl/inc/classesh.inc +++ b/fcl/inc/classesh.inc @@ -1101,6 +1101,7 @@ type FOnTerminate: TNotifyEvent; FMethod: TThreadMethod; FSynchronizeException: TObject; + FFatalException: TObject; procedure CallOnTerminate; function GetPriority: TThreadPriority; procedure SetPriority(Value: TThreadPriority); @@ -1130,6 +1131,7 @@ type property Suspended: Boolean read FSuspended write SetSuspended; property ThreadID: THandle read FThreadID; property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate; + property FatalException: TObject read FFatalException; end; { TComponent class } @@ -1519,7 +1521,10 @@ function LineStart(Buffer, BufPos: PChar): PChar; { $Log$ - Revision 1.25 2003-08-16 15:50:47 michael + Revision 1.26 2003-10-06 17:06:55 florian + * applied Johannes Berg's patch for exception handling in threads + + Revision 1.25 2003/08/16 15:50:47 michael + Fix from Mattias gaertner for IDE support Revision 1.24 2003/06/04 15:27:24 michael diff --git a/fcl/linux/thread.inc b/fcl/linux/thread.inc index d886f413dc..eb88e8f909 100644 --- a/fcl/linux/thread.inc +++ b/fcl/linux/thread.inc @@ -150,7 +150,11 @@ var FreeThread: Boolean; Thread : TThread absolute args; begin - Thread.Execute; + try + Thread.Execute; + except + Thread.FFatalException := TObject(AcquireExceptionObject); + end; FreeThread := Thread.FFreeOnTerminate; Result := Thread.FReturnValue; Thread.FFinished := True; @@ -179,6 +183,7 @@ begin if FSuspended then Suspend; FThreadID := FHandle; IsMultiThread := TRUE; + FFatalException := nil; end; @@ -193,6 +198,8 @@ begin {$ifdef ver1_0}Kill{$else}fpkill{$endif}(FHandle, SIGKILL); dec(FStackPointer,FStackSize); Freemem(pointer(FStackPointer),FStackSize); + FFatalException.Free; + FFatalException := nil; inherited Destroy; RemoveThread(self); end; @@ -295,7 +302,10 @@ end; { $Log$ - Revision 1.8 2003-09-20 15:10:30 marco + Revision 1.9 2003-10-06 17:06:55 florian + * applied Johannes Berg's patch for exception handling in threads + + Revision 1.8 2003/09/20 15:10:30 marco * small fixes. fcl now compiles Revision 1.7 2002/12/18 20:44:36 peter diff --git a/fcl/netbsd/thread.inc b/fcl/netbsd/thread.inc index 0e12d07645..6b80414ae8 100644 --- a/fcl/netbsd/thread.inc +++ b/fcl/netbsd/thread.inc @@ -158,7 +158,11 @@ var FreeThread: Boolean; Thread : TThread absolute args; begin - Thread.Execute; + try + Thread.Execute; + except + Thread.FFatalException := TObject(AcquireExceptionObject); + end; FreeThread := Thread.FFreeOnTerminate; Result := Thread.FReturnValue; Thread.FFinished := True; @@ -187,6 +191,7 @@ begin if FSuspended then Suspend; FThreadID := FHandle; IsMultiThread := TRUE; + FFatalException := nil; end; @@ -201,6 +206,8 @@ begin Kill(FHandle, SIGKILL); dec(FStackPointer,FStackSize); Freemem(pointer(FStackPointer),FStackSize); + FFatalException.Free; + FFatalException := nil; inherited Destroy; RemoveThread(self); end; @@ -295,7 +302,10 @@ end; { $Log$ - Revision 1.5 2003-01-31 14:49:56 pierre + Revision 1.6 2003-10-06 17:06:55 florian + * applied Johannes Berg's patch for exception handling in threads + + Revision 1.5 2003/01/31 14:49:56 pierre * adapt 1.0 to change in signal.inc Revision 1.4 2003/01/24 21:13:31 marco diff --git a/fcl/netware/thread.inc b/fcl/netware/thread.inc index eb535583cd..52b22a1518 100644 --- a/fcl/netware/thread.inc +++ b/fcl/netware/thread.inc @@ -123,7 +123,11 @@ var FreeThread: Boolean; Thread : TThread absolute args; begin - Thread.Execute; + try + Thread.Execute; + except + Thread.FFatalException := TObject(AcquireExceptionObject); + end; FreeThread := Thread.FFreeOnTerminate; Result := Thread.FReturnValue; Thread.FFinished := True; @@ -146,6 +150,7 @@ begin if FSuspended then Suspend; FThreadID := FHandle; //IsMultiThread := TRUE; {already set by systhrds} + FFatalException := nil; end; @@ -159,6 +164,8 @@ begin end; if FHandle <> -1 then KillThread (FHandle); {something went wrong, kill the thread (not possible on netware)} + FFatalException.Free; + FFatalException := nil; inherited Destroy; RemoveThread(self); end; @@ -253,7 +260,10 @@ end; { $Log$ - Revision 1.2 2003-03-27 17:14:27 armin + Revision 1.3 2003-10-06 17:06:55 florian + * applied Johannes Berg's patch for exception handling in threads + + Revision 1.2 2003/03/27 17:14:27 armin * more platform independent thread routines, needs to be implemented for unix Revision 1.1 2003/03/25 17:56:19 armin diff --git a/fcl/openbsd/thread.inc b/fcl/openbsd/thread.inc index 4d70110998..f9158c4868 100644 --- a/fcl/openbsd/thread.inc +++ b/fcl/openbsd/thread.inc @@ -147,7 +147,11 @@ var FreeThread: Boolean; Thread : TThread absolute args; begin - Thread.Execute; + try + Thread.Execute; + except + Thread.FFatalException := TObject(AcquireExceptionObject); + end; FreeThread := Thread.FFreeOnTerminate; Result := Thread.FReturnValue; Thread.FFinished := True; @@ -176,6 +180,7 @@ begin if FSuspended then Suspend; FThreadID := FHandle; IsMultiThread := TRUE; + FFatalException := nil; end; @@ -190,6 +195,8 @@ begin Kill(FHandle, SIGKILL); dec(FStackPointer,FStackSize); Freemem(pointer(FStackPointer),FStackSize); + FFatalException.Free; + FFatalException := nil; inherited Destroy; RemoveThread(self); end; @@ -284,7 +291,10 @@ end; { $Log$ - Revision 1.2 2002-09-07 15:15:27 peter + Revision 1.3 2003-10-06 17:06:55 florian + * applied Johannes Berg's patch for exception handling in threads + + Revision 1.2 2002/09/07 15:15:27 peter * old logs removed and tabs fixed Revision 1.1 2002/07/30 16:03:29 marco diff --git a/fcl/os2/thread.inc b/fcl/os2/thread.inc index dbc5a50bf1..08ffee608b 100644 --- a/fcl/os2/thread.inc +++ b/fcl/os2/thread.inc @@ -166,7 +166,11 @@ var FreeThread: Boolean; Thread: TThread absolute Args; begin - Thread.Execute; + try + Thread.Execute; + except + Thread.FFatalException := TObject(AcquireExceptionObject); + end; FreeThread := Thread.FFreeOnTerminate; Result := Thread.FReturnValue; Thread.FFinished := True; @@ -191,6 +195,7 @@ begin Destroy; end else FHandle := FThreadID; IsMultiThread := TRUE; + FFatalException := nil; end; @@ -202,6 +207,8 @@ begin WaitFor; end; if FHandle <> -1 then DosKillThread (FHandle); + FFatalException.Free; + FFatalException := nil; inherited Destroy; RemoveThread (Self); end; @@ -233,7 +240,10 @@ end; { $Log$ - Revision 1.7 2003-02-20 17:12:39 hajny + Revision 1.8 2003-10-06 17:06:55 florian + * applied Johannes Berg's patch for exception handling in threads + + Revision 1.7 2003/02/20 17:12:39 hajny * fixes for OS/2 v2.1 incompatibility Revision 1.6 2002/09/07 15:15:27 peter diff --git a/fcl/win32/thread.inc b/fcl/win32/thread.inc index 8a3273cbcb..bc174cec23 100644 --- a/fcl/win32/thread.inc +++ b/fcl/win32/thread.inc @@ -99,7 +99,11 @@ function ThreadProc(Thread: TThread): Integer; var FreeThread: Boolean; begin - Thread.Execute; + try + Thread.Execute; + except + Thread.FFatalException := TObject(AcquireExceptionObject); + end; FreeThread := Thread.FFreeOnTerminate; Result := Thread.FReturnValue; Thread.FFinished := True; @@ -119,6 +123,7 @@ begin if CreateSuspended then Flags := CREATE_SUSPENDED; IsMultiThread := TRUE; FHandle := CreateThread(nil, 0, @ThreadProc, Pointer(self), Flags, DWord(FThreadID)); + FFatalException := nil; end; @@ -130,6 +135,8 @@ begin WaitFor; end; if FHandle <> 0 then CloseHandle(FHandle); + FFatalException.Free; + FFatalException := nil; inherited Destroy; RemoveThread; end; @@ -212,7 +219,10 @@ begin end; { $Log$ - Revision 1.7 2003-04-23 11:35:30 peter + Revision 1.8 2003-10-06 17:06:55 florian + * applied Johannes Berg's patch for exception handling in threads + + Revision 1.7 2003/04/23 11:35:30 peter * wndproc definition fix Revision 1.6 2002/09/07 15:15:29 peter