From 17921c4b5a6529034d3901844fb6a8f4173abd17 Mon Sep 17 00:00:00 2001 From: ceriel Date: Fri, 19 Feb 1988 12:53:15 +0000 Subject: [PATCH] Added the ArraySort module --- lang/m2/libm2/.distr | 1 + lang/m2/libm2/ArraySort.def | 26 +++++++ lang/m2/libm2/ArraySort.mod | 150 ++++++++++++++++++++++++++++++++++++ lang/m2/libm2/LIST | 1 + lang/m2/libm2/Makefile | 2 +- 5 files changed, 179 insertions(+), 1 deletion(-) create mode 100644 lang/m2/libm2/ArraySort.def create mode 100644 lang/m2/libm2/ArraySort.mod diff --git a/lang/m2/libm2/.distr b/lang/m2/libm2/.distr index 7ef476437..dc9fdf46e 100644 --- a/lang/m2/libm2/.distr +++ b/lang/m2/libm2/.distr @@ -24,3 +24,4 @@ Traps.def CSP.def Epilogue.def Streams.def +ArraySort.def diff --git a/lang/m2/libm2/ArraySort.def b/lang/m2/libm2/ArraySort.def new file mode 100644 index 000000000..96179fa35 --- /dev/null +++ b/lang/m2/libm2/ArraySort.def @@ -0,0 +1,26 @@ +DEFINITION MODULE ArraySort; +(* + Module: Array sorting module + Author: Ceriel J.H. Jacobs + Date: $Header$ + + Interface is like the qsort() interface in C, so that an array of values + can be sorted. This does not mean that it has to be an ARRAY, but it does + mean that the values must be consecutive in memory, and the order is the + "memory" order. + The user has to define a comparison procedure of type CompareProc. + This routine gets two pointers as parameters. These are pointers to the + opbjects that must be compared. The sorting takes place in ascending order, + so that f.i. if the result of the comparison is "less", the first argument + comes in front of the second. +*) + FROM SYSTEM IMPORT ADDRESS; (* no generics in Modula-2, sorry *) + + TYPE CompareResult = (less, equal, greater); + CompareProc = PROCEDURE(ADDRESS, ADDRESS): CompareResult; + + 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 *) +END ArraySort. diff --git a/lang/m2/libm2/ArraySort.mod b/lang/m2/libm2/ArraySort.mod new file mode 100644 index 000000000..8ad9c3efe --- /dev/null +++ b/lang/m2/libm2/ArraySort.mod @@ -0,0 +1,150 @@ +(*$R-*) +IMPLEMENTATION MODULE ArraySort; +(* + Module: Array sorting module. + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + 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); + 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. + diff --git a/lang/m2/libm2/LIST b/lang/m2/libm2/LIST index 0e407d519..3c5b0b20f 100644 --- a/lang/m2/libm2/LIST +++ b/lang/m2/libm2/LIST @@ -16,6 +16,7 @@ Conversion.mod Semaphores.mod random.mod Strings.mod +ArraySort.mod catch.c Traps.mod Arguments.c diff --git a/lang/m2/libm2/Makefile b/lang/m2/libm2/Makefile index fd76aa3f0..b945a1861 100644 --- a/lang/m2/libm2/Makefile +++ b/lang/m2/libm2/Makefile @@ -6,7 +6,7 @@ SOURCES = ASCII.def EM.def MathLib0.def Processes.def \ random.def Semaphores.def Unix.def RealConver.def \ Strings.def InOut.def Terminal.def TTY.def \ Mathlib.def PascalIO.def Traps.def CSP.def \ - Epilogue.def Streams.def + Epilogue.def Streams.def ArraySort.def all: -- 2.34.1