[Lazarus] Mutlithreaded Dll Callback crashes my Application

[Alexander Grau]

Hello Maik!

I have tried out your test program, and I get the crash too.  However 
your program is already doing 10 things at the same time ;-) - This is 
too difficult to find out the real problem - you need to scale down 
everything ... So, I have written a minimal test program for you here to 
start with - it works for me (no crash), how does it work at your side?

Regards,
Alexander


program project1;

{$mode objfpc}{$H+}

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

{$R project1.res}

type
  MT_THREAD_HANDLE   = Pointer;

  tdummy = class
    name: string;
    constructor create(aname: string);
    procedure test;
  end;


function vcmtdll_NewThread: MT_THREAD_HANDLE; stdcall; external 
'vcmtdll.dll';
procedure vcmtdll_DeleteThread(ahandle : MT_THREAD_HANDLE); stdcall; 
external 'vcmtdll.dll';
procedure vcmtdll_RegisterCallback(ahandle : MT_THREAD_HANDLE; pCBFunc : 
Pointer; pCBData : Pointer); stdcall; external 'vcmtdll.dll';
procedure vcmtdll_StartThread(ahandle : MT_THREAD_HANDLE; iDelay : 
Cardinal); stdcall; external 'vcmtdll.dll';

var
  handle: MT_THREAD_HANDLE;


constructor tdummy.create(aname: string);
begin
  inherited create;
  name:=aname;
end;

procedure tdummy.test;
begin
  writeln('tdummy.test: ', name);
end;

procedure OnExecuteClb(pCBData : Pointer); cdecl;
var
  dummy: tdummy;
  i: integer;
begin
  writeln('onExecuteClb');
  dummy:=tdummy.create('callbackdummy');
  tdummy(pCBData).test;
  for i:=1 to 30 do
    dummy.test();
  dummy.free;
end;

var
  globaldummy: tdummy;

begin
  globaldummy:=tdummy.create('globaldummy');

  writeln('start');
  Handle  := vcmtdll_NewThread();
  writeln('handle=', hexStr(handle));

  vcmtdll_RegisterCallback(Handle, @OnExecuteClb, globaldummy);
  vcmtdll_StartThread(handle, 0);

  sleep(1000);

  vcmtdll_DeleteThread(handle);
  writeln('bye');
  globaldummy.free;
end.







Maik Wojcieszak schrieb:
> Hi,
>
> After my holiday I've done done more research on this problem and hope I
> can get an answer while continuing this thread.
>
> My Versions (again)
>
> Lazarus IDE v0.9.28.2 Beta
> MS Windows XP Prof DE sp3
> FPC Version 2.2.4
>
> What I basically do is passing a pointer to a calback funtion to a dll
> writte in c++ (Visual Studio 2005) and call it from there.
> ** The follwing code is from the example attached to this mail **
>
> procedure OnExecuteClb(pCBData : Pointer); cdecl;
> begin
> ...
> end;
>
> The function is passed to the dll like this
>
> ...
>     FHandle    := uVCMTDLL.vcmtdll_NewThread();
>     uVCMTDLL.vcmtdll_RegisterCallback(FHandle, at OnExecuteClb,self);
> ...
>
>
> The test includes a dll which has the following interface
>
> ...
> #define VCMTDLL_API __declspec(dllexport)
>
> namespace VCMTDLL {
>
> typedef void* MT_THREAD_HANDLE;
>
> extern "C" {
>
> VCMTDLL_API MT_THREAD_HANDLE vcmtdll_NewThread();  // create a new
> thread object
> VCMTDLL_API void vcmtdll_DeleteThread(MT_THREAD_HANDLE ahandle); //
> delete an existing thread object
> VCMTDLL_API void vcmtdll_RegisterCallback(MT_THREAD_HANDLE ahandle,
> void* pCBFunc, void* pCBData); // pass a callback to execute inside the
> thread context
> VCMTDLL_API void vcmtdll_StartThread(MT_THREAD_HANDLE ahandle, unsigned
> int iDelay); // start the execution with a delay of <iDelay> milliseconds
>
> }// extern "C"
>
> ...
>
> with a loop in the callback function everything is fine
>
> ...
>    x := 0;
>    while x < 100 do
>    begin
>      x := x + 1;
>    end;
> ...
>
> I can execute it without problems.
>
> BUT if I create and destroy an object inside the procedure the app
> crahes or hangs after several runs of the test (between 1 an 10 starts).
>
> the object:
>
> ...
> TVCMTDummyObject = class
> private
> public
>       Tag : Integer;
> end;
> ...
>
> the code in the callback
>
> ...
>    a := TVCMTDummyObject.Create;
>    a.Free;
> ...
>
> Another problem is that a PostMessage from the callback's thread context
> immediatly crashes the app. But this may be resolved later.
>
> If there is anybody who uses a similar mechanism in his lazarus project
> and knows how to solve this problem it'd be great.
> The demo project together with dll is attached too.
>
> Best Regards
> Maik
>
>
>
>
>
>
>
>
>
> ------------------------------------------------------------------------
>
> --
> _______________________________________________
> Lazarus mailing list
> Lazarus at lists.lazarus.freepascal.org
> http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
>