{$O+,F+,X+}
UNIT QSortMem;       { Quick Sort in Memory }

{    Процедура быстрой в памяти чего угодно вне зависимости от типа
  элементов.  Входные данные:
  constructor Init(<кол-во элементов>,  <размер элемента>);

  procedure Sort(<указатель первого элемента>); - сортирует массив

  function CompMem(i,j:pointer):shortint; virtual; - функция сравнения
					       должна возвращать:
					       1 - если (i^> j^),
					       0 - если (i^= j^),
					      -1 - если (i^< j^);
  procedure Swap(i,j:tNumber); virtual; - вызывается при обмене i и j-го
					  элементов местами.

}

INTERFACE

const
{$IfDef Seg16}
  cMaxSize=$FFFF-SizeOf(word);
{$Else}
  cMaxSize=$FFFFFFFF-SizeOf(integer);;
{$EndIf Def Seg16}

type
  tNumber=1..cMaxSize;
  tElementSize=1..$FF;
  tInternalBuffer=array[tElementSize] of Byte;


  MemoryQSort=object
     constructor Init(TotalElementNumber:tNumber;
		      ElementSize:tElementSize);

     procedure Sort(Data:pointer);

     procedure Swap(i,j:tNumber); virtual;
     function  CompMem(i,j:pointer):shortint; virtual;

     procedure SetArrayParameters(TotalElementNumber:tNumber;
				    ElementSize:tElementSize);
     procedure GetArrayParameters(var TotalElementNumber:tNumber;
				    var ElementSize:tElementSize);
  private
     Tmp,Bnd:tInternalBuffer;
     prTotalElementNumber:tNumber;
     prElementSize:tElementSize;
  end;

IMPLEMENTATION

type
  tByteArray=array[0..cMaxSize] of Byte;
  tPtrByteArray=^tByteArray;

procedure MemoryQSort.Swap;
begin
end;

function MemoryQSort.CompMem(i,j:pointer):shortint;
begin
  RunError(211);
end;

constructor MemoryQSort.Init;
begin
  SetArrayParameters(TotalElementNumber,ElementSize);
end;

procedure MemoryQSort.Sort;

  var ESize:word;

  function Nth(n:tNumber):pointer;
  begin
    Nth:=@tPtrByteArray(Data)^[Pred(n)*ESize];
  end;

   procedure srt(l,r:tNumber);
     var i,j: longint;
   begin
     j:=r; i:=l;
     Move(Nth((i+j) div 2)^,Bnd,ESize);

     { Separating of array in range [l..r] }
      repeat
	{ Move left bound of area [i..j] }
	while CompMem(Nth(i), @Bnd)<=0 do Inc(i);

	{ Move right bound of area [i..j] }
	while CompMem(@Bnd, Nth(j))>=0 do Dec(j);

	if (i<j) then begin
	  { Swapping of elements i and j }
	  Move(Nth(i)^,tmp,    ESize);
	  Move(Nth(j)^,Nth(i)^,ESize);
	  Move(tmp,    Nth(j)^,ESize);
	  Swap(i, j);
	  Inc(i); Dec(j);
	end else if (i=j) then begin
	  Inc(i); Dec(j);
	end;
      until (j<=i);

     { Recoursive call for separating subareas }
     if (j-l) < (r-i) then begin
	if (l<j) then srt(l,j);
	if (i<r) then srt(i,r);
     end else begin
	if (i<r) then srt(i,r);
	if (l<j) then srt(l,j);
     end;

   end;

begin
  { Call the subprocedure to minimize memory requirements }
  ESize:=prElementSize;
  srt(1,prTotalElementNumber);
end;

procedure MemoryQSort.SetArrayParameters;
begin
{$IfOpt R+}
  if prTotalElementNumber*prElementSize>cMaxSize then RunError(201);
{$EndIf}
  prTotalElementNumber:=TotalElementNumber;
  prElementSize:=ElementSize;
end;

procedure MemoryQSort.GetArrayParameters;
begin
  TotalElementNumber:=prTotalElementNumber;
  ElementSize:=prElementSize;
end;

END.