unit c_qsort;

//
//  Implementation of C-like qsort.
//

{$MODE FPC}
{$MODESWITCH DEFAULTPARAMETERS}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}

interface

type
  TQSortComp = function (A, B: Pointer): PtrInt;
procedure qsort(ptr: Pointer; count: SizeUInt; size: SizeUInt; comp: TQSortComp);

implementation

procedure QSwap(X, Y, XEnd: Pointer; Buf: PtrUInt = 0); inline;
begin
  while X + SizeOf(PtrUInt) <= XEnd do begin
    Buf := PtrUInt(X^);
    PtrUInt(X^) := PtrUInt(Y^);
    PtrUInt(Y^) := Buf;
    Inc(X, SizeOf(PtrUInt));
    Inc(Y, SizeOf(PtrUInt));
  end;
  while X < XEnd do begin
    Buf := UInt8(X^);
    UInt8(X^) := UInt8(Y^);
    UInt8(Y^) := Buf;
    Inc(X);
    Inc(Y);
  end;
end;

procedure qsort(ptr: Pointer; count: SizeUInt; size: SizeUInt; comp: TQSortComp);
var
  M: Pointer;
  L, R: Pointer;
begin
  if size <= 0 then
    Exit;
  while count > 1 do begin
    L := ptr;
    R := ptr + (count - 1) * size;
    M := ptr + (count div 2) * size;
    repeat
      while comp(L, M) = -1 do Inc(L, size);
      while comp(M, R) = -1 do Dec(R, size);
      if L <= R then begin
        QSwap(L, R, L + size);
        if L = M then begin
          M := R;
        end else if R = M then
          M := L;
        Inc(L, size);
        Dec(R, size);
      end;
    until L > R;
    if L < ptr + count * size then
      qsort(L, (ptr + count * size - L) div size, size, comp);
    // explicit tail recursion
    count := (R - ptr) div size + 1;
  end;
end;

end.
