123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155 |
- (*
- (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands.
- See the copyright notice in the ACK home directory, in the file "Copyright".
- *)
- (*$R-*)
- IMPLEMENTATION MODULE ArraySort;
- (*
- Module: Array sorting module.
- Author: Ceriel J.H. Jacobs
- Version: $Id$
- *)
- FROM SYSTEM IMPORT ADDRESS, BYTE; (* no generics in Modula-2, sorry *)
- TYPE BytePtr = POINTER TO BYTE;
- VAR compareproc: CompareProc;
- PROCEDURE Sort(base: ADDRESS; (* address of array *)
- nel: CARDINAL; (* number of elements in array *)
- size: CARDINAL; (* size of each element *)
- compar: CompareProc); (* the comparison procedure *)
- BEGIN
- compareproc := compar;
- qsort(base, base+(nel-1)*size, size);
- END Sort;
- PROCEDURE qsort(a1, a2: ADDRESS; size: CARDINAL);
- (* Implemented with quick-sort, with some extra's *)
- VAR left, right, lefteq, righteq: ADDRESS;
- cmp: CompareResult;
- mainloop: BOOLEAN;
- BEGIN
- WHILE a2 > a1 DO
- left := a1;
- right := a2;
- lefteq := a1 + size * (((a2 - a1) + size) DIV (2 * size));
- righteq := lefteq;
- (*
- Pick an element in the middle of the array.
- We will collect the equals around it.
- "lefteq" and "righteq" indicate the left and right
- bounds of the equals respectively.
- Smaller elements end up left of it, larger elements end
- up right of it.
- *)
- LOOP
- LOOP
- IF left >= lefteq THEN EXIT END;
- cmp := compareproc(left, lefteq);
- IF cmp = greater THEN EXIT END;
- IF cmp = less THEN
- left := left + size;
- ELSE
- (* equal, so exchange with the element
- to the left of the "equal"-interval.
- *)
- lefteq := lefteq - size;
- exchange(left, lefteq, size);
- END;
- END;
- mainloop := FALSE;
- LOOP
- IF right <= righteq THEN EXIT END;
- cmp := compareproc(right, righteq);
- IF cmp = less THEN
- IF left < lefteq THEN
- (* larger one at the left,
- so exchange
- *)
- exchange(left,right,size);
- left := left + size;
- right := right - size;
- mainloop := TRUE;
- EXIT;
- END;
- (*
- no more room at the left part, so we
- move the "equal-interval" one place to the
- right, and the smaller element to the
- left of it.
- This is best expressed as a three-way
- exchange.
- *)
- righteq := righteq + size;
- threewayexchange(left, righteq, right,
- size);
- lefteq := lefteq + size;
- left := lefteq;
- ELSIF cmp = equal THEN
- (* equal, zo exchange with the element
- to the right of the "equal"
- interval
- *)
- righteq := righteq + size;
- exchange(right, righteq, size);
- ELSE
- (* leave it where it is *)
- right := right - size;
- END;
- END;
- IF (NOT mainloop) THEN
- IF left >= lefteq THEN
- (* sort "smaller" part *)
- qsort(a1, lefteq - size, size);
- (* and now the "larger" part, saving a
- procedure call, because of this big
- WHILE loop
- *)
- a1 := righteq + size;
- EXIT; (* from the LOOP *)
- END;
- (* larger element to the left, but no more room,
- so move the "equal-interval" one place to the
- left, and the larger element to the right
- of it.
- *)
- lefteq := lefteq - size;
- threewayexchange(right, lefteq, left, size);
- righteq := righteq - size;
- right := righteq;
- END;
- END;
- END;
- END qsort;
- PROCEDURE exchange(a,b: BytePtr; size : CARDINAL);
- VAR c: BYTE;
- BEGIN
- WHILE size > 0 DO
- DEC(size);
- c := a^;
- a^ := b^;
- a := ADDRESS(a) + 1;
- b^ := c;
- b := ADDRESS(b) + 1;
- END;
- END exchange;
- PROCEDURE threewayexchange(p,q,r: BytePtr; size: CARDINAL);
- VAR c: BYTE;
- BEGIN
- WHILE size > 0 DO
- DEC(size);
- c := p^;
- p^ := r^;
- p := ADDRESS(p) + 1;
- r^ := q^;
- r := ADDRESS(r) + 1;
- q^ := c;
- q := ADDRESS(q) + 1;
- END;
- END threewayexchange;
- END ArraySort.
|