Compucolor.org – Virtual Media

Listing of file='DSKCPY.BAS;01' on disk='vmedia/ncc_4_11-sector.ccvf'

1100 CLEAR 200
1200 DIM SL(3),BA(3)
1300 PLOT 6,2,27,24,12:REM 	PAGE MODE CLEAR SCREEN
1400 PLOT 14:PRINT "SINGLE/DUAL-DRIVE DISK-DISK COPY PROGRAM"
1500 PRINT "COPIES BY SECTOR ADDRESS WITH NO REFORMATTING"
1600 PLOT 15
1605 PLOT 3,1,6,11
1610 PRINT  "ENTER FROM AND TOO DISK ADDRESSES"
1611 PLOT 11
1615 INPUT  "AS SINGLE DIGITS 0 OR 1(EG. 0,0 OR 0,1): ";FD$,TD$
1620 IF FD$< > "0"AND FD$< > "1"THEN 1605
1630 IF TD$< > "0"AND TD$< > "1"THEN 1605
1700 PRINT "ENTER START AND END SECTOR ADDRESSES "
1800 PRINT "ENTER DECIMAL WITH +(EG. +255)"
1900 PRINT "ENTER HEX(0-9,A-F) WITH NO +(1FF)
2000 PRINT "IF END<START IT IS TAKEN AS A COUNT"
2100 PRINT "ENTER 0,DIR TO USE DIRECTORY LIMITS"
2200 GOSUB 7100
2300 PLOT 3,36,8:INPUT ":";S$,R$
2400 CI$= S$:GOSUB 50000:AD= CO
2500 DI= AD:GOSUB 52000:S$= DO$
2600 IF  R$< >  "DIR" THEN 2700
2610 RN= 399:AD= 0:S$= "0":GOSUB 5100:GOTO 6000
2700 CI$= R$:GOSUB 50000:RN= CO
2800 IF RN< ADTHEN RN= AD+ RN- 1
2900 DI= RN:GOSUB 52000:R$= DO$
3000 GOSUB 5000
3100 GOTO 6000
5000 PLOT 3,1,9,11
5100 PRINT "FROM RECORD ";AD;"[";S$;"] TO RECORD ";RN;"[";R$;"]"
5200 RETURN
6000 FOR  N= 10 TO  13:PLOT  3,1,N,11:NEXT  N
6001 PLOT 3,1,17,11,10,11,10,11
6100 SL(1)= AD:SL(2)= AD:SL(3)= RN
6200 GOTO 10000:REM 	BR OVER SUB
7000 REM  		SUBR TO ALLOC DISK BUFFER
7100 BF= PEEK (32986)+ 256* PEEK (32987)
7200 BF= INT ((BF+ 200+ 256)/ 256)* 256
7300 DI= BF:GOSUB 52000:BF$= DO$
7400 EB= 256* (PEEK (32941)- 2):REM  END OF BUFFER AREA +1
7500 PLOT 10
7600 DI= EB:GOSUB 52000:PRINT "DISK BUFFER ";BF$;"-";DO$
7700 MR= (EB- BF)/ 128
7800 DI= MR:GOSUB 52000:PRINT "MAX REC/PASS ";MR;"[";DO$;"]"
7900 RETURN :REM 
10000 REM  			RLP0:
10100 BA(1)= BF:BA(2)= EB:REM 	SET BUFFER LIMITS
10101 BA(3)= BF
10200 P= BF+ 23:REM 		P -> 1ST ATTR BYTE FOR DIR SCH
10300 REM  			RLP:
10400 FOR N= 17TO 31:PLOT 3,1,N,11:NEXT
10500 PLOT 3,1,19
10600 PRINT "READY TO ";
10700 PLOT 14
10800 PRINT "READ";" FROM CD";FD$;" ";
10900 DI= SL(2):GOSUB 52000
11000 PRINT "RECORD ";DI;"[";DO$;"] TO ";
11100 DI= SL(2)+ MR- 1:REM 	LAST REC IF LIMIT BY BUFFER
11200 EM$= " NOT LAST PASS "
11300 IF SL(3)< = DITHEN DI= SL(3):EM$= ""
11400 GOSUB 52000
11500 PRINT DI;"[";DO$;"]"
11510 IF  FD$= TD$ THEN PRINT  TAB( 31);EM$:PLOT  10:GOTO 11700
11600 PLOT 10,10
11700 PRINT "ENTER CONT WHEN READY"
11800 END
11900 PLOT 3,1,19,18,14
12000 PRINT "      READING"
12100 FOR N= 21TO 31:PLOT 3,1,N,11:NEXT
20000 REM  		READ LOOP FOR DISK
20100 RC= 0:RL= 5:REM  	RETRY COUNT & LIMIT
20200 FOR CR= SL(2)TO SL(3)
20300 IF BA(1)> = BA(2)THEN 33500:REM  	BUFFER FULL; TO WRITE
20400 RS$= "READ CD"+ FD$+ ": "
20500 DI= CR:GOSUB 52000
20600 RS$= RS$+ DO$+ " "
20700 DI= BA(1):GOSUB 52000
20800 RS$= RS$+ DO$+ "-"
20900 DI= BA(1)+ 127:GOSUB 52000
21000 IF RC> 0THEN 21500
21100 DI =  BA(1) +  128 *  (SL(3)- CR+ 1)- 1
21200 GOSUB 52000
21300 IF DI< BA(2)THEN BA(2)= DI+ 1:GOTO 21500
21301 REM 				LIMIT BY SECT RNG
21400 DI= BA(2)- 1:GOSUB 52000:REM 	LIMITED BY BUFFER
21500 RS$= RS$+ DO$
21600 PLOT 3,1,20
21700 PRINT RS$
21800 PLOT 3,1,21,11:REM 	CLEAR POSSIBLE FCS ERROR MSG
21900 PLOT 27,4:REM 		ACCESS FCS
22000 PRINT RS$:PLOT 27,27
22100 IF PEEK (31360)< > 32THEN 25000
22200 REM 			DETECT FCS DISK ERR MSG
22300 IF R$= "DIR"THEN GOSUB 60000
22400 IF RC> 0THEN 22700
22500 CR= CR+ INT (( BA(2)- BA(1))/ 128)- 1
22550 BA(1)= BA(2)
22600 GOTO 23000
22700 RC= 0:REM 			RESET RETRY COUNTER
22800 PRINT ""
22900 BA(1)= BA(1)+ 128:REM 	INCR BUFFER POINTER
23000 NEXT CR
23100 REM
23200 PLOT 3,0,11
23300 PRINT "ALL RECORDS HAVE BEEN READ"
23400 GOTO 35000:REM 		TO COMMON WRITE
25000 REM  			FERR:ENTRY FOR READ ERROR
25100 RC= RC+ 1
25200 REM 			SECT. NUM. FRM FCS ERR MSG
25300 CI$= CHR$ (PEEK (31386))
25400 CI$= CI$+ CHR$ (PEEK (31388))
25500 CI$= CI$+ CHR$ (PEEK (31390))
25600 CI$= CI$+ CHR$ (PEEK (31392))
25700 GOSUB 50000
25800 BA(1)= BA(1)+ (CO- CR)* 128
25900 CR= CO
26000 IF RC< = RLTHEN 20400:REM 	AUTO RETRY
26100 DI= CR:GOSUB 52000
26200 PLOT 3,1,22
26300 PRINT "READ ERROR AT RECORD ";DI;"[";DO$;"]"
26400 PRINT "ENTER RETRY TO ATTEMPT A RE-READ"
26500 PRINT "ENTER DUMP  TO WRITE OUT RECORDS SUCCESSFULLY READ"
26600 PRINT "ENTER ACCEPT TO TAKE RECORD AS READ
26700 INPUT RP$
26800 FOR N= 21TO 31:PLOT 3,0,N,11:NEXT
26900 IF RP$= "RETRY"THEN 33000
27000 IF RP$= "DUMP"THEN 33300
27100 IF RP$= "ACCEPT"THEN 22700
27200 GOTO 26200
33000 REM  RETRY:ATTEMPT RE-READ OF RECORD IN ERROR
33100 SL(2)= CR
33200 GOTO 11900
33300 REM  EDUMP:DUMP GOOD RECORDS AFTER READ ERROR
33400 EM$= "INCOMPLETE-READ ERR"
33500 REM  PDUMP:DUMP AFTER BUFFER FULL
35000 REM  CDUMP:COMMON DISK WRITE
35100 CR= CR- 1:REM LST REC READ
35200 FOR N= 18TO 31:PLOT 3,1,N,11:NEXT
35300 PLOT 3,1,19:PRINT "READY TO";:PLOT 14
35400 PRINT " WRITE TO CD";TD$;"  FROM ";
35500 DI= SL(1):GOSUB 52000
35600 PRINT "RECORD ";DI;"[";DO$;"] TO ";
35700 DI= CR:GOSUB 52000
35800 PRINT DI;"[";DO$;"]"
35850 IF  FD$< > TD$ THEN 36500:REM NO PAUSE FOR TWO-DISK COPY
35900 PRINT SPC( 23);EM$
36000 PLOT 10,10,14,11:PRINT SPC( 15);
36100 PRINT "CHANGE THE DISK!!!!"
36200 PLOT 10,10
36300 PRINT "ENTER CONT WHEN READY AFTER CHANGING DISK"
36400 END
36500 FOR N= 17TO 35:PLOT 3,1,N,11:NEXT
36600 REM  GENERATE DISK WRITE
36700 WF$= "WRITE CD"+ TD$+ ": "
36800 DI= SL(1):GOSUB 52000
36900 WF$= WF$+ DO$+ " "
37000 DI= BA(3):GOSUB 52000
37100 WF$= WF$+ DO$+ "-"
37200 DI= BA(1)- 1:GOSUB 52000
37300 WF$= WF$+ DO$
37310 PLOT 3,1,21,11:REM 	CLEAR POSSIBLE FCS ERROR MSG
37400 PLOT 3,1,20
37500 PRINT WF$
37600 PLOT 27,4:REM 	ACCESS FCS
37700 PRINT WF$:PLOT 27,27
37710 IF PEEK (31360)= 32THEN 38200
37712 REM  			WERR: WRITE ERROR
37714 RC= RC+ 1
37718 REM 			SECT. NUM. FRM FCS ERR MSG
37722 CI$= CHR$ (PEEK (31386))
37726 CI$= CI$+ CHR$ (PEEK (31388))
37730 CI$= CI$+ CHR$ (PEEK (31390))
37734 CI$= CI$+ CHR$ (PEEK (31392))
37738 GOSUB 50000
37742 PLOT 3,1,22
37746 PRINT "WRITE ERROR AT RECORD ";CO;"[";CI$;"]"
37750 PRINT "ENTER RETRY TO REWRITE"
37754 PRINT "ENTER ACCEPT TO CONTINUE"
37758 INPUT RP$
37762 FOR N= 21TO 31:PLOT 3,0,N,11:NEXT
37770 IF RP$< > "RETRY"THEN 37800
37780 BA(3)= BA(3)+ (CO- SL(1))* 128
37790 SL(1)= CO
37795 GOTO  36600
37800 IF RP$< > "ACCEPT"THEN 37742
37850 BA(3)= BA(3)+ (CO+ 1- SL(1))* 128
37860 SL(1)= CO+ 1
37870 IF  SL(1)> SL(2) THEN  38300
38000 GOTO  36600
38200 PRINT "ABOVE WRITE HAS COMPLETED OK"
38300 SL(2)= SL(1) +  (BA(1)- BA(3))/ 128
38301 REM  		RECORD TO CONTINUE READ/WRITE CYCLE
38400 SL(1)= SL(2)
38500 IF SL(2)> = SL(3)THEN 38900
38600 PRINT "ENTER CONT TO CONTINUE, OR RUN TO ENTER NEW PARAMETERS":END
38700 FOR N= 13TO 35:PLOT 3,1,N:NEXT
38800 GOTO 10000
38900 PRINT "END OF JOB"
39000 END
39100 RUN
50000 REM  	CONVERT HEX STRING IN CI$ TO ARITH IN CO
50010 CO= 0
50020 IF MID$ (CI$,1,1)= "+"THEN CO= VAL (CI$):RETURN
50030 FOR I= 1TO LEN (CI$)
50040 C1= ASC (MID$ (CI$,I,1))
50050 C2= 16
50060 IF C1> 47AND C1< 58THEN C2= C1- 48
50070 IF C1> 64AND C1< 71THEN C2= C1- 55:REM  HEX A-F
50080 IF C2> 15THEN PRINT "HEX INPUT ERROR ";CI$:END
50090 CO= CO* 16+ C2
50100 NEXT I
50110 RETURN
51000 REM  CONVERT ARITH VALUE IN HI(0-255) TO TWO HEX CHAR
51010 REM  IN HO$
51020 IF HI< 0THEN HI= HI+ 128
51030 H0= INT (HI/ 16)
51040 H1= HIAND 15
51050 HO$= MID$ ("0123456789ABCDEF",H0+ 1,1)
51060 HO$= HO$+ MID$ ("0123456789ABCDEF",H1+ 1,1)
51070 RETURN
52000 REM  CONVERT TWO-BYTE VALUE TO 4-BYTE HEX STRING
52010 IF DI< 0THEN DI= DI+ 65536
52020 HI= INT (DI/ 256):GOSUB 51000:DO$= HO$
52030 HI= (DI- HI* 256):GOSUB 51000
52040 DO$= DO$+ HO$
52050 RETURN
60000 REM  SUB TO FIND LOGICAL END OF DISK FROM DIR
60100 REM  P=BF+23 AT LINE RLP0:
60200 Q= PEEK (P+ 11)+ 256* PEEK (P+ 12):REM  1ST SECT
60300 DI= Q:GOSUB 52000
60400 IF PEEK (P)< > 1THEN 60800
60500 RN= Q:R$= DO$:SL(3)= Q
60510 N= BA(3)+ 128* (SL(3)- SL(1))
60520 IF  N< BA(2) THEN  BA(2)= N
60600 GOSUB 5000
60700 RETURN
60800 P= P+ 21
60900 IF INT (P/ 128)< > P/ 128THEN 60200
61000 P= P+ 2
61100 IF P< BA(2) AND  RC= 0 THEN 60200
61200 RETURN