[Lazarus] Mutlithreaded Dll Callback crashes my Application

Alexander Grau alex at grauonline.de
Wed Aug 25 15:46:11 CEST 2010


Sven Barth schrieb:
> Am 25.08.2010 13:53, schrieb Maik Wojcieszak:
>> Alexander,
>>
>> I found something in the lazarus package for vortex :
>>
>> { FPC specific thread create function to replace Vortex's thread create.
>> This is required because FPC doesn't work when C libraries create 
>> their own
>> threads}
>>
>> This may lead us to a solution I guess.
>> Some more background about that would be nice. Is this documented
>> anywhere ?
>>
>> Maik
>
> You can read this thread on the fpc-pascal list: 
> http://www.hu.freepascal.org/lists/fpc-pascal/2010-July/025939.html
>
> Jonas has implemented a possibilty for external C threads to work, but 
> you need to use a SVN FPC and you need to create at least one thread 
> in FPC (it can terminate immediatly, it's just needed to initialise 
> the threading subsystem). (And this fix is *nix only)
If you read this thread carefully, you can notice that I already posted 
this here in my first answer to Maik ;-)

I also showed in a test program in a later post that this problem 
doesn't seem to exist in the Win32 target, it was just the Darwin 
target. Here's again the test program I wrote . I creates a non-FPC 
thread and inside that thread it calls back a FPC funtion and object. 
This fully works without crashes.




program project1;

{$APPTYPE CONSOLE}

{$mode objfpc}{$H+}


uses
 {$IFDEF UNIX}{$IFDEF UseCThreads}
 cthreads,
 {$ENDIF}{$ENDIF}
 Classes,
 { you can add units after this }
 windows;

{$R project1.res}

type
 TSomeClass = class
 public
   procedure someMethod();
 end;

procedure TSomeClass.someMethod();
begin
 writeln('TSomeClass.someMethod called');
end;


var
 ThreadID: DWORD;       //Thread-ID
 ThreadHandle: THandle; //Rückgabewert von CreateThread
 someObj: TSomeClass;


procedure someFunc(param: pchar); cdecl;
begin
 WriteLn('External is called - ThreadID=', GetCurrentThreadId);
 if assigned(param) then writeln('blub');
 writeln('param=', param);
 someObj.someMethod();
end;

function ExternalThread(zahl: Pointer): LongInt; stdcall;
begin
 //Sleep(2000);
 someFunc('test');
 Result:=0;
end;

begin
 WriteLn('Main ThreadID=', GetCurrentThreadId);
 someObj:=TSomeClass.create;

 WriteLn('Creating external thread');
 ThreadHandle:=CreateThread(nil, 0, TFNThreadStartRoutine(@ExternalThread),
   nil, 0, ThreadID);
 if ThreadHandle = 0 then writeln('ERROR creating external thread');
 readln;

 WriteLn('Freeing external thread');
 if ThreadHandle<>0 then CloseHandle(ThreadHandle);

 someObj.free;
end.






More information about the Lazarus mailing list