+ added a sort algorithm interface that accepts a custom callback function for

exchanging two elements. This is required for TStringList.Sort (and is the
  most generic form for a sort algorithm interface that I can think of).

git-svn-id: trunk@41182 -

rtl/inc/sortbase.pp

@@ -26,25 +26,37 @@ type
   TItemListSorter_NoContext = procedure(Items: Pointer; ItemCount, ItemSize: SizeUInt; Comparer: TListSortComparer_NoContext);
 
   TListSortComparer_Context = function(Item1, Item2, Context: Pointer): Integer;
+  TListSortCustomItemExchanger_Context = procedure(Item1, Item2, Context: Pointer);
   TPtrListSorter_Context = procedure(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
   TItemListSorter_Context = procedure(Items: Pointer; ItemCount, ItemSize: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
+  TItemListSorter_CustomItemExchanger_Context = procedure(Items: Pointer;
+    ItemCount, ItemSize: SizeUInt; Comparer: TListSortComparer_Context;
+    Exchanger: TListSortCustomItemExchanger_Context; Context: Pointer);
 
   PSortingAlgorithm = ^TSortingAlgorithm;
   TSortingAlgorithm = record
     PtrListSorter_NoContextComparer: TPtrListSorter_NoContext;
     PtrListSorter_ContextComparer: TPtrListSorter_Context;
     ItemListSorter_ContextComparer: TItemListSorter_Context;
+    ItemListSorter_CustomItemExchanger_ContextComparer: TItemListSorter_CustomItemExchanger_Context;
   end;
 
 procedure QuickSort_PtrList_NoContext(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_NoContext);
 procedure QuickSort_PtrList_Context(ItemPtrs: PPointer; ItemCount: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
 procedure QuickSort_ItemList_Context(Items: Pointer; ItemCount, ItemSize: SizeUInt; Comparer: TListSortComparer_Context; Context: Pointer);
+procedure QuickSort_ItemList_CustomItemExchanger_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Exchanger: TListSortCustomItemExchanger_Context;
+                Context: Pointer);
 
 const
   QuickSort: TSortingAlgorithm = (
     PtrListSorter_NoContextComparer: @QuickSort_PtrList_NoContext;
     PtrListSorter_ContextComparer: @QuickSort_PtrList_Context;
     ItemListSorter_ContextComparer: @QuickSort_ItemList_Context;
+    ItemListSorter_CustomItemExchanger_ContextComparer: @QuickSort_ItemList_CustomItemExchanger_Context;
   );
 
 var
@@ -204,4 +216,56 @@ begin
   FreeMem(TempBuf, ItemSize);
 end;
 
+procedure QuickSort_ItemList_CustomItemExchanger_Context(
+                Items: Pointer;
+                ItemCount, ItemSize: SizeUInt;
+                Comparer: TListSortComparer_Context;
+                Exchanger: TListSortCustomItemExchanger_Context;
+                Context: Pointer);
+
+  procedure QuickSort(L, R : Longint);
+  var
+    I, J : Longint;
+    P : Pointer;
+  begin
+    repeat
+      I := L;
+      J := R;
+      P := Items + ItemSize*((L + R) div 2);
+      repeat
+        while Comparer(P, Items + ItemSize*I, Context) > 0 do
+          Inc(I);
+        while Comparer(P, Items + ItemSize*J, Context) < 0 do
+          Dec(J);
+        If I <= J then
+        begin
+          Exchanger(Items + ItemSize*I, Items + ItemSize*J, Context);
+          Inc(I);
+          Dec(J);
+        end;
+      until I > J;
+      // sort the smaller range recursively
+      // sort the bigger range via the loop
+      // Reasons: memory usage is O(log(n)) instead of O(n) and loop is faster than recursion
+      if J - L < R - I then
+      begin
+        if L < J then
+          QuickSort(L, J);
+        L := I;
+      end
+      else
+      begin
+        if I < R then
+          QuickSort(I, R);
+        R := J;
+      end;
+    until L >= R;
+  end;
+
+begin
+  if not Assigned(Items) or (ItemCount < 2) or (ItemSize < 1) then
+    exit;
+  QuickSort(0, ItemCount - 1);
+end;
+
 end.