paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-18 05:39:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed FreeOnTerminate (was already fixed in Linux version)

Browse Source 
* handle interrupted reads from the semaphore pipe in Darwin (should be
    applied to *BSD and Linux as well)
  + lots of extra debugging code in Darwin tthread.inc if DEBUG_MT defined

git-svn-id: trunk@1416 -
This commit is contained in:
Jonas Maebe 2005-10-16 13:59:19 +00:00
parent 6ec54bc2c9
commit f5083e8dfa
4 changed files with 24 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
rtl/darwin/tthread.inc
View File

@ -54,6 +54,15 @@
Johannes Berg <johannes@sipsolutions.de>, Sunday, November 16 2003
}
{ ok, so this is a hack, but it works nicely. Just never use
a multiline argument with WRITE_DEBUG! }
{$MACRO ON}
{$IFDEF DEBUG_MT}
{$define WRITE_DEBUG := writeln} // actually write something
{$ELSE}
{$define WRITE_DEBUG := //} // just comment out those lines
{$ENDIF}
// ========== semaphore stuff ==========
{
I don't like this. It eats up 2 filedescriptors for each thread,
@ -70,13 +79,18 @@ function SemaphoreInit: Pointer;
begin
SemaphoreInit := GetMem(SizeOf(TFilDes));
fppipe(PFilDes(SemaphoreInit)^);
WRITE_DEBUG('Opened file descriptor ',PFilDes(SemaphoreInit)^[0]);
end;
procedure SemaphoreWait(const FSem: Pointer);
var
b: byte;
begin
fpread(PFilDes(FSem)^[0], b, 1);
WRITE_DEBUG('Waiting for file descriptor ',PFilDes(FSem)^[0]);
repeat
if fpread(PFilDes(FSem)^[0], b, 1) = -1 then
WRITE_DEBUG('Error reading from semaphore ',PFilDes(FSem)^[0],' error = ',fpgeterrno);
until fpgeterrno <> ESysEIntr;
end;
procedure SemaphorePost(const FSem: Pointer);
@ -85,16 +99,19 @@ var
b : byte;
{$endif}
begin
WRITE_DEBUG('Activating file descriptor ',PFilDes(FSem)^[0]);
{$ifdef VER2_0}
b:=0;
fpwrite(PFilDes(FSem)^[1], b, 1);
{$else}
fpwrite(PFilDes(FSem)^[1], #0, 1);
if fpwrite(PFilDes(FSem)^[1], #0, 1) = -1 then
WRITE_DEBUG('Error writing file descriptor ',PFilDes(FSem)^[0],' error = ',fpgeterrno);
{$endif}
end;
procedure SemaphoreDestroy(const FSem: Pointer);
begin
WRITE_DEBUG('Closing file descriptor ',PFilDes(FSem)^[0]);
fpclose(PFilDes(FSem)^[0]);
fpclose(PFilDes(FSem)^[1]);
FreeMemory(FSem);
@ -121,15 +138,6 @@ begin
ThreadsInited := false;
end;
{ ok, so this is a hack, but it works nicely. Just never use
a multiline argument with WRITE_DEBUG! }
{$MACRO ON}
{$IFDEF DEBUG_MT}
{$define WRITE_DEBUG := writeln} // actually write something
{$ELSE}
{$define WRITE_DEBUG := //} // just comment out those lines
{$ENDIF}
function ThreadFunc(parameter: Pointer): LongInt;
var
LThread: TThread;
@ -191,7 +199,7 @@ end;
destructor TThread.Destroy;
begin
if FThreadID = GetCurrentThreadID then begin
if (FThreadID = GetCurrentThreadID) and not(FFreeOnTerminate) then begin
raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
end;
// if someone calls .Free on a thread with
@ -256,7 +264,7 @@ end;
function TThread.WaitFor: Integer;
begin
WRITE_DEBUG('waiting for thread ',FHandle);
WRITE_DEBUG('waiting for thread ',ptrint(FHandle));
WaitFor := WaitForThreadTerminate(FHandle, 0);
WRITE_DEBUG('thread terminated');
end;

2
rtl/freebsd/tthread.inc
View File

@ -204,7 +204,7 @@ end;
destructor TThread.Destroy;
begin
if FThreadID = GetCurrentThreadID then begin
if (FThreadID = GetCurrentThreadID) and not(FFreeOnTerminate) then begin
raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
end;
// if someone calls .Free on a thread with

2
rtl/netbsd/tthread.inc
View File

@ -195,7 +195,7 @@ end;
destructor TThread.Destroy;
begin
if FThreadID = GetCurrentThreadID then begin
if (FThreadID = GetCurrentThreadID) and not(FFreeOnTerminate) then begin
raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
end;
// if someone calls .Free on a thread with

2
rtl/openbsd/tthread.inc
View File

@ -205,7 +205,7 @@ end;
destructor TThread.Destroy;
begin
if FThreadID = GetCurrentThreadID then begin
if (FThreadID = GetCurrentThreadID) and not(FFreeOnTerminate) then begin
raise EThreadDestroyCalled.Create('A thread cannot destroy itself except by setting FreeOnTerminate and leaving!');
end;
// if someone calls .Free on a thread with