home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 03 / kurs / qsort1.mod < prev    next >
Encoding:
Text File  |  1990-01-10  |  3.0 KB  |  79 lines

  1. (**********************************************************)
  2. (*                   Modula-Kurs Teil 6                   *)
  3. (*             (C) Peter Viczena & toolbox 1990           *)
  4. (**********************************************************)
  5.  
  6. MODULE Qsort1;
  7. (* ein kurzes Beispiel, wie man PointerQuickSort zur Sortie-
  8. rung von Integerzahlen verwenden kann. *)
  9.  
  10. FROM InOut     IMPORT WriteString,WriteInt,WriteLn;
  11. FROM IO        IMPORT WrLngCard;
  12. FROM Storage   IMPORT ALLOCATE,DEALLOCATE;
  13. (* FROM SYSTEM    IMPORT LONG; *)
  14. FROM SortMerg  IMPORT Ptr,CompareResult,CProc,
  15.                       PointerQuickSort;
  16.  
  17. CONST nmax  = 20;    (* Zahl der zu sortierenden Elemente *)
  18.       Greater =   1;                      (* evtl. ändern *)
  19.       Equal   =   0;
  20.       Less    =  -1;
  21. TYPE IntPtr = POINTER TO LONGCARD;             (* INTEGER *)
  22.                                           (* evtl. ändern *)
  23. VAR a       : ARRAY [1..nmax] OF Ptr;
  24.     i,j     : INTEGER;
  25.     dummypt : IntPtr;                     (* Hilfspointer *)
  26.  
  27. (* This is an example of a user-defined procedure that com-
  28.    pares the values to which its two arguments point. Note
  29.    that you have to use two pointers of the appropriate type
  30.    to do the comparison. This may seem inefficient, but it
  31.    is necessary (how else are you going to compare any-
  32.    thing?). Anyway, a good compiler will not produce any
  33.    extra code for the variables ah and bh. *)
  34.  
  35. PROCEDURE CompareInt(a,b:Ptr):CompareResult;
  36.  
  37. (* Diese Prozedur zeigt, wie eine benutzerdefinierte Ver-
  38.    gleichsoperation aufgebaut sein kann. Beachten Sie, daß
  39.    die unten benutzten Pointer vom richtigen Typ sein müs-
  40.    sen. Da diese Pointer aber kein Allocate machen, wird
  41.    kein überflüssiger speicherplatz verbraucht. *)
  42.  
  43. VAR ah,bh: IntPtr;
  44.  
  45. BEGIN        (* ah zeigt jetzt auf denselben Inhalt wie a *)
  46.    ah := a; bh := b;
  47.    IF ah^ > bh^ THEN
  48.       RETURN Greater
  49.    ELSIF ah^ = bh^ THEN
  50.       RETURN Equal
  51.    ELSE
  52.       RETURN Less
  53.    END;
  54. END CompareInt;    (* Vergleich der Inhalte von ah und bh *)
  55.  
  56. BEGIN                                    (* Hauptprogramm *)
  57.  
  58.    WriteString('BEGIN Qsort1'); WriteLn;
  59.    WriteString('raw data:'); WriteLn;
  60.  
  61.    FOR i := 1 TO nmax DO  (* Fülle einen Array mit Werten *)
  62.       ALLOCATE(dummypt,SIZE(dummypt^));
  63.       dummypt^ := (LONGCARD(i) * 35256) MOD 2156;
  64.       a[i] := dummypt;                    (* evtl. ändern *)
  65.       WrLngCard(dummypt^,10);WriteLn;     (* evtl. ändern *)
  66.    END;
  67.  
  68.    PointerQuickSort(a,nmax,CompareInt);
  69.                                     (* sortiere den Array *)
  70.    WriteString('ordered data:'); WriteLn;
  71.    FOR i := 1 TO nmax DO      (* Gib sortierten Array aus *)
  72.       dummypt := a[i];
  73.       WrLngCard(dummypt^,10);WriteLn;     (* evtl. ändern *)
  74.       DEALLOCATE(a[i],SIZE(a[i]^));       (* evtl. ändern *)
  75.    END;                      (* Gibt Speicher wieder frei *)
  76.    WriteString('END Qsort1.'); WriteLn;
  77.  
  78. END Qsort1.                              (* Hauptprogramm *)
  79.