But  using pthreads alone is working fine.

testthread1 can work under uclibc linux.


program testthread1;

{$mode objfpc}

uses
  sysutils, pthreads;

const
  threadcount = 10;
  stringlen = 10000;

var
   finished : longint;

threadvar
   thri : longint;

function myf(p : pointer) : longint;cdecl;

var
  s : ansistring;

begin
  Writeln('thread ',longint(p),' started');
  thri:=0;
  while (thri<stringlen) do
    begin
    s:=s+'1';
    inc(thri);
    end;
  Writeln('thread ',longint(p),' finished');
  InterLockedIncrement(finished);
  myf:=0;
end;

var
   i : longint;
    ThreadID1: ppthread_t;
begin
   Writeln('thread testing',longint(i),' started');
   finished:=0;
   for i:=1 to threadcount do
     pthread_create(@ThreadID1, nil, @myf, Pointer(i));
   while finished<threadcount do ;
   Writeln(finished);
end.
 



program testthread2 using cthreads will crash.

{$mode delphi}

uses
   sysutils, cthreads;

const
  threadcount = 100;
  stringlen = 10000;

var
   finished : longint;

threadvar
   thri : longint;

function f(p : pointer) : longint;

var
  s : ansistring;

begin
  Writeln('thread ',longint(p),' started');
  thri:=0;
  while (thri<stringlen) do
    begin
    s:=s+'1';
    inc(thri);
    end;
  Writeln('thread ',longint(p),' finished');
  InterLockedIncrement(finished);
  f:=0;
end;

function myf(p : pointer) : longint;cdecl;

var
  s : ansistring;

begin
  Writeln('thread ',longint(p),' started');
  thri:=0;
  while (thri<stringlen) do
    begin
    s:=s+'1';
    inc(thri);
    end;
  Writeln('thread ',longint(p),' finished');
  InterLockedIncrement(finished);
  myf:=0;
end;

var
   i : longint;
   t: TThreadId;
begin
   finished:=0;
   i := 65536;
   for i:=1 to threadcount do
     BeginThread(nil, i, @f, Pointer(i), 1, t);
   while finished<threadcount do ;
   Writeln(finished);
end.





_______________________________________________
fpc-devel maillist  -  [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-devel

Reply via email to