TITLE	COPY
	SUBTTL	Copy a disk from drive A to drive B

	.Z80
WBOOT	EQU	0
LSTSEC	EQU	52       ;Double density value.
BDOS	EQU	5
DFTDRV	EQU	2
TBUFF	EQU	80H
CR	EQU	0DH
LF	EQU	0AH
ESC	EQU	27

COPY:	LD	C,12	;Return version number
	CALL	BDOS
	LD	A,H
	OR	L
	JR	NZ,VEROK
	LD	DE,CPMMSG
	LD	C,9	;Print string
	JP	BDOS
VEROK:	LD	HL,(WBOOT+1)
	LD	DE,24
	ADD	HL,DE
	LD	DE,JPVEC
	LD	BC,24
	LDIR
	LD	HL,TBUFF
	XOR	A	;CLEAR ACC.
	ADD	A,(HL)	;GET MESSAGE SIZE
	JR	Z,NOMSG	;NONE FOUND
	INC	HL	;ADD FOR ADDR. PAST MESSAGE
	LD	B,0	;EMPTY FOR ADD
	LD	C,A
	ADD	HL,BC	;ADD CHARACTER COUNT TO HL
	LD	(HL),"$"	;END BUFFER CHARACTER
	LD	A,(TBUFF+2)	;FIRST CHARACTER ADDRESS
	CP	"D"
	JR	Z,DATSET
	CP	"A"
	JR	Z,ALLSET
	PUSH	HL

BADMSG:	POP	HL
	LD	DE,CMDER1
	LD	C,9
	CALL	BDOS
	LD	DE,TBUFF+1	;PRINT ERRONEOUS COMMAND
	LD	C,9
	CALL	BDOS
	LD	DE,CMDER2
	LD	C,9
	CALL	BDOS
NOMSG:	LD	DE,CMDINF
	LD	C,9
Š	JP	BDOS

MSGTST:	LD	HL,TBUFF+3
MSGTS1:	LD	A,(DE)
	CPI
	INC	DE
	JR	NZ,BADMSG
	RET	PO
	JR	MSGTS1

DATSET:	LD	DE,DATMSG
	LD	BC,4
	CALL	MSGTST
	LD	HL,77*256+2
	JR	PUTPAR

FAILR:	LD	DE,MESGD
	JR	DIE
FAILW:	LD	DE,MESGE
DIE:	LD	C,9	;BDOS PRINT BUFFER FUNCTION CALL
	CALL	BDOS
	LD	C,1
	CALL	BDOS
	CP	CR
	RET	Z
	CP	ESC
	JR	NZ,DONE

EXIT:	LD	A,(DFTDRV)
	AND	0FH
	LD	C,A
	CALL	SELDSK
	LD	SP,(CCPSP)
	RET

ALLSET:	LD	DE,ALLMSG
	LD	BC,3
	CALL	MSGTST
	LD	HL,77*256

PUTPAR:	LD	(CCPSP),SP
	LD	(TRKSRT),HL
DONE:	LD	SP,STACK
	LD	DE,SIGNON
	LD	C,9
	CALL	BDOS
	LD	C,1
	CALL	BDOS
	CP	ESC
	JP	Z,EXIT
	CP	CR
	JR	NZ,DONE
	LD	DE,CRLF
	LD	C,9
	CALL	BDOS
Š	LD	A,(TRKSRT)	;FIRST TRACK TO MOVE
	LD	(TRK),A	;MAKE CURRENT
RDLOOP:	XOR	A
	LD	(CMPERR),A
	LD	C,A
	CALL	SELDS1
	LD	A,(TRK)	;GET TRACK
	LD	C,A
	PUSH	BC
	CALL	READT	;READ ENTIRE TRACK
RETRYW:	LD	C,1
	CALL	SELDS1
	POP	BC
	PUSH	BC
	CALL	WRITET	;WRITE TRACK
	POP	BC
	PUSH	BC
	CALL	COMPT	;REREAD AND COMPARE
	JR	NZ,RETRYW	;RETRY IF ERR
	POP	BC
	INC	C
	LD	HL,TRK
	LD	(HL),C
	LD	A,(TRKSRT+1)
	CP	C
	JR	NZ,RDLOOP	;LOOP IF NOT
	LD	DE,DONMSG
	LD	C,9
	CALL	BDOS
	JR	DONE

SELDS1:	CALL	SELDSK
	LD	E,(HL)
	INC	HL
	LD	D,(HL)
	LD	(XLTADR),DE
	RET

PRTHEX:	PUSH	AF	;SAVE FOR LSN
	RRA	;SHIFT MS NIBLE TO LSN
	RRA
	RRA
	RRA
	CALL	PRTNBL	;PRINT IT
	POP	AF	;NOW FOR LSN
PRTNBL:	AND	0FH
	ADD	A,"0"	;SHIFT TO ASCII VALUE
	CP	"9"+1	;OVER 9?
	JR	C,SML
	ADD	A,7	;SHIFT TO ALPHA
SML:	LD	E,A	;FOR BDOS CALL
	LD	C,2	;WRITE CONSOLE FUNCTION
	JP	BDOS

COMPT:	LD	HL,BUF1
Š	CALL	RT2	;REREAD INTO BUF1
	LD	HL,BUF0
	LD	DE,BUF1
	LD	BC,LSTSEC*128
CMPLP:	LD	A,(DE)
	CPI
	INC	DE
	JR	NZ,CERR
	RET	PO
	JR	CMPLP

CERR:	PUSH	BC
	LD	DE,MESGA
	LD	C,9	;BDOS PRINT BUFFER FUNCTION CALL
	CALL	BDOS
	LD	A,(TRK)
	CALL	PRTHEX
	LD	DE,MESGB
	LD	C,9	;BDOS PRINT BUFFER FUNCTION CALL
	CALL	BDOS
	POP	HL	;PUSHED FROM B
	ADD	HL,HL	;COMPUTE SECTOR IN ERROR
	LD	A,LSTSEC-1
	SUB	H
	LD	B,0
	LD	C,A
	LD	DE,(XLTADR)
	CALL	SECTRN
	LD	A,L
	CALL	PRTHEX	;PRINT SECTOR
	LD	A,(CMPERR)
	INC	A
	LD	(CMPERR),A	;INCREMENT ERROR COUNT
	CP	10
	RET	NZ
	LD	C,9	;BDOS PRINT BUFFER FUNCTION CALL
	LD	DE,MESGC
	CALL	BDOS
	XOR	A
	RET

DMASET:	PUSH	BC
	LD	B,H
	LD	C,L
	CALL	SETDMA
	POP	BC
	RET

READT:	LD	HL,BUF0	;TRACK # IN C
RT2:	LD	(DMAAD),HL
	CALL	DMASET
	CALL	SETTRK
	LD	BC,0
RT3:	PUSH	BC
	LD	DE,(XLTADR)
Š	CALL	SECTRN
	LD	B,H
	LD	C,L
	CALL	SETSEC
	CALL	READ
	OR	A
	CALL	NZ,FAILR
	LD	HL,(DMAAD)
	LD	DE,128
	ADD	HL,DE
	LD	(DMAAD),HL
	CALL	DMASET
	POP	BC
	LD	A,LSTSEC-1
	CP	C
	RET	Z
	INC	C
	JR	RT3

WRITET:	LD	HL,BUF0	;TRACK # IN C
WT2:	LD	(DMAAD),HL
	CALL	DMASET
	CALL	SETTRK
	LD	BC,0
WT3:	PUSH	BC
	LD	DE,(XLTADR)
	CALL	SECTRN
	LD	B,H
	LD	C,L
	CALL	SETSEC
	CALL	WRITE
	OR	A
	CALL	NZ,FAILW
	LD	HL,(DMAAD)
	LD	DE,128
	ADD	HL,DE
	LD	(DMAAD),HL
	CALL	DMASET
	POP	BC
	LD	A,LSTSEC-1
	CP	C
	RET	Z
	INC	C
	JR	WT3

CPMMSG:	DEFB	"Requires CP/M version 2.0 or later$"
DATMSG:	DEFB	"ATA$"	;DATA MESSAGE
ALLMSG:	DEFB	"LL$"	;ALL MESSAGE
CMDER1:	DEFB	"Command ""COPY$"
CMDER2:	DEFB	""" has syntax error",CR,LF,"$"
CMDINF:	DEFB	"This program is initiated with the command"
	DEFB	CR,LF,"""COPY DATA"" or ""COPY ALL""$"
DONMSG:	DEFB	CR,LF,"Function complete$"
MESGA:	DEFB	CR,LF,"Compare error on track $"
MESGB:	DEFB	", sector $"
ŠMESGC:	DEFB	" is permanent$"
MESGD:	DEFB	CR,LF,"Read error, type CR to continue, ESC to abort:$"
MESGE:	DEFB	CR,LF,"Write error, type CR to continue, ESC to abort:$"
SIGNON:	DEFB	CR,LF,"Source on A, Destination on B"
	DEFB	CR,LF,"Type CR to copy, ESC to abort:$"
CRLF:	DEFB	CR,LF,"$"

END:
DMAAD:	DEFS	2
TRKSRT:	DEFS	2
CMPERR:	DEFS	1	;NUMBER OF COMPARE ERRORS
TRK:	DEFS	1
XLTADR:	DEFS	2
CCPSP:	DEFS	2

JPVEC:	DEFS	24
SELDSK	EQU	JPVEC
SETTRK	EQU	JPVEC+3
SETSEC	EQU	JPVEC+6
SETDMA	EQU	JPVEC+9
READ	EQU	JPVEC+0CH
WRITE	EQU	JPVEC+0FH
SECTRN	EQU	JPVEC+15H

	DEFS	64
STACK:

BUF0:	DEFS	LSTSEC*128
BUF1:
	ORG	END
	END