Listing of file='KFAM1003' on disk='vmedia/701-2049C.wvd.zip'
# Sector 158, program filename = 'KFAM1003'
0010 REM KFAM1003,VER.02/27/76
0012 COM Q6$64
0800 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$1,V8$1,V0$2,V1$8,V2$2,V3$2,V6$1,T2$2,T4$3
0840 DIM T5$30,T7$30,T2$(8)2,T(8),T8$1,Q9$2,Q0$(4)60
: D8$="310320330350B10B20B30"
0870 PRINT HEX(03)
0880 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8)
: U1$=Q6$
: IF STR(U1$,5,1)="F"THEN 940
: GOSUB '43("FILE NAME MUST HAVE F IN POSITION 5")
: GOTO 880
0940 IF STR(U1$,6,1)<"0"THEN 970
: IF STR(U1$,6,1)>"9"THEN 970
: GOTO 1000
0970 GOSUB '43("FILE NAME MUST HAVE NUMBER IN POSITION 6")
: GOTO 880
1000 GOSUB '125("ENTER THE NO. OF THE DATA FILE DEVICE ADDRESS")
: D2=X
: U0$=STR(D8$,X*3-2,3)
: ON D2-1GOTO 1053,1057,1061,1065,1069,1073
: SELECT #2310
: GOTO 1130
1053 SELECT #2320
: GOTO 1130
1057 SELECT #2330
: GOTO 1130
1061 SELECT #2350
: GOTO 1130
1065 SELECT #2B10
: GOTO 1130
1069 SELECT #2B20
: GOTO 1130
1073 SELECT #2B30
1130 FOR X=1TO 7
: A(X),R(X)=0
: NEXT X
: GOSUB '40(U1$,2)
: GOSUB '44("IS DATA FILE CATALOGUED? (Y OR N)")
: IF Q6$="N"THEN 1194
: IF X>0THEN 1202
: GOSUB '43("FILE NOT FOUND")
: GOTO 880
1194 IF X=0THEN 1202
: GOSUB '43("FILE ALREADY CATALOGUED")
: GOTO 880
1202 A(D2)=A
: C2=X
1270 GOSUB '245("ENTER KEY FILE NUMBER",1,0)
: IF Q9>0THEN 1320
: GOSUB '43("ZERO INVALID")
: GOTO 1270
1320 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)
: ON D1-1GOTO 1413,1417,1421,1425,1429,1433
: SELECT #1310
: GOTO 1500
1413 SELECT #1320
: GOTO 1500
1417 SELECT #1330
: GOTO 1500
1421 SELECT #1350
: GOTO 1500
1425 SELECT #1B10
: GOTO 1500
1429 SELECT #1B20
: GOTO 1500
1433 SELECT #1B30
1500 GOSUB '40(K1$,1)
: GOSUB '44("IS KEY FILE CATALOGUED? (Y OR N)")
: IF Q6$="N"THEN 1514
: IF X>0THEN 1522
: GOSUB '43("FILE NOT FOUND")
: GOTO 1270
1514 IF X=0THEN 1522
: GOSUB '43("FILE ALREADY CATALOGUED")
: GOTO 1270
1522 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 1925
1910 GOSUB '43("INVALID -- KEY MUST BE 1 TO 30")
: GOTO 1860
1925 T5=U3+3
: V6=INT(240/T5)
1940 GOSUB '245("ENTER STARTING POSITION OF KEY",5,0)
: U4=Q9
: IF V1$>"C"THEN 2030
: IF V1$="C"THEN 2000
: IF U4<3THEN 2080
2000 IF U3+U4>U1+2THEN 2080
: GOTO 2120
2030 IF U3+U4>256*UTHEN 2080
: IF INT(U4/256)=INT((U3+U4)/256)THEN 2120
: GOSUB '43("KEY MAY NOT SPAN SECTORS")
: GOTO 1940
2080 GOSUB '43("KEY OVERLAPS END OF RECORD")
: GOTO 1940
2120 IF C2=0THEN 2170
: GOSUB '45(U1$,2)
2170 GOSUB '245("ENTER ESTIMATED NUMBER OF RECORDS",5,0)
: GOSUB '248(4,0,1)
: U6=Q9
: U8=INT(U6/U2+.999)
: IF U<2THEN 2232
: U8=U8*U
2232 U8=U8+2
: IF C2=0THEN 2250
: IF U8>A+2THEN 2244
: U8=A+2
: GOTO 2270
2244 GOSUB '43("USER FILE TOO SMALL")
: GOTO 2170
2250 R(D2)=U8
2270 IF C1=0THEN 2425
: GOSUB '45(K1$,1)
: K2=A+2
: X=INT(V6*.75)-1
: K1=INT(U6/X)+5
: IF K2>=K1THEN 2460
: K3=1
: GOTO 2460
2425 X=INT(V6*.6)-1
: K2=INT(U6/X)+5
: R(D1)=R(D1)+K2
2460 IF R(D1)>A(D1)THEN 2500
: IF R(D2)>A(D2)THEN 2500
: GOTO 2710
2500 IF C2=0THEN 2540
: GOSUB '248(0,0,4)
: STOP "NO ROOM FOR KEY FILE"
2540 GOSUB '248(3,0,2)
: PRINT "SECTORS AVAILABLE, ";
: IF R(D1)=0THEN 2580
: PRINT "DEVICE ";K0$;" =";A(D1);TAB(43);
2580 IF R(D2)=0THEN 2600
: IF D1=D2THEN 2600
: PRINT "DEVICE ";U0$;" = ";A(D2);
2600 PRINT " "
: PRINT "SECTORS REQUESTED, ";
: IF R(D1)=0THEN 2640
: PRINT "DEVICE ";K0$;" =";R(D1);TAB(43);
2640 IF R(D2)=0THEN 2660
: IF D1=D2THEN 2660
: PRINT "DEVICE ";U0$;" = ";R(D2);
2660 PRINT " "
: FOR X=1TO 7
: R(X)=0
: NEXT X
: GOTO 2170
2710 GOSUB '248(4,0,0)
: GOSUB '46
: GOSUB '44("ARE FILE SPECIFICATIONS OK? (Y OR N)")
: IF Q6$="N"THEN 870
: GOSUB '44("DO YOU WANT A HARD COPY PRINTOUT OF FILE DESCRIPTION? (Y OR N)
")
: IF Q6$="N"THEN 2820
: SELECT PRINT 215
: GOSUB '46
2790 SELECT PRINT 005
2820 IF C1>0THEN 2890
: DATA SAVE DC OPEN T$#1,K2,K1$
: DSKIP #1,K2-2S
: DATA SAVE DC $#1,END
: DATA SAVE DC CLOSE#1
2890 IF C2>0THEN 2970
: DATA SAVE DC OPEN T$#2,U8,U1$
: DSKIP #2,U8-2S
: DATA SAVE DC $#2,END
: DATA SAVE DC CLOSE#2
2970 Q2$=HEX(0000)
: BIN(STR(Q2$,2))=U-1
: XOR (Q2$,FF)
: Y=U8-3
: X=INT(Y/256)
: BIN(Q3$)=X
: BIN(STR(Q3$,2))=Y-256*X
: BIN(V8$)=U2
: V5$=V8$
: BIN(STR(V1$,2))=U1
: X=INT(U4/256)
: BIN(STR(V1$,3))=X
: BIN(STR(V1$,4))=U4-256*X
: BIN(STR(V1$,5))=U3
3105 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
: V8=.5
: T8$="X"
: DATA LOAD DC OPEN T#1,K1$
3240 DATA SAVE DC $#1,Q2$,Q3$,V5$,V8$,V0$,V1$,V2$,V3$,V6$,T2$,T0,T1,T2,V8,T4$,
T5$,T7$,T2$(),T(),T8$
: INIT(FF)Q0$()
: INIT(00)STR(Q0$(1),1,U3)
: Q9$=HEX(0001)
: DATA SAVE DC $#1,Q9$,Q0$()
: LIMITS T#2,U1$,X,Y,Z
: Y=Y-1
3258 Q0$(1)=HEX(A0FD)
: STR(Q0$(1),3)=Q2$
: STR(Q0$(1),5)=V5$
: STR(Q0$(1),6)=V8$
: STR(Q0$(1),7)=V1$
: STR(Q0$(1),15)=V6$
: DATA SAVE BA T$#2,(Y,Y)Q0$()
: GOSUB '44("DO YOU WISH TO DO ANOTHER FILE? (Y OR N)")
: IF Q6$="Y"THEN 870
3330 GOSUB '248(0,0,15)
: COM CLEAR Q6$
: LOAD DC T#0,"START050"
3410 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$)
3590 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 3770
: IF Y=0THEN 3770
: H=0
3710 DATA LOAD BA T#Z,(H,X)I$()
: GOSUB '42
: IF X>0THEN 3770
: H=H+1
: IF H<S9THEN 3710
3770 RETURN
3800 DEFFN'41
: AND (STR(X1$,1,1),7F)
: X=VAL(X1$)*256+VAL(STR(X1$,2))
: RETURN
3860 DEFFN'42
: Y=0
: X=2
: IF H>0THEN 3910
: X=4
3910 IF STR(I$(X-1),1,1)=HEX(10)THEN 3940
: IF STR(I$(X-1),1,1)=HEX(00)THEN 3990
: GOTO 3950
3940 IF I$(X)=N$THEN 4010
3950 X=X+2
: IF X<34THEN 3910
: Y=1
3990 X=0
4010 RETURN
4040 DEFFN'43(Q6$)
: PRINT HEX(010A0A0A)
: PRINT Q6$
: RETURN
4100 DEFFN'44(X$)
4110 GOSUB '243(X$,1)
: IF Q6$=" "THEN 4180
: IF Q6$="Y"THEN 4200
: IF Q6$="N"THEN 4200
: GOSUB '43("RE-ENTER")
: GOTO 4110
4180 Q6$="Y"
4200 RETURN
4260 DEFFN'45(N$,Z)
: LIMITS T#Z,N$,X,Y,H
: H=H-2
: A=Y-X-1
: IF A=HTHEN 4380
: DATA LOAD DC OPEN T#Z,N$
: IF H<0THEN 4350
: DSKIP #Z,END
: DATA SAVE DC $#Z,N$
4350 DSKIP #Z,A-H-1S
: DATA SAVE DC $#Z,END
: DATA SAVE DC CLOSE#Z
4380 RETURN
4410 DEFFN'46
: IF K3=0THEN 4420
: PRINT "WARNING -- KEY FILE TOO SMALL"
4420 PRINTUSING 4460,U1$,K1$
: PRINTUSING 4470,U0$;
: PRINT TAB(32);
: PRINTUSING 4470,K0$
4460 %DATA FILE NAME ######## KEY FILE NAME ########
4470 % DEVICE ADDRESS ###
4480 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 4530
: PRINTUSING 4520,U1;
: GOTO 4540
4520 % RECORD LENGTH ###
4530 PRINTUSING 4520,U;
4540 PRINT TAB(32);
: PRINTUSING 4560,U3
4560 % KEY LENGTH ##
4570 IF V1$>"C"THEN 4610
: PRINTUSING 4600,U2;
: GOTO 4620
4600 % BLOCKING FACTOR ###
4610 PRINT " (SECTORS)";
4620 PRINT TAB(32);
: PRINTUSING 4640,U4
4640 % KEY POSITION #####
4650 PRINTUSING 4680,U8;
: PRINT TAB(32);
: PRINTUSING 4680,K2
4680 % NO. OF SECTORS #####
4685 PRINT HEX(0A)
: RETURN
4740 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"
4800 GOSUB '245(X$,1,0)
: X=Q9
: IF X<1THEN 4860
: IF X>7THEN 4860
: GOSUB '248(5,0,5)
: RETURN
4860 PRINT HEX(010A0A0A)
: PRINT "INVALID DEVICE ADDRESS"
: GOTO 4800
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