paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 19:10:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
florian 2003-10-06 17:06:55 +00:00
parent c08fc17e6a
commit f13b9aa406
8 changed files with 90 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
fcl/freebsd/thread.inc
View File

@ -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

7
fcl/inc/classesh.inc
View File

@ -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

14
fcl/linux/thread.inc
View File

@ -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

14
fcl/netbsd/thread.inc
View File

@ -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

14
fcl/netware/thread.inc
View File

@ -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

14
fcl/openbsd/thread.inc
View File

@ -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

14
fcl/os2/thread.inc
View File

@ -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

14
fcl/win32/thread.inc
View File

@ -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