image of READY prompt

Wang2200.org

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