home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-UTIL.ARK / SHELSORT.SRC < prev    next >
Text File  |  1986-01-06  |  896b  |  36 lines
  1. PROCEDURE SHELLSORT(VAR SORTBUF : KEYARRAY; RECS : INTEGER);
  2.  
  3. VAR I,J,K,L : INTEGER;
  4.     SPREAD  : INTEGER;
  5.  
  6.  
  7. PROCEDURE INT_SWAP(VAR RR,SS : KEYREC);
  8.  
  9. VAR T : KEYREC;
  10.  
  11. BEGIN
  12.   T := RR;
  13.   RR := SS;
  14.   SS := T
  15. END;
  16.  
  17.  
  18. BEGIN
  19.   SPREAD := RECS DIV 2;       { First spread is half record count  }
  20.   WHILE SPREAD > 0 DO         { Do until spread goes to zero:      }
  21.     BEGIN
  22.       FOR I := SPREAD + 1 TO RECS DO
  23.         BEGIN
  24.           J := I - SPREAD;
  25.           WHILE J > 0 DO
  26.             BEGIN             { Test & swap across the array }
  27.               L := J + SPREAD;
  28.               IF SORTBUF[J].KEY <= SORTBUF[L].KEY THEN J := 0 ELSE
  29.                 INT_SWAP(SORTBUF[J],SORTBUF[L]);
  30.               J := J - SPREAD
  31.             END
  32.         END;
  33.       SPREAD := SPREAD DIV 2    { Halve spread for next pass }
  34.     END
  35. END;
  36.        FOUND := TRUE;             { Set foun