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