diff --git a/rtl/inc/sortbase.pp b/rtl/inc/sortbase.pp index 3c5c8865d5..3fc38a41bd 100644 --- a/rtl/inc/sortbase.pp +++ b/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.