[fpc-pascal] Random thread lockup. QueueAsyncCall??

[Xiangrong Fang]

Hi There,

I am writing my "prime finder" app to understand how thread synchronization
works.  I tried two methods (critical section and rtlevent), both have
problem.  For example the rtlevent version will run for a while then
randomly stops. However, after the thread stops working it seems that the
GUI is still responsive.

Here is three core functions from then rtlevent version:

procedure TPrimeFinder.Execute;
begin
  while not Terminated do begin
    RTLeventWaitFor(Barrier);
    if not IsPrime then Number := 0;
    Application.QueueAsyncCall(@AddPrime, PtrInt(Self));
    RTLeventResetEvent(Barrier);
  end;
end;

procedure TPrimeFinder.AddPrime(data: PtrInt);
var
  tr: TPrimeFinder;
begin
  tr := TPrimeFinder(data);
  with fmMain do begin
    if tr.Number > 0 then begin
      cnt += 1;
      if tr.Number > max then max := tr.Number;
    end;
    tr.Number := num;
    RTLeventSetEvent(tr.Barrier);
    Inc(num);
    leCount.Text := IntToStr(cnt);
    leMax.Text := IntToStr(max);
  end;
end;

procedure TfmMain.Button1Click(Sender: TObject);
var
  i, c: Integer;
begin
  num := 2;
  c := StrToIntDef(edThreads.Text, 1);
  if c < 1 then c := 1;
  SetLength(wk, c);
  for i := 0 to c - 1 do begin
    wk[i] := TPrimeFinder.Create(False);
    wk[i].FreeOnTerminate := True;
    wk[i].Barrier := RTLEventCreate;
    wk[i].Number := num;
    Inc(num);
    RTLeventSetEvent(wk[i].Barrier);
  end;
end;

I suspect that it is blocked on the RTLeventWaitFor, because if I use this:

    RTLeventWaitFor(Barrier, 1000);

It will periodically pause for 1 second, then continue.

Is this a problem in Application.QueueAsyncCall, or I made some mistakes?

Thanks!
Xiangrong
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20140918/b8fdae0d/attachment.html>