home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 06_07 / sort.inc < prev    next >
Encoding:
Text File  |  1988-03-21  |  6.9 KB  |  154 lines
  1. (*************************************************************************)
  2. (*          >>>>>>>>>>  MODUL:      SORT.INC  (v1.0)  <<<<<<<<<<         *)
  3. (*               AUFGABE:  Sortieren von beliebigen Arrays               *)
  4. (*         (c) 1988  Karsten Gieselmann  &  PASCAL International         *)
  5. (*************************************************************************)
  6.      (* Sortierreihenfolge *)
  7. TYPE SortOrder = (Ascending, Descending); (* aufsteigend, absteigend  *)
  8.  
  9. PROCEDURE Sort (VAR Data;                                (* Datenfeld   *)
  10.                 n,                               (* Anzahl Feldelemente *)
  11.                 Size,                  (* Größe eines Elements in Bytes *)
  12.                 Comparison : INTEGER;        (* Adr. d. Vergleichsfunk. *)
  13.                 Order      : SortOrder);          (* Sortierreihenfolge *)
  14.  
  15. (*
  16. SORT implementiert einen Shellsort-Algorithmus für die Sortierung
  17. feldorientierter Datenstrukturen.  Die Routine sortiert die ersten
  18. "n" Komponenten  der  ARRAY-Variablen "Data" in der Reihenfolge "Order".
  19. Eine Komponente des Feldes ist "Size" Bytes groß,  das Sortierkriterium
  20. (der Vergleich zweier Feldelemente) wird  durch die an der Adresse
  21. "Comparison" befindliche boolesche Funktion
  22.     FUNCTION Lower (VAR a,b :SortType) : BOOLEAN;
  23. bestimmt (ist a < b ?). Die Adresse dieser Funktion im Code können DOS-User
  24. sich  über "Comparison:=Ofs(Lower)" besorgen, CP/M-ler erhalten sie übeS
  25. die Anweisung Comparison:=Addr(Lower).
  26. *)
  27.  
  28. TYPE Pointer = ^Byte;            (* allgemeiner Zeigertyp *)
  29.  
  30. VAR  i, j, k : INTEGER;
  31.  
  32. FUNCTION Compare (VAR a,b) :BOOLEAN; EXTERNAL 'CALL.BIN';
  33. (*
  34. erledigt den  Aufruf des "Pseudo"-Prozeduralparameters "Comparison"E
  35. Der EXTERNAL-Anhang ist implementationsspezifisch und ist für Turbod
  36.            DOS:    EXTERNAL 'CALL.BIN';
  37.            CP/M:   EXTERNAL $0110;
  38. Benutzer von DOS-Turbo, die Binärdatei 'CALL.BIN' noch nicht habenb
  39. können diese mit dem DOS-Debugger wie folgt erzeugenk
  40.            A>debug
  41.              -e100
  42.               b8 00 00 ff e0
  43.              -r cx
  44.               5
  45.              -ncall.bin
  46.              -w
  47.              -q
  48. *)
  49.  
  50.   PROCEDURE InitializeCall;
  51.   (*
  52.   Diese  Prozedur initialisiert den  Aufruf des  Prozeduralparameters; wie
  53.   der Aufruf ist auch sie abhängig von der verwendeten Version des Turbo
  54.   Pascal Compilers (8 oder 16 Bit):
  55.            DOS:   MemW [CSeg:succ(Ofs(Compare))] := Comparison;
  56.            CP/M:  Mem  [$0110] := $21;
  57.                   Mem  [$0111] := Lo (Comparison);
  58.                   Mem  [$0112] := Hi (Comparison);
  59.                   Mem  [$0113] := $E9
  60.    *)
  61.   BEGIN
  62.     MemW [CSeg:Succ(Ofs(Compare))] := Comparison;    (* hier für DOS-Turbo *)
  63.   END;
  64.  
  65.   FUNCTION Lower (a,b :Pointer) :BOOLEAN;
  66.     (* Vergleich in Abhängigkeit der Sortierreihenfolge *)
  67.   BEGIN
  68.     IF Order = Ascending THEN Lower := Compare (a^,b^)
  69.     ELSE Lower := Compare (b^,a^)
  70.   END;
  71.  
  72.   FUNCTION p (i :INTEGER) : Pointer;
  73.   (*
  74.   liefert  einen Zeiger auf das  i-te Feldelement;  die saubere Lösung
  75.   dieses Zugriffs auf eine Komponente des  Datenfeldes wäre für Turbo-
  76.           DOS:     p := Ptr (Seg(Data), Ofs(Data)+pred(i)*Size);
  77.           CP/M:    p := Ptr (Addr(Data)+pred(i)*Size);
  78.   Die folgende Inline-Anweisung  erledigt diese  Aufgabe in wesentlich
  79.   kürzerer Zeit, sie gilt jedoch nur für die DOS-Version von Turbo!
  80.   *)
  81.   BEGIN
  82.   INLINE ($8b/$7E/$00/           (*          MOV  DI,[BP+00]             *)
  83.           $36/$C4/$9d/Data/      (*          LES  BX,SS:[DI+Data]        *)
  84.           $8b/$86/i/             (*          MOV  AX,[BP+i]              *)
  85.           $48/                   (*          DEC  AX                     *)
  86.           $36/$F7/$A5/Size/      (*          MUL  WORD PTR SS:[DI+Size]  *)
  87.           $01/$D8/               (*          ADD  AX,BX                  *)
  88.           $8C/$C2/               (*          MOV  DX,ES                  *)
  89.           $89/$46/$06/           (*          MOV  [BP+06],AX             *)
  90.           $89/$56/$08)           (*          MOV  [BP+08],DX             *)
  91.   END;
  92.  
  93.  
  94.   PROCEDURE Swap (a,b :Pointer; Size :INTEGER);
  95.   (*
  96.   vertauscht die Feldelemente,  auf die "a" und "b" zeigen durch Tausch der
  97.   ersten "Size" Bytes; auch hier gibt es eine saubere, aber langsame
  98.   Lösung, diese ist für DOS- und CP/M-Turbo Pascal identisch:
  99.  
  100.     Var temp :Array [1..???] of Byte;
  101.  
  102.     Begin
  103.       Move (a^, temp, Size);  Move (b^, a^, Size);  Move (temp, b^, Size);
  104.     End;
  105.  
  106.   ACHTUNG: der Zwischenspeichers "temp" muß so groß deklariert sein, um
  107.   eine Feldkomponente vollständig aufnehmen zu können! Die schnelle In-
  108.   line-Anweisung darf wiederum nur auf DOS-Rechnern benutzt werden; er-
  109.   setzt man die Parameterliste durch "Var a,b; Size :Integer",  so kann
  110.   man diese Prozedur auch als allgemeine Vertauschroutine verwenden!
  111.   *)
  112.   BEGIN
  113.   INLINE ($1E/                   (*          PUSH DS                     *)
  114.           $C5/$B6/a/             (*          LDS  SI,[BP+a]              *)
  115.           $C4/$BE/b/             (*          LES  DI,[BP+b]              *)
  116.           $8b/$8E/Size/          (*          MOV  CX,[BP+Size]           *)
  117.           $D1/$E9/               (*          SHR  CX,1                   *)
  118.           $73/$09/               (*          JNB  013A                   *)
  119.           $8a/$04/               (*          MOV  AL,[SI]                *)
  120.           $26/$86/$05/           (*          XCHG AL,ES:[DI]             *)
  121.           $88/$04/               (*          MOV  [SI],AL                *)
  122.           $46/                   (*          INC  SI                     *)
  123.           $47/                   (*          INC  DI                     *)
  124.           $83/$F9/$00/           (*          CMP  CX,00                  *)
  125.           $74/$0d/               (*          JZ   014C                   *)
  126.           $8b/$04/               (*   Swap:  MOV  AX,[SI]                *)
  127.           $26/$87/$05/           (*          XCHG AX,ES:[DI]             *)
  128.           $89/$04/               (*          MOV  [SI],AX                *)
  129.           $46/                   (*          INC  SI                     *)
  130.           $46/                   (*          INC  SI                     *)
  131.           $47/                   (*          INC  DI                     *)
  132.           $47/                   (*          INC  DI                     *)
  133.           $E2/$F3/               (*          LOOP Swap                   *)
  134.           $1f)                   (*          POP  DS                     *)
  135.   END;
  136.  
  137. BEGIN
  138.   InitializeCall;
  139.   k := n;
  140.   WHILE k > 1 DO BEGIN          (* der verfeinerte Shellsort-Algorithmus *)
  141.     k := k SHR 1;
  142.     FOR i:=1 TO n-k DO
  143.       IF Lower(p(i+k),p(i)) THEN BEGIN
  144.         Swap (p(i),p(i+k),Size);
  145.         j := i;
  146.         WHILE (j >= k+1) AND Lower(p(j),p(j-k)) DO BEGIN
  147.           Swap (p(j),p(j-k),Size);
  148.           j := j - k
  149.         END
  150.       END
  151.   END
  152. END;
  153. (*************** ENDE SORT.INC *******************************************)
  154.