[comp.lang.modula2] Generic sort p. 3

ob@IFI.UIB.NO (Ole Bjorn Tuftedal) (04/04/91)

IMPLEMENTATION MODULE GenericSorting;
(*
                          Richard S. Wiener,
                   Department of Computer Science,
              University of Colorado at Colorado Springs
             Colorado Springs, Colorado 80907, U S A.
*)

(* Related modules: DEFINITION MODULE GenericSorting,
                            file name GENERICS.DEF
                    MODULE TestGenericSorting;
                            file name TSTGENSO.MOD  *)

FROM SYSTEM IMPORT WORD;

   PROCEDURE GenericSort(VAR ObjectArray: ARRAY OF WORD;
                             object1, object2: ARRAY OF WORD;
                             GreaterThan: UserProc);
   (* GenericSort inputs an array of objects and returns the sorted
      array of objects.  Sorting method is bubble sort.
      Object1 and object2 are dummy samles of the objects being sorted.
      The implementation module requires the workspace of exactly two
      sample objects.
      The purpose of these objects is to provide workspace of the correct
      word size.
      The client program must supply GreaterThan. *)

   VAR   WordSizeOfObject: CARDINAL;
         NumberObjects: CARDINAL;
         index: CARDINAL;
         pos: CARDINAL;

      PROCEDURE Interchange(index1, index2: CARDINAL);
      VAR   WordCount: CARDINAL;
      BEGIN (* Interchange *)
         FOR WordCount:= 1 TO WordSizeOfObject DO
            object1[WordCount - 1]:= ObjectArray[index1 *
                                          WordSizeOfObject + WordCount - 1];
            object2[WordCount - 1]:= ObjectArray[index2 *
                                          WordSizeOfObject + WordCount - 1];
         END; (* FOR *)
         FOR WordCount:= 1 TO WordSizeOfObject DO
            ObjectArray[index1 * WordSizeOfObject + WordCount - 1]:=
                                             object2[WordCount - 1];
            ObjectArray[index2 * WordSizeOfObject + WordCount - 1]:=
                                             object1[WordCount - 1];
         END; (* FOR *)
      END Interchange;

      PROCEDURE Maximum(UPPER: CARDINAL; VAR pos: CARDINAL);
      VAR   index: CARDINAL;
            WordCount: CARDINAL;

         PROCEDURE GetObject(index: CARDINAL;
                             VAR Object: ARRAY OF WORD);
         VAR   WordCount: CARDINAL;
         BEGIN (*Get Object *)
            FOR WordCount:= 1 TO WordSizeOfObject DO
               Object[WordCount - 1]:= ObjectArray[index *
                                             WordSizeOfObject + WordCount - 1];
            END; (* FOR *)
         END GetObject;

      BEGIN (* Maximum *)
         pos:= 0;
         index:= 0;
         GetObject(index, object1);
         FOR index:= 1 TO UPPER DO
            GetObject(index, object2);
            IF GreaterThan(object2, object1) THEN
               FOR WordCount:= 1 TO WordSizeOfObject DO
                  object1[WordCount - 1]:= object2[WordCount - 1];
               END; (* FOR WordC *)
               pos:= index;
            END; (* IF GreaterThan *)
         END; (* FOR index *)
      END Maximum;

   BEGIN (* GenericSort *)
      WordSizeOfObject:= HIGH(object1) + 1;
      NumberObjects:= (HIGH(ObjectArray) + 1) DIV WordSizeOfObject;
      index:= NumberObjects;
      REPEAT
         DEC(index);
         Maximum(index, pos);
         Interchange(pos, index);
      UNTIL index = 0;
   END GenericSort;

END GenericSorting.

Ole-Bjorn Tuftedal
University of Bergen, Norway
Internet:  tuftedal@ifi.uib.no
Bitnet:    sinot@nobergen