Listing of file='KFAM6004' on disk='vmedia/701-2086B.wvd.zip'
# Sector 306, program filename = 'KFAM6004' 0010 REM KFAM6004,VER.11/08/76 0012 COM Q6$64 0300 DIM Q2$2,Q3$2,V5$1,V5$(4)1,V8$1,V0$2,V1$8 : DIM V2$2,V3$2,V6$1,T2$2,T4$3,T5$30,T7$30 : DIM T2$(8)2,T(8),T8$1,T8$(4)1,Q0$4,V4$(4)2,V2$(4)2 : DIM U1$8,X$64,K1$8 : DIM Y$1,Y1$30,X1$2,X2$5 0350 DIM Q9$2,Q0$(4)60,T3$(1)33 0500 PRINT HEX(030A0A0A0A) : PRINT "PRINT KEY FILE" 0510 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8) : U1$=Q6$ : IF STR(U1$,5,1)<>"F"THEN 560 : IF STR(U1$,6,1)<"0"THEN 560 : IF STR(U1$,6,1)<="9"THEN 590 0560 GOSUB '60("NOT KFAM FILE NAME") : GOTO 510 0590 GOSUB '245("ENTER KEY FILE NUMBER (NORMAL = 1)",1,0) : K9=Q9 : IF K9>0THEN 650 : GOSUB '60("INVALID") : GOTO 590 0650 GOSUB '125("ENTER THE NO. OF THE KEY FILE DEVICE ADDRESS") : D1=X : GOSUB '210(1) : K1$=U1$ : STR(K1$,5,1)="K" : CONVERT K9TO STR(K1$,6,1),(#) : LIMITS T#1,K1$,A,F,U : S9=A+1 : DATA LOAD DC OPEN T#1,K1$ 0760 DATA LOAD DC #1,Q2$,Q3$,V5$(),V8$,V1$,V2$,V3$,V6$,T2$,T0,T8$(),Q0$,V4$(), V2$() 0810 SELECT PRINT 215(132) 0830 PRINT HEX(0E);"KEY FILE ";K1$ : PRINT HEX(0A0A) : PRINT "KDR FIELD";TAB(30);"VALUE HEX VARIABLE" : PRINT HEX(0A) : PRINT "LAST DATA SECTOR";TAB(30); : GOSUB '50(Q2$,2) : PRINT "Q2$2" : PRINT "DATA SECTOR LIMIT";TAB(30); : GOSUB '50(Q3$,2) 0920 PRINT "Q3$2" : PRINT "RECORDS PER BLOCK";TAB(30); : GOSUB '50(V8$,1) : PRINT "V8$1" : PRINT "TYPE OF BLOCKING";TAB(34);STR(V1$,1,1);TAB(50);"STR(V1$,1,1)" : PRINT "RECORD LENGTH";TAB(30); : GOSUB '50(STR(V1$,2,1),1) : PRINT "STR(V1$,2,1)" 1000 PRINT "STARTING POSITION OF KEY";TAB(30); : GOSUB '50(STR(V1$,3,2),2) : PRINT "STR(V1$,3,2)" : PRINT "KEY LENGTH";TAB(30); : GOSUB '50(STR(V1$,5,1),1) : T4=X : T5=T4+3 : PRINT "STR(V1$,5,1)" : PRINT "NUMBER OF ENTRIES IN KIR";TAB(30); 1090 GOSUB '50(STR(V1$,6,1),1) : PRINT "STR(V1$,6,1)" : V6=X : PRINT "KEY FILE, LAST SECTOR USED";TAB(30); : GOSUB '50(V2$,2) : L=A+X : PRINT "V2$2" : PRINT "KEY FILE, LAST SECTOR AVAIL.";TAB(30); : GOSUB '50(V3$,2) : PRINT "V3$2" 1190 PRINT "SECTORS PER LOGICAL RECORD";TAB(30); : GOSUB '50(V6$,1) : PRINT "V6$1" : PRINT "HIGHEST LEVEL INDEX SECTOR";TAB(30); : GOSUB '50(T2$,2) : PRINT "T2$2" : PRINT "NUMBER OF INDEX LEVELS";TAB(30); : PRINTUSING 2000,T0; : PRINT TAB(50);"T0" : PRINT HEX(0A) 1290 PRINT TAB(10);"PER CPU ACCESS TABLE --" : PRINT HEX(0A) : PRINT " ACCESS COMPLETION PROTECTED FINDNEW F INDNEW" 1320 PRINT " # TYPE CODE SECTOR (HEX) SECTOR (HEX) REC ORD (HEX)" : PRINT " V0 Q0$4 T8$(4)1 V4$(4)2 V2$(4)2 V 5$(4)1" : PRINT HEX(0A) : FOR X=1TO 4 1360 PRINTUSING 2300,X; : X2$=STR(Q0$,X,1) : IF X2$>" "THEN 1400 : X2$="NONE" 1400 PRINT TAB(8);X2$;TAB(18); : IF T8$(X)=" "THEN 1440 : PRINT T8$(X); : GOTO 1450 1440 PRINT "BLANK"; 1450 PRINT TAB(32); : HEXPRINT V4$(X); : PRINT TAB(49); : HEXPRINT V2$(X); : PRINT TAB(65); : HEXPRINT V5$(X) : NEXT X 2000 %##### 2030 PRINT HEX(0C) : PRINT HEX(0E);"KEY INDEX SECTORS" : S2=12 : IF T4<12THEN 2080 : S2=T4 2080 PRINT HEX(0A0A) : DATA LOAD DA T#1,(S9,S9)Q9$,Q0$() : GOSUB '51(Q9$) : PRINT "SECTOR "; : PRINTUSING 2000,X; : PRINT TAB(16);"HEX("; : HEXPRINT Q9$; : PRINT ")" : PRINT " # HEX KEY";TAB(4+2*S2);"POINTER ( KEY";TAB(13+3*S2);") SECT OR REC#" : T=1 : FOR Z=1TO V6 2190 MAT COPY Q0$()<T,T5>TO T3$() : GOSUB '51(STR(T3$(1),T4+1,2)) : Y=VAL(STR(T3$(1),T5,1)) : Y1$=STR(T3$(1),1,T4) : FOR Z1=1TO T4 : Y$=STR(Y1$,Z1,1) : IF Y$<HEX(20)THEN 2280 : IF Y$>HEX(7A)THEN 2280 : GOTO 2290 2280 STR(Y1$,Z1,1)="-" 2290 NEXT Z1 2300 %## 2310 PRINTUSING 2300,Z; : PRINT " "; : HEXPRINT STR(T3$(1),1,T4); : PRINT TAB(5+2*S2); : HEXPRINT STR(T3$(1),T4+1,3); : PRINT " ";STR(Y1$,1,T4);TAB(16+3*S2); : PRINTUSING 2000,X;Y : T=T+T5 : NEXT Z : IF S9<=LTHEN 2080 : PRINT HEX(0C) : SELECT PRINT 005(64) : GOSUB '211(1) : $IF ON #1,2450 2450 COM CLEAR Q6$ : LOAD DC T#0,"START065" 2490 DEFFN'50(X1$,C) : IF C=1THEN 2530 : GOSUB '51(X1$) : GOTO 2540 2530 X=VAL(X1$) 2540 PRINTUSING 2000,X; : PRINT TAB(40); : HEXPRINT STR(X1$,1,C); : PRINT TAB(50); : RETURN 2610 DEFFN'51(X1$) : X=VAL(X1$)*256+VAL(STR(X1$,2)) : RETURN 4010 DEFFN'60(X$) : PRINT HEX(010A0A0A) : PRINT X$ : RETURN 4090 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" 4150 GOSUB '245(X$,1,0) : X=Q9 : IF X<1THEN 4210 : IF X>7THEN 4210 : GOSUB '248(5,0,5) : RETURN 4210 PRINT HEX(010A0A0A) : PRINT "INVALID DEVICE ADDRESS" : GOTO 4150 4280 DEFFN'210(T6) : IF M$="X"THEN 4480 : ON D1GOTO 4310,4330,4350,4370,4390,4410,4430 4310 SELECT #1390 : RETURN 4330 SELECT #13A0 : RETURN 4350 SELECT #13B0 : RETURN 4370 SELECT #13D0 : RETURN 4390 SELECT #1B90 : RETURN 4410 SELECT #1BA0 : RETURN 4430 SELECT #1BB0 : RETURN 4470 DEFFN'211(T6) 4480 ON D1GOTO 4490,4510,4530,4550,4570,4590,4610 4490 SELECT #1310 : RETURN 4510 SELECT #1320 : RETURN 4530 SELECT #1330 : RETURN 4550 SELECT #1350 : RETURN 4570 SELECT #1B10 : RETURN 4590 SELECT #1B20 : RETURN 4610 SELECT #1B30 : 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