unit qwiksort;

interface

type
  // тип - функция сравнения 2х элементов
  // возвращает число:
  // >0, если a > b
  // <0, если a < b
  // =0, если a = b
  compare_function = function (var a;var b):integer;

procedure qsort(base:pointer;nmemb,size:longint;comp:compare_function);

implementation

const
  maxstack = 256;

  // процедура меняет местами содержимое 2х
  // элементов размера s в байтах
procedure xchg(var a;var b;s:longint);
var
  t:pointer;
begin
  getmem(t,s);
  move(a,t^,s);
  move(b,a,s);
  move(t^,b,s);
  freemem(t,s);
end;

  // собственно процедура сортировки, параметры:
  // base - указатель на 1й элемент
  // nmemb - кол-во элементов в массиве
  // size - размер элемента
  // comp - указатель на пользовательскую функцию сравнения
procedure qsort(base:pointer;nmemb,size:longint;comp:compare_function);
var
  lbs,ubs:array [0..maxstack-1] of pointer;
  sp:longint;
  offset:cardinal;
  lb,ub,m,p,i,j,t:pointer;
begin
  lbs[0] := base;
  ubs[0] := base; inc(ubs[0],(nmemb-1)*size);
  sp := 0;
  while sp >= 0 do
  begin
    lb := lbs[sp];
    ub := ubs[sp];
    while lb < ub  do
    begin
      offset := (ub - lb) shr 1;
      p := lb;
      inc(p,offset-(offset mod size));
      xchg(lb^,p^,size);
      i := lb;
      inc(i,size);
      j := ub;
      while (true) do
      begin
        while (i < j) and (comp(lb^,i^) > 0) do inc(i,size);
        while (j >= i) and (comp(j^,lb^) > 0) do dec(j,size);
        if i >= j then break;
        xchg(i^,j^,size);
        dec(j,size);
        inc(i,size);
      end;
      xchg(lb^,j^,size);
      m := j;
      if (m - lb) <= (ub - m) then
      begin
        t := m;
        inc(t,size);
        if t < ub then
        begin
          lbs[sp] := t;
          ubs[sp] := ub;
          inc(sp);
        end;
        t := m;
        dec(t,size);
        ub := t;
      end
      else
      begin
        t := m;
        dec(t,size);
        if t > lb then
        begin
          lbs[sp] := lb;
          ubs[sp] := t;
          inc(sp);
        end;
        t := m;
        inc(t,size);
        lb := t;
      end;
    end;
    dec(sp);
  end;
end;

begin
end.