Listing of file='KFAM1004' on disk='vmedia/701-2086B.wvd.zip'
# Sector 369, program filename = 'KFAM1004' 0010 REM KFAM1004,VER.03/04/76 0012 COM Q6$64 0750 DIM K0$3,K1$8,U0$3,U1$8,D8$21 : DIM X$64,X1$2,I$(32)8,Z$8,N$8,H$2,L$1,A(7),R(7) : DIM Q2$2,Q3$2,V5$(4)1,V8$1,V1$8,V2$2,V3$2,V6$1,T2$2 : DIM T8$(4)1,Q0$4,V4$(4)2,V2$(4)2,Q9$2,Q0$(4)60 0820 PRINT HEX(03) : D8$="310320330350B10B20B30" 0890 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8) : U1$=Q6$ : IF STR(U1$,5,1)="F"THEN 950 : GOSUB '43("FILE NAME MUST HAVE F IN POSITION 5") : GOTO 890 0950 IF STR(U1$,6,1)<"0"THEN 980 : IF STR(U1$,6,1)>"9"THEN 980 : GOTO 1010 0980 GOSUB '43("FILE NAME MUST HAVE NUMBER IN POSITION 6") : GOTO 890 1010 GOSUB '125("ENTER THE NO. OF THE DATA FILE DEVICE ADDRESS") : D2=X : U0$=STR(D8$,X*3-2,3) : GOSUB '127(2) : FOR X=1TO 7 : A(X),R(X)=0 : NEXT X : GOSUB '40(U1$,2) : GOSUB '44("IS DATA FILE CATALOGUED? (Y OR N)") 1140 IF Q6$="N"THEN 1180 : IF X>0THEN 1220 : GOSUB '43("FILE NOT FOUND") : GOTO 890 1180 IF X=0THEN 1220 : GOSUB '43("FILE ALREADY CATALOGUED") : GOTO 890 1220 A(D2)=A : C2=X 1250 GOSUB '245("ENTER KEY FILE NUMBER",1,0) : IF Q9>0THEN 1300 : GOSUB '43("ZERO INVALID") : GOTO 1250 1300 K1$=U1$ : STR(K1$,5,1)="K" : CONVERT Q9TO STR(K1$,6,1),(#) : GOSUB '125("ENTER THE NO. OF THE KEY FILE DEVICE ADDRESS") : D1=X : K0$=STR(D8$,X*3-2,3) : GOSUB '210(1) : GOSUB '40(K1$,1) 1420 GOSUB '44("IS KEY FILE CATALOGUED? (Y OR N)") : IF Q6$="N"THEN 1470 : IF X>0THEN 1510 : GOSUB '43("FILE NOT FOUND") : GOTO 1250 1470 IF X=0THEN 1510 : GOSUB '43("FILE ALREADY CATALOGUED") : GOTO 1250 1510 A(D1)=A : C1=X 1540 GOSUB '243("ENTER RECORD TYPE (A,C,N,M)",1) : V1$=Q6$ : U,U1,U2=1 : K3=0 : IF V1$="A"THEN 1650 : IF V1$="C"THEN 1650 : IF V1$="N"THEN 1860 : IF V1$="M"THEN 1770 : GOSUB '43("INVALID RECORD TYPE") : GOTO 1540 1650 GOSUB '245("ENTER LOGICAL RECORD LENGTH",3,0) : U1=Q9 : GOSUB '245("ENTER BLOCKING FACTOR",2,0) : U2=Q9 : X=U1*U2 : IF X<2THEN 1730 : IF V1$="C"THEN 1710 : X=X+3 1710 IF X>256THEN 1730 : GOTO 1860 1730 GOSUB '43("BLOCKING FACTOR OR RECORD LENGTH INCORRECT") : GOTO 1650 1770 GOSUB '245("ENTER NUMBER OF SECTORS PER RECORD",3,0) : U=Q9 : IF U<2THEN 1820 : IF U>255THEN 1820 : GOTO 1860 1820 GOSUB '43("INVALID - MUST BE 2 TO 255") : GOTO 1770 1860 GOSUB '245("ENTER KEY LENGTH",2,0) : U3=Q9 : IF U3<1THEN 1910 : IF U3>30THEN 1910 : GOTO 1940 1910 GOSUB '43("INVALID -- KEY MUST BE 1 TO 30") : GOTO 1860 1940 T5=U3+3 : V6=INT(240/T5) 1970 GOSUB '245("ENTER STARTING POSITION OF KEY",5,0) : U4=Q9 : IF V1$>"C"THEN 2060 : IF V1$="C"THEN 2030 : IF U4<3THEN 2110 2030 IF U3+U4>U1+2THEN 2110 : GOTO 2150 2060 IF U3+U4>256*UTHEN 2110 : IF INT(U4/256)=INT((U3+U4)/256)THEN 2150 : GOSUB '43("KEY MAY NOT SPAN SECTORS") : GOTO 1970 2110 GOSUB '43("KEY OVERLAPS END OF RECORD") : GOTO 1970 2150 IF C2=0THEN 2190 : GOSUB '45(U1$,2) 2190 GOSUB '245("ENTER ESTIMATED NUMBER OF RECORDS",5,0) : GOSUB '248(4,0,1) : U6=Q9 : U8=INT(U6/U2+.999) : IF U<2THEN 2260 : U8=U8*U 2260 U8=U8+2 : IF C2=0THEN 2340 : IF U8>A+2THEN 2320 : U8=A+2 : GOTO 2360 2320 GOSUB '43("USER FILE TOO SMALL") : GOTO 2190 2340 R(D2)=U8 2360 IF C1=0THEN 2530 : GOSUB '45(K1$,1) : K2=A+2 : X=INT(V6*.75)-1 : K1=INT(U6/X)+5 : IF K2>=K1THEN 2570 : K3=1 : GOTO 2570 2530 X=INT(V6*.6)-1 : K2=INT(U6/X)+5 : R(D1)=R(D1)+K2 2570 IF R(D1)>A(D1)THEN 2610 : IF R(D2)>A(D2)THEN 2610 : GOTO 2860 2610 IF C2=0THEN 2650 : GOSUB '248(0,0,4) : STOP "NO ROOM FOR KEY FILE" 2650 GOSUB '248(3,0,2) : PRINT "SECTORS AVAILABLE, "; : IF R(D1)=0THEN 2690 : PRINT "DEVICE ";K0$;" = ";A(D1);TAB(43); 2690 IF R(D2)=0THEN 2720 : IF D1=D2THEN 2720 : PRINT "DEVICE ";U0$;" = ";A(D2); 2720 PRINT " " : PRINT "SECTORS REQUESTED, "; : IF R(D1)=0THEN 2760 : PRINT "DEVICE ";K0$;" = ";R(D1);TAB(43); 2760 IF R(D2)=0THEN 2790 : IF D1=D2THEN 2790 : PRINT "DEVICE ";U0$;" = ";R(D2); 2790 PRINT " " : FOR X=1TO 7 : R(X)=0 : NEXT X : GOTO 2190 2860 GOSUB '248(4,0,0) : GOSUB '46 : GOSUB '44("ARE FILE SPECIFICATIONS OK? (Y OR N)") : IF Q6$="N"THEN 820 : GOSUB '44("DO YOU WANT A HARD COPY PRINTOUT OF FILE DESCRIPTION? (Y OR N) ") : IF Q6$="N"THEN 2970 : SELECT PRINT 215 : GOSUB '46 2940 SELECT PRINT 005 2970 IF C1>0THEN 3040 : DATA SAVE DC OPEN T$#1,K2,K1$ : DSKIP #1,K2-2S : DATA SAVE DC $#1,END : DATA SAVE DC CLOSE#1 3040 IF C2>0THEN 3120 : DATA SAVE DC OPEN T$#2,U8,U1$ : DSKIP #2,U8-2S : DATA SAVE DC $#2,END : DATA SAVE DC CLOSE#2 3120 Q2$=HEX(0000) : BIN(STR(Q2$,2))=U-1 : XOR (Q2$,FF) : INIT(FF)V2$() : Y=U8-3 : X=INT(Y/256) : BIN(Q3$)=X : BIN(STR(Q3$,2))=Y-256*X : BIN(V8$)=U2 : FOR X=1TO 4 : V5$(X)=V8$ : NEXT X : BIN(STR(V1$,2))=U1 : X=INT(U4/256) : BIN(STR(V1$,3))=X 3280 BIN(STR(V1$,4))=U4-256*X : BIN(STR(V1$,5))=U3 : BIN(STR(V1$,6))=V6 : V2$=HEX(0001) : Y=K2-3 : X=INT(Y/256) : BIN(V3$)=X : BIN(STR(V3$,2))=Y-256*X : BIN(V6$)=U : T2$=HEX(0001) : T0=1 : Q0$=" " : INIT(FF)V4$() : INIT(5A)T8$() : DATA LOAD DC OPEN T#1,K1$ 3460 DATA SAVE DC $#1,Q2$,Q3$,V5$(),V8$,V1$,V2$,V3$,V6$,T2$,T0,T8$(),Q0$,V4$() ,V2$() : INIT(FF)Q0$() : INIT(00)STR(Q0$(1),1,U3) : Q9$=HEX(0001) : GOSUB '211(1) : DATA SAVE DC $#1,Q9$,Q0$() : LIMITS T#2,U1$,X,Y,Z : Y=Y-1 : X1$=HEX(A0FD) 3530 X$=HEX(A002A002A001A001A008A001A002) : $PACK(F=X$)Q0$()FROMX1$,Q2$,V5$(),V8$,V1$,V6$,V2$() : GOSUB '128(2) : DATA SAVE BA T$#2,(Y,Y)Q0$() : GOSUB '44("DO YOU WISH TO DO ANOTHER FILE? (Y OR N)") 3600 IF Q6$="Y"THEN 820 : COM CLEAR Q6$ : LOAD DC T#0,"START065" 3690 DEFFN'40(N$,Z) : DATA LOAD BA T#Z,(0,X)I$() : X1$=STR(I$(1),1,2) : GOSUB '41 : S9=X : X1$=STR(I$(1),3,2) : GOSUB '41 : Y=X : X1$=STR(I$(1),5,2) : GOSUB '41 : A=X-Y : Z$=N$ : XOR (STR(Z$,2),Z$) : L$=STR(Z$,8,1) : H$=HEX(0000) : ADDC(H$,L$) : ADDC(H$,L$) 3880 ADDC(H$,L$) : ADD(STR(H$,1,1),STR(H$,2,1)) : H=VAL(H$) : H=H-INT(H/S9)*S9 : DATA LOAD BA T#Z,(H,X)I$() : GOSUB '42 : IF X>0THEN 4040 : IF Y=0THEN 4040 : H=0 3980 DATA LOAD BA T#Z,(H,X)I$() : GOSUB '42 : IF X>0THEN 4040 : H=H+1 : IF H<S9THEN 3980 4040 RETURN 4070 DEFFN'41 : AND (STR(X1$,1,1),7F) : X=VAL(X1$)*256+VAL(STR(X1$,2)) : RETURN 4130 DEFFN'42 : Y=0 : X=2 : IF H>0THEN 4180 : X=4 4180 IF STR(I$(X-1),1,1)=HEX(10)THEN 4210 : IF STR(I$(X-1),1,1)=HEX(00)THEN 4260 : GOTO 4220 4210 IF I$(X)=N$THEN 4280 4220 X=X+2 : IF X<34THEN 4180 : Y=1 4260 X=0 4280 RETURN 4310 DEFFN'43(Q6$) : PRINT HEX(010A0A0A) : PRINT Q6$ : RETURN 4370 DEFFN'44(X$) 4380 GOSUB '243(X$,1) : IF Q6$=" "THEN 4450 : IF Q6$="Y"THEN 4470 : IF Q6$="N"THEN 4470 : GOSUB '43("RE-ENTER") : GOTO 4380 4450 Q6$="Y" 4470 RETURN 4530 DEFFN'45(N$,Z) : LIMITS T#Z,N$,X,Y,H : H=H-2 : A=Y-X-1 : IF A=HTHEN 4670 : DATA LOAD DC OPEN T#Z,N$ : IF H<0THEN 4640 : DSKIP #Z,END : DATA SAVE DC $#Z,N$ 4640 DSKIP #Z,A-H-1S : DATA SAVE DC $#Z,END : DATA SAVE DC CLOSE#Z 4670 RETURN 4700 DEFFN'46 : IF K3=0THEN 4730 : PRINT "WARNING -- KEY FILE TOO SMALL" 4730 PRINTUSING 4770,U1$,K1$ : PRINTUSING 4780,U0$; : PRINT TAB(32); : PRINTUSING 4780,K0$ 4770 %DATA FILE NAME ######## KEY FILE NAME ######## 4780 % DEVICE ADDRESS ### 4790 PRINT " RECORD TYPE";TAB(23);STR(V1$,1,1);TAB(33);"KEY FILE NUMBER";TAB(5 5);STR(K1$,6,1) : IF V1$>"C"THEN 4840 : PRINTUSING 4830,U1; : GOTO 4850 4830 % RECORD LENGTH ### 4840 PRINTUSING 4830,U; 4850 PRINT TAB(32); : PRINTUSING 4870,U3 4870 % KEY LENGTH ## 4880 IF V1$>"C"THEN 4920 : PRINTUSING 4910,U2; : GOTO 4930 4910 % BLOCKING FACTOR ### 4920 PRINT " (SECTORS)"; 4930 PRINT TAB(32); : PRINTUSING 4950,U4 4950 % KEY POSITION ##### 4960 PRINTUSING 4990,U8; : PRINT TAB(32); : PRINTUSING 4990,K2 4990 % NO. OF SECTORS ##### 5000 PRINT HEX(0A) : RETURN 5060 DEFFN'125(X$) : GOSUB '248(5,0,5) : PRINT ,"1. 310 5. B10" : PRINT ,"2. 320 6. B20" : PRINT ,"3. 330 7. B30" : PRINT ,"4. 350" 5120 GOSUB '245(X$,1,0) : X=Q9 : IF X<1THEN 5180 : IF X>7THEN 5180 : GOSUB '248(5,0,5) : RETURN 5180 PRINT HEX(010A0A0A) : PRINT "INVALID DEVICE ADDRESS" : GOTO 5120 5250 DEFFN'210(T6) : IF M$="X"THEN 5450 : ON D1GOTO 5280,5300,5320,5340,5360,5380,5400 5280 SELECT #1390 : RETURN 5300 SELECT #13A0 : RETURN 5320 SELECT #13B0 : RETURN 5340 SELECT #13D0 : RETURN 5360 SELECT #1B90 : RETURN 5380 SELECT #1BA0 : RETURN 5400 SELECT #1BB0 : RETURN 5440 DEFFN'211(T6) 5450 ON D1GOTO 5460,5480,5500,5520,5540,5560,5580 5460 SELECT #1310 : RETURN 5480 SELECT #1320 : RETURN 5500 SELECT #1330 : RETURN 5520 SELECT #1350 : RETURN 5540 SELECT #1B10 : RETURN 5560 SELECT #1B20 : RETURN 5580 SELECT #1B30 : RETURN 5620 DEFFN'127(T6) : IF M$="X"THEN 5820 : ON D2GOTO 5650,5670,5690,5710,5730,5750,5770 5650 SELECT #2390 : RETURN 5670 SELECT #23A0 : RETURN 5690 SELECT #23B0 : RETURN 5710 SELECT #23D0 : RETURN 5730 SELECT #2B90 : RETURN 5750 SELECT #2BA0 : RETURN 5770 SELECT #2BB0 : RETURN 5810 DEFFN'128(T6) 5820 ON D2GOTO 5830,5850,5870,5890,5910,5930,5950 5830 SELECT #2310 : RETURN 5850 SELECT #2320 : RETURN 5870 SELECT #2330 : RETURN 5890 SELECT #2350 : RETURN 5910 SELECT #2B10 : RETURN 5930 SELECT #2B20 : RETURN 5950 SELECT #2B30 : RETURN 8710 Q6=3 : GOTO 9289 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 8710 9150 GOSUB 8710 : 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 : Q6=0 9289 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