Re: [fpc-pascal] Threads executing in sequence instead of parallel

[Micha Nelissen]

Graeme Geldenhuys wrote:
> We have a problem!!!
> 
> The test project /fcl/tests/threads.pp as well as a Sort Demo (Bubble,
> Section and Quick Sort) all execute the threads in sequence, waiting
> for the previous thread to complete, before the next one executes.
> Kind of defeats the point of using threads.

There is no bug. The time slice management is simply different. Try
attached demo (it's your demo modified). You will notice that output
will be mixed.

Linux simply gives longer timeslices to threads (for efficiency reasons).

Micha

program demo1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes, SysUtils;
  
type
  // counts up till 1k
  TIncrementer = class(TThread)
  protected
    procedure Execute; override;
  end;
  
  // counts down from 1k
  TDecrementer = class(TThread)
  protected
    procedure Execute; override;
  end;
  
  
  TRunThreads = class(TObject)
    procedure ThreadTerminated(Sender: TObject);
  private
    t1, t2: TThread;
    FThreadCount: integer;
  public
    constructor Create;
    procedure RunNow;
  end;


{ TRunThreads }

procedure TRunThreads.ThreadTerminated(Sender: TObject);
begin
  Dec(FThreadCount);
end;


constructor TRunThreads.Create;
begin
  FThreadCount := 2;
  
  t1 := TIncrementer.Create(True);
  t1.OnTerminate := @ThreadTerminated;
  t1.Priority := tpLower;
  t1.FreeOnTerminate := True;
  
  t2 := TDecrementer.Create(True);
  t2.OnTerminate := @ThreadTerminated;
  t2.Priority := tpLower;
  t2.FreeOnTerminate := True;
end;


procedure TRunThreads.RunNow;
begin
  writeln('RunNow');
  t1.Resume;
  t2.Resume;
  repeat
    sleep(100);
  until FThreadCount = 0;
  WriteLn('All threads completed!');
end;

{ TIncrementer }

procedure BurnCPU(Multiplier: integer);
var
  i, k: integer;
begin
  k := 13;
  for i := 0 to Multiplier*500000 do
    k := k div 5 * 6;
end;

procedure TIncrementer.Execute;
var
  i: integer;
begin
  for i := 0 to 1000 do
  begin
    Writeln(Classname + ': ' + IntToStr(i));
    BurnCPU(3);
  end;
end;

{ TDecrementer }

procedure TDecrementer.Execute;
var
  i: integer;
begin
  for i := 1000 downto 0 do
  begin
    Writeln(Classname + ': ' + IntToStr(i));
    BurnCPU(4);
  end;
end;


var
  lRunThreads: TRunThreads;

begin
  lRunThreads := TRunThreads.Create;
  lRunThreads.RunNow;
  writeln('Done...');
end.


_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal