(****************************************************************************)
(*  Bibliotheks-Modul QSORT.BIB                                             *)
(*    Sehr schnelle und universelle Quicksort-Routine zum Sortieren         *)
(*    von beliebigen Feldern beliebiger Datentypen.                         *)
(*                                                                          *)
(*    Vor dem Aufruf (nicht vor dem Einbinden!) muss eine asymmetrische     *)
(*    Ordnungsfunktion definiert werden:                                    *)
(*      function IrgendEinName(var x,y : TypDerFeldElemente) : boolean      *)
(*    Beispiel: funktion kleiner(var x,y : integer) : boolean;              *)
(*                begin kleiner:=x<y end;                                   *)
(*              keinesfalls: kleiner:=x<=y (nicht asymmetrisch!)            *)
(*    Wichtig: x und y muessen VAR-Parameter sein !!!                       *)
(*                                                                          *)
(*  pSortiere(SortArray,Siezof(SortArray),LoIndex,HiIndex,OrdAdr,von,bis)   *)
(*                                                                          *)
(*    hierbei ist                                                           *)
(*      SortArray das zu sortierende Feld                                   *)
(*      LoIndex   der unterste,                                             *)
(*      HiIndex   der oberste Feldindex wie bei der Felddeklaration         *)
(*      OrdAdr    Adresse der Ordnungsfunktion, als im Beispiel             *)
(*         addr(kleiner) bei CP/M-80                                        *)
(*         ofs(kleiner)  sonst                                              *)
(*                                                                          *)
(*      von, bis  der Sortierbereich                                        *)
(****************************************************************************)

procedure sortiere(var sortarray; size,loindex,hiindex,ordadr,von,bis:integer);
  type arrayptr = ^Byte;
  var elementgroesse : integer;
      mitte, i0, j0, m0 : arrayptr;

  procedure swap(var x,y; size:integer); (* aus TURBO-Special 2/3 *)
    begin
      inline($2a/x/$ed/$5b/y/$ed/$4b/size/$78/$b1/
             $28/$09/$1a/$ed/$a0/$2b/$77/$23/$ea/*+$fff9);
    end;

  function sortkleiner(var x,y; ordadr:integer) : boolean;
    begin
      inline($dd/$e1/$2a/x/$e5/$2a/y/$e5/$dd/$e5/$2a/ordadr/$e9);
    end;

  function element(i:integer) : arrayptr;
    begin
      element:=ptr(addr(sortarray)+i*elementgroesse);
    end;

  procedure inc(var index:integer; var pointer:arrayptr);
    begin
      index:=succ(index);
      pointer:=ptr(ord(pointer)+elementgroesse);
    end;

  procedure dec(var index:integer; var pointer:arrayptr);
    begin
      index:=pred(index);
      pointer:=ptr(ord(pointer)-elementgroesse);
    end;

  procedure e_sort(von, bis:integer); (* Einfacher Sort durch Austausch *)
    label exit;
    var i,j : integer;
    begin
      if bis<von then goto exit;
      i:=von; i0:=element(i);
      while i<bis do begin
        m0:=i0; j:=i; j0:=i0; inc(j,j0);
        while j<=bis do begin
          if sortkleiner(j0^,m0^,ordadr) then m0:=j0;
          inc(j,j0);
        end;
        if m0<>i0 then swap(i0^,m0^,elementgroesse);
        inc(i,i0);
      end;
      exit:
    end;

  {$A-}
  procedure sort(von, bis:integer); (* Rekursiver Quicksort *)
    label exit;
    var i,j : integer;
    begin
      if bis-von<6 then begin e_sort(von,bis); goto exit end;
      i:=von; j:=bis; m0:=element((i+j) shr 1);
      move(m0^,mitte^,elementgroesse); i0:=element(i); j0:=element(j);
      while i<=j do begin
        while sortkleiner(i0^,mitte^,ordadr) do inc(i,i0);
        while sortkleiner(mitte^,j0^,ordadr) do dec(j,j0);
        if i<=j then begin
          if i<>j then swap(i0^,j0^,elementgroesse);
          inc(i,i0); dec(j,j0);
        end;
      end;
      if bis-i < j-von then begin
                         if i<bis then sort(i,bis);
                         if von<j then sort(von,j);
                         end
                       else begin
                         if von<j then sort(von,j);
                         if i<bis then sort(i,bis)
                         end;
      exit:
    end;
  {$A+}

begin
  elementgroesse:=trunc(((size and 1)+2.0*(size shr 1))/succ(hiindex-loindex));
  getmem(mitte,elementgroesse);
  sort(von-loindex, bis-loindex);
  freemem(mitte,elementgroesse)
end;
