;BACKUP3/ASM - Backup By Class
;
;	Find highest available memory page
;
	LD	HL,0		;Set up to get HIGH$
	LD	B,L
	@@HIGH$
	INC	HL		;Find highest available
	DEC	H		;  memory page
	LD	A,H
	LD	(DOFIL06+1),A	;Save for later testing
	LD	(DOFIL08+1),A
	LD	(LSTBUF1+1),A
	LD	A,0C9H
	LD	(PMTDST1),A	;Ignore dest disk test
	CALL	PMTDST		;Prompt dest drive
;
;	Calculate mamximum free space per dest disk type
;
	LD	A,(IY+7)	;P/u # heads & sect/trk
	LD	B,A		;Save heads
	AND	1FH		;Mask all but sectors
	LD	C,A
	INC	C		;Adj for zero offset
	XOR	B		;Get # of heads
	RLCA
	RLCA			;  in bits 0-2
	RLCA
	INC	A		;Adj to 0 offset
	LD	B,A		;Init loop counter
	XOR	A		;Init sector count to 0
	ADD	A,C		;Multiply # sectors/track
	DJNZ	$-1		;  x # of heads/cyl
	LD	L,A
	LD	H,0		;Xfer to 16-bit reg
	JR	NC,NMXSEC	;Go if not 256 sect
	INC	H		;  else set to 256
NMXSEC	BIT	5,(IY+4)	;If 2-sided diskette
	JR	Z,$+3
	ADD	HL,HL		;  double the # of sectors
	LD	C,(IY+6)	;P/u # cyls & adjust for
	DEC	C		;  BOOT & DIR
	@@MUL16			;Calc total records
	LD	H,L		;Results to HL
	LD	L,A
	LD	(SIZSAV+1),HL	;Save for later
;
;	Read the BOOT sector of dest disk
;
	LD	DE,1		;Track 0, sector 1
	LD	HL,BUF2$	;Disk buffer area
	CALL	RDSEC		;Read the sector
	JP	NZ,EXIT3	;Quit on read error
	LD	A,(BOOTST$)	;Locn of boot step rate
	LD	L,A
	LD	A,(HL)		;Get the step rate in
	AND	3		;  bits 0 and 1
	LD	(BSCLS+1),A	;Save for later
	LD	A,(BUF2$+2)	;P/u dir cyl
	LD	(IY+9),A	;Stuff into DCT
;
;	Check id type byte
;
	CALL	CKSWDD
;
;	If a system backup, then check the GAT & HIT
;
	LD	A,(PRMTBL$+SYSRSP)
	OR	A		;P/u SYS parm response
	JP	Z,CLSBU5	;  and skip next if not SYS
;
;	If already a SYSTEM disk, don't check BOOT space
;
	IF	@MOD2
	CALL	PMTDST		;Get dest data
;
	LD	A,(IY+3)	;Get DCT data
	AND	28H		;Bit 5/3
	CP	20H		;8" floppy?
	JR	NZ,SETSYS2	;Go if not
	LD	A,(IY+4)	;Get data
	AND	50H		;Bit 6/4
	CP	40H		;DD not alien?
SETSYS2	LD	D,0		;Cyl 0 if not
	JR	NZ,$+3		;Go if system
	INC	D		;Sysinfo on cyl 1
	ENDIF
;
	LD	HL,HITBUF	;Set disk buffer
	LD	E,2		;  and sector 2
;
;	Mod II save sysinfo sector for later check
;
	IF	@MOD2
	LD	(CKPROT2),DE	;Save cyl/sect
	ENDIF
;
	IF	@MOD4
	CALL	RDSEC		;Read the sysinfo sector
	JP	NZ,EXIT3	;QUit on read error
	LD	A,(HITBUF+0C0H)	;P/u & test the SYSTEM
	INC	A		;  disk byte. If already
	LD	D,(IY+9)
	JP	Z,CLSBU01	;  a system disk, bypass
	ENDIF
;
	IF	@MOD2
;
	LD	D,(IY+9)	;P/u dir cyl
;
	ENDIF
;
	LD	E,L		;Set sector 0, dir trk
	CALL	RDSEC		;Read the GAT
	CP	6		;Expect error 6
	LD	A,20		;Init "GAT read error
	JP	NZ,EXIT3	;Quit on any other error
;
	IF	@MOD4
	LD	B,0		;Need no more
	BIT	3,(IY+3)	;  if rigid drive
	JR	NZ,SETSYS	;NZ = rigid
	ENDIF
;
;	Check GAT byte on Mod2/12
	IF	@MOD2
	LD	L,0CDH
	BIT	7,(HL)
	LD	L,0
	JP	Z,CLSBU01	;Go if system disk
	ENDIF
;
;	If ALIEN or NOT 8" space is OK
;
	IF	@MOD2
	LD	A,(CKPROT2+1)
	OR	A
	JR	Z,SETSYS	;Go if not
	ENDIF
;
;	Mod II must have track 0 fully available
;
	IF	@MOD2
	LD	A,(HITBUF+60H)	;Track 0 lockout data
	OR	1		;Boot/sys allocation
	CP	(HL)		;Anything here?
	JP	NZ,NOTSYS	;Yes, cannot use!
	ENDIF
;
;	Mod II must have 16 sectors available on cyl 1
;
	IF	@MOD2
	INC	HL		;Point to cyl 1
	LD	B,3		;2 grans SD or DD
	ENDIF
;
;	Check to be sure additional grans needed for boot
;	are not already allocated
;
	IF	@MOD4
	LD	B,2		;If 8" SDEN or DDEN, then
	ENDIF
;
	BIT	5,(IY+3)	;  need gran 1
	JR	NZ,$+4
	LD	B,6		;5" needs grans 1 & 2
	LD	A,(HL)		;P/u GAT byte for BOOT
	AND	B		;  & ck for needed space
	JR	NZ,NOTSYS	;Go if no free space
	LD	A,(HL)		;Reserve the GAT space
	OR	B
	LD	(HL),A
;
;	Mod II must make force locked/used cyl 0
;
	IF	@MOD2
	LD	A,-1		;Init
	LD	L,0		;Reset to beginning
	LD	(HL),A		;Allocate cyl 0
	LD	L,60H		;Lockout table
	LD	(HL),A		;Lockout cyl 0
	ENDIF
;
;
;	Mask the config byte "data/system" disk bit
;
SETSYS	LD	L,0CDH		;Point to config byte
	RES	7,(HL)		;  & show system disk
	CALL	WRGAT
;
;	Adjust the allocation info for BOOT/SYS
;
CLSBU0	LD	E,2		;Read the directory
	CALL	RDSEC		;  sector containing
	CP	6		;  BOOT/SYS record
	LD	A,17		;Init "dir read error
	JP	NZ,EXIT3
	INC	B		;Code to 7 3 1
	INC	B		;Code to 8 4 2
	SRA	B		;Code to 4 2 1
	SRA	B		;Code to 2 1 0
;
	IF	@MOD2
	LD	A,(CKPROT2+1)
	OR	A
	JR	Z,CLSBU01
	ENDIF
;
;	Mod II must force BOOT/SYS to new cyl 1
;
	IF	@MOD2
CLSBU00	LD	L,16H		;Cylinder start
	LD	(HL),1		;Force cyl 1
	ENDIF
;
	LD	L,17H		;Point to gran alloc
	LD	(HL),B		;Reset alloc
	LD	L,14H		;Point to ERN
	LD	(HL),16		;Update # BOOT records
	LD	L,0
	CALL	WRSYS		;Write dir sector back
	LD	A,18		;Init "dir write error
	JP	NZ,EXIT3	;Exit if so
;
;	If OLD entered No SYS file check needed
;
CLSBU01
	LD	A,(OLDPRM$)	;Check for OLD entered
	OR	A
	JR	NZ,CLSBU5	;Skip SYS setup if so
;
;
;	Now check the HIT positions for /SYS files
;
	CALL	HITRD		;Read in destination HIT
	JP	NZ,EXIT3
	LD	DE,SYSDEC	;Pt to SYS file hash codes
	EX	DE,HL		;HIT to DE, hash tbl to HL
	LD	B,16		;Check 16 DECs
CLSBU1	LD	A,(DE)		;If dest spare, stuff
	OR	A		;  with source else
	JR	NZ,CLSBU2	;  test for match
	LD	A,(HL)
	LD	(DE),A
CLSBU2	CP	(HL)		;Dest match source?
	JR	Z,CLSBU3	;Continue if so
NOTSYS	LD	HL,NOTSYS$	;Init"Can't make sys disk...
	JP	EXIT4		;Display and quit
CLSBU3	INC	E		;Bump to next DEC
	INC	HL		;  & our table
	LD	A,8		;At midpoint?
	CP	E
	JR	NZ,CLSBU4	;Skip if not
	LD	E,20H		;Adjust DEC row #
CLSBU4	DJNZ	CLSBU1
	LD	D,(IY+9)	;Ok to backup SYSTEM
	LD	E,1		;Init to HIT sector
	LD	HL,HITBUF
	CALL	WRSYS		;Write back dest HIT
	LD	A,23		;Init "HIT write error
	CALL	Z,HITRD		;Verify if write OK
	JP	NZ,EXIT3	;Quit on any error
;
;	Set up byte 'C0' in SYSINFO sector
;
	IF	@MOD2
	LD	DE,(CKPROT2)	;Get sysinfo sector
	LD	E,2		;Force sector 2
	ENDIF
;
	IF	@MOD4
	LD	DE,02		;P/u Mod4 SYSINFO sect
	ENDIF
;
;	HL => to HITBUF at this point
;
	CALL	RDSEC		;Read the sector
	LD	L,0C0H		;Point to type flag
	LD	(HL),0FFH	;Set it
	LD	L,0		;Reset buffer
	CALL	WRSEC		; Write it back
;
CLSBU5
	CALL	PMTSRC		;Set up for source disk
	CALL	HITRD		;Read source HIT
	JP	NZ,EXIT3
;
;	Start the backup of files
;
	LD	HL,HITBUF	;Init to start of HIT
	JR	SCNH3		;Branch to start
OPENIT	DB	'R'!80H		;R2
SCNHIT	POP	HL		;Remove top stack entry
SCNH1	POP	BC		;Recover DEC posn
	LD	H,HITBUF<-8	;HIT buf hi-order
	LD	L,B		;  and lo-order
SCNH2	@@CKBRKC		;Check break hit
	JP	NZ,BREAK	;Quit if so
	LD	A,L		;Get the current DEC posn
	ADD	A,20H		;Advance to next file on
	LD	L,A		;  this dir sector until
	JR	NC,SCNH3	;  end, then go to next
	INC	L		;  dir sector in the HIT
	BIT	5,L		;Did we go off the end?
	JR	Z,SCNH3		;  (ie from 1F to 20)
	LD	A,0
SETBIT	EQU	$-1
	OR	A
	JR	Z,TOEXIT1	;If not, all done
	CALL	PMTDST		;Get dest DCT in IY
	LD	HL,HITBUF
	LD	D,(IY+9)	;Get dir cyl
	LD	E,L		;Point to GAT sector
	CALL	RDSEC		;  & read it
	CP	6
	LD	A,20		;Init "GAT read error
	JP	NZ,EXIT3
	LD	L,0CDH		;Point to config byte
	SET	4,(HL)
	CALL	WRGAT
TOEXIT1	JP	EXIT1
;
;	Continue to scan the major loop
;
SCNH3	LD	A,(HL)		;Is HIT entry spare?
	OR	A
	JR	Z,SCNH2		;Loop back if so
	LD	A,L
	AND	0FEH		;Bypass if BOOT or DIR
	JR	Z,SCNH2
	LD	B,L		;Save DEC
	PUSH	BC
	CALL	PMTSRC		;Set up for source disk
	LD	D,(IY+9)	;P/u DIR cyl
	LD	A,B		;Pt to dir sector of
	AND	1FH		;  this file
	ADD	A,2		;Adj for GAT & HIT
	LD	E,A
	LD	HL,BUF2$	;Read dir sector
	CALL	RDSEC
	CP	6		;Proper errcod?
	JP	NZ,DIRERR
	LD	A,B		;Pt to dir record for
	AND	0E0H		;  the source file
	LD	L,A
	LD	H,BUF2$<-8	;Pt to hi-order dir buf
	LD	A,(HL)		;Ignore file if not
	LD	(ATTRIB+1),A	;  assigned in directory
	BIT	4,A
	JR	Z,NODOIT
	BIT	7,A		;Ignore file if FXDE
	JP	NZ,SCNH1
	INC	L		;Bump to DIR+1
	LD	A,(MODPRM$)	;Bypass if Mod parm
	OR	A		;  not entered
	JR	Z,SCNH4
	BIT	6,(HL)		;If Mod parm and bit not set
	JR	Z,NODOIT	;  skip the file
;
SCNH4	BIT	4,(HL)		;Check date not current
	JR	Z,SCNH4A
	LD	A,(SVCTR)
	OR	A		;Was date set?
	JR	Z,NODOIT	;Bypass if not
	INC	A		;Is date current?
	JR	Z,NODOIT	;Bypass if not
;
SCNH4A	DEC	L		;DIR + 0
	LD	A,(CLSFLG$)	;P/u CLASS parm byte
	BIT	6,(HL)		;Bypass if not SYS file
	JR	Z,CKINV
	BIT	6,A		;Ok, it is, was SYS used?
	JR	Z,NODOIT	;Go if no SYS parm
	JR	CKNAM		;  else back it up
CKINV	BIT	3,(HL)		;Test if file is INV
	JR	Z,CKNAM
	BIT	3,A		;File is, want INV files?
NODOIT	JP	Z,SCNH1		;Don't want invisibles
CKNAM	LD	A,(SPCFLD$)	;Now test filespec match
	CP	' '		;If blank, don't bother
	JR	NZ,CKNAM0	;  to match, take it
	LD	A,(SPCFLD$+8)	;How about the extension?
	CP	' '
	JR	Z,SCNH6		;Go if no ext either
;
;	Test for a filespec match
;
CKNAM0	PUSH	HL
	LD	A,L
	ADD	A,5		;Pt to filename in dir
	LD	L,A
	LD	DE,SPCFLD$	;Pt to user filespec
	LD	B,11		;11 char max
CKNAM1	LD	A,(DE)		;P/u user entry
	CP	'$'		;Wild card character?
	JR	Z,CKNAM2	;Always matches
	CP	(HL)		;Same as filespec?
	JR	Z,CKNAM2	;Loop if so
	CP	' '		;Ignore any further?
	JP	NZ,TSTMFLG	;If not blank, no match
CKNAM2	INC	HL		;Match so far
	INC	DE
	DJNZ	CKNAM1
;
;	Filespec class matches, check if NOT used
;
	LD	A,(MFLG$)	;Bypass if a match but
	OR	A		;  - exclude given
	JP	NZ,SCNHIT	;- was used, skip file
	JR	SCNH5
;
TSTMFLG	LD	A,(MFLG$)	;Ignore if NG match &
	OR	A		;  no exclude given
	JP	Z,SCNHIT
SCNH5	POP	HL		;Rcvr ptr to DIR+0
SCNH6	PUSH	HL
;
;	Now check if date matches
;
	INC	HL		;Pt to date field
	CALL	UNPACK		;Alter date for cpr
	LD	A,(FTFLG$)
	RLCA			;Tst From bit
	JR	NC,SCNH7
	LD	A,D		;Ignore if date was
	OR	E		;  00/00/00 for file
	JP	Z,SCNHIT
	LD	HL,(FMPAKD$)	;P/u user entry
	EX	DE,HL
	CALL	CPHLDE		;HL-DE
	EX	DE,HL
	JP	C,SCNHIT	;Bypass if date range bad
SCNH7	LD	A,(FTFLG$)
	RRCA			;Test TO bit
	JR	NC,MATCHES	;Go if no TOPARM else
	LD	A,D		;  ck if file is dated
	OR	E
	JP	Z,SCNHIT	;Bypass if date was 00
	LD	HL,(TOPAKD$)	;P/u user's packed date
	CALL	CPHLDE		;HL-DE
	JP	C,SCNHIT	;Bypass if out of range
MATCHES	POP	HL
DONAM	LD	A,L		;Pt to start of dir rec
	AND	0E0H
	LD	L,A		;Make sure it's on stack
	PUSH	HL
	ADD	A,5		;Pt to start of filename
	LD	L,A
	LD	DE,FCB1$	;Move filename into fcb
	LD	B,8		;Init 8 chars for filename
DONAM1	LD	A,(HL)		;P/u a char from the dir
	CP	' '		;Space = end of name
	JR	Z,DONAM2
	LD	(DE),A		;Move char to FCB
	INC	HL		;Bump both ptrs
	INC	DE
	DJNZ	DONAM1		;Loop for more
DONAM2	LD	A,L		;Pt to file extension
	ADD	A,B		;  by adding the
	LD	L,A		;  loop remainder
	LD	A,(HL)
	CP	' '
	JR	Z,DONAM5	;Bypass if none there
	LD	A,'/'		;  else set separator
	LD	(DE),A		;  into the FCB
	INC	DE
	LD	B,3		;Now move in ext
DONAM4	LD	A,(HL)		;P/u ext char
	CP	' '		;End if no more
	JR	Z,DONAM5
	LD	(DE),A		;Put in in the FCB
	INC	HL		;Bump both ptrs
	INC	DE
	DJNZ	DONAM4		;Loop for more
DONAM5	LD	A,3		;Terminate with ETX
	LD	(DE),A
	PUSH	DE		;Save pointer to spec end
;
;	Check for NEW or OLD option
;
	LD	A,(OLDPRM$)	;P/u parm & merge
	LD	HL,NEWPRM$	;  with new
	OR	(HL)		;If neither, bypass
	JR	Z,BYPASS
	LD	HL,FCB1$	;Save current spec
	LD	DE,FCB3$
	LD	BC,32
	LDIR
	POP	DE		;Recover spec end
	PUSH	DE		;  needed to add drivespec
	CALL	MAKSPC		;Make it a file spec
	CALL	GETDST		;Bring in the dest disk
	LD	HL,(BUFFER$)	;Buffer is irrelevant
	LD	DE,FCB2$	;Pt to dest spec
	PUSH	IY
	@@FLAGS			;IY => flag table base
	SET	0,(IY+'S'-'A')	;Inhibit file open bit
	POP	IY
	@@OPEN			;Attempt to open
	POP	DE		;Keep stack proper
	JR	Z,CKOLD		;If file exists, ck OLD
	CP	25		;File access denied?
	JR	Z,CKOLD		;  means it exists
	CP	24		;File not found?
	JP	NZ,SCNHIT	;Ignore if not
	LD	A,(NEWPRM$)	;Check if NEW  requested
	OR	A
	JR	NZ,GODOIT	;Go if NEW & not found
	JP	SCNHIT
CKOLD	LD	A,(OLDPRM$)	;Was found, backup old
	OR	A		; files this time?
	JP	Z,SCNHIT	;Ignore if not OLD
GODOIT	PUSH	DE
	LD	HL,FCB3$	;Recover the original
	LD	DE,FCB1$	;  file name
	LD	BC,32
	LDIR
;
;	Check if prompting or not (Q parm)
;
BYPASS	LD	A,(QPARM$+1)	;Query each file?
	OR	A
	JP	Z,NOPRMPT	;Not if not entered
	@@DSPLY	QUERY		;"backup filespec ?
;
;	Display file info for user decision
;
	POP	DE		;Rcvr ptr to file buf
	POP	HL		;Rcvr ptr to 1st dir byte
	PUSH	DE
	INC	HL		;Pt to MOD bit
	BIT	6,(HL)		;Test MOD flag
	JR	Z,SCDAT1	;Go if not set
	LD	A,' '		;Put a space
	LD	(DE),A
	INC	DE
	LD	A,'+'
	LD	(DE),A		;Display '+' if MOD
	INC	DE
SCDAT1	LD	A,' '		;Write a space
	LD	(DE),A
	INC	DE
	INC	HL		;Advance to date field
	EX	DE,HL
	LD	(HL),'{'	;Stuff left brace
	INC	HL
	EX	DE,HL
	LD	A,(HL)		;If no date, then skip
	OR	A
	JR	Z,SCDAT4	;Ignore if no date saved
	RRCA			;Has date, get day
	RRCA
	RRCA
	AND	1FH
	LD	B,2FH		;Convert day to decimal
SCDAT2	INC	B		;  by counting # of 10's
	SUB	10		;Sub 10 from day #
	JR	NC,SCDAT2
	ADD	A,3AH		;Cvrt lo order to ASCII
	PUSH	AF		;Save day low order
	LD	A,B		;Stuff day hi order
	LD	(DE),A
	INC	DE		;Bump
	POP	AF		;Rcvr lo order day #
	LD	(DE),A		;Stuff low order
	INC	DE		;Bump pointer to msg
	LD	A,'-'
	LD	(DE),A		;Stuff '-'
	INC	DE		;Pt tO month field
	PUSH	HL		;Save DIR ptr
	PUSH	AF		;Save separator char
	DEC	HL		;Pt to DIR+1 (month+)
	LD	A,(HL)		;P/u month etc
	AND	0FH		;Strip off flags
	DEC	A		;(mon-1)*3 to index
	LD	C,A		;   string conversion table
	RLCA			;X2
	ADD	A,C		;X3
	LD	C,A		;Results to BC
	LD	B,0
	LD	HL,MONTBL	;Ptr to month names
	ADD	HL,BC		;Add offset to tbl start
	LD	C,3
	LDIR			;Move 3-char month
	POP	AF
	LD	(DE),A
	INC	DE		;Advance to year field
	POP	HL		;Ptr to DIR+2
	LD	C,'8'		;Init for 1980's
	LD	A,(DVTEST1)
	OR	A
	JR	NZ,NEWDT2	;Go if new style
	LD	A,(HL)		;Else get old year
	AND	7		;Mask it
	JR	THERE
NEWDT2	LD	A,L		;Offset to year
	ADD	A,17
	LD	L,A		;DIR+19
	LD	A,(HL)
	AND	1FH		;Mask time
	IF	@BLD631
L3B2F:				;<631>
	ENDIF
	CP	10		;1980's?
	JR	C,THERE
	IF	@BLD631
	INC	C		;<631>was '8', now '9' bump decade
	ELSE
	LD	C,'9'		;Bump decade
	ENDIF
	SUB	10
	CP	10		;Now must be 0-9
	JR	C,THERE
	IF	@BLD631
	SUB	0AH		;<631>
	LD	C,'0'		;<631>
	JR	L3B2F		;<631>
	ELSE
	LD	A,9		;  else make 1999
	ENDIF
THERE	LD	B,A		;Save year offset
	LD	A,C		;Stuff decade for dsply
	LD	(DE),A
	INC	DE
	LD	A,B		;Year
	ADD	A,'0'		;Make ascii
	LD	(DE),A
	INC	DE
SCDAT4	LD	A,3		;Show etx for display
	LD	(DE),A
	@@DSPLY	FCB1$		;Display filename
	@@DSPLY	QMARK$		;" } ? "
	LD	HL,(BUFFER$)	;Get user response
	LD	BC,3<8		;3 char max
	@@KEYIN
	JP	C,ABRTBU	;Quit on Break
	LD	A,(HL)		;Get the 1st char
	RES	5,A		;Strip lc if present
	CP	'Y'		;Yes means move the file
	JR	Z,CPYMSG	;Go if so
;
;	Accept 'C' for response to set QUERY=N
;
	SUB	'C'		;Was response "C"?
	JP	NZ,SCNHIT	;Don't backup if not
	LD	(QPARM$+1),A	;Set QUERY=N
CPYMSG	EX	(SP),HL		;Place dummy HL below
	PUSH	HL		;  FCB1$ ETX pointer
;
;	Display copying file info
;
NOPRMPT	@@CKBRKC		;Ck if BREAK
	JP	NZ,ABRTBU	;Quit if so
	@@LOGOT	CPYFIL$		;"copying file...
	POP	HL		;Get pointer where ETX
	LD	(HL),CR		;  is & replace with CR
	PUSH	HL
	@@LOGOT	FCB1$		;Display the filespec
	POP	DE		;Rcvr ptr to CR
	POP	HL
;
;	Put in the drive spec
;
DOBU	CALL	MAKSPC		;Make the filespec
	POP	BC		;Get DEC of source
	PUSH	BC
	LD	A,B		;Test if a SYS DEC
	AND	0D8H
	JP	NZ,DOFIL0	;Jump if not SYS
ATTRIB	LD	A,0		;P/u attribute byte
	BIT	6,A		;Don't do if not SYS
	JP	Z,DOFIL0
;
;	Routine to copy over SYS files
;
	CALL	PMTDST		;Prompt dest drive
	LD	D,(IY+9)	;P/u dir cyl of dest
	LD	A,B		;Get DEC & calc sector
	AND	1FH
	ADD	A,2		;Adj for GAT & HIT
	LD	E,A
	LD	HL,(BUFFER$)	;P/u buffer addr
	CALL	RDSEC		;Read dir sect
	CP	6		;Proper errcod?
	JP	NZ,DIRERR
	LD	A,B		;Pt to 1st byte of
	AND	0E0H		;  dir record
	LD	L,A
	BIT	4,(HL)		;Go if already assigned
	JR	NZ,DOSYS1
	LD	(HL),5FH	;Show assigned, SYS, INV
	INC	HL		;  & no access
	IF	@BLD631
	LD	BC,3		;<631>
	LD	(HL),B		;<631>B==0 Zero out DIR+1 to DIR+4
	LD	D,H		;<631>
	LD	E,L		;<631>
	INC	DE		;<631>
	ELSE
	LD	(HL),0		;Zero out DIR+1 to DIR+4
	LD	D,H
	LD	E,L
	INC	DE
	LD	BC,3
	ENDIF
	LDIR
	LD	A,L		;Pt HL to DIR+16
	ADD	A,12
	LD	L,A
	INC	A
	LD	E,A		;Pt DE to DIR+17
	LD	(HL),0FFH	;Stuff X'FF' into extent
	LD	C,15		;  & pswd fields
	LDIR
DOSYS1	LD	A,L		;Pt HL to Dir+0
	AND	0E0H		;  of dest
	BIT	6,(HL)		;Guard against writing
	JP	Z,NOTSYS	;  over a non-SYS file
	ADD	A,5		;Pt to name field
	LD	L,A
	LD	E,A		;Pt DE to name field of
	LD	H,BUF2$<-8	;  destination
	LD	A,(BUFFER$+1)	;P/u buffer hi-order addr
	LD	D,A
	LD	BC,13		;Move name/ext into dest
	LDIR
	LD	D,(IY+9)	;P/u dir cyl of dest
	POP	BC		;Rcvr DEC of source
	PUSH	BC
	LD	A,B		;Calc dir sector for
	AND	1FH		;  source SYS module
	ADD	A,2
	LD	E,A
	LD	HL,(BUFFER$)	;P/u buffer ptr for dest
	CALL	WRSYS		;Write the dir to dest
	LD	A,18		;Init "Dir write error
	JP	NZ,EXIT3	;  and quit on bad write
;
;	The HIT entries were transferred prior
;
	POP	BC		;Rcvr DEC of source
	PUSH	BC
	LD	A,B		;Test for SYS0
	CP	2
	JP	NZ,DOFIL0	;Bypass if not SYS0
	CALL	PMTSRC		;Prompt source
	IF	@MOD4
	LD	B,16		;Init to xfer BOOT track
	LD	DE,0		;Init track 0, sector 0
	ENDIF
	IF	@MOD2
	LD	DE,(PROTSEC)	;Get sysinfo sector
	LD	A,D
	OR	A
	LD	B,5
	JR	Z,NBTSEC2
	LD	B,16
NBTSEC2	LD	E,0
	ENDIF
;
	LD	HL,(BUFFER$)	;Set disk buffer
RDBOOT	CALL	RDSEC		;Read sector and
	JP	NZ,EXIT3	;  quit on error
	INC	H		;Pt to next block
	INC	E		;Point to next sector
	DJNZ	RDBOOT		;Continue reading boot
;
;	Turn off CONFIG on destination disk
;
	LD	HL,(BUFFER$)	;Start cyl image
	LD	DE,100H*2+1	;Offset to sector 2 +1
	ADD	HL,DE		;HL => config byte
	LD	(HL),0C9H	;Config off
;
DOSYS2	CALL	PMTDST		;Prompt destination
	IF	@MOD4
	LD	B,16		;Sector count for boot
	LD	DE,0		;Init track and sector 0
	ENDIF
	IF	@MOD2
	LD	DE,(CKPROT2)	;Get dest cyl number
	LD	A,(PROTSEC+1)
	LD	B,5		;Default 5 sectors
	OR	A
	JR	Z,NBTSECS
	AND	D
	JR	Z,NBTSECS
	LD	B,16		;Use 16 sectors
NBTSECS	LD	E,0
	ENDIF
	LD	HL,(BUFFER$)	;P/u buffer start
WRBOOT	LD	A,E		;If sector 0 or 1,
	CP	2		;  correct DIRCYL &
	JR	NC,WRBOOT2	;  BOOT step rate
	OR	A
	JR	Z,WRBOOT1	;If sec 0 only dir cyl
;
	LD	A,(BOOTST$)	;P/u step pointer
	LD	L,A
	LD	A,(HL)		;P/u BOOT step rate
	AND	0FCH		;Strip the rate
BSCLS	OR	0		;Merge dest rate
	LD	(HL),A
WRBOOT1	LD	A,(IY+9)	;P/u DIR cyl
	LD	L,2
	LD	(HL),A
	LD	L,0		;Restart to buf start
WRBOOT2	CALL	WRSEC		;Write dest boot sector
	JP	NZ,EXIT3	;Quit on error
	INC	H		;Bump buffer page
	INC	E		;Bump sector
	DJNZ	WRBOOT
;
;	Verify this track
;
	IF	@MOD4
	LD	B,16		;16 sector just written
	LD	DE,0		;  on track 0
	ENDIF
	IF	@MOD2
	LD	A,(PROTSEC+1)
	LD	B,5
	LD	DE,(CKPROT2)
	OR	A
	JR	Z,NBTSEC1
	AND	D
	JR	Z,NBTSEC1
	LD	B,16
NBTSEC1	LD	E,0
	ENDIF
VRBOOT	CALL	VERSEC		;Verify a boot sector
	JP	NZ,EXIT3	;Quit on an error
	INC	E		;Inc sector #
	DJNZ	VRBOOT
;
;	Mod II check if cyl 0 to be formatted on dest
;
	IF	@MOD2
	LD	DE,(CKPROT2)	;Get sysinfo sector
	LD	A,(PROTSEC+1)
	AND	D
	JR	Z,COPY0E	;Go if yes
OKWRT0	CALL	PMTSRC		;Get source disk
	CALL	READ0		;Read cyl 0
	JP	NZ,EXIT3	;Go on disk error
	CALL	PMTDST		;Get dest disk
	CALL	FORMAT0		;Format cyl
	JP	NZ,EXIT3	;Go on disk error
;
;	Setup new track length into boot data
;
	LD	HL,(BUFFER$)	;Get I/O buffer
	PUSH	HL		;Save start
	INC	HL		;+1
	INC	HL		;+2 (dir cyl)
	LD	A,(IY+9)	;Get dir cyl
	LD	(HL),A		;To buffer
	INC	HL		;+3 (boot step rate)
	LD	A,(BSCLS+1)	;Get step rate
	AND	3		;Step rate only
	LD	(HL),A		;Load into buffer
	INC	HL		;Bump
	LD	A,(IY+7)	;Get data
	AND	1FH		;Highest sector #
	INC	A		;Sectors / track
	LD	(HL),A		;To buffer
	INC	HL		;Bump
	LD	A,(IY+3)	;Get data
	ADD	A,A		;Density => bit 7
	AND	80H		;Keep only
	LD	(HL),A		;To buffer
	POP	HL		;HL => buffer start
	LD	D,H		;Pass to DE
	LD	E,L		;DE => buffer start
	LD	BC,80H		;Buffer length
	ADD	HL,BC		;HL => dest
	EX	DE,HL		;HL=>source, DE=>dest
	LDIR			;Copy sector 0 => sec 1
	CALL	PMTDST		;Re-fetch DCT
	CALL	WRITE0		;Write the cylinder
	JP	NZ,EXIT3	;Go on disk error
COPY0E	EQU	$
	ENDIF
;
;	Routine to perform the file copy to destination
;
DOFIL0	LD	DE,OPENIT	;Check the name
	@@RENAM
	LD	B,0		;Lrl = 256
	CALL	GETSRC		;Prompt source & set fcb
	LD	HL,(BUFFER$)	;Get buffer addr
	@@FLAGS
	SET	0,(IY+'S'-'A')	;Inhibit file open bit
	@@OPEN			;Open the source file
	JP	NZ,EXIT3	;Quit on open error
;
;	Check if source file can fit on destination disk
;
	LD	HL,(FCB1$+12)	;P/u ERN
SIZSAV	LD	DE,$-$		;P/u disk capacity
	EX	DE,HL		;flip them around for test
	SBC	HL,DE		;If <= size, then OK
	JR	NC,SIZOK
	LD	HL,SIZBIG$	;  else file to big
	@@LOGOT			;Inform user & continue
	JP	SCNH1		;Loop back for another file
SIZOK	LD	DE,OPENIT	;Check the name
	@@RENAM
	LD	B,0		;Lrl = 256
	CALL	GETDST		;Prompt dest & set fcb
	LD	HL,(BUFFER$)	;Get buffer addr
	@@INIT			;Init the dest
	JR	Z,LRLOK		;If no error, cont.
	CP	42		;Was it LRL error?
	JR	Z,LRLOK		;Ignore if so
	JP	EXIT3		;  else real error, abort
LRLOK	LD	A,(FCB2$+7)	;P/u DEC of dest
	LD	(DOFIL11+1),A
	LD	BC,(FCB1$+12)	;P/u ERN & ck for enuf
	CALL	WRERN		; dest space on disk
	POP	BC		;Recover DEC
	LD	L,B		;Reset HL to dir
	LD	H,BUF2$<-8
	PUSH	BC		;Save DEC
	JR	Z,DOFIL02	;Go if there was room
	CALL	PMTSRC		;  else make source current, loop
	JP	DONAM		;  back because dest was swapped
DOFIL02	LD	A,L		;Check if date current
	AND	0E0H		;Index to proper direc
	INC	A
	LD	L,A
	BIT	4,(HL)		;Check if bit set
	JR	Z,$+5
	LD	(SETBIT),A
;
	LD	HL,0
	LD	(FCB2$+12),HL	;Set dest ERN to 0
	@@REW			;Rewind the dest
DOFIL03	LD	HL,(BUFFER$)	;Buffer addr
DOFIL04	LD	(FCB1$+3),HL	;Set buffer addr in fcb
	CALL	GETSRC		;Prompt source & set fcb
	@@READ			;Read a source file sector
	JR	Z,DOFIL05	;Go if no error
	CP	1CH		;Eof?
	JR	Z,DOFIL09	;Yes, finished loading
	CP	1DH		;Nrn > ern?
	JR	Z,DOFIL09	;Also means load done
	JP	EXIT3		;Abort on any other error
DOFIL05	INC	H		;Bump the buffer ptr
	LD	A,H
DOFIL06	CP	$-$		;Test out of memory
	JR	NZ,DOFIL04	;Loop if more room
	LD	HL,(BUFFER$)	;P/u buffer start
DOFIL07	LD	(FCB2$+3),HL	;  & set into dest fcb
	CALL	GETDST		;Prompt dest & set fcb
	@@VER			;Write dest w/verify
	JP	NZ,EXIT3	;Quit on error
	INC	H		;Bump buffer page
	LD	A,H
DOFIL08	CP	$-$		;Out of memory?
	JR	NZ,DOFIL07	;Write another if not
	JR	DOFIL03		;  else back to loading
;
;	Reached the end of the source file
;
DOFIL09	CALL	LSTBUF		;Write remaining buffer
	LD	HL,(FCB1$+8)	;P/u DEC & LRL
	LD	(FCB2$+8),HL	;  & stuff into dest
	CALL	GETDST		;Set for dest fcb
	@@CLOSE			;Close 'er up
	JP	NZ,EXIT3	;Abort on close error
;
;	Now remove the mod flag from destination
;	 and do CLONE function
;
	LD	D,(IY+9)	;P/u dir cyl
DOFIL11	LD	B,$-$		;P/u DEC
	LD	A,B		;Pt to dir sector
	AND	1FH
	ADD	A,2		;Bypass GAT and HIT
	LD	E,A
	PUSH	DE		;Save cyl/sect
	LD	HL,(BUFFER$)	;P/u buffer addr
	CALL	RDSEC		;Read the dir sect
	CP	6		;Proper errcod?
	LD	A,17		;Init "Dir read error
	JP	NZ,EXIT3
	LD	A,B		;Pt to dir record
	AND	0E0H
	LD	E,A		;Pt to DIR lo order
	LD	A,(BUFFER$+1)	;P/u hi order buffer pos
	LD	D,A
	POP	HL
	POP	BC		;P/u DEC & buffer of src
	PUSH	BC
	PUSH	HL
	LD	A,B		;Get source DEC
	AND	0E0H		;  and pt to the direc
	LD	L,A		;  of the current file
	LD	H,BUF2$<-8
	INC	L		;Pt to mod flag byte
	PUSH	HL		;Save source DIR+1
	RES	6,(HL)		;Reset the MOD bit
	DEC	L		;Point to DIR+0
	LD	BC,5		;Transfer up thru
	LDIR			;  DIR+4
BYSPACE	LD	A,E		;Point DE to the dest
	ADD	A,11		;  password fields
	LD	E,A
	LD	A,L		;Point HL to the source
	ADD	A,11		;  password fields
	LD	L,A
	IF	@BLD631
	LD	C,4		;<631>(B==0) Move both pswds
	ELSE
	LD	BC,4		;Move both pswds
	ENDIF
	LDIR
	POP	HL		;Get source DIR+1
	INC	HL		;Pt to year field
	DEC	DE		;Pt to new year
	LD	A,(NEWDT)	;Old to new flag
	CP	4		;If not old to new, done
	JR	NZ,NEWDT1
	LD	A,(HL)		;Get old year
	AND	7
	LD	(DE),A		;Store in new year posn
	DEC	DE
	XOR	A		;Not time
	LD	(DE),A
NEWDT1	LD	HL,(BUFFER$)	;P/u buffer addr
	POP	DE		;Rcvr cyl/sect
	CALL	WRSYS		;Write back
	IF	@BLD631
TOEXIT3:			;<631>
	ENDIF
	LD	A,18		;Init "Dir write error
	JP	NZ,EXIT3	;Quit on error
;
;	Attempt to clear mod flag of source
;
DOFIL12	LD	A,0		;Test for write prot src
	OR	A		;Which implies, can't
	JP	NZ,SCNH1	;  clear mod flags
	POP	BC		;P/u DEC of source
	PUSH	BC
	LD	A,B		;Clear mod flag on source
	AND	0E0H		;Dir sector is resident
	INC	A		;In a buffer at BUF2
	LD	L,A
	LD	H,BUF2$<-8
	RES	6,(HL)		;Reset mod bit
	CALL	PMTSRC		;Set for source i/o
	LD	D,(IY+9)	;P/u dir cyl
	LD	A,B		;Pt to dir sect of source
	AND	1FH
	ADD	A,2		;Adjust for GAT and HIT
	LD	E,A
	LD	HL,BUF2$
	CALL	WRSYS		;Write it back
	JP	Z,SCNH1		;Back on good write
	CP	15		;Accept only "write prot error
	IF	@BLD631
	JR	NZ,TOEXIT3	;<631>and quit
	ELSE
	LD	A,18		;Any other, "Dir write error
	JP	NZ,EXIT3	;  and quit
	ENDIF
	LD	A,0FFH		;Turn off clear mod
	LD	(DOFIL12+1),A	;  flag test
	@@LOGOT	CCMOD$		;"can't clear...
	JP	SCNH1		;Loop to next file
;
;	Routine to compare HL to DE, ret Z if equal
;
CPHLDE	LD	A,H		;Test H=D
	SUB	D
	RET	NZ		;Back if not
	LD	A,L		;Test L=E
	SUB	E
	RET			;Back with condition
;
;	Routine to construct filespec from name/ext
;
MAKSPC	LD	A,':'		;Prepare for drivespec
	LD	(DE),A
	INC	DE
	PUSH	DE		;Save pointer
	LD	A,(DSTDRV$+1)	;P/u dest drive #
	AND	7		;Cvrt to ASCII
	ADD	A,'0'
	LD	(DE),A		; & stuff at filespec end
	INC	DE
	LD	A,3		;Terminate with ETX
	LD	(DE),A
	LD	HL,FCB1$	;Copy source fcb to
	LD	DE,FCB2$	;  dest fcb
	LD	BC,32
	LDIR
	POP	DE		;Rcvr where source spec
	LD	A,(SRCDRV$+1)	;P/u source drive #
	AND	7		;Cvrt to ASCII
	ADD	A,'0'
	LD	(DE),A		;Stuff in dest fcb
	RET
;
;	Routine to extract date from directory
;
UNPACK	LD	A,(HL)		;P/u DIR+1
	AND	0FH		;Remove flags
	LD	E,0
	LD	D,A		;Split mont to DE
	SRL	D
	RR	E
	INC	HL		;Pt to day
	LD	A,(HL)
	AND	0F8H		;Mask off year
	RRCA			;Bits 2-6
	OR	E		;Merge w/month
	LD	E,A
	LD	A,(DVTEST2)
	OR	A		;New style year?
	JR	NZ,NEWDT3	;Go if so
	LD	A,(HL)		;get old year
	AND	7
SHFTD	RLCA
	RLCA
	RLCA			;To bits 3-7
	OR	D		;Merge w/month
	LD	D,A
	RET
NEWDT3	LD	A,L
	ADD	A,17
	LD	L,A		;DIR+19
	LD	A,(HL)
	AND	1FH
	JR	SHFTD
;
;	Write the GAT back to disk
;
WRGAT	LD	L,0		;HL to start of buffer
	CALL	WRSYS		;Write dir sector
	LD	A,21		;Init GAT write error
	JP	NZ,EXIT3	;  and quit on error
	CALL	VERSEC		;Verify good write
	CP	6		;Expect error 6
	LD	A,20		;Init GAT read error
	JP	NZ,EXIT3	;Quit on any other error
	RET
;
;	Write last buffer if needed
;
LSTBUF	LD	A,(BUFFER$+1)	;P/u hi order buffer start
	CP	H		;Are we there now?
	RET	Z		;Back if so, nothing loaded
LSTBUF1	LD	A,$-$		;P/u last available page
	CP	H		;There now?
	RET	Z		;Already written if so
	LD	B,H		;Need to write to this page
	LD	HL,(BUFFER$)	;P/u buffer start
LSTBUF2	LD	(FCB2$+3),HL	;  and put in dest fcb
	CALL	GETDST		;Prompt dest
	@@VER			;Write with verify
	JP	NZ,EXIT3	;Quit on bad write
	INC	H		;Bump buffer page
	LD	A,H
	CP	B		;At the end?
	JR	NZ,LSTBUF2	;Loop if more
	RET
;
;	Check if enough space on destination disk
;
WRERN	LD	A,B		;If ERN = 0, don't
	OR	C		; write a ERN
	RET	Z
	DEC	BC		;Adjust for 0 offset
	CALL	GETDST		;Prompt dest
	PUSH	DE		;Save fcb pointer
	@@POSN			;Position to end
	LD	HL,(BUFFER$)	;P/u buffer addr
	LD	D,H		;Construct a format
	LD	E,L		;  sector of all X'E5's
	INC	DE
	LD	BC,255
	LD	(HL),0E5H
	LDIR
	POP	DE		;Rcvr fcb ptr
	@@VER			;Write with verify
	RET	Z		;Ret if no error
	CP	27		;Disk Full?
	JR	NZ,NOTDF	;No - quit on real error
	@@REMOV			;Remove what can't fit
	BIT	3,(IY+3)	;Is this a rigid disk?
	JR	Z,NOTHARD	;Go if not
	BIT	2,(IY+3)	;Shown as Removable?
	JR	Z,NOTHARD	;Prompt disk swap if so
	LD	HL,FULDRV$	;Prepare disk full error
	JR	DOING1
NOTHARD	@@FLAGS
	BIT	5,(IY+'S'-'A')	;Can't switch while DOing
	JR	NZ,DOING
	LD	HL,NEWDISK	;"disk full, enter new...
	CALL	FLASH
	OR	1		;Show switched dest
	RET
NOTDF	EQU	$
	JP	EXIT3		;Error exit
;
GETSRC	PUSH	BC
	LD	DE,FCB1$	;Pt to source FCB
	CALL	PMTSRC		;Show source is current
	POP	BC		;  for disk I/O
	RET
;
GETDST	PUSH	BC
	LD	DE,FCB2$	;Pt to dest FCB
	CALL	PMTDST		;Show dest is current
	POP	BC		;  for disk I/O
	RET
;
HITRD	LD	D,(IY+9)	;P/u dir cyl of source
	LD	E,1		;Read HIT
	LD	HL,HITBUF	;Into HIT buffer
	CALL	RDSEC
	CP	6		;Errcod correct?
	LD	A,16H		;Init "HIT read error
	RET			;Return w/condition
;
DOING	LD	HL,DOMSG
DOING1	JP	EXIT4
;
CPYFIL$	DB	29,'Copying file: ',3
QUERY	DB	'Backup ',3
FULDRV$	DB	'Disk is full ',CR
NEWDISK	DB	'Disk is full - Insert new formatted '
	DB	'destination disk, <ENTER>',29,3
DOMSG	DB	'Disk is full! - Can''t switch '
	DB	'while <DO> in effect',CR
SIZBIG$	DB	'  File is larger than destination '
	DB	'capacity - backup is bypassed',CR
NOTSYS$	DB	'Can''t create SYSTEM disk - '
	DB	'directory slots in use',CR
QMARK$	DB	'} ? ',3
MONTBL	DM	'JanFebMarAprMayJunJulAugSepOctNovDec'
SYSDEC	DB	0A2H,0C4H,2EH,2FH,2CH,2DH,2AH,2BH
	DB	28H,29H,26H,27H,27H,0A7H,26H,0A6H
;
	DC	64,0		;PATCH space
;
	ORG	$<-8+1<+8
HITBUF	DS	256