program ConcurrentQuickSort;
{ Program demonstruje paralelni trideni. Misto rekurzivniho volani tridici
  procedury je pro kazde subpole vytvorena nova instance procesu Sort.
  Proces Counter zjistuje dokonceni vsech tridicich procesu a informuje
  o tom hlavni proces. }
{ Pro spravne osetreni pripadnych chyb je vhodne nastavit DEFINE = DOS }

uses Kernel, DOS;

var Increment, Decrement, Done: MailBox;

const N = 100;

var Pole: array [1..N] of Word;

{$F+}
procedure Counter;
{$F-}
const Count: Word = 1;                        { Citac tridicich procesu }
begin
     Start('Counter', 1000, 127, 0); Exit;         { Startovaci sekvence }
     repeat
                 { Cekani na zpravu o vytvoreni resp. o zruseni procesu }
           ChoiceEmpty(1, Increment);
           ChoiceEmpty(2, Decrement);
           case Receive of
                1: Inc(Count);
                2: Dec(Count);
           end;
     until Count=0;
     SendEmpty(Done);                       { Zprava o ukonceni trideni }
end {Counter};

{$F+}
procedure Sort(Low, High: Word);
{$F-}
var I,J: Word;

procedure Divide(Low: Word; var I,J: Word; High: Word);
var X,W: Word;
begin
     I := High;
     J := Low;
     X := Pole[(Low+High) div 2];
     repeat
           while Pole[J]<X do Inc(J);
           while Pole[I]>X do Dec(I);
           if J<=I then
           begin
                W := Pole[I];
                Pole[I] := Pole[J];
                Pole[J] := W;
                Inc(J);
                Dec(I);
           end;
     until J>I;
end {Divide};

begin {Sort}
      Start('Sort', 800, 0, 254); Exit;           { Startovaci sekvence }
      Divide(Low, I, J, High);
      if Low<I then
      begin
           SendEmpty(Increment);    { Zprava o vytvoreni noveho procesu }
           Sort(Low, I);                 { Rekurzivni vytvoreni procesu }
      end;
      if J<High then
      begin
           SendEmpty(Increment);    { Zprava o vytvoreni noveho procesu }
           Sort(J, High);                { Rekurzivni vytvoreni procesu }
      end;
      SendEmpty(Decrement);                { Zprava o dokonceni procesu }
end {Sort};

{$F+}
procedure MyTerminate;

begin
{     if ReadyCount>0 then Ready.List;
{!ViP}{ Kernel vola MyTerminate v okamziku, kdy jeste bezi Main a Dummy}
{Pro 0 je tak vzdy vypisuje jako Ready}
     if ReadyCount>2 then Ready.List; {}

     if DelayCount>0 then DelayQ.List;

end {MyTerminate};

var I: Word;
begin {Main}
      UserTerminate := MyTerminate;
      StartMain(0, 0);                             { Inicializace jadra }
      InitInterruptStack(1, 128);{ Inicializace zasobniku pro preruseni }
      StartTimeSlicing(8);            { Inicializace casoveho preruseni }
                                                { Inicializace schranek }
      InitCounterMailBox(Increment, 'Increment', Normal);
      InitCounterMailBox(Decrement, 'Decrement', Normal);
      InitCounterMailBox(Done,      'Done'     , Normal);
      Randomize;
      Lock;              { Chranena sekce pro vypis nesetridenenho pole }
       Writeln('Start');
       for I := 1 to N do
       begin
           Pole[I]:=Random(N);
           Write(Pole[I]:8);
       end;
      UnLock;
      Counter;                               { Spusteni procesu Counter }
      Sort(1, N);                       { Spusteni prvniho procesu Sort }
                 { Cekani na zpravu o dokonceni vsech tridicich procesu }
      ChoiceEmpty(1, Done);
      if Receive=1 then;
      Lock;                 { Chranena sekce pro vypis setrideneho pole }
       Writeln('Done');
       for I := 1 to N do Write(Pole[I]:8);
      UnLock;
      TerminateMain;                          { Ukonceni cinnosti jadra }
{      Writeln('End');
{!ViP} {jen pro moznost prohlednuti vysledku }
      Writeln('End...press enter');
      Readln; {}
end {Main}.
