First of all I would like to show you my code:
unit BSort;
{==============================================================================}
{$mode objfpc}{$H+}
{==============================================================================}
interface
{==============================================================================}
uses
Classes, SysUtils;
{==============================================================================}
type
TcompFunc = function(AValue1, AValue2 : Integer) : boolean;
TIntegerArray = array of integer;
PIntegerArray = ^TIntegerArray;
{==============================================================================}
procedure BubbleSort(var AMatrix : TIntegerArray; ACompFunc : TCompFunc);
function V1LargerV2(AValue1, AValue2 : Integer) : Boolean;
{==============================================================================}
implementation
{==============================================================================}
procedure Swap(var AValue1, AValue2 : Integer);
var
Tmp : Integer;
begin
Tmp := AValue1;
AValue1 := AValue2;
AValue2 := Tmp;
end;
{==============================================================================}
function V1LargerV2(AValue1, AValue2 : Integer) : Boolean;
begin
result := AValue1 > AValue2;
end;
{------------------------------------------------------------------------------}
procedure BubbleSort(var AMatrix : TIntegerArray; ACompFunc : TCompFunc);
var
i,j : Word;
begin
for i := Low(AMatrix) to High(AMatrix) - 1 do
for j := Low(AMatrix) to High(AMatrix) - 1 do
begin
if ACompFunc(AMatrix[j], AMatrix[j+1]) then
Swap(AMatrix[j], AMatrix[j+1]);
end;
end;
{==============================================================================}
end.
unit MultiThreadSort;
{==============================================================================}
{$mode objfpc}{$H+}
{==============================================================================}
interface
{==============================================================================}
uses
Classes, SysUtils, BSort;
{==============================================================================}
type
TSortThread = class(TThread)
FMatrix : PIntegerArray;
protected
procedure Execute; override;
public
constructor Create(var AMatrix : TIntegerArray);
public
property Terminated;
end;
{==============================================================================}
implementation
{==============================================================================}
constructor TSortThread.Create(var AMatrix : TIntegerArray);
begin
inherited Create(False);
FreeOnTerminate := False;
FMatrix := @AMatrix;
end;
{------------------------------------------------------------------------------}
procedure TSortThread.Execute;
begin
BubbleSort(FMatrix^, @V1LargerV2);
end;
{==============================================================================}
end.
program sortuj;
{==============================================================================}
{$mode objfpc}{$H+}
{==============================================================================}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, MultiThreadSort, BSort, Crt;
{==============================================================================}
const
Zakres = 20;
{==============================================================================}
var
Start : Double;
Stop : Double;
Time : array[0..1] of Double;
Matrix : array[0..9] of TIntegerArray;
i,j : Word;
{==============================================================================}
procedure Sort(var AMatrix : TIntegerArray);
var
SortThread : array[0..1] of TSortThread;
Matrix : array[0..1] of TIntegerArray;
Highest : Integer;
i, j, k : Word;
begin
// Znalezienie największej liczby w tablicy.
Highest := Low(Integer);
for i := Low(AMatrix) to High(AMatrix) do
if AMatrix[i] > Highest then
Highest := AMatrix[i];
// Zerowanie tablic pomocniczych.
for i := 0 to 1 do
SetLength(Matrix[i], 0);
// Podział tablicy do sortowania na dwie tablice:
// - pierwsza od najniższej do połowy najwyższej liczby.
// - druga od połowy najwyższej do najwyższej liczby.
j := 0;
k := 0;
for i := Low(AMatrix) to High(AMatrix) do
if AMatrix[i] < Highest div 2 then
begin
SetLength(Matrix[0], Length(Matrix[0]) + 1);
Matrix[0,j] := AMatrix[i];
Inc(j);
end
else
begin
SetLength(Matrix[1], Length(Matrix[1]) + 1);
Matrix[1,k] := AMatrix[i];
Inc(k);
end;
//Tworzenie i start wątków sortujacych.
for i := 0 to 1 do
SortThread[i] := TSortThread.Create(Matrix[i]);
// Oczekiwanie na zakończenie watków sortujących.
//for i := 0 to 1 do
// SortThread[i].WaitFor;
// while not SortThread[i].Terminated do
// sleep(2);
Sleep(10);
SortThread[0].WaitFor;
Sleep(10);
SortThread[1].WaitFor;
Sleep(10);
// Zwalnianie wątków sortujacych.
for i := 0 to 1 do
FreeAndNil(SortThread[i]);
// Łączenie tablic pomocniczych w jedną.
k := 0;
for i := 0 to 1 do
for j := Low(Matrix[i]) to High(Matrix[i]) do
begin
AMatrix[k] := Matrix[i,j];
Inc(k);
end;
end;
{==============================================================================}
begin
Randomize;
ClrScr;
for i := 0 to 9 do
begin
SetLength(Matrix[i],Zakres);
Write('Losowanie ', i, ' tablicy...');
for j := 0 to Zakres - 1 do
Matrix[i,j] := Random(100) - 50;
Writeln('Wylosowana');
end;
Writeln;
Start := TimeStampToMsecs(DateTimeToTimeStamp(Now));
for i := 0 to 9 do
begin
Write('Sortowanie ', i, ' tablicy...');
BubbleSort(Matrix[i],@V1LargerV2);
Writeln('Posortowana');
end;
Stop := TimeStampToMsecs(DateTimeToTimeStamp(Now));
Time[0] := Stop - Start;
Writeln;
for i := 0 to 9 do
begin
Write('Losowanie ',i,' tablicy...');
for j := 0 to Zakres do
Matrix[i,j] := Random(100) - 50;
Writeln('Wylosowana');
end;
Writeln;
Start := TimeStampToMsecs(DateTimeToTimeStamp(Now));
for i := 0 to 9 do
begin
Write('Sortowanie dwuwatkowe ', i, ' tablicy...');
Sort(Matrix[i]);
Writeln('Posortowana');
end;
Stop := TimeStampToMsecs(DateTimeToTimeStamp(Now));
Time[1] := Stop - Start;
Writeln;
Writeln('Sortowanie bąbelkowe : ',Time[0]);
Writeln('Sortowanie dwuwatkowe: ',Time[1]);
Readln;
end.
When I compile that code and run with Delphi 7 it is working fine. But when I compile it with Lazarus the last "writeln" text is doubled or tripled and program hangs. Could someone tell me why?
Delphi 7 is correct:
Lazarus is not correct:
