Listing of file='SORTSP01' on disk='vmedia/701-2048D.wvd.zip'
# Sector 782, program filename = 'SORTSP01'
0010 REM SORTSP01,00-01(04/14/76),12003A
0100 COM I2,I2$2
: COM D0$2,D1$2,D2$2,O$8,M0$2,M2$2
: COM N3$2,K2$3
: COM T1$1,T2$1
: COM L1,D2,D3,D6,D9,R0,K
: DIM V2$56,V3$56,V6$10,V8$10,V9$10
: DIM Z$8,Y$1,D$(4)64,X1$2,B$1,Y1$1,K1$1
0200 DIM I$11,W1$11,O1$11,Z1$11
: DIM Q6$64,E$30,E1$8
0250 M=S
0270 SELECT #4310
0310 PRINT HEX(030A0A0A0A)
: PRINT "ISS DISK SORT UTILITY"
: IF M>=8THEN 350
: STOP "MEMORY SIZE TOO SMALL"
0350 GOSUB '45("INPUT",6,1)
: Z$,I$=Z1$
: LIMITS T#1,Z$,I0,X,I1
: I3=I0+I1-2
: DATA LOAD BA T#1,(I3,X)D$()
: Y$=HEX(F0)
: AND (Y$,STR(D$(1),1,1))
: IF Y$=HEX(A0)THEN 500
: GOSUB '2("INPUT INVALID")
: GOTO 350
0500 DATA LOAD BA T#1,(I0,X)D$()
0520 GOSUB '245("RECORDS PER BLOCK",2,0)
: R0=Q9
: GOSUB '3("RECORDS PER BLOCK",7,0)
: IF R0<1THEN 1650
: IF R0>255THEN 1650
: R=55
: IF R0=1THEN 620
: R=38
0620 V=0
: L2=0
: N2=0
: P=3
: A1=I0+1
: B3=1
: C=0
0760 X=INT((P-1)/64)
: Y=P-64*X
: X=X+1
: Y$=STR(D$(X),Y,1)
: IF Y$=HEX(FD)THEN 1140
: C=C+1
: IF C>1THEN 1090
: V=V+1
: IF V<=RTHEN 900
: GOSUB '248(0,0,4)
: GOSUB '99("TOO MANY FIELDS")
0900 Y1$=Y$
: IF Y$=HEX(08)THEN 970
: STR(V2$,V,1)=HEX(00)
: IF Y$<HEX(81)THEN 950
: IF Y$<HEX(C1)THEN 990
0950 GOSUB '248(0,0,4)
: GOSUB '99("INVALID RECORD FORMAT")
0970 N2=N2+1
: STR(V2$,V,1)=HEX(01)
0990 AND (Y$,7F)
: STR(V3$,V,1)=Y$
: L2=L2+VAL(Y$)
1030 IF C<R0THEN 1050
: C=0
1050 P=P+1+VAL(STR(V3$,V,1))
: IF P>256THEN 950
: GOTO 760
1090 IF Y$=Y1$THEN 1030
1100 GOSUB '248(0,0,4)
: GOSUB '99("NOT BLOCKED AS SPECIFIED")
1140 Y$=STR(D$(1),1,1)
: IF Y$=HEX(81)THEN 1240
: IF Y$<>HEX(82)THEN 950
: B3=B3+1
: DATA LOAD BA T#1,(A1,A1)D$()
: IF B3<>VAL(STR(D$(1),2,1))THEN 950
: P=3
: GOTO 760
1240 IF C>0THEN 1100
1260 E$="STARTING RECORD # TO BE SORTED"
: GOSUB '245(E$,8,0)
: L0=Q9
: GOSUB '3(E$,8,0)
: IF L0<1THEN 1610
1310 GOSUB '243("NUMBER OF RECORDS TO BE SORTED (OR ALL)",8)
: Z$=Q6$
: GOSUB '1("NUMBER OF RECORDS TO BE SORTED",9,0)
: L1=9E9
: IF Z$="ALL"THEN 1420
: IF NUM(Z$)=0THEN 1630
: CONVERT STR(Z$,1,NUM(Z$))TO L1
: IF L1<1THEN 1630
1390 IF L1<>INT(L1)THEN 1630
1420 X=INT((L0-1)/R0)
: I2=L0-R0*X
: Y=I0+X*B3
: IF Y>I3-1THEN 1580
: Z=(I3-I0)/B3
: IF Z<>INT(Z)THEN 950
: Z=Z*R0-L0+1
: IF Z>L1THEN 1530
: L1=Z
1530 X=INT(Y/256)
: BIN(I2$)=X
: BIN(STR(I2$,2))=Y-256*X
: GOTO 1710
1580 GOSUB '2("STARTING RECORD TOO HIGH")
: GOSUB '248(8,0,2)
: GOTO 1260
1610 GOSUB '2("INVALID")
: GOTO 1260
1630 GOSUB '2("INVALID")
: GOTO 1310
1650 GOSUB '2("INVALID")
: GOTO 520
1670 GOSUB '2("INVALID")
: GOTO 1710
1710 GOSUB '245("NUMBER OF KEY FIELDS (1 TO 10)",2,0)
: K0=Q9
: GOSUB '3("NUMBER OF KEY FIELDS",10,0)
: IF K0<1THEN 1670
: IF K0>10THEN 1670
: IF K0>VTHEN 1670
: B$=HEX(01)
: INIT(00)V9$
: K2=0
: K3=0
: K1$=HEX(00)
: A=0
: N1=0
: FOR X=1TO K0
1850 Q6$="ENTER SEQUENCE NUMBER OF KEY FIELD IN RECORD"
: CONVERT XTO STR(Q6$,36,2),(##)
: GOSUB '245(Q6$,2,0)
: IF Q9<1THEN 1900
: IF Q9<=VTHEN 1920
1900 GOSUB '2("RE-ENTER")
: GOTO 1850
1920 Y=Q9
: IF STR(V2$,Y,1)>HEX(01)THEN 1900
: GOSUB '248(11,A,0)
: IF X>1THEN 2010
: PRINTUSING 1990,Y
: A=13
: GOTO 2040
1990 %KEY FIELDS ##
2000 %, ##
2010 PRINTUSING 2000,Y
: A=A+4
2040 IF STR(V2$,Y,1)<HEX(01)THEN 2060
: N1=N1+1
2060 OR (STR(V2$,Y,1),02)
: ADDC(K1$,STR(V3$,Y,1))
: IF K1$<HEX(41)THEN 2110
: GOSUB '248(0,0,4)
: GOSUB '99("SORT KEY TOO LONG")
2110 Q6$="KEY FIELD ASCENDING OR DESCENDING? (A OR D)"
: CONVERT XTO STR(Q6$,11,2),(##)
: GOSUB '243(Q6$,1)
: Y$=Q6$
: IF Y$=" "THEN 2300
: IF Y$="A"THEN 2250
: IF Y$="D"THEN 2210
: GOSUB '2("RE-ENTER")
: GOTO 2110
2210 STR(V9$,X,1)=HEX(01)
: K2=K2+1
: IF STR(V2$,Y,1)=HEX(03)THEN 2250
: K3=K3+1
2250 GOSUB '248(11,A,0)
: A=A+1
: PRINT Y$
2300 STR(V6$,X,1)=B$
: ADDC(B$,STR(V3$,Y,1))
: BIN(STR(V8$,X,1))=Y
: NEXT X
: K=VAL(K1$)
: L=L2+8*N1
2400 GOSUB '45("WORK",12,2)
: Z$,W1$=Z1$
: LIMITS T#2,Z$,S0,S9,Z
: S9=S9-S0+1
: GOSUB '43
: D0$=X1$
: IF S9<25THEN 3950
: IF W1$<>I$THEN 2560
: GOSUB '2("DUPLICATE FILE")
: GOTO 3960
2560 D2$=D0$
: S0=S0+15
: GOSUB '43
: M0$,D1$=X1$
: M0=M*1024-698
: IF L-K>64THEN 2820
: IF K/L<.4THEN 2820
2720 T1$="R"
: M2=M0-3400
: L3=L
: U=1+SGN(L-K)
: Z=2+12*V+24*N2+12*N1+3*(V+N1)*SGN(R0-1)
: M2=M2-(38+150*U+27*V+16*N2+R0*L2+K+L3+10*K3+(12*V+3*N2+3*K3+12*K0+13*N1)*
SGN(R0-1))
: GOTO 2910
2820 T1$="K"
: M2=M0-3100
: L3=K+3
: U=2
: Z=13+12*K0+3*K0*SGN(R0-1)
2910 M1=M0-2200
: X=41+138*U+42*N1+15*V+L3-7*N2+8*N1*R0+R0*L2+10*K2+(9*V+3*N2-12*N1+3*K2)*S
GN(R0-1)
: M1=M1-Z-X
: D2=129
: T2$="L"
: GOSUB 3170
: IF D6<6THEN 3250
: GOSUB 3190
: GOSUB 3210
: D9=D2
: GOSUB '42
: X=INT(4095/D2)
3110 IF D3<XTHEN 3130
: D3=X
3130 IF D6<XTHEN 3620
: D6=X
: GOTO 3620
3170 D6=INT((M2-D2*2*L3)/(10+D2*L3))
: RETURN
3190 D2=INT((M2-D6*10)/(L3*(D6+2)))
: RETURN
3210 D3=INT((M1-D2*2*(L3+1))/(3+D2*L3))
: RETURN
3250 D6=6
: GOSUB 3190
: IF L3>20THEN 3370
: X=(L3+U)/253
: Y=X*D2
: Z=Y-INT(Y)
: IF Z>.5THEN 3370
: D2=D2-INT(Z/X+1)
3370 GOSUB '42
: IF Q7<128THEN 3430
: D2=D2-1
: GOTO 3370
3430 IF D2>5THEN 3490
: IF T1$="R"THEN 2820
: GOSUB '248(0,0,4)
: GOSUB '99("NO ROOM TO SORT")
3490 GOSUB 3170
: GOSUB 3210
: D9=D2
: X=D2+D2*D3
: IF X>255THEN 3620
: T2$="S"
: D9=INT(((M1+109+43*U-L3*D2)/(2+L3))/D2)*D2
: D3=1
3620 N3$=HEX(0000)
: BIN(STR(N3$,2))=B
: INIT(00)K2$
: BIN(STR(K2$,3))=D2-1
: XOR (K2$,FF)
: GOSUB '245("ENTER THE NUMBER OF RECORDS TO BE SORTED.",5,0)
: L1=Q9
3740 Y=INT((L1-1)/(D9*D3))+1
: Z=INT((Y-1)/36)+1
: Q8=(INT((L1-1)/D2)+1)*B
: IF T1$="K"THEN 3830
: PRINT HEX(030A0A0A0A0A);"FULL RECORD SORT"
: GOTO 3840
3830 PRINT HEX(030A0A0A0A0A);"KEY SORT"
3840 PRINT "NUMBER OF SECTORS NEEDED FOR THE SORT-WORK FILE =";15+Z+Q8
: GOSUB '243("KEY RETURN(EXEC) TO RESUME.",0)
: IF T1$="K"THEN 3890
: T1$="K"
: GOTO 2820
3890 COM CLEAR I2
: LOAD DC T#0,"START055"
3950 GOSUB '2("WORK SPACE TOO SMALL")
3960 GOSUB '248(12,0,1)
: GOTO 2400
4390 DEFFN'1(E$,Q6,Q7)
: E1$=Q6$
: GOSUB '248(Q6,Q7,1)
: PRINT E$;" ";E1$
: RETURN
4460 DEFFN'99(Q6$)
: GOSUB '2(Q6$)
: GOSUB '243("KEY RETURN(EXEC) TO RESUME",0)
: COM CLEAR I2
: LOAD DC T#0,"START055"
4530 DEFFN'2(Q6$)
: PRINT HEX(010A0A0A)
: PRINT Q6$
: RETURN
4590 DEFFN'3(E$,Q6,Q7)
: GOSUB '248(Q6,Q7,1)
: PRINT E$;" ";Q9
: RETURN
4680 DEFFN'42
: B=1
: Q6=0
: Q7=250
: Q8=K+1
: Q9=0
4740 X=INT(Q7/Q8)
: IF X+Q9>=D2THEN 4820
: Q9=Q9+X
: Q7=253
: B=B+1
: GOTO 4740
4820 Q7=Q7-Q8*(D2-Q9)
: IF Q6=1THEN 4890
: IF U=1THEN 4890
: Q6=1
: Q8=L3-K+1
: Q9=0
: GOTO 4740
4890 RETURN
4930 DEFFN'43
: X=INT(S0/256)
: BIN(X1$)=X
: BIN(STR(X1$,2,1))=S0-256*X
: RETURN
5040 DEFFN'45(Z$,X,Y)
: E$=Z$
: Z=LEN(E$)+2
: STR(E$,Z)="FILE NAME"
: GOSUB '243(E$,8)
: Z1$=Q6$
: GOSUB '1(E$,X,0)
5110 STR(E$,Z)="FILE DEVICE ADDRESS"
: GOSUB '243(E$,3)
: STR(Z1$,9)=Q6$
: GOSUB '1("DEVICE",X,30)
: IF E1$="310"THEN 5230
: IF E1$="320"THEN 5310
: IF E1$="B20"THEN 5350
: IF E1$="B10"THEN 5270
: IF E1$="350"THEN 5390
5200 GOSUB '2("INVALID DEVICE ADDRESS")
: E$=Z$
: GOTO 5110
5230 ON YGOTO 5240,5250,5260
: STOP
5240 SELECT #1310
: RETURN
5250 SELECT #2310
: RETURN
5260 SELECT #3310
: RETURN
5270 ON YGOTO 5280,5290,5300
: STOP
5280 SELECT #1B10
: RETURN
5290 SELECT #2B10
: RETURN
5300 SELECT #3B10
: RETURN
5310 ON YGOTO 5320,5330,5340
: STOP
5320 SELECT #1320
: RETURN
5330 SELECT #2320
: RETURN
5340 SELECT #3320
: RETURN
5350 ON YGOTO 5360,5370,5380
: STOP
5360 SELECT #1B20
: RETURN
5370 SELECT #2B20
: RETURN
5380 SELECT #3B20
: RETURN
5390 ON YGOTO 5400,5410,5420
: STOP
5400 SELECT #1350
: RETURN
5410 SELECT #2350
: RETURN
5420 SELECT #3350
: RETURN
5490 DEFFN'242(W0,Q6$)
: IF W0<=0THEN 6100
: IF W0=1THEN 5530
: STR(Q6$,2)=STR(Q6$,1,W0-1)
5530 PRINT Q6$;
: RETURN
5550 DEFFN'243(Q6$,Q0)
: GOSUB 5880
5570 SELECT CO 205
: Q6$=" "
: INPUT Q6$
: IF Q0=0THEN 5920
: IF LEN(Q6$)<=Q0THEN 5920
: GOSUB 5870
5630 DEFFN'244(Q0)
: GOSUB 5900
: GOSUB 5890
: GOTO 5570
5670 DEFFN'245(Q6$,Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 5880
5700 GOSUB '242(ABS(Q2)+2,HEX(09))
: PRINT "/"
: GOSUB 5900
: SELECT CO 205
: Q9,W0=-1E-99
: INPUT Q9
: IF W0=Q9THEN 5770
: IF Q9>=0THEN 5830
: IF Q2<=0THEN 5830
5770 GOSUB 5870
5780 DEFFN'246(Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 5900
: GOSUB 5890
: GOTO 5700
5830 IF ABS(Q9)>=10^ABS(Q2)THEN 5770
: W0=ABS(Q9*10^Q3)
: IF INT(W0)<>W0THEN 5770
: GOTO 5950
5870 GOSUB 5950
: PRINT "RE-ENTER"
: RETURN
5880 GOSUB 6100
: PRINT HEX(010A);STR(Q6$,1);
5890 GOSUB 6100
: GOSUB '242(Q0+2,"-")
: PRINT TAB(64)
5900 PRINT HEX(010A0A)
: RETURN
5920 PRINT HEX(0A);TAB(64)
: GOTO 6100
5950 Q6=3
: Q7=0
: Q8=1
5960 DEFFN'248(Q6,Q7,Q8)
: GOSUB 6100
: IF Q8<1THEN 6070
: GOSUB 6070
: SELECT PRINT 205
: Q6$=" "
: PRINT STR(Q6$,Q7+1)
: IF Q8<2THEN 6070
: FOR W0=2TO Q8
: PRINT HEX(0A);STR(Q6$,1)
: NEXT W0
6070 PRINT HEX(01)
: GOSUB '242(Q7,HEX(09))
: GOSUB '242(Q6,HEX(0A))
6100 SELECT PRINT 005(64),CO 005
: RETURN