Browse Source

* applied Johannes Berg's patch for exception handling in threads

florian 22 years ago
parent
commit
f13b9aa406

+ 12 - 2
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

+ 6 - 1
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

+ 12 - 2
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

+ 12 - 2
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

+ 12 - 2
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

+ 12 - 2
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

+ 12 - 2
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

+ 12 - 2
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