few@well.UUCP (Frank Whaley) (09/11/86)
The following is a shell archive containing M2 source to three sort routines I wrote for a friend. Possibly they are of general utility, hence I post. I am most impressed with the insertion sort (InSort). Using the binary search really makes this one hum along. Pay close attention to the local routines CopyBytes and SwapBytes (near the end of Sorts.mod). They are as generic as I could make them, and still be algorithmicly correct. Thus they probably won't work on your machine (I use L*gitech's 8086 compiler). I normally use 8086 assembler versions, which I'll post if enough people ask. few Frank Whaley Senior Engineer, Beyond Words UUCP: hplabs! ihnp4!ptsfa! seismo!lll-crg!well!few ARPA: well!few@lll-crg.ARPA Tell your boss what you really think; the truth will set you free. -----cut here-----cut here-----cut here-----cut here----- #! /bin/sh # This is a shell archive, meaning: # 1. Remove everything above the #! /bin/sh line. # 2. Save the resulting text in a file. # 3. Execute the file with /bin/sh (not csh) to create: # sorts.def # sorts.mod # This archive created: Wed Sep 10 13:52:57 1986 export PATH; PATH=/bin:/usr/bin:$PATH if test -f 'sorts.def' then echo shar: "will not over-write existing file 'sorts.def'" else cat << \SHAR_EOF > 'sorts.def' (**************************************** * * * Sorts.def -> various sorts * * * ****************************************) DEFINITION MODULE Sorts; FROM SYSTEM IMPORT ADDRESS; EXPORT QUALIFIED InSort, QuickSort, ShellSort, compfunc; TYPE (* a comparison function *) compfunc = PROCEDURE(ADDRESS, ADDRESS) : INTEGER; (* returns: 0 if first = second * 1 if first > second * -1 if first < second *) (**************************************** * * * InSort : insertion sort * * * ****************************************) PROCEDURE InSort( item : ADDRESS; (* IN:item to be inserted *) ary : ADDRESS; (* IN/OUT:array of items *) VAR nitems : CARDINAL; (* IN/OUT:number of items *) width : CARDINAL; (* IN:width of an item *) cmp : compfunc (* IN:comparison function *) ); (* * InSort inserts "item" into the given array (which is assumed to * be sorted) in the proper position. "nitems" is incremented to * indicate the new item count. *) (**************************************** * * * QuickSort : Hoare's QuickSort * * * ****************************************) PROCEDURE QuickSort( ary : ADDRESS; (* IN/OUT:array of items *) nitems : CARDINAL; (* IN:current item count *) width : CARDINAL; (* IN:width of an item *) cmp : compfunc (* IN:comparison function *) ); (* * QuickSort is an implementation of Hoare's QuickSort algorithm. * "ary" is the address of the base of the data; "nitems" is the number * of elements; "width" is the width of an element in bytes; "cmp" is a * comparison function to be called with two arguments which are the * addresses of the elements being compared. *) (**************************************** * * * ShellSort : Shell-Metzner sort * * * ****************************************) PROCEDURE ShellSort( ary : ADDRESS; (* IN/OUT:array of items *) nitems : CARDINAL; (* IN:number of items *) width : CARDINAL; (* IN:width of an item *) cmp : compfunc (* IN:comparison function *) ); (* * ShellSort is an implementation of the Shell-Metzner sort algorithm. * "ary" is the address of the base of the data; "nitems" is the number * of elements; "width" is the width of an element in bytes; "cmp" is a * comparison function to be called with two arguments which are the * addresses of the elements being compared. *) END Sorts. SHAR_EOF fi if test -f 'sorts.mod' then echo shar: "will not over-write existing file 'sorts.mod'" else cat << \SHAR_EOF > 'sorts.mod' (**************************************** * * * Sorts.mod -> various sorts * * * ****************************************) IMPLEMENTATION MODULE Sorts; FROM SYSTEM IMPORT ADDRESS, ADR, BYTE, TSIZE; CONST DEPTH = 20; (* QuickSort stack depth (handles 2^DEPTH elements) *) TYPE BytePtr = POINTER TO BYTE; (************************ * * * InSort * * * ************************) PROCEDURE InSort( item : ADDRESS; (* item to be inserted *) ary : ADDRESS; (* array of items *) VAR nitems : CARDINAL; (* current item count *) width : CARDINAL; (* width of an item *) cmp : compfunc (* comparison function *) ); VAR a, (* source ptr *) b : ADDRESS; (* destination ptr *) p : CARDINAL; (* insertion point index *) BEGIN IF nitems = 0 THEN a := ary; INC(nitems) ELSE (* find insertion point *) p := bSearch(item, ary, nitems, width, cmp); a := ary + (p * width); (* a -> insertion point *) b := ary + ((p + 1) * width); (* b -> new position *) INC(nitems); (* make room for new item *) CopyBytes(a, b, (nitems - p) * width) END; (* insert new item into array *) CopyBytes(item, a, width) END InSort; (************************ * * * QuickSort * * * ************************) PROCEDURE QuickSort( bas : ADDRESS; (* array of items *) n : CARDINAL; (* current item count *) wid : CARDINAL; (* width of an item *) cmp : compfunc (* comparison function *) ); VAR j, k, pvt, cnt : CARDINAL; lo, hi : ARRAY [0..(DEPTH - 1)] OF CARDINAL; BEGIN IF n < 2 THEN (* already sorted ?? *) RETURN END; cnt := 1; (* init *) lo[0] := 0; hi[0] := n - 1; WHILE cnt # 0 DO DEC(cnt); pvt := lo[cnt]; j := pvt + 1; k := hi[cnt]; n := k; WHILE j < k DO WHILE (j < k) AND (cmp(bas + (j * wid), bas + (pvt * wid)) < 1) DO INC(j) END; WHILE (j <= k) AND (cmp(bas + (pvt * wid), bas + (k * wid)) < 1) DO DEC(k) END; IF j < k THEN SwapBytes(bas + (j * wid), bas + (k * wid), wid); INC(j); DEC(k) END END; IF cmp(bas + (pvt * wid), bas + (k * wid)) > 0 THEN SwapBytes(bas + (pvt * wid), bas + (k * wid), wid) END; IF k > pvt THEN DEC(k) END; IF (k > pvt) AND (n > j) AND ((k - pvt) < (n - j)) THEN SwapBytes(ADR(k), ADR(n), TSIZE(CARDINAL)); SwapBytes(ADR(pvt), ADR(j), TSIZE(CARDINAL)) END; IF k > pvt THEN lo[cnt] := pvt; hi[cnt] := k; INC(cnt) END; IF n > j THEN lo[cnt] := j; hi[cnt] := n; INC(cnt) END; IF cnt >= DEPTH THEN HALT END; END END QuickSort; (************************ * * * ShellSort * * * ************************) PROCEDURE ShellSort( ary : ADDRESS; (* array of items *) nitems : CARDINAL; (* current item count *) width : CARDINAL; (* width of an item *) cmp : compfunc (* comparison function *) ); VAR a1, a2 : ADDRESS; i : INTEGER; j, jump : CARDINAL; BEGIN jump := nitems; LOOP jump := jump DIV 2; IF jump = 0 THEN EXIT END; FOR j := 0 TO (nitems - jump) DO i := j; REPEAT a1 := ary + (CARDINAL(i) * width); a2 := ary + ((CARDINAL(i) + jump) * width); IF cmp(a1, a2) <= 0 THEN i := -1; ELSE SwapBytes(a1, a2, width); DEC(i, jump) END UNTIL i < 0 END END END ShellSort; (* ===================================================== *) (* ================ LOCAL ROUTINES ===================== *) (* ===================================================== *) (************************************************ * * * bSearch -> perform binary search * * * ************************************************) PROCEDURE bSearch( key : ADDRESS; (* key to search for *) ary : ADDRESS; (* array of search items *) nitems : CARDINAL; (* number of items in array *) width : CARDINAL; (* width of an item *) cmp : compfunc (* comparison function *) ) : CARDINAL; VAR c, (* current index *) p, (* previous index *) lo, (* low index *) hi : CARDINAL; (* high index *) r : INTEGER; (* temp result *) BEGIN lo := 0; hi := nitems; p := hi; LOOP c := (hi + lo) DIV 2; IF p = c THEN EXIT END; p := c; r := cmp(key, ary + (c * width)); IF r = 0 THEN RETURN (c) END; IF r > 0 THEN lo := c ELSE hi := c END; END; RETURN (hi) END bSearch; (**************************************************************** * * * CopyBytes -> copy bytes from one address to another * * * ****************************************************************) PROCEDURE CopyBytes( src : ADDRESS; dst : ADDRESS; len : CARDINAL); VAR sp, dp : BytePtr; BEGIN (* check for overlap *) IF (dst > src) AND ((src + len) > dst) THEN src := src + len; dst := dst + len; WHILE len # 0 DO DEC(dst); DEC(src); sp := BytePtr(src); dp := BytePtr(dst); dp^ := sp^; DEC(len) END ELSE WHILE len # 0 DO sp := BytePtr(src); dp := BytePtr(dst); dp^ := sp^; INC(src); INC(dst); DEC(len) END END END CopyBytes; (**************************************** * * * SwapBytes -> swap bytes * * * ****************************************) PROCEDURE SwapBytes( a : ADDRESS; (* swap addresses *) b : ADDRESS; len : CARDINAL (* swap length *) ); VAR ap, bp : BytePtr; t : BYTE; BEGIN WHILE len # 0 DO ap := BytePtr(a); bp := BytePtr(b); t := ap^; ap^ := bp^; bp^ := t; INC(a); INC(b); DEC(len) END END SwapBytes; END Sorts. SHAR_EOF fi exit 0 # End of shell archive -- Frank Whaley Senior Engineer, Beyond Words UUCP: hplabs! ihnp4!ptsfa! seismo!lll-crg!well!few ARPA: well!few@lll-crg.ARPA Tell your boss what you really think; the truth will set you free.