Listing of file='KFAM4104' on disk='vmedia/701-2086B.wvd.zip'
# Sector 98, program filename = 'KFAM4104'
0010 REM KFAM4104,VER.03/02/76
0012 COM Q6$64
: DIM X$64,D8$21,E$60,I1$3,O1$3,T$1,Z$8,H$2,L$1
: DIM X1$2,N$8,I$(32)8,D$(4)64
: D8$="310320330350B10B20B30"
0610 C=0
: PRINT HEX(030A0A0A0A)
: PRINT "DISK COPY AND REORGANIZE"
0640 GOSUB '125("ENTER THE NO. OF THE INPUT PLATTER DEVICE ADDRESS")
: D1=X
: I1$=STR(D8$,D1*3-2,3)
: GOSUB '125("ENTER THE NO. OF THE OUTPUT PLATTER DEVICE ADDRESS")
: D2=X
: O1$=STR(D8$,D2*3-2,3)
0810 IF D1=D2THEN 910
: GOSUB 4240
: GOSUB 4590
: GOTO 960
0910 GOSUB '40("INPUT AND OUTPUT PLATTERS MUST BE DIFFERENT")
: GOTO 640
0960 GOSUB '243("ENTER FILE NAME",8)
: N$=Q6$
: IF N$=" "THEN 1862
: GOSUB '50(N$,1)
: IF X>0THEN 990
: GOSUB '40("FILE NOT FOUND")
: GOTO 960
0990 LIMITS T#1,N$,F0,F9,F1
: L=F9-F0+1
0995 DATA LOAD BA T#1,(F0,X)D$()
: AND (STR(D$(1),1,1),10)
: IF STR(D$(1),1,1)=HEX(00)THEN 1020
: GOSUB '40("PROTECTED PROGRAM")
: GOTO 960
1020 DATA LOAD BA T#2,(0,X)D$()
: X1$=STR(D$(1),1,2)
: GOSUB '41
: S7=X
: X1$=STR(D$(1),3,2)
: GOSUB '41
: S0=X
: X1$=STR(D$(1),5,2)
: GOSUB '41
: S9=X
: S2=S9-S0
: GOSUB '248(5,0,1)
: PRINT "INPUT ";I1$,"OUTPUT ";O1$,"AVAILABLE SPACE ";TAB(48);S2
1160 IF C>0THEN 1200
1170 C=7
: GOSUB '248(7,0,8)
: PRINT "FILE NAME LENGTH SECTORS USED NEW LENGTH"
1200 C=C+1
: IF C>14THEN 1170
: GOSUB '248(C,0,0)
: PRINTUSING 1240,N$,L,F1
1240 %######## ##### #####
1245 IF F1>S2THEN 1845
1260 GOSUB '245("ENTER NUMBER OF SECTORS TO BE COPIED",5,0)
: N1=Q9
: IF N1<F1THEN 1810
: IF N1>S2THEN 1830
: GOSUB '248(C,44,0)
: PRINTUSING 1320,N1
1320 %#####
1340 DATA SAVE DC OPEN T$#2,N1,N$
1360 DATA LOAD BA T#1,(F9,X)D$()
: T$=STR(D$(1),1,1)
: AND (T$,F0)
1420 DATA SAVE BA T$#2,(S0+N1-1,X)D$()
: Z=L-2
: IF N1>LTHEN 1480
: Z=N1-2
1480 FOR Y=0TO Z
1490 DATA LOAD BA T#1,(F0+Y,X)D$()
1500 DATA SAVE BA T$#2,(S0+Y,X)D$()
: NEXT Y
: IF T$=HEX(A0)THEN 1785
: Z$=N$
: XOR (STR(Z$,2),Z$)
: L$=STR(Z$,8,1)
: H$=HEX(0000)
: ADDC(H$,L$)
: ADDC(H$,L$)
: ADDC(H$,L$)
: ADD(STR(H$,1,1),STR(H$,2,1))
: H=VAL(H$)
: H=H-INT(H/S7)*S7
1670 DATA LOAD BA T#2,(H,X)I$()
: GOSUB '42
: IF X>0THEN 1770
: H=0
1710 DATA LOAD BA T#2,(H,X)I$()
: GOSUB '42
: IF X>0THEN 1770
: H=H+1
: IF H<S7THEN 1710
: STOP "DISASTER"
1770 STR(I$(X-1),2,1)=HEX(80)
1780 DATA SAVE BA T$#2,(H,X)I$()
1785 GOSUB '248(5,48,1)
: PRINT S2-N1
: GOTO 960
1810 GOSUB '40("LESS THAN SECTORS USED")
: GOTO 1260
1830 GOSUB '40("GREATER THAN AVAILABLE SPACE")
: GOTO 1260
1845 GOSUB '248(0,0,4)
: PRINT "NO ROOM TO COPY"
: GOSUB 1876
: STOP
1862 GOSUB 1876
1863 GOSUB '248(0,0,4)
: GOSUB '50("START065",0)
: IF X>0THEN 1869
: PRINT "MOUNT SYSTEM DISK"
: GOSUB '243("KEY RETURN(EXEC) TO RESUME",0)
: GOTO 1863
1869 COM CLEAR Q6$
: LOAD DC T#0,"START065"
1876 GOSUB 4420
: $IF ON #1,1880
1880 GOSUB 4770
: $IF ON #2,1884
1884 RETURN
1920 DEFFN'40(E$)
: GOSUB '248(3,0,0)
: PRINT E$
: RETURN
3410 DEFFN'50(N$,Z)
3430 DATA LOAD BA T#Z,(0,X)I$()
: X1$=STR(I$(1),1,2)
: GOSUB '41
: S7=X
: Z$=N$
: XOR (STR(Z$,2),Z$)
: L$=STR(Z$,8,1)
: H$=HEX(0000)
: ADDC(H$,L$)
: ADDC(H$,L$)
: ADDC(H$,L$)
: ADD(STR(H$,1,1),STR(H$,2,1))
: H=VAL(H$)
: H=H-INT(H/S7)*S7
3640 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<S7THEN 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
4070 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"
4130 GOSUB '245(X$,1,0)
: X=Q9
: IF X<1THEN 4190
: IF X>7THEN 4190
: GOSUB '248(5,0,5)
: RETURN
4190 PRINT HEX(010A0A0A)
: PRINT "INVALID DEVICE ADDRESS"
: GOTO 4130
4240 IF M$="X"THEN 4420
: ON D1GOTO 4260,4280,4300,4320,4340,4360,4380
4260 SELECT #1390
: RETURN
4280 SELECT #13A0
: RETURN
4300 SELECT #13B0
: RETURN
4320 SELECT #13D0
: RETURN
4340 SELECT #1B90
: RETURN
4360 SELECT #1BA0
: RETURN
4380 SELECT #1BB0
: RETURN
4420 ON D1GOTO 4430,4450,4470,4490,4510,4530,4550
4430 SELECT #1310
: RETURN
4450 SELECT #1320
: RETURN
4470 SELECT #1330
: RETURN
4490 SELECT #1350
: RETURN
4510 SELECT #1B10
: RETURN
4530 SELECT #1B20
: RETURN
4550 SELECT #1B30
: RETURN
4590 IF M$="X"THEN 4770
: ON D2GOTO 4610,4630,4650,4670,4690,4710,4730
4610 SELECT #2390
: RETURN
4630 SELECT #23A0
: RETURN
4650 SELECT #23B0
: RETURN
4670 SELECT #23D0
: RETURN
4690 SELECT #2B90
: RETURN
4710 SELECT #2BA0
: RETURN
4730 SELECT #2BB0
: RETURN
4770 ON D2GOTO 4780,4800,4820,4840,4860,4880,4900
4780 SELECT #2310
: RETURN
4800 SELECT #2320
: RETURN
4820 SELECT #2330
: RETURN
4840 SELECT #2350
: RETURN
4860 SELECT #2B10
: RETURN
4880 SELECT #2B20
: RETURN
4900 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