1000 ! SORTF -- WCIS FLOATING-POINT DISK SORT 1020 ! OUTPUT FILE MAY BE DISK OR DECTAPE; IF DEFAULTED ! ONLY INDEX FILE IS WRITTEN. INPUT FILE MUST BE ! IN RECORD I/O AND ON A DISK. 1040 ! SWITCHES: /B:N (N RECORDS/BLOCK) ! /K:S.L (KEY:STARTING COL . LENGTH) 1050 ! /D (DESCENDING SORT) 1060 ! 09-MAR-74 J. WARDEN WABASH COLLEGE 1080 T3=TIME(0%) : &"WCIS FP DISK SORT V02D" 1100 DIM I$(63),O$(63),A$(63),P$(63),A2$(16) 1120 ON ERROR GO TO 1440 : OPEN "KB:" AS FILE 9% 1140 PRINT"#"; : INPUT LINE #9%,F$ : F$=LEFT(F$,LEN(F$)-2%) : IF ASCII(F$)<32% THEN CLOSE 9% : GO TO 5260 1150 F%=INSTR(1%,F$,"/D") : IF F% THEN D%=1% : F$=LEFT(F$,F%-1%)+RIGHT(F$,F%+2%) 1160 F%=INSTR(1%,F$,"<") : IF F% THEN F2$=LEFT(F$,F%-1%) : F$=RIGHT(F$,F%+1%) 1180 F3%=INSTR(1%,"DT0:DT1:",LEFT(F2$,4%)) 1200 F%=INSTR(1%,F$,"/K:") : IF F%=0% THEN 1420 1220 F=VAL(RIGHT(F$,F%+3%)) : F$=LEFT(F$,F%-1%) 1240 C1%=F : L1%=(F-C1%)*10.01 : IF L1%<1% OR L1%>6% OR C1%<1% THEN 1420 1260 F%=INSTR(1%,F$,"/B:") : IF F%=0% THEN 1420 1280 N%=VAL(RIGHT(F$,F%+3%)) : F$=LEFT(F$,F%-1%) : IF N%<1% OR N%>63% THEN &"** ILLEGAL BLOCKING **" : GO TO 1140 1300 N6%=N%-1% : N1%=510%/N% : N2%=N1%-8% 1310 IF L1%<>4% THEN 1420 1320 IF INSTR(1%,"DT0:DT1:",LEFT(F$,4%)) THEN PRINT"** DISK SORT ONLY **" : GO TO 1140 1340 IF INSTR(1%,"DK0:DK1:DK2:DK3:",LEFT(F$,4%)) THEN D$=LEFT(F$,4%) 1360 L2%=L1%*C1% : IF L2%=6% THEN E$=".IDC" ELSE IF L2%=14% THEN E$=".CYR" ELSE IF L2%=565% THEN E$=".ZIP" ELSE E$=".KEY" 1380 L2%=L1%+1% 1400 ON ERROR GO TO 2080 : GO TO 1460 1420 PRINT"** RETYPE PLEASE **" : GO TO 1140 1440 RESUME 1420 1460 OPEN F$ FOR INPUT AS FILE 5% 1480 FIELD #5%,N1%*R% AS Z$,N1% AS I$(R%) FOR R%=0% TO N6% 1500 C%=1% 1520 P1$= D$+"SORTX1.TMP" : GOSUB 4280 1540 IF R%5% THEN ON ERROR GO TO 0 2100 PRINT"** CAN'T FIND FILE '";F$;"' **" : RESUME 1140 2120 ! NOW WE MUST OPEN A MERGE FILE 2140 ON ERROR GO TO 0 2160 P1$= D$+"SORTX1.TMP" : GOSUB 4280 2180 A1$= D$+"SORTX2.TMP" : GOSUB 4180 2200 ! BEGIN MERGE SEQUENCE 2220 PRINT CHR$(9%);"MERGE:"; 2240 F%=16% 2260 ! RE-INITIALIZE MERGE SEQUENCES HERE 2280 S1%=1% : S2%=1%+F% ! STARTING PLACES 2300 PRINT F%; 2320 ! SHORT MERGES CONTINUE HERE 2340 U1%=S1%+F%-1% : U2%=S2%+F%-1% ! UPPER LIMITS 2360 IF U1%>=C% THEN 2960 2380 IF U2%>C% THEN U2%=C% 2400 H%=S1% : GOSUB 4360 2420 H%=S2% : GOSUB 4440 2440 IF D% THEN 2450 2445 IF CVT$F(A$(A%))<=CVT$F(O$(O%)) THEN 2560 ELSE 2460 2450 IF CVT$F(A$(A%))>=CVT$F(O$(O%)) THEN 2560 2460 LSET P$(P%)=O$(O%) 2480 S2%=S2%+1% 2500 GOSUB 4600 2520 IF S2%>U2% THEN 2780 2540 GOSUB 4560 : GO TO 2440 2560 LSET P$(P%)=A$(A%) 2580 S1%=S1%+1% 2600 GOSUB 4600 2620 IF S1%>U1% THEN 2660 2640 GOSUB 4520 : GO TO 2440 2660 LSET P$(P%)=O$(O%) 2680 GOSUB 4600 2700 FOR I%=S2%+1% TO U2% 2720 GOSUB 4560 : LSET P$(P%)=O$(O%) : GOSUB 4600 2740 NEXT I% 2760 GO TO 2900 2780 LSET P$(P%)=A$(A%) 2800 GOSUB 4600 2820 FOR I%=S1%+1% TO U1% 2840 GOSUB 4520 : LSET P$(P%)=A$(A%) : GOSUB 4600 2860 NEXT I% 2880 ! FIRST SHORT MERGE COMPLETE 2900 S1%=U2%+1% : S2%=S1%+F% 2920 GO TO 2340 2940 ! WRITE UNMERGED ENTRIES 2960 H%=P9% : GOSUB 4360 2980 Q%=P9% 3000 FOR I%=Q% TO C% 3020 GOSUB 4520 : LSET P$(P%)=A$(A%) : GOSUB 4600 3040 NEXT I% 3060 LSET P$(P1%)="\\\\\\\\" FOR P1%=P% TO 62% 3080 PUT #1%,COUNT 504% 3100 ! COMPLETE PASS THROUGH FILE 3120 CLOSE 1%,2%,3% 3140 F%=F%*2% 3160 IF F%>=C% THEN 3320 3180 IF P1$= D$+"SORTX1.TMP" THEN 3260 3200 P1$= D$+"SORTX1.TMP" : GOSUB 4280 3220 A1$= D$+"SORTX2.TMP" : GOSUB 4180 3240 GO TO 2280 3260 P1$= D$+"SORTX2.TMP" : GOSUB 4280 3280 A1$= D$+"SORTX1.TMP" : GOSUB 4180 3300 GO TO 2280 3320 ! WE'RE DONE!! 3340 PRINT"DONE" : KILL A1$ 3360 IF LEN(F2$) THEN 3500 3380 R%=INSTR(1%,F$,".") : IF R% THEN F$=LEFT(F$,R%-1%) 3400 ON ERROR GO TO 3480 3420 NAME P1$ AS F$+E$ : PRINT CHR$(9%);"INDEX FILE: ";F$+E$ 3440 F%=(TIME(0%)-T3)/6. : F=F% : & CHR$(9%);"TIME";F/10.;"MINUTES" 3460 GO TO 5260 3480 IF ERR=16% AND ERL=3420% THEN KILL F$+E$ : RESUME 3420 3500 ON ERROR GO TO 0 3520 ! NOW WRITE THE RESULTS 3540 OPEN P1$ FOR INPUT AS FILE 1% 3560 FIELD #1%,8%*A% AS Z$,8% AS A$(A%) FOR A%=0% TO 62% 3580 OPEN F2$ FOR OUTPUT AS FILE 6% 3600 FIELD #6,N1%*S% AS Z$,N1% AS O$(S%) FOR S%=0% TO N6% 3620 S%,S0%=0% : IF F3%=0% AND C%>N% THEN PUT #6%, RECORD C%/N% 3640 FOR I%=1% TO C% 3660 IF A%<62% THEN A%=A%+1% ELSE A%=0% : GET #1% 3680 I2%=CVT$%(MID(A$(A%),L2%,2%)) 3700 R1%=(I2%+N6%)/N% 3720 R%=I2%-1%-(R1%-1%)*N% 3740 GET #5%,RECORD R1% 3760 LSET O$(S%)=I$(R%) 3780 GOSUB 4680 3800 NEXT I% 3820 GOSUB 4740 3840 KILL P1$ 3860 GO TO 3440 3880 ! OPEN NEW FILE SUBROUTINE 3900 GOSUB 4740 3920 ON ERROR GO TO 4080 3940 INPUT"NEW OUTPUT FILE";F2$ 3960 OPEN F2$ FOR OUTPUT AS FILE 6% 3980 FIELD #6%,N1%*S% AS Z$, N1% AS O$(S%) FOR S%=0% TO N6% 4000 S%,S0%=0% 4020 F3%=INSTR(1%,F2$,"DT0:") 4040 IF F3%=0% THEN F3%=INSTR(1%,F2$,"DT1:") 4060 GO TO 4140 4080 IF ERR=2% THEN PRINT"ILLEGAL FILE NAME - RETYPE!" : RESUME 3940 4100 IF ERR=14% THEN PRINT"DEVICE OK ???" : RESUME 3940 4120 ON ERROR GO TO 0 4140 RETURN 4160 ! - - - I/O SUBROUTINES - - - 4180 OPEN A1$ FOR INPUT AS FILE 3% 4200 FIELD #3%,8%*O% AS Z$,8% AS O$(O%) FOR O%=0% TO 62% 4220 OPEN A1$ FOR INPUT AS FILE 2% 4240 FIELD #2%,8%*A% AS Z$,8% AS A$(A%) FOR A%=0% TO 62% 4260 RETURN 4280 OPEN P1$ FOR OUTPUT AS FILE 1% : IF C%>63% THEN PUT #1%,RECORD C%/63% 4300 FIELD #1%,8%*P% AS Z$, 8% AS P$(P%) FOR P%=0% TO 62% 4320 P%,P9%,P0%=0% 4340 RETURN 4360 R1%=(H%+62%)/63% 4380 A%=H%+62%-R1%*63% 4400 GET #2%,RECORD R1% 4420 RETURN 4440 R2%=(H%+62%)/63% 4460 O%=H%+62%-R2%*63% 4480 GET #3%,RECORD R2% 4500 RETURN 4520 IF A%<62% THEN A%=A%+1% ELSE A%=0% : GET #2% 4540 RETURN 4560 IF O%<62% THEN O%=O%+1% ELSE O%=0% : GET #3% 4580 RETURN 4600 IF P%<62% THEN P%=P%+1% ELSE P%=0% : P0%=P0%+1% : PUT #1%, RECORD P0% 4620 P9%=P9%+1% 4640 RETURN 4660 ! 'PUT' SUBROUTINE 4680 IF S%=530% THEN GOSUB 3880 !(NEW TAPE) 4720 RETURN 4740 ! CLOSE SUBROUTINE 4760 LSET O$(R%)="\\\\\\"+SPACE$(N2%)+CHR$(13%)+CHR$(10%) FOR R%=S% TO N6% : PUT #6% : CLOSE 6% 4780 PRINT CHR$(9%);"SORTED RECORDS:";S0%*N%+S% 4800 RETURN 4820 ! BUBBLE SORT SUBROUTINE 4840 FOR R%=C2% TO C3% 4860 S%=R%-C2% 4880 IF A%<62% THEN A%=A%+1% ELSE A%=0% : GET #2% 4900 A2$(S%)=A$(A%)+"" 4920 NEXT R% 4940 FOR R%=0% TO C3%-C2% 4960 T2%=0% 4980 FOR S%=1% TO C3%-C2% 5000 S1%=S%-1% 5020 IF D% THEN 5030 5025 IF CVT$F(A2$(S%))>=CVT$F(A2$(S1%)) THEN 5080 ELSE 5040 5030 IF CVT$F(A2$(S%))<=CVT$F(A2$(S1%)) THEN 5080 5040 T$=A2$(S%) : A2$(S%)=A2$(S1%) : A2$(S1%)=T$ 5060 T2%=1% 5080 NEXT S% 5100 IF T2%=0% THEN 5140 5120 NEXT R% 5140 FOR R%=C2% TO C3% 5160 S%=R%-C2% 5180 LSET P$(P%)=A2$(S%) 5200 IF P%<62% THEN P%=P%+1% ELSE P%=0% : P0%=P0%+1% : PUT #1%, RECORD P0% 5220 NEXT R% 5240 RETURN 5260 END