+ added support for intialising/finalising threads not started via the FPC

runtime

git-svn-id: trunk@15557 -
This commit is contained in:
Jonas Maebe 2010-07-12 16:16:50 +00:00
parent 547f082abc
commit bfc1a6ff1c
3 changed files with 138 additions and 8 deletions

1
.gitattributes vendored
View File

@ -9137,6 +9137,7 @@ tests/test/texception6.pp svneol=native#text/plain
tests/test/texception7.pp svneol=native#text/plain
tests/test/texception8.pp svneol=native#text/plain
tests/test/texception9.pp svneol=native#text/plain
tests/test/textthr.pp svneol=native#text/plain
tests/test/tfillchr.pp svneol=native#text/plain
tests/test/tfinal1.pp svneol=native#text/pascal
tests/test/tfinal2.pp svneol=native#text/pascal

View File

@ -107,7 +107,8 @@ Type PINTRTLEvent = ^TINTRTLEvent;
var
TLSKey : pthread_key_t;
TLSKey,
CleanupKey : pthread_key_t;
procedure CInitThreadvar(var offset : dword;size : dword);
begin
@ -160,22 +161,54 @@ Type PINTRTLEvent = ^TINTRTLEvent;
pthread_setspecific(tlskey,dataindex);
end;
procedure CthreadCleanup(p: pointer); cdecl;
{$ifdef DEBUG_MT}
var
s: string[100]; // not an ansistring
{$endif DEBUG_MT}
begin
{$ifdef DEBUG_MT}
s := 'finishing externally started thread'#10;
fpwrite(0,s[1],length(s));
{$endif DEBUG_MT}
{ clean up }
DoneThread;
{ the pthread routine that calls us is supposed to do this, but doesn't
at least on Mac OS X 10.6 }
pthread_setspecific(CleanupKey,nil);
end;
procedure HookThread;
begin
{ Allocate local thread vars, this must be the first thing,
because the exception management and io depends on threadvars }
CAllocateThreadVars;
{ we cannot know the stack size of the current thread, so pretend it
is really large to prevent spurious stack overflow errors }
InitThread(1000000000);
{ instruct the pthreads system to clean up this thread when it exits }
pthread_setspecific(CleanupKey,pointer(1));
end;
function CRelocateThreadvar(offset : dword) : pointer;
var
P : Pointer;
var
P : Pointer;
begin
P:=pthread_getspecific(tlskey);
{ a thread which we did not create? }
if (P=Nil) then
begin
CAllocateThreadvars;
// If this also goes wrong: bye bye threadvars...
P:=pthread_getspecific(tlskey);
HookThread;
// If this also goes wrong: bye bye threadvars...
P:=pthread_getspecific(tlskey);
end;
CRelocateThreadvar:=P+Offset;
end;
procedure CReleaseThreadVars;
begin
Fpmunmap(pointer(pthread_getspecific(tlskey)),threadvarblocksize);
@ -276,6 +309,16 @@ Type PINTRTLEvent = ^TINTRTLEvent;
{ We're still running in single thread mode, setup the TLS }
pthread_key_create(@TLSKey,nil);
InitThreadVars(@CRelocateThreadvar);
{ used to clean up threads that we did not create ourselves:
a) the default value for a key (and hence also this one) in
new threads is NULL, and if it's still like that when the
thread terminates, nothing will happen
b) if it's non-NULL, the destructor routine will be called
when the thread terminates
-> we will set it to 1 if the threadvar relocation routine is
called from a thread we did not create, so that we can
clean up everything at the end }
pthread_key_create(@CleanupKey,@CthreadCleanup);
end
end;
{ the only way to pass data to the newly created thread

86
tests/test/textthr.pp Normal file
View File

@ -0,0 +1,86 @@
{ %os=darwin,linux,freebsd,solaris,haiku }
{$mode objfpc}
uses
cthreads, pthreads, classes, unixtype;
type
tc = class(tthread)
procedure execute;override;
end;
procedure tc.execute;
begin
end;
function threadproc(arg: pointer): pointer; cdecl;
var
p: pointer;
a: ansistring;
begin
setlength(a,4000000);
getmem(p,5);
writeln('hi from thread ',ptruint(arg));
freemem(p);
result:=pointer(ptruint(arg)+10);
end;
var
t1, t2, t3: pthread_t;
res: pointer;
begin
{ initialise threading system }
with tc.create(false) do
begin
waitfor;
free;
end;
if pthread_create(@t1,nil,@threadproc,pointer(1))<>0 then
begin
writeln('error creating 1');
halt(1);
end;
if pthread_create(@t2,nil,@threadproc,pointer(2))<>0 then
begin
writeln('error creating 2');
halt(1);
end;
if pthread_create(@t3,nil,@threadproc,pointer(3))<>0 then
begin
writeln('error creating 3');
halt(1);
end;
if pthread_join(t1,@res)<>0 then
begin
writeln('error joining 1');
halt(1);
end;
if res<>pointer(11) then
begin
writeln('error 1');
halt(1);
end;
if pthread_join(t2,@res)<>0 then
begin
writeln('error joining 1');
halt(1);
end;
if res<>pointer(12) then
begin
writeln('error 2');
halt(2);
end;
if pthread_join(t3,@res)<>0 then
begin
writeln('error joining 1');
halt(1);
end;
if res<>pointer(13) then
begin
writeln('error 3');
halt(3);
end;
end.