image of READY prompt

Wang2200.org

Listing of file='SORT3 ' on disk='vmedia/701-2047D.wvd.zip'

# Sector 197, program filename = 'SORT3'
0010 REM SORT3,00-00(02/18/76),12003A - COPYRIGHT WANG LABS. INC., 1976
0180 COM M$8,G$8,H$8,J$1,C$1,D$1,R7$2,P7
   : COM R1,P2$2,P0$2,S1$2,S2$2,O$8,M0$2,M2$2,N4$2
   : COM N3$2,P3$3,R1$1,R2$1,R9$1
   : COM F,R2,P2,P4,P6,P9,R0,K,P3,S3,R3,S7$2,S8$3,S9,S4,Z
   : GOTO 3100
3100 DIM K(10),B(10),N(10),Z2$56,Z3$56
   : DIM P8$1,B$10,N$10
   : DIM X1$(56)2,X2$56,X3$56,X6$10,X8$10,X9$10
   : DIM Z$8,Y$1,D$(4)64,X1$2,Y1$1,K1$1,L$8
   : DIM I$8,F$8
3150 M=8
3160 M=S+(1-SGN(S))*M
   : G$=" "
   : G2=0
   : H$=" "
   : J$=" "
   : R0,L0=1
   : L$="ALL"
   : FOR X=1TO 10
   : K(X),N(X)=0
   : B(X)=1
   : NEXT X
   : INIT(20)X2$,X3$
   : INIT(00)X9$
   : F$,P8$=" "
   : C$="Y"
   : D$=" "
   : INIT(00)B$,N$,X9$
3730 PRINT HEX(030A0A0A0A)
   : PRINT "SORT-3 SPECIFICATIONS"
   : PRINT HEX(0A)
   : PRINT "INPUT FILE  ";I$;TAB(45);"FORMAT  ";F
   : IF F=2THEN 4040
   : IF F=0THEN 3850
   : Z$="SCRATCH"
   : IF F=1THEN 3970
   : Z$=I$
   : IF F=3THEN 3970
   : STOP "INVALID FORMAT"
3850 LIMITS T#1,I$,I0,X,I1
   : I1=I1-2
   : I3=I0+I1
   : DATA LOAD BA T#1,(I3,X)D$()
   : Y$=HEX(F0)
   : AND (Y$,STR(D$(1),1,1))
   : IF Y$=HEX(A0)THEN 4200
   : STOP "INPUT INVALID"
3970 LIMITS T#1,Z$,I0,X,I1
   : I1=I1-4
   : DATA LOAD BA T#1,(I0,I0)D$()
   : IF STR(D$(1),4,3)<>"HDR"THEN 4020
   : IF STR(D$(1),8,8)=I$THEN 4200
4020 STOP "WRONG INPUT FILE"
4040 GOSUB '230(1,5,1,J,I$)
   : IF Q$=" "THEN 4070
   : STOP "ERROR OPENING KFAM FILE"
4070 LIMITS T#1,I$,S0,X,I1
   : GOSUB '43
   : N4$=X1$
   : I1=VAL(Q2$)*256+VAL(STR(Q2$,2))+VAL(V6$)
   : I3=S0+I1
   : GOSUB '235(1)
   : IF Q$=" "THEN 4180
   : STOP "KFAM FINDFIRST ERROR"
4180 I0=S0+T6
4200 DATA LOAD BA T#1,(I0,A1)D$()
   : PRINT "RECORDS PER BLOCK  ";R0
   : IF R0<1THEN 5350
   : IF R0>255THEN 5350
   : IF R0<>INT(R0)THEN 5350
   : Y1=55
   : IF R0=1THEN 4310
   : Y1=38
4310 S8=0
   : L2=0
   : N2=0
   : P=3
   : B3=1
   : C=0
4440 X=INT((P-1)/64)
   : Y=P-64*X
   : X=X+1
   : Y$=STR(D$(X),Y,1)
   : IF Y$=HEX(FD)THEN 4790
   : C=C+1
   : IF C>1THEN 4750
   : S8=S8+1
   : IF S8<=Y1THEN 4570
   : STOP "TOO MANY FIELDS"
4570 Y1$=Y$
   : IF Y$=HEX(08)THEN 4630
   : STR(X2$,S8,1)=HEX(00)
   : IF Y$<HEX(81)THEN 4620
   : IF Y$<HEX(C1)THEN 4650
4620 STOP "INVALID RECORD FORMAT"
4630 N2=N2+1
   : STR(X2$,S8,1)=HEX(01)
4650 AND (Y$,7F)
   : STR(X3$,S8,1)=Y$
   : L2=L2+VAL(Y$)
4690 IF C<R0THEN 4710
   : C=0
4710 P=P+1+VAL(STR(X3$,S8,1))
   : IF P>256THEN 4620
   : GOTO 4440
4750 IF Y$=Y1$THEN 4690
4760 STOP "NOT BLOCKED AS SPECIFIED"
4790 Y$=STR(D$(1),1,1)
   : IF Y$=HEX(81)THEN 4890
   : IF Y$<>HEX(82)THEN 4620
   : B3=B3+1
   : DATA LOAD BA T#1,(A1,A1)D$()
   : IF B3<>VAL(STR(D$(1),2,1))THEN 4620
   : P=3
   : GOTO 4440
4890 IF C>0THEN 4760
   : PRINT "STARTING RECORD # TO BE SORTED  ";L0
   : IF L0<1THEN 5330
   : IF L0<>INT(L0)THEN 5330
   : PRINT "NUMBER OF RECORDS TO BE SORTED  ";L$
   : R2=9E9
   : IF L$="ALL"THEN 5030
   : IF NUM(L$)=0THEN 5340
   : CONVERT STR(L$,1,NUM(L$))TO R2
   : IF R2<1THEN 5340
5000 IF R2<>INT(R2)THEN 5340
5030 X=INT((L0-1)/R0)
   : R1=L0-R0*X
   : Y=X*B3
   : IF Y>I1-1THEN 5320
   : Z=(I1/B3)*R0-L0+1
   : IF Z=INT(Z)THEN 5120
   : IF F=0THEN 4620
   : Z=INT(Z)+R0
5120 IF Z>R2THEN 5140
   : R2=Z
5140 IF F=2THEN 5220
   : Y=Y+I0
   : X=INT(Y/256)
   : BIN(P2$)=X
   : BIN(STR(P2$,2))=Y-256*X
   : GOTO 5390
5220 IF L0=1THEN 5390
   : FOR X=2TO L0
   : GOSUB '237(1)
   : IF Q$=" "THEN 5290
   : IF Q$="E"THEN 5320
   : STOP "KFAM READ ERROR"
5290 NEXT X
   : GOTO 5390
5320 STOP "STARTING RECORD TOO HIGH"
5330 STOP "INVALID STARTING RECORD"
5340 STOP "INVALID NUMBER OF RECORDS"
5350 STOP "INVALID RECORDS PER BLOCK"
5360 STOP "INVALID NUMBER OF KEY FIELDS"
5390 PRINT "NUMBER OF KEY FIELDS  ";K0
   : IF K0<1THEN 5360
   : IF K0>10THEN 5360
   : Y1$=HEX(01)
   : K2=0
   : K3=0
   : K4=0
   : R1$="R"
   : K1$=HEX(00)
   : A=0
   : N1=0
   : FOR X=1TO K0
   : Y=K(X)
   : IF Y<>INT(Y)THEN 5560
   : IF Y<1THEN 5560
   : IF Y<=S8THEN 5570
5560 STOP "INVALID KEY FIELD NUMBER"
5570 IF STR(X2$,Y,1)<HEX(02)THEN 5600
   : R1$="K"
5600 IF X>1THEN 5650
   : PRINTUSING 5630,Y;
   : GOTO 5660
5630 %KEY FIELDS ##
5640 %, ##
5650 PRINTUSING 5640,Y;
5660 B(X)=B(X)-1
   : IF STR(X2$,Y,1)=HEX(00)THEN 5780
   : IF STR(X2$,Y,1)=HEX(02)THEN 5780
   : N1=N1+1
   : IF N(X)<>0THEN 5730
   : IF B(X)=0THEN 5740
5730 STOP "INVALID PARTIAL FIELD"
5740 N(X)=8
   : Y$=HEX(08)
   : GOTO 5930
5780 Z=VAL(STR(X3$,Y,1))
   : IF B(X)<0THEN 5730
   : IF N(X)<0THEN 5730
   : IF B(X)>0THEN 5840
   : IF N(X)=0THEN 5860
   : IF N(X)=ZTHEN 5860
5840 R1$="K"
   : K4=K4+1
5860 IF N(X)>0THEN 5880
   : N(X)=Z-B(X)
5880 IF B(X)+N(X)>ZTHEN 5730
   : IF B(X)<>INT(B(X))THEN 5730
   : IF N(X)<>INT(N(X))THEN 5730
   : BIN(Y$)=N(X)
5930 OR (STR(X2$,Y,1),02)
   : BIN(STR(B$,X,1))=B(X)
   : STR(N$,X,1)=Y$
   : ADDC(K1$,Y$)
   : IF K1$<HEX(41)THEN 6000
   : STOP "SORT KEY TOO LONG"
6000 IF STR(X9$,X,1)=HEX(00)THEN 6090
   : IF STR(X9$,X,1)=HEX(01)THEN 6040
   : STOP "INVALID ASCENDING/DESCENDING"
6040 PRINT "D";
   : K2=K2+1
   : IF STR(X2$,Y,1)=HEX(03)THEN 6090
   : K3=K3+1
6090 STR(X6$,X,1)=Y1$
   : ADDC(Y1$,Y$)
   : BIN(STR(X8$,X,1))=Y
   : NEXT X
   : PRINT " "
   : K=VAL(K1$)
   : L=L2+8*N1
   : PRINT "WORK FILE  ";F$
   : LIMITS T#2,F$,S0,R7,Z
   : S9=R7-S0+1
   : GOSUB '43
   : P0$=X1$
   : GOTO 6400
6400 IF S9<25THEN 7890
   : S2$=P0$
   : S0=S0+15
   : GOSUB '43
   : M0$,S1$=X1$
   : M0=INT(M*1024-698)
   : IF P8$="K"THEN 6780
   : IF R1$="K"THEN 6780
   : IF L-K>64THEN 6780
   : IF P8$="R"THEN 6680
   : IF K/L<.4THEN 6780
6680 R1$="R"
   : M2=M0-3550
   : L3=L
   : U=1+SGN(L-K)
   : Z=2+12*S8+24*N2+12*N1+3*(S8+N1)*SGN(R0-1)
   : M2=M2-(38+141*U+27*S8+16*N2+R0*L2+K+L3+10*K3+(12*S8+3*N2+3*K3+12*K0+13*N1
     )*SGN(R0-1))
   : GOTO 6890
6780 R1$="K"
   : IF P8$<>"R"THEN 6810
6800 STOP "FULL RECORD SORT NOT POSSIBLE"
6810 M2=M0-3250
   : M2=M2-K-3
   : IF J$=" "THEN 6830
   : M2=M2-100
6830 L3=K+3
   : U=2
   : Z=13+12*K0+3*K0*SGN(R0-1)+8*K4
6890 M1=M0-2400
   : IF F=0THEN 7020
   : IF F<>2THEN 7000
   : M1=M1-3300
   : IF M<11THEN 7430
   : GOTO 7020
7000 M1=M1-50
7020 X=41+129*U+42*N1+15*S8+L3-7*N2+8*N1*R0+R0*L2+18*K2+(9*S8+3*N2-12*N1+3*K2)
     *SGN(R0-1)+K5
   : M1=M1-Z-X
   : R2$="L"
   : P6=6
   : GOSUB 7180
   : IF P2<170THEN 7230
   : P2=170
   : GOSUB 7160
   : GOTO 7230
7160 P6=INT((M2-P2*2*L3)/(10+P2*L3))
   : RETURN
7180 P2=INT((M2-P6*10)/(L3*(P6+2)))
   : RETURN
7200 P4=INT((M1-P2*2*(L3+1))/(3+P2*L3))
   : RETURN
7230 IF L3>20THEN 7330
   : X=(L3+U)/253
   : Y=X*P2
   : Z=Y-INT(Y)
   : IF Z>.5THEN 7330
   : P2=P2-INT(Z/X+1)
7330 GOSUB '42
   : IF Q7<128THEN 7390
   : P2=P2-1
   : GOTO 7330
7390 IF P2>5THEN 7450
   : IF P8$="R"THEN 6800
   : IF R1$="R"THEN 6780
7430 STOP "NO ROOM TO SORT"
7450 GOSUB 7160
   : GOSUB 7200
   : P9=P2
   : X=P2+P2*P4
   : IF X>255THEN 7580
   : R2$="S"
   : P9=INT(((M1+90+43*U-L3*P2)/(2+L3))/P2)*P2
   : P4=1
7580 X=INT(4095/P2)
   : IF P4<XTHEN 7610
   : P4=X
7610 IF P6<XTHEN 7640
   : P6=X
7640 N3$=HEX(0000)
   : BIN(STR(N3$,2))=B
   : INIT(00)P3$
   : BIN(STR(P3$,3))=P2-1
   : XOR (P3$,FF)
   : BIN(R9$)=P2
   : R7=R7-B+1
   : X=INT(R7/256)
   : BIN(R7$)=X
   : BIN(STR(R7$,2))=R7-256*X
7760 Y=INT((R2-1)/(P9*P4))+1
   : Z=INT((Y-1)/36)+1
   : Q8=(INT((R2-1)/P2)+1)*B
7840 IF S9>=15+Z+Q8THEN 7930
   : IF R1$="K"THEN 7880
   : IF P8$<>"R"THEN 6780
7880 IF G$<>" "THEN 7900
7890 STOP "WORK SPACE TOO SMALL"
7900 G2=1
7930 S0=S0+Z
   : GOSUB '43
   : M2$=X1$
   : IF J$=" "THEN 8230
   : IF X2$<>Z2$THEN 8300
   : IF X3$<>Z3$THEN 8300
8230 DATA SAVE DA T$#2,(P0$,X1$)X2$,X3$,X6$,X8$,X9$,U,S8,L3,K0,B$,N$,B3,G2
   : LOAD DC T#0,"SORT300B"3100,9999
8300 STOP "INVALID RECORD LAYOUT"
8360 DEFFN'42
   : B=1
   : Q6=0
   : Q7=250
   : Q8=K+1
   : Q9=0
8420 X=INT(Q7/Q8)
   : IF X+Q9>=P2THEN 8500
   : Q9=Q9+X
   : Q7=253
   : B=B+1
   : GOTO 8420
8500 Q7=Q7-Q8*(P2-Q9)
   : IF Q6=1THEN 8570
   : IF U=1THEN 8570
   : Q6=1
   : Q8=L3-K+1
   : Q9=0
   : GOTO 8420
8570 RETURN
8610 DEFFN'43
   : X=INT(S0/256)
   : BIN(X1$)=X
   : BIN(STR(X1$,2,1))=S0-256*X
   : RETURN