Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/sortdn.sim
There is 1 other file named sortdn.sim in the archive. Click here to see a list.
00100	OPTIONS(/E/C/-A/-Q/-I/-D);
00200	COMMENT Procedure SORTDN will sort the contents
00300	of the directory array in ASCENDING order.
00400	Author: Algorithm 271 CACM 11-65, 5-66.
00500	Modified by: Mats Ohlin, FOA 1, S-104 50 STOCKHOLM 80, SWEDEN.
00600	Date: 75-09-19, corrected 76-12-11.
00700	Directory sort modification: Lars Enderin 1977-11-17.
00800	The array is a slice of a SIXBIT directory: ARR[1,i]=file name,
00900	ARR[2,i]=file name extension + compressed file pointer.
01000	;
01100	PROCEDURE sortdn (arr,i1,n,key);
01200	INTEGER ARRAY arr;   INTEGER i1, n, key;
01300	BEGIN   INTEGER i,k,q,m,p,n1;   INTEGER t,u,x,y,f,s;
01400	    INTEGER ARRAY ut,lz [1:Ln(Abs(n-i1+1)+2)/0.69314718];
01500	
01550	    n1:= n;
01600	    OPTIONS(/A);
01700	    IF key > 3 OR key < 0 THEN key:= 0;
01800	    f:= IF key >= 2 THEN 2 ELSE 1; s:=3-f;
01900	    IF arr[f,i1] > arr[f,n] THEN
02000	    BEGIN
02100		t:= arr[f,i1]; u:= arr[s,i1];
02200		OPTIONS(/-A);
02300		arr[f,i1]:= arr[f,n];   arr[f,n]:= t;
02400		arr[s,i1]:= arr[s,n];   arr[s,n]:= u;
02500	    END test and swap;
02600	
02700	    i:= i1;  m:= 1;
02800	    WHILE m > 0 DO
02900	    BEGIN
03000		IF n-i > 1 THEN
03100		BEGIN
03200		    p:= (n+i)//2;    t:= arr[f,p]; u:= arr[s,p];
03300		    arr[f,p]:= arr[f,i];
03400		    arr[s,p]:= arr[s,i];   q:= n;   k:= i;
03500		    FOR k:= k+1 WHILE k <= q DO
03600		    BEGIN
03700			IF arr[f,k] > t THEN
03800			BEGIN
03900			    WHILE q >= k DO
04000			    BEGIN
04100				IF arr[f,q] < t THEN
04200				BEGIN
04300				    x:= arr[f,k];   arr[f,k]:= arr[f,q];
04400				    y:= arr[s,k];   arr[s,k]:= arr[s,q];
04500				    arr[f,q]:= x;   arr[s,q]:= y;   q:= q-1;
04600				    GO TO l;
04700				END;
04800				q:= q-1;
04900			    END Q;
05000			END;
05100			l:
05200		    END K;
05300		    arr[f,i]:= arr[f,q];
05400		    arr[s,i]:= arr[s,q];
05500		    arr[f,q]:= t;  arr[s,q]:= u;
05600		    IF 2*q>i+n THEN
05700		    BEGIN
05800			lz[m]:= i;   ut[m]:= q-1;   i:= q+1;
05900		    END
06000		    ELSE
06100		    BEGIN
06200			lz[m]:= q+1;   ut[m]:= n;   n:= q-1;
06300		    END;
06400		    m:= m+1;
06500		END
06600		ELSE
06700		BEGIN
06800		    IF (IF i < n THEN arr[f,i] > arr[f,n] ELSE FALSE) THEN
06900		    BEGIN
07000			x:= arr[f,i];   arr[f,i]:= arr[f,n];   arr[f,n]:= x;
07100			y:= arr[s,i];   arr[s,i]:= arr[s,n];   arr[s,n]:= y;
07200		    END;
07300		    m:= m-1;
07400		    IF m > 0 THEN
07500		    BEGIN   i:= lz[m];   n:= ut[m]   END;
07600		END
07700	    END m > 0 loop;
07800	
07900	    IF key = 0 OR key = 3 THEN
08000	    BEGIN   !Sort on secondary key;
08100		i:= i1;
08200		WHILE i < n1 DO
08300		BEGIN
08400		    m:= i; t:= arr[f,m];
08500		    WHILE i < n1 AND arr[f,i+1] = t DO i:= i+1;
08600		    IF i > m THEN
08700		    sortdn(arr,m,i,IF key = 0 THEN 2 ELSE 0);
08800		    i:= i+1;
08900		END;
09000	    END;
09100	END SORT DIRECTORY NAMES IN ASCENDING ORDER;