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 - [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
