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

[Graeme Geldenhuys]

On 29/09/06, Vincent Snijders <vsnijders at quicknet.nl> wrote:
> I thought in your initial mail your were talking about having a console test app
> with threads. Synchronize is harder then, because you have to call CheckSynchronize
> yourself.
>
> Vincent.

Below is a text (console) thread demo. The one thread counts from 0 to
1k and the other thread counts down from 1k to 0.  Again, under Linux,
one thread executes and teminates, then the next thread executes and
terminates.  Under windows, both threads run at the same time (output
is mixed as expected). No sychronize() is used in this demo.  See
attached screenshots for my output.

Regards,
  - Graeme  -


---------------------------------------
program demo1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$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 TIncrementer.Execute;
var
  i: integer;
begin
  for i := 0 to 1000 do
    Writeln(Classname + ': ' + IntToStr(i));
  Terminate;
end;

{ TDecrementer }

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


var
  lRunThreads: TRunThreads;

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

---------------------------------------



-- 
There's no place like 127.0.0.1
-------------- next part --------------
A non-text attachment was scrubbed...
Name: linux_demo1.png
Type: image/png
Size: 18749 bytes
Desc: not available
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20060929/236a1c06/attachment.png>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: vmware_win32_demo1.png
Type: image/png
Size: 5278 bytes
Desc: not available
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20060929/236a1c06/attachment-0001.png>