Listing of file='SORT' on disk='vmedia/701-2048D.wvd.zip'
# Sector 673, program filename = 'SORT'
0010 REM SORT,00-00(02/20/76),12003A
0310 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
0420 DIM I$11,W1$11,O1$11,Z1$11
: DIM Q6$64,E$30,E1$8
0480 M=S
0500 PRINT HEX(030A0A0A0A)
: PRINT "ISS DISK SORT UTILITY"
: IF M>=8THEN 530
: STOP "MEMORY SIZE TOO SMALL"
0530 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 750
: GOSUB '2("INPUT INVALID")
: GOTO 530
0750 DATA LOAD BA T#1,(I0,X)D$()
0770 GOSUB '245("RECORDS PER BLOCK",2,0)
: R0=Q9
: GOSUB '3("RECORDS PER BLOCK",7,0)
: IF R0<1THEN 1890
: IF R0>255THEN 1890
: R=55
: IF R0=1THEN 870
: R=38
0870 V=0
: L2=0
: N2=0
: P=3
: A1=I0+1
: B3=1
: C=0
1010 X=INT((P-1)/64)
: Y=P-64*X
: X=X+1
: Y$=STR(D$(X),Y,1)
: IF Y$=HEX(FD)THEN 1390
: C=C+1
: IF C>1THEN 1340
: V=V+1
: IF V<=RTHEN 1150
: GOSUB '248(0,0,4)
: GOSUB '99("TOO MANY FIELDS")
1150 Y1$=Y$
: IF Y$=HEX(08)THEN 1220
: STR(V2$,V,1)=HEX(00)
: IF Y$<HEX(81)THEN 1200
: IF Y$<HEX(C1)THEN 1240
1200 GOSUB '248(0,0,4)
: GOSUB '99("INVALID RECORD FORMAT")
1220 N2=N2+1
: STR(V2$,V,1)=HEX(01)
1240 AND (Y$,7F)
: STR(V3$,V,1)=Y$
: L2=L2+VAL(Y$)
1280 IF C<R0THEN 1300
: C=0
1300 P=P+1+VAL(STR(V3$,V,1))
: IF P>256THEN 1200
: GOTO 1010
1340 IF Y$=Y1$THEN 1280
1350 GOSUB '248(0,0,4)
: GOSUB '99("NOT BLOCKED AS SPECIFIED")
1390 Y$=STR(D$(1),1,1)
: IF Y$=HEX(81)THEN 1490
: IF Y$<>HEX(82)THEN 1200
: B3=B3+1
: DATA LOAD BA T#1,(A1,A1)D$()
: IF B3<>VAL(STR(D$(1),2,1))THEN 1200
: P=3
: GOTO 1010
1490 IF C>0THEN 1350
1510 E$="STARTING RECORD # TO BE SORTED"
: GOSUB '245(E$,8,0)
: L0=Q9
: GOSUB '3(E$,8,0)
: IF L0<1THEN 1850
1550 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 1660
: IF NUM(Z$)=0THEN 1870
: CONVERT STR(Z$,1,NUM(Z$))TO L1
: IF L1<1THEN 1870
1630 IF L1<>INT(L1)THEN 1870
1660 X=INT((L0-1)/R0)
: I2=L0-R0*X
: Y=I0+X*B3
: IF Y>I3-1THEN 1820
: Z=(I3-I0)/B3
: IF Z<>INT(Z)THEN 1200
: Z=Z*R0-L0+1
: IF Z>L1THEN 1770
: L1=Z
1770 X=INT(Y/256)
: BIN(I2$)=X
: BIN(STR(I2$,2))=Y-256*X
: GOTO 1950
1820 GOSUB '2("STARTING RECORD TOO HIGH")
: GOSUB '248(8,0,2)
: GOTO 1510
1850 GOSUB '2("INVALID")
: GOTO 1510
1870 GOSUB '2("INVALID")
: GOTO 1550
1890 GOSUB '2("INVALID")
: GOTO 770
1910 GOSUB '2("INVALID")
: GOTO 1950
1950 GOSUB '245("NUMBER OF KEY FIELDS (1 TO 10)",2,0)
: K0=Q9
: GOSUB '3("NUMBER OF KEY FIELDS",10,0)
: IF K0<1THEN 1910
: IF K0>10THEN 1910
: IF K0>VTHEN 1910
: B$=HEX(01)
: INIT(00)V9$
: K2=0
: K3=0
: K1$=HEX(00)
: A=0
: N1=0
: FOR X=1TO K0
2070 Q6$="ENTER SEQUENCE NUMBER OF KEY FIELD IN RECORD"
: CONVERT XTO STR(Q6$,36,2),(##)
: GOSUB '245(Q6$,2,0)
: IF Q9<1THEN 2120
: IF Q9<=VTHEN 2140
2120 GOSUB '2("RE-ENTER")
: GOTO 2070
2140 Y=Q9
: IF STR(V2$,Y,1)>HEX(01)THEN 2120
: GOSUB '248(11,A,0)
: IF X>1THEN 2220
: PRINTUSING 2200,Y
: A=13
: GOTO 2250
2200 %KEY FIELDS ##
2210 %, ##
2220 PRINTUSING 2210,Y
: A=A+4
2250 IF STR(V2$,Y,1)<HEX(01)THEN 2270
: N1=N1+1
2270 OR (STR(V2$,Y,1),02)
: ADDC(K1$,STR(V3$,Y,1))
: IF K1$<HEX(41)THEN 2320
: GOSUB '248(0,0,4)
: GOSUB '99("SORT KEY TOO LONG")
2320 Q6$="KEY FIELD ASCENDING OR DESCENDING? (A OR D)"
: CONVERT XTO STR(Q6$,11,2),(##)
: GOSUB '243(Q6$,1)
: Y$=Q6$
: IF Y$=" "THEN 2495
: IF Y$="A"THEN 2440
: IF Y$="D"THEN 2420
: GOSUB '2("RE-ENTER")
: GOTO 2320
2420 STR(V9$,X,1)=HEX(01)
: K2=K2+1
: IF STR(V2$,Y,1)=HEX(03)THEN 2440
: K3=K3+1
2440 GOSUB '248(11,A,0)
: A=A+1
: PRINT Y$
2495 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
2580 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 4110
: IF W1$<>I$THEN 2890
: GOSUB '2("DUPLICATE FILE")
: GOTO 4120
2890 D2$=D0$
: S0=S0+15
: GOSUB '43
: M0$,D1$=X1$
: M0=M*1024-698
: IF L-K>64THEN 3190
: IF K/L<.4THEN 3190
3090 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 3290
3190 T1$="K"
: M2=M0-3100
: L3=K+3
: U=2
: Z=13+12*K0+3*K0*SGN(R0-1)
3290 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 3490
: IF D6<6THEN 3570
: GOSUB 3510
: GOSUB 3530
: D9=D2
: GOSUB '42
: X=INT(4095/D2)
3466 IF D3<XTHEN 3470
: D3=X
3470 IF D6<XTHEN 3930
: D6=X
: GOTO 3930
3490 D6=INT((M2-D2*2*L3)/(10+D2*L3))
: RETURN
3510 D2=INT((M2-D6*10)/(L3*(D6+2)))
: RETURN
3530 D3=INT((M1-D2*2*(L3+1))/(3+D2*L3))
: RETURN
3570 D6=6
: GOSUB 3510
: IF L3>20THEN 3690
: X=(L3+U)/253
: Y=X*D2
: Z=Y-INT(Y)
: IF Z>.5THEN 3690
: D2=D2-INT(Z/X+1)
3690 GOSUB '42
: IF Q7<128THEN 3750
: D2=D2-1
: GOTO 3690
3750 IF D2>5THEN 3810
: IF T1$="R"THEN 3190
: GOSUB '248(0,0,4)
: GOSUB '99("NO ROOM TO SORT")
3810 GOSUB 3490
: GOSUB 3530
: D9=D2
: X=D2+D2*D3
: IF X>255THEN 3930
: T2$="S"
: D9=INT(((M1+109+43*U-L3*D2)/(2+L3))/D2)*D2
: D3=1
3930 N3$=HEX(0000)
: BIN(STR(N3$,2))=B
: INIT(00)K2$
: BIN(STR(K2$,3))=D2-1
: XOR (K2$,FF)
4020 Y=INT((L1-1)/(D9*D3))+1
: Z=INT((Y-1)/36)+1
: Q8=(INT((L1-1)/D2)+1)*B
4080 IF S9>=15+Z+Q8THEN 4150
: IF T1$="R"THEN 3190
4110 GOSUB '2("WORK SPACE TOO SMALL")
4120 GOSUB '248(12,0,1)
: GOTO 2580
4150 S0=S0+Z
: GOSUB '43
: M2$=X1$
4200 GOSUB '45("OUTPUT",13,3)
: O$,O1$=Z1$
: IF I$=O1$THEN 4290
: IF W1$<>O1$THEN 4320
4290 GOSUB '2("DUPLICATE FILE")
: GOTO 4200
4320 P=(INT((L1-1)/R0)+1)*B3+2
4330 GOSUB '243("IS OUTPUT FILE CATALOGUED? (Y OR N)",1)
: Y$=Q6$
: GOSUB '1("CATALOGUED",13,45)
: IF Y$="Y"THEN 4420
: IF Y$=" "THEN 4420
: IF Y$="N"THEN 4520
: GOSUB '2("RE-ENTER")
: GOTO 4330
4420 X,Y=0
: LIMITS T#3,O$,X,Y,Z
: IF P<=Y-X+1THEN 4550
: GOSUB '2("OUTPUT SPACE TOO SMALL")
: GOTO 4200
4520 DATA SAVE DC OPEN T$#3,P,O$
: DATA SAVE DC CLOSE#3
4550 GOSUB '248(0,0,4)
: DATA SAVE DA T$#2,(D0$,X1$)V2$,V3$,V6$,V8$,V9$,U,V,L3,K0
: LOAD DC T#0,"DSM200BA"
4620 DEFFN'1(E$,Q6,Q7)
: E1$=Q6$
: GOSUB '248(Q6,Q7,1)
: PRINT E$;" ";E1$
: RETURN
4690 DEFFN'2(Q6$)
: PRINT HEX(010A0A0A)
: PRINT Q6$
: RETURN
4723 DEFFN'99(Q6$)
: GOSUB '2(Q6$)
: GOSUB '243("KEY RETURN(EXEC) TO RESUME",0)
: COM CLEAR I2
: LOAD DC T#0,"START055"
4750 DEFFN'3(E$,Q6,Q7)
: GOSUB '248(Q6,Q7,1)
: PRINT E$;" ";Q9
: RETURN
4840 DEFFN'42
: B=1
: Q6=0
: Q7=250
: Q8=K+1
: Q9=0
4900 X=INT(Q7/Q8)
: IF X+Q9>=D2THEN 4980
: Q9=Q9+X
: Q7=253
: B=B+1
: GOTO 4900
4980 Q7=Q7-Q8*(D2-Q9)
: IF Q6=1THEN 5050
: IF U=1THEN 5050
: Q6=1
: Q8=L3-K+1
: Q9=0
: GOTO 4900
5050 RETURN
5320 DEFFN'43
: X=INT(S0/256)
: BIN(X1$)=X
: BIN(STR(X1$,2,1))=S0-256*X
: RETURN
5460 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)
5530 STR(E$,Z)="FILE DEVICE ADDRESS"
: GOSUB '243(E$,3)
: STR(Z1$,9)=Q6$
: GOSUB '1("DEVICE",X,30)
: IF E1$="310"THEN 5650
: IF E1$="320"THEN 5730
: IF E1$="B20"THEN 5770
: IF E1$="B10"THEN 5690
: IF E1$="350"THEN 5810
5620 GOSUB '2("INVALID DEVICE ADDRESS")
: E$=Z$
: GOTO 5530
5650 ON YGOTO 5660,5670,5680
: STOP
5660 SELECT #1310
: RETURN
5670 SELECT #2310
: RETURN
5680 SELECT #3310
: RETURN
5690 ON YGOTO 5700,5710,5720
: STOP
5700 SELECT #1B10
: RETURN
5710 SELECT #2B10
: RETURN
5720 SELECT #3B10
: RETURN
5730 ON YGOTO 5740,5750,5760
: STOP
5740 SELECT #1320
: RETURN
5750 SELECT #2320
: RETURN
5760 SELECT #3320
: RETURN
5770 ON YGOTO 5780,5790,5800
: STOP
5780 SELECT #1B20
: RETURN
5790 SELECT #2B20
: RETURN
5800 SELECT #3B20
: RETURN
5810 ON YGOTO 5820,5830,5840
: STOP
5820 SELECT #1350
: RETURN
5830 SELECT #2350
: RETURN
5840 SELECT #3350
: RETURN
8975 DEFFN'242(W0,Q6$)
: IF W0<=0THEN 9405
: IF W0=1THEN 8990
: STR(Q6$,2)=STR(Q6$,1,W0-1)
8990 PRINT Q6$;
: RETURN
9010 DEFFN'243(Q6$,Q0)
: GOSUB 9200
9022 SELECT CO 205
: Q6$=" "
: INPUT Q6$
: IF Q0=0THEN 9231
: IF LEN(Q6$)<=Q0THEN 9231
: GOSUB 9150
9032 DEFFN'244(Q0)
: GOSUB 9220
: GOSUB 9210
: GOTO 9022
9038 DEFFN'245(Q6$,Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 9200
9044 GOSUB '242(ABS(Q2)+2,HEX(09))
: PRINT "/"
: GOSUB 9220
: SELECT CO 205
: Q9,W0=-1E-99
: INPUT Q9
: IF W0=Q9THEN 9058
: IF Q9>=0THEN 9070
: IF Q2<=0THEN 9070
9058 GOSUB 9150
9060 DEFFN'246(Q2,Q3)
: Q0=ABS(Q2)+Q3+1
: GOSUB 9220
: GOSUB 9210
: GOTO 9044
9070 IF ABS(Q9)>=10^ABS(Q2)THEN 9058
: W0=ABS(Q9*10^Q3)
: IF INT(W0)<>W0THEN 9058
: GOTO 9288
9150 GOSUB 9288
: PRINT "RE-ENTER"
: RETURN
9200 GOSUB 9405
: PRINT HEX(010A);STR(Q6$,1);
9210 GOSUB 9405
: GOSUB '242(Q0+2,"-")
: PRINT TAB(64)
9220 PRINT HEX(010A0A)
: RETURN
9231 PRINT HEX(0A);TAB(64)
: GOTO 9405
9288 Q6=3
: Q7=0
: Q8=1
9290 DEFFN'248(Q6,Q7,Q8)
: GOSUB 9405
: IF Q8<1THEN 9350
: GOSUB 9350
: SELECT PRINT 205
: Q6$=" "
: PRINT STR(Q6$,Q7+1)
: IF Q8<2THEN 9350
: FOR W0=2TO Q8
: PRINT HEX(0A);STR(Q6$,1)
: NEXT W0
9350 PRINT HEX(01)
: GOSUB '242(Q7,HEX(09))
: GOSUB '242(Q6,HEX(0A))
9405 SELECT PRINT 005(64),CO 005
: RETURN