From: mxmora@unix.sri.com (Matthew Xavier Mora)
Newsgroups: comp.sys.mac.programmer
Subject: fastQSort.p (Pascal port of  fastQsort.c)
Date: 28 Sep 92 22:58:59 GMT
Followup-To: comp.sys.mac.programmer
Organization: SRI International

I don't remember seeing this get posted so I'll post another copy.
This is the Pascal version of Hadyn Huntley's fastQsort.c that was
posted here long ago. Since I posted a request for sorting code in pascal,
I thought I should post this for the net in case anyone else is 
interested.

It could use a better memswap if someone has one.

Matt



{------------------------------------------------}
{ fastQsort port by Matthew Xavier Mora based on }
{ Hadyn Huntley fastqsort.c                      }
{ posted to C.S.M.P. on 09-28-92                 }
{                                                }
{Researched and written by:                      }
{                                                }
{		Haydn Huntley                                 }
{		Haydn's Consulting                            }
{		203 West Stone                                }
{		Fairfield, Iowa  52556                        }
{	(515) 472-7025                                 }
{                                                }		
{	During the school year, I may be reached at the}
{ following address:                             }
{                                                }	
{		Haydn Huntley                                 }
{		Eigenmann Hall #289                           }
{		Indiana University                            }
{		Bloomington, IN  47406                        }
{		(812) 857-8620                                }
{                                                }
{	E-mail:  huntley@copper.ucs.indiana.edu        }
{------------------------------------------------}
unit fastqsort;

interface

	procedure FastQSort (base: Ptr; numberofRecords: longint; sizeofRecord:
longint);

implementation


	procedure FastQSort (base: Ptr; numberofRecords: longint; sizeofRecord:
longint);
		var
			gSize: longint;
			tmp, LowerLimit, UpperLimit: ptr;

		procedure memSwap (p, q: ptr; qSize: longint);

		begin
			BlockMove(p, tmp, qSize);
			BlockMove(q, p, qSize);
			BlockMove(tmp, q, qSize);
		end;

		function GetSize (var n: longint; last, first: ptr): integer;
		begin
			n := (ord(last) - Ord(first)) div gsize;
			GetSize := n;
		end;

		function cmpFn (aPtr, bPtr: ptr): integer;
		begin
			cmpFn := IUMagString(ptr(ord(aPtr) + 1), ptr(ord(bPtr) + 1), gsize,
gsize);
		end;

{ ------------- begin doFastQSort ------------------------ }
		procedure doFastQSort (first, last: ptr);
			var
				i, j: Ptr;
				n: longint;
		begin
	{ first, last, i, and j are scaled by gSize in this function }

			while ((getsize(n, last, first)) > 1) do
				begin

			{ use a random pivot }
					memSwap(ptr(ord(first) + (abs(random) mod n) * gSize), first, gSize);

					i := first;
					j := last;

					while (true) do
						begin
							i := Ptr(ord(i) + gSize);
							while (ord(i) < ord(last)) and (CmpFn(i, first) < 0) do
								i := Ptr(ord(i) + gSize);

							j := Ptr(ord(j) - gSize);
							while (ord(j) > ord(first)) and (CmpFn(j, first) > 0) do
								j := Ptr(ord(j) - gSize);

							if (ord(i) >= ord(j)) then
								leave;

							memSwap(i, j, gSize);
						end;

					if (j = first) then
						begin
							first := ptr(ord(first) + gSize);
							cycle;
						end;

					memSwap(first, j, gSize);
					if (ord(j) - ord(first)) < (ord(last) - (ord(j) + gSize)) then
						begin
							doFastQSort(first, j);
							first := ptr(ord(j) + gSize);
			{ equivalent to doFastQSort (j + gSize, last);		}
			{ to save stack space								}
						end
					else
						begin
							doFastQSort(ptr(ord(j) + gSize), last);
							last := j;
			{ equivalent to doFastQSort (first, j);			}
			{ to save stack space								}
						end;
				end;
		end;
{ ------------- begin FastQsort ------------------------ }
	begin
	{ setup the global variables used by fastQSort() }

		gSize := sizeofRecord;
		randseed := TickCount;
		tmp := NewPtr(gsize); 						{temp ptr for swapping}
  if tmp <> nil then 
    begin 
	     { the args for fastQSort () must be scaled by gSize }
	    	doFastQSort(base, ptr(ord(base) + (numberofRecords) * gSize));
	    	DisposePtr(tmp);
   end;
	end;
end.