Listing of file='KFAM4004' on disk='vmedia/701-2086B.wvd.zip'
# Sector 219, program filename = 'KFAM4004'
0010 REM KFAM4004,VER.03/02/76
0012 COM Q6$64
5270 DIM X$64,E$2,E1$4,A$(4)64
: DIM Q2$2,Q3$2,V5$(4)1,V8$1,V1$8,V2$2,V3$2,V6$1,T2$2
: DIM V2$(4)2,Q0$4,T8$(4)1,V4$(4)2
: DIM U1$8,K1$8,X1$2
5420 PRINT HEX(03)
5430 GOSUB '243("ENTER USER FILE NAME (SSSSFJNN)",8)
: U1$=Q6$
: IF STR(U1$,5,1)="F"THEN 5490
: GOSUB '50("FILE NAME MUST HAVE F IN POSITION 5")
: GOTO 5430
5490 IF STR(U1$,6,1)<"0"THEN 5520
: IF STR(U1$,6,1)>"9"THEN 5520
: GOTO 5550
5520 GOSUB '50("FILE NAME MUST HAVE NUMBER IN POSITION 6")
: GOTO 5430
5550 PRINT HEX(03)
: GOSUB '125("ENTER THE NO. OF THE USER FILE DEVICE ADDRESS")
: D1=Q9
: GOSUB 7300
: PRINT HEX(03)
: GOSUB '125("ENTER THE NO. OF THE KEY FILE DEVICE ADDRESS")
: D2=Q9
: GOSUB 7670
: PRINT HEX(03)
5782 GOSUB '245("ENTER NUMBER OF KEY FILE",1,0)
: IF Q9>0THEN 5794
: GOSUB '50("INVALID")
: GOTO 5782
5794 K1$=U1$
: STR(K1$,5,1)="K"
: CONVERT Q9TO STR(K1$,6,1),(#)
: ON ERRORE$,E1$GOTO 8030
: LIMITS T#1,U1$,U1,U2,U3
: LIMITS T#2,K1$,K1,K2,K3
: DATA LOAD DC OPEN T#2,K1$
5890 DATA LOAD DC #2,Q2$,Q3$,V5$(),V8$,V1$,V2$,V3$,V6$,T2$,T0,T8$(),Q0$,V4$(),
V2$()
: IF Q0$<>" "THEN 8110
: U6,U7=VAL(Q3$)*256+VAL(STR(Q3$,2))+1
: K6,K7=VAL(V3$)*256+VAL(STR(V3$,2))+1
: U4=VAL(Q2$)*256+VAL(STR(Q2$,2))+VAL(V6$)
5940 U5=U2-U1-1
: K4=VAL(V2$)*256+VAL(STR(V2$,2))+1
: IF Q2$<HEX(FF00)THEN 5960
: PRINT "RUN KFAM2004 FIRST"
: GOTO 8230
5960 K5=K2-K1-1
: GOSUB '248(6,0,0)
: PRINT TAB(10);"LENGTH LOW LIMIT HIGH LIMIT NEW LENGTH"
: PRINT "USER FILE ";
: PRINTUSING 6010,U6,U4,U5
6010 %##### ##### #####
6020 PRINT "KEY FILE ";
: PRINTUSING 6010,K6,K4,K5
6060 GOSUB '243("DO YOU WISH TO REALLOCATE UF SPACE? (Y OR N)",1)
: IF Q6$=" "THEN 6120
: IF Q6$="Y"THEN 6120
: IF Q6$="N"THEN 6210
: GOSUB '50("ANSWER Y OR N")
: GOTO 6060
6120 GOSUB '248(0,0,4)
6130 GOSUB '245("INPUT NEW UF SECTOR ALLOCATION",5,0)
: U6=Q9
: IF U6<U4THEN 6180
: IF U6>U5THEN 6180
: GOTO 6210
6180 GOSUB '50("INVALID - OUT OF BOUNDS")
: GOTO 6130
6210 GOSUB '248(7,49,0)
: PRINTUSING 6420,U6
: GOSUB '248(0,0,4)
6250 GOSUB '243("DO YOU WISH TO REALLOCATE SPACE FOR KF? (Y OR N)",1)
: IF Q6$=" "THEN 6310
: IF Q6$="Y"THEN 6310
: IF Q6$="N"THEN 6400
: GOSUB '50("ANSWER Y OR N")
: GOTO 6250
6310 GOSUB '248(0,0,4)
6320 GOSUB '245("ENTER NEW KF SECTOR ALLOCATION",5,0)
: K6=Q9
: IF K6<K4THEN 6370
: IF K6>K5THEN 6370
: GOTO 6400
6370 IF K4>K5THEN 6385
: GOSUB '50("INVALID - OUT OF BOUNDS")
: GOTO 6320
6385 GOSUB '248(0,0,4)
: PRINT "COPY AND LENGTHEN KF FIRST"
: GOTO 8230
6400 GOSUB '248(8,49,0)
: PRINTUSING 6420,K6
6420 %#####
6450 IF U6=U7THEN 6620
: U8=U1+U7
: DATA LOAD BA T#1,(U8,X)A$()
: DATA LOAD DC OPEN T#1,U1$
: DSKIP #1,END
: DATA SAVE DC $#1,U1$
: IF U6>U7THEN 6540
: Y=U7-U6+1
: DBACKSPACE #1,YS
: GOTO 6580
6540 Y=U6-U7-1
: IF Y=0THEN 6580
: DSKIP #1,YS
6580 DATA SAVE DC $#1,END
: U8=U1+U6
: DATA SAVE BA T$#1,(U8,U8)A$()
: DATA SAVE DC CLOSE#1
: GOSUB '51(U6-1)
: Q3$=X1$
6620 IF K6=K7THEN 6790
: DSKIP #2,END
: DATA SAVE DC $#2,K1$
: IF K6>K7THEN 6710
: Y=K7-K6+1
: DBACKSPACE #2,YS
: GOTO 6750
6710 Y=K6-K7-1
: IF Y=0THEN 6750
: DSKIP #2,YS
6750 DATA SAVE DC $#2,END
: DATA SAVE DC CLOSE#2
: GOSUB '51(K6-1)
: V3$=X1$
6790 DATA LOAD DC OPEN T#2,K1$
: DATA SAVE DC $#2,Q2$,Q3$,V5$(),V8$,V1$,V2$,V3$,V6$,T2$,T0,T8$(),Q0$,V4$()
,V2$()
: GOSUB '248(0,0,4)
6840 GOSUB '243("DO YOU WISH TO DO ANOTHER FILE? (Y OR N)",1)
: IF Q6$=" "THEN 5420
: IF Q6$="Y"THEN 5420
: IF Q6$="N"THEN 6910
: GOSUB '50("ANSWER Y OR N")
: GOTO 6840
6910 GOSUB 8162
6915 COM CLEAR Q6$
: LOAD DC T#0,"START065"
6950 DEFFN'50(Q6$)
: PRINT HEX(010A0A0A)
: PRINT Q6$
: RETURN
7010 DEFFN'51(X)
: Y=INT(X/256)
: BIN(X1$)=Y
: BIN(STR(X1$,2))=X-256*Y
: RETURN
7100 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"
7160 GOSUB '245(X$,1,0)
: X=Q9
: IF X<1THEN 7220
: IF X>7THEN 7220
: GOSUB '248(5,0,5)
: RETURN
7220 PRINT HEX(010A0A0A)
: PRINT "INVALID DEVICE ADDRESS"
: GOTO 7160
7300 IF M$="X"THEN 7490
: ON D1GOTO 7320,7340,7360,7380,7400,7420,7440
7320 SELECT #1390
: RETURN
7340 SELECT #13A0
: RETURN
7360 SELECT #13B0
: RETURN
7380 SELECT #13D0
: RETURN
7400 SELECT #1B90
: RETURN
7420 SELECT #1BA0
: RETURN
7440 SELECT #1BB0
: RETURN
7490 ON D1GOTO 7500,7520,7540,7560,7580,7600,7620
7500 SELECT #1310
: RETURN
7520 SELECT #1320
: RETURN
7540 SELECT #1330
: RETURN
7560 SELECT #1350
: RETURN
7580 SELECT #1B10
: RETURN
7600 SELECT #1B20
: RETURN
7620 SELECT #1B30
: RETURN
7670 IF M$="X"THEN 7860
: ON D2GOTO 7690,7710,7730,7750,7770,7790,7810
7690 SELECT #2390
: RETURN
7710 SELECT #23A0
: RETURN
7730 SELECT #23B0
: RETURN
7750 SELECT #23D0
: RETURN
7770 SELECT #2B90
: RETURN
7790 SELECT #2BA0
: RETURN
7810 SELECT #2BB0
: RETURN
7860 ON D2GOTO 7870,7890,7910,7930,7950,7970,7990
7870 SELECT #2310
: RETURN
7890 SELECT #2320
: RETURN
7910 SELECT #2330
: RETURN
7930 SELECT #2350
: RETURN
7950 SELECT #2B10
: RETURN
7970 SELECT #2B20
: RETURN
7990 SELECT #2B30
: RETURN
8030 GOSUB '248(0,0,4)
: IF E$<>"80"THEN 8080
: PRINT "FILE NOT FOUND"
: GOTO 8230
8080 PRINTUSING 8090,E$,E1$
8090 %ERR ## LINE ####
8100 GOTO 8230
8110 GOSUB '248(0,0,4)
: PRINT "FILE BUSY"
: GOTO 8230
8162 GOSUB 7860
: $IF ON #2,8180
8180 GOSUB 7490
: $IF ON #1,8200
8200 RETURN
8230 GOSUB 8162
: STOP
: GOTO 6915
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