Dostałem świra i stwierdziłem, że zaimplementuje sobie sortowanie bąbelkowe w dwóch wątkach. Pomińmy fakt wydajności i sensu takiej implementacji a zajmijmy się kodem.
I od kodu zacznijmy:
unit BSort;
{==============================================================================}
{$mode objfpc}{$H+}
{==============================================================================}
interface
{==============================================================================}
uses
Classes, SysUtils;
{==============================================================================}
type
TcompFunc = function(AValue1, AValue2 : Integer) : boolean;
{==============================================================================}
procedure BubbleSort(var AMatrix : array of Integer; 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 := false;
if AValue1 > AValue2 then
result := true;
end;
{------------------------------------------------------------------------------}
procedure BubbleSort(var AMatrix : array of Integer; ACompFunc : TCompFunc);
var
i,j : Word;
begin
for i := Low(AMatrix) to High(AMatrix) do
for j := Low(AMatrix) to High(AMatrix) 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
TData = array of integer;
PData = ^TData;
{------------------------------------------------------------------------------}
type
TSort = class(TThread)
FMatrix : PData;
protected
procedure Execute; override;
public
constructor Create(var AMatrix : array of Integer);
public
property Terminated;
end;
{==============================================================================}
implementation
{==============================================================================}
constructor TSort.Create(var AMatrix : array of Integer);
begin
inherited Create(False);
FreeOnTerminate := False;
FMatrix := @AMatrix;
end;
{------------------------------------------------------------------------------}
procedure TSort.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
Max = 1000;
{==============================================================================}
var
Start : Double;
Stop : Double;
Time : array[0..1] of Double;
Matrix : array[0..9,0..Max] of integer;
i,j : Word;
{==============================================================================}
procedure Sort(var AMatrix : array of Integer);
var
Sort : array[0..1] of TSort;
Matrix : array[0..1] of array of Integer;
Highest : Integer;
i, j, k : Word;
begin
Highest := Low(Integer);
for i := Low(AMatrix) to High(AMatrix) do
if AMatrix[i] > Highest then
Highest := AMatrix[i];
for i := 0 to 1 do
SetLength(Matrix[i], Length(AMatrix) div 2);
j := 0;
k := 0;
for i := Low(AMatrix) to High(AMatrix) do
if AMatrix[i] < Highest div 2 then
begin
Matrix[0,j] := AMatrix[i];
Inc(j);
end
else
begin
Matrix[1,k] := AMatrix[i];
Inc(k);
end;
for i := 0 to 1 do
Sort[i] := TSort.Create(Matrix[i]);
for i := 0 to 1 do
if not Sort[i].Terminated then sleep(2);
for i := 0 to 1 do
FreeAndNil(Sort[i]);
k := 0;
for i := 0 to 2 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
Write('Losowanie ', i, ' tablicy...');
for j := 0 to Max do
Matrix[i,j] := Random(60000) - 30000;
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 Max do
Matrix[i,j] := Random(60000) - 30000;
Writeln('Wylosowana');
end;
Writeln;
Start := TimeStampToMsecs(DateTimeToTimeStamp(Now));
for i := 0 to 9 do
begin
Write('Sortowanie dwuwątkowe', 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 dwuwątkowe: ',Time[1]);
Readln;
end.
No i przy tworzeniu dwóch wątków wywala SIGSEGV :( zawsze miałem problem z wątkami i nie wiem dlaczego ten sigsegv jest.
--- edit ---
Poprawa błędu w kodzie.
--- edit 2 ---
dodanie var w konstruktorze wątku
poprawa błędu w kodzie.