[9] | 1 | (*
|
---|
| 2 | (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
|
---|
| 3 | See the copyright notice in the ACK home directory, in the file "Copyright".
|
---|
| 4 | *)
|
---|
| 5 |
|
---|
| 6 | (*$R-*)
|
---|
| 7 | IMPLEMENTATION MODULE ArraySort;
|
---|
| 8 | (*
|
---|
| 9 | Module: Array sorting module.
|
---|
| 10 | Author: Ceriel J.H. Jacobs
|
---|
| 11 | Version: $Header: /cvsup/minix/src/lib/ack/libm2/ArraySort.mod,v 1.1 2005/10/10 15:27:46 beng Exp $
|
---|
| 12 | *)
|
---|
| 13 | FROM SYSTEM IMPORT ADDRESS, BYTE; (* no generics in Modula-2, sorry *)
|
---|
| 14 |
|
---|
| 15 | TYPE BytePtr = POINTER TO BYTE;
|
---|
| 16 |
|
---|
| 17 | VAR compareproc: CompareProc;
|
---|
| 18 |
|
---|
| 19 | PROCEDURE Sort(base: ADDRESS; (* address of array *)
|
---|
| 20 | nel: CARDINAL; (* number of elements in array *)
|
---|
| 21 | size: CARDINAL; (* size of each element *)
|
---|
| 22 | compar: CompareProc); (* the comparison procedure *)
|
---|
| 23 | BEGIN
|
---|
| 24 | compareproc := compar;
|
---|
| 25 | qsort(base, base+(nel-1)*size, size);
|
---|
| 26 | END Sort;
|
---|
| 27 |
|
---|
| 28 | PROCEDURE qsort(a1, a2: ADDRESS; size: CARDINAL);
|
---|
| 29 | (* Implemented with quick-sort, with some extra's *)
|
---|
| 30 | VAR left, right, lefteq, righteq: ADDRESS;
|
---|
| 31 | cmp: CompareResult;
|
---|
| 32 | mainloop: BOOLEAN;
|
---|
| 33 | BEGIN
|
---|
| 34 | WHILE a2 > a1 DO
|
---|
| 35 | left := a1;
|
---|
| 36 | right := a2;
|
---|
| 37 | lefteq := a1 + size * (((a2 - a1) + size) DIV (2 * size));
|
---|
| 38 | righteq := lefteq;
|
---|
| 39 | (*
|
---|
| 40 | Pick an element in the middle of the array.
|
---|
| 41 | We will collect the equals around it.
|
---|
| 42 | "lefteq" and "righteq" indicate the left and right
|
---|
| 43 | bounds of the equals respectively.
|
---|
| 44 | Smaller elements end up left of it, larger elements end
|
---|
| 45 | up right of it.
|
---|
| 46 | *)
|
---|
| 47 | LOOP
|
---|
| 48 | LOOP
|
---|
| 49 | IF left >= lefteq THEN EXIT END;
|
---|
| 50 | cmp := compareproc(left, lefteq);
|
---|
| 51 | IF cmp = greater THEN EXIT END;
|
---|
| 52 | IF cmp = less THEN
|
---|
| 53 | left := left + size;
|
---|
| 54 | ELSE
|
---|
| 55 | (* equal, so exchange with the element
|
---|
| 56 | to the left of the "equal"-interval.
|
---|
| 57 | *)
|
---|
| 58 | lefteq := lefteq - size;
|
---|
| 59 | exchange(left, lefteq, size);
|
---|
| 60 | END;
|
---|
| 61 | END;
|
---|
| 62 | mainloop := FALSE;
|
---|
| 63 | LOOP
|
---|
| 64 | IF right <= righteq THEN EXIT END;
|
---|
| 65 | cmp := compareproc(right, righteq);
|
---|
| 66 | IF cmp = less THEN
|
---|
| 67 | IF left < lefteq THEN
|
---|
| 68 | (* larger one at the left,
|
---|
| 69 | so exchange
|
---|
| 70 | *)
|
---|
| 71 | exchange(left,right,size);
|
---|
| 72 | left := left + size;
|
---|
| 73 | right := right - size;
|
---|
| 74 | mainloop := TRUE;
|
---|
| 75 | EXIT;
|
---|
| 76 | END;
|
---|
| 77 | (*
|
---|
| 78 | no more room at the left part, so we
|
---|
| 79 | move the "equal-interval" one place to the
|
---|
| 80 | right, and the smaller element to the
|
---|
| 81 | left of it.
|
---|
| 82 | This is best expressed as a three-way
|
---|
| 83 | exchange.
|
---|
| 84 | *)
|
---|
| 85 | righteq := righteq + size;
|
---|
| 86 | threewayexchange(left, righteq, right,
|
---|
| 87 | size);
|
---|
| 88 | lefteq := lefteq + size;
|
---|
| 89 | left := lefteq;
|
---|
| 90 | ELSIF cmp = equal THEN
|
---|
| 91 | (* equal, zo exchange with the element
|
---|
| 92 | to the right of the "equal"
|
---|
| 93 | interval
|
---|
| 94 | *)
|
---|
| 95 | righteq := righteq + size;
|
---|
| 96 | exchange(right, righteq, size);
|
---|
| 97 | ELSE
|
---|
| 98 | (* leave it where it is *)
|
---|
| 99 | right := right - size;
|
---|
| 100 | END;
|
---|
| 101 | END;
|
---|
| 102 | IF (NOT mainloop) THEN
|
---|
| 103 | IF left >= lefteq THEN
|
---|
| 104 | (* sort "smaller" part *)
|
---|
| 105 | qsort(a1, lefteq - size, size);
|
---|
| 106 | (* and now the "larger" part, saving a
|
---|
| 107 | procedure call, because of this big
|
---|
| 108 | WHILE loop
|
---|
| 109 | *)
|
---|
| 110 | a1 := righteq + size;
|
---|
| 111 | EXIT; (* from the LOOP *)
|
---|
| 112 | END;
|
---|
| 113 | (* larger element to the left, but no more room,
|
---|
| 114 | so move the "equal-interval" one place to the
|
---|
| 115 | left, and the larger element to the right
|
---|
| 116 | of it.
|
---|
| 117 | *)
|
---|
| 118 | lefteq := lefteq - size;
|
---|
| 119 | threewayexchange(right, lefteq, left, size);
|
---|
| 120 | righteq := righteq - size;
|
---|
| 121 | right := righteq;
|
---|
| 122 | END;
|
---|
| 123 | END;
|
---|
| 124 | END;
|
---|
| 125 | END qsort;
|
---|
| 126 |
|
---|
| 127 | PROCEDURE exchange(a,b: BytePtr; size : CARDINAL);
|
---|
| 128 | VAR c: BYTE;
|
---|
| 129 | BEGIN
|
---|
| 130 | WHILE size > 0 DO
|
---|
| 131 | DEC(size);
|
---|
| 132 | c := a^;
|
---|
| 133 | a^ := b^;
|
---|
| 134 | a := ADDRESS(a) + 1;
|
---|
| 135 | b^ := c;
|
---|
| 136 | b := ADDRESS(b) + 1;
|
---|
| 137 | END;
|
---|
| 138 | END exchange;
|
---|
| 139 |
|
---|
| 140 | PROCEDURE threewayexchange(p,q,r: BytePtr; size: CARDINAL);
|
---|
| 141 | VAR c: BYTE;
|
---|
| 142 | BEGIN
|
---|
| 143 | WHILE size > 0 DO
|
---|
| 144 | DEC(size);
|
---|
| 145 | c := p^;
|
---|
| 146 | p^ := r^;
|
---|
| 147 | p := ADDRESS(p) + 1;
|
---|
| 148 | r^ := q^;
|
---|
| 149 | r := ADDRESS(r) + 1;
|
---|
| 150 | q^ := c;
|
---|
| 151 | q := ADDRESS(q) + 1;
|
---|
| 152 | END;
|
---|
| 153 | END threewayexchange;
|
---|
| 154 |
|
---|
| 155 | END ArraySort.
|
---|