*THIS PROGRAM TRANSFERS A FILE FROM A CP/M FORMAT DISK TO A
* DEC FORMAT DISK
*
*
*CP/M DEFINITIONS FOR PRIMITIVES
*
RDCON	EQU	1	;GET CHAR FROM CONSOLE
WRTCON	EQU	2	;TYPE CHAR ON CONSOLE
RDRDR	EQU	3	;GETCHAR FROM PAPER TAPE READER
WRTPCH	EQU	4	;SEND CHAR TO PUNCH
WRTLST	EQU	5	;SEND CHAR TO LIST DEVICE
IOSTAT	EQU	7	;INTERROGATE I/O STATUS (NOT USED HERE)
ALTIO	EQU	8	;ALTER I/O STATUS (NOT USED HERE)
PCONBF	EQU	9	;PRINT CONSOLE BUFFER
RCONBF	EQU	10	;READ CONSOLE BUFFER
CONST	EQU	11	;CHECK CONSOLE STATUS (BIT0 SET IF READY)
LIFTHD	EQU	12	;LIFT DISK HEAD (NOT USED HERE)
RSTDSK	EQU	13	;DMA ADDR TO 80H,SELECT DISK A
SELDSK	EQU	14	;SELECT DISK
OPENF	EQU	15	;OPEN FILE
CLOSEF	EQU	16	;CLOSE FILE
SRCH1	EQU	17	;SEARCH FOR FIRST FILE OCCURRENCE
SCHNXT	EQU	18	;SEARCH FOR NEXT FILE OCCURRENCE
DELETF	EQU	19	;DELETE FILE
READF	EQU	20	;READ TO BUFFER
WRITEF	EQU	21	;WRITE TO BUFFER
MAKEF	EQU	22	;CREATE A FILE ENTRY
RENAMF	EQU	23	;RENAME A FILE
INTLOG	EQU	24	;INTERROGATE LOGIN VECTOR
INTDSK	EQU	25	;INTERROGATE DISK (RETURNS SELECTED DISK #)
SETDMA	EQU	26	;SET DMA ADDR
INTALL	EQU	27	;INTERROGATE ALLOCATION VECTOR
*
BDOS	EQU	0005H	;DOS ENTRY POINT
FCB	EQU	5CH	;DEFAULT FILE CONTROL BLOCK ADDRESS
BUFF	EQU	80H	;DEFAULT DMA ADDRESS
*
	ORG	0100H
*
*SET UP STACK
	LXI	SP,STKTOP
	JMP	EXEC
*STACK AREA
STACK:	DS	64
STKTOP	EQU	$
*
*VARIABLES
CONBUF:	DS	80
*
EXEC:	MVI	A,79
	STA	CONBUF	;SET FIRST BYTE TO BUFFER LENGTH
	JMP	MAIN	;JUMP TO MAIN PROGRAM
*SUBROUTINES
PCHAR:	;PRINT CHAR IN REG A
	PUSH H!	PUSH D!	PUSH B	;ENVIRONMENT SAVED
	MVI	C,WRTCON
	MOV	E,A
	CALL	BDOS
	POP B!	POP D!	POP H	;ENVIRONMENT RESTORED
	RET
*
CRLF:	;PRINT A CARRIAGE RETURN & LINE FEED
	MVI	A,0DH
	CALL	PCHAR
	MVI	A,0AH
	CALL	PCHAR
	RET
*
PNIB:	;PRINT NIBBLE IN REG A
	ANI	0FH	;LOWER 4 BITS
	CPI	10
	JNC	P10
	;LESS THAN OR EQUAL TO 9
	ADI	'0'
	JMP	PRN
	;GREATER THAN OR EQUAL TO 10
P10:	ADI	'A'-10
PRN:	CALL	PCHAR
	RET
*
PHEX:	;PRINT HEX CHAR IN REG A
	PUSH	PSW
	RRC
	RRC
	RRC
	RRC
	CALL	PNIB	;PRINT NIBBLE
	POP	PSW
	CALL	PNIB
	RET
*
CHIN:	;GET A CHAR FROM CONSOLE 
	PUSH H!	PUSH D!	PUSH B
	MVI	C,RDCON
	CALL	BDOS
	POP B!	POP D!	POP H
	RET
*
MSG:	;PRINT A MESSAGE POINTED TO BY HL (END OF MESSAGE=0FFH)
	MOV	A,M
	CPI	0FFH
	RZ		;RETURN IF END OF MESSAGE
	CALL	PCHAR
	INX	H
	JMP	MSG
*
SETTRK:	;SET TRACK IN C
	LHLD	1
	LXI	D,27
	DAD	D
	PCHL
*
SETSEC:	LHLD	1
	LXI	D,30
	DAD	D
	PCHL
*
RDSEC:	LHLD	1
	LXI	D,36
	DAD	D
	PCHL
*
WRTSEC:	LHLD	1
	LXI	D,39
	DAD	D
	PCHL
*
RDWRT:	;READ/WRITE TO DISK B-LOG.TRACK IN "TRACK",LOG.SECTOR IN "SECTOR"
	PUSH	B
	PUSH	D
	LDA	TRACK
	STA	BTRACK
	LDA	SECTOR
	STA	BSECT
	LDA	INTLEV	;GET INTERLEAVE FLAG
	ORA	A
	JZ	CONSEC	;0 > CONSECUTIVE SECTORS
*
*INTERLEAVE ALGORITHM FOR STANDARD DEC DISKS
*
	MVI	H,0
	LDA	BTRACK
	MOV	L,A
	DCX	H	;HL=TRACK-1;NOW MULTIPLY BY 6
	MOV	A,L
	ADD	A
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	SHLD	X2	;HL*2
INTLV3:	MOV	A,L
	ADD	A
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	XCHG
	LHLD	X2
	DAD	D	;HL*6 IN HL
* 6*(TRACK-1) IN HL
*
INTLV0:	MOV	A,H
	ORA	A
	JNZ	INTLV5
	MOV	A,L
	CPI	26
	JC	INTLV4
INTLV5:	LXI	D,0-26
	DAD	D
	JMP	INTLV0
INTLV4:	LDA	BSECT
	DCR	A	;SHIFT SECTOR DOWN (0-25)
	PUSH	PSW
	ADD	A
	MOV	E,A	;SAVE S2
	POP	PSW
	CPI	13
	MOV	A,E	;GET S2 BACK TO ACC.
	JM	INTLV2
	INR	A
INTLV2:	ADD	L	;ADD BIAS
INTLV1:	SUI	26
	JP	INTLV1
	ADI	27
	STA	BSECT	;NEW PHYSICAL SECTOR TO BSECT
*
*END OF INTERLEAVE ALGORITHM
*
CONSEC:	LDA	BSECT
	MOV	C,A
	CALL	SETSEC
	LDA	BTRACK
	MOV	C,A
	CALL	SETTRK
	LDA	OPFLAG
	CPI	0
	JNZ	CONSC1
	CALL	RDSEC
	POP	D
	POP	B
	RET
CONSC1:	CALL	WRTSEC
	POP	D
	POP	B
	RET
*
DIRECT:	;IF READ:GET SEG.1 OF DIRECT.TO DRBUFF
	;IF WRITE:WRITE SEG.1 OF DIRECT.ONTO DIRECTORY AREA OF DEC DISK
	;IN BOTH CASES,ASSUME FILE WILL BE IN OR FIT IN SEG.1
	MVI	A,2
	STA	COUNT
	MVI	A,01H
	STA	TRACK
	MVI	A,19H
	STA	SECTOR
	LXI	H,DRBUFF
	SHLD	BUFFPT	;INIT. BUFFPT
	MVI	C,SELDSK
	MVI	E,1	;B
	CALL	BDOS
	LXI	D,0
GTDIR1:	LHLD	BUFFPT
	DAD	D
	SHLD	BUFFPT
	XCHG
	MVI	C,SETDMA
	CALL	BDOS
	CALL	RDWRT	;READ/WRITE SECTOR FROM/TO DISK
	LXI	D,128
	MVI	A,1AH
	STA	SECTOR
	LDA	COUNT
	DCR	A
	STA	COUNT
	JNZ	GTDIR1	;READ IN FIRST 2 SECTORS
	MVI	A,6
	STA	COUNT
	MVI	A,02
	STA	TRACK
	DCR	A
	STA	SECTOR
GTDIR2:	LXI	D,128	;LENGTH OF A SECTOR
	LHLD	BUFFPT
	DAD	D
	SHLD	BUFFPT
	XCHG		;DMA ADDR > DE
	MVI	C,SETDMA
	CALL	BDOS
	CALL	RDWRT
	LDA	SECTOR
	INR	A
	STA	SECTOR
	LDA	COUNT
	DCR	A
	STA	COUNT
	JNZ	GTDIR2
	RET
*
*
TRSEC:	;CALCULATES TR#,SEC# FROM # OF BLOCKS TO FILE
	LHLD	BLOCKS	;#OF BLOCKS > HL (4 SECTORS/BLOCK)
	MVI	B,2
TRSC1:	MOV	A,L
	ADD	A
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	DCR	B
	JNZ	TRSC1	;BLOCKS*4 IN HL
*
	MVI	A,1
	STA	 TRACK	;INIT. TRACK
TRSC4:	LXI	D,0FFE6H	;-26
	DAD	D
	MOV	A,H
	RAL
	JNC	TRSC2
	LXI	D,1BH
	DAD	D
	JMP	TRSC3
TRSC2:	LDA	TRACK
	INR	A
	STA	TRACK
	JMP	TRSC4
TRSC3:	MOV	A,L
	STA	SECTOR
	RET		;TR# IS IN TRACK,SEC# IS IN SECTOR
*
NAMCOM:	;COMPARES PERM. FILE NAME WITH NEW FILE NAME AND SETS FLAG
	; "MATCH" IF SAME
	PUSH	H
	PUSH	B
	MVI	C,6
	LXI	H,FILE
	SHLD	FLNMPT
	LXI	H,FILELO
	SHLD	FLBFPT
NMCOM1:	LHLD	FLNMPT
	MOV	B,M
	INX	H
	SHLD	FLNMPT
	LHLD	FLBFPT
	MOV	A,M
	INX	H
	SHLD	FLBFPT
	CMP	B
	JNZ	NOMACH
	DCR	C
	JNZ	NMCOM1
	MVI	A,1
	STA	MATCH
	POP B!	POP H
	RET
NOMACH:	XRA	A
	STA	MATCH
	POP B!	POP H
	RET
*
*
*
CHR3:	;TAKES 3 ASCII CHARS FROM A,B,C (SEQ.) & CONVERTS THEM
	; TO A RADIX50 WORD IN R50NUM
	PUSH	H
	PUSH	D
	CALL	ASCR50	;CONVERT TO RAD50 CHAR
	MOV	L,A
	MVI	H,0
	CALL	X50
	CALL	X50	;MULTIPLY HL BY 50**2 (OCTAL)
	SHLD	R50NUM	;C1*50**2
	MOV	A,B
	CALL	ASCR50
	MOV	L,A
	MVI	H,0
	CALL	X50	;C2*50Q
	XCHG
	LHLD	R50NUM
	DAD	D
	SHLD	R50NUM	;C1*50**2+C2*50
	MOV	A,C
	CALL	ASCR50
	MOV	L,A
	MVI	H,0
	XCHG
	LHLD	R50NUM
	DAD	D
	SHLD	R50NUM	;C1*50**2+C2*50+C3
	POP	D
	POP	H
	RET
*
ASCR50:	;CONVERTS AN ASCII CHAR TO A BASIC RADIX50 CHAR(RET IN A)
	CPI	20H
	JNZ	ASC1
	XRA	A
	RET
ASC1:	CPI	'$'
	JNZ	ASC2
	MVI	A,1BH
	RET
ASC2:	CPI	'.'
	JNZ	ASC3
	MVI	A,1CH
	RET
ASC3:	CPI	'A'
	JM	ASC4
	CPI	5BH
	JP	ILLCHR
	SUI	40H
	RET
ASC4:	CPI	'0'
	JM	ILLCHR
	CPI	3AH
	JP	ILLCHR
	SUI	12H
	RET
ILLCHR:	LXI	H,M5	;NON-RAD50 CHAR-TRY AGAIN
	CALL	MSG
	JMP	AGAIN
*
X50:	;MULTIPLY HL BY 50Q & RETURN IN HL
	PUSH	B
	PUSH	D
	MVI	B,3
X50A:	MOV	A,L
	ADD	A
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	DCR	B
	JNZ	X50A
	SHLD	X8
	MVI	B,2
X50B:	MOV	A,L
	ADD	A
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	DCR	B
	JNZ	X50B
	XCHG
	LHLD	X8
	DAD	D
	POP	D
	POP	B
	RET
GETNAM:	JMP	BEGIN
*
*BUFFER:*
NAMBUF:	DS	25
*
*
BEGIN:	MVI	A,24
	STA	CONBUF
	MVI	C,RCONBF
	LXI	D,CONBUF
	CALL	BDOS
	LXI	H,CONBUF+1
	LDA	CNTMSK
	MOV	D,A
	MOV	A,M
	STA	COUNT
	CMP	D
	JP	SYNERR
	INX	H
	LXI	B,NAMBUF
	LDA	COUNT2
	MOV	D,A
	MVI	E,0
MOVCHR:	MOV	A,M
	CPI	'.'
	JZ	DOT
	DCR	D
	JZ	SYNERR
	STAX	B
	INX	B
	INX	H
	INR	E
	JMP	MOVCHR
DOT:	DCR	D
	JZ	GETEXT
	MVI	A,20H
DOT1:	STAX	B
	INX	B
	DCR	D
	JNZ	DOT1
GETEXT:	MVI	A,'.'
	STAX	B
	INR	E
	LDA	COUNT
	SUB	E
	CPI	4
	JP	SYNERR
	MOV	D,A
	MVI	A,3
	SUB	D
	INR	A
	MOV	E,A
	CPI	4
	JZ	GTEXT2
GTEXT1:	INX	H
	INX	B
	MOV	A,M
	STAX	B
	DCR	D
	JNZ	GTEXT1
GTEXT2:	DCR	E
	JZ	PUT$
	MVI	A,20H
	INX	B
	STAX	B
	JMP	GTEXT2
PUT$	INX	B
	MVI	A,'$'
	STAX	B
	RET
SYNERR:	CALL	CRLF
	LXI	H,M7	;SYNTAX ERROR
	CALL	MSG
	JMP	AGAIN
*
*
*
MAIN:	LXI	H,SIGNON	;THIS PROGRAM...
	CALL	MSG
	LXI	H,M18	;ZERO DEC DISK(Y/N)?
	CALL	MSG
	CALL	CHIN
	CPI	'Y'
	JNZ	AGAIN
	LXI	H,M19	;ARE YOU SURE(Y/N)?
	CALL	MSG
	CALL	CHIN
	CPI	'Y'
	JNZ	AGAIN
	LXI	H,M0	;PLACE DESTINATION...
	CALL	MSG
STDIR1:	LXI	H,M14	;IS DEC DISK INTERLEAVED?
	CALL	MSG
	CALL	CHIN
	CPI	'Y'
	JNZ	STDIR2
	MVI	A,1
	STA	INTLEV
	JMP	SETDIR
STDIR2:	CPI	'N'
	JNZ	STDIR1
	XRA	A
	STA	INTLEV
SETDIR:	LXI	H,4
	SHLD	HDWD1	;SEGMENTS AVAILABLE=4
	LXI	H,0
	SHLD	HDWD2	;NEXT SEGMENT=0
	SHLD	HDWD4	;EXTRA WORDS/ENTRY=0
	INX	H
	SHLD	HDWD3	;HIGHEST OPEN SEG.=1
	LXI	H,000EH
	SHLD	HDWD5	;FILES START AT BLOCK 000E
	LXI	H,0200H
	SHLD	ENTRYS	;SET SW1 TO EMPTY FILE
	LXI	H,479
	SHLD	ENTRYS+8	;SET EMPTY LENGTH TO ENTIRE DISK (479 BL)
	LXI	H,0800H
	SHLD	ENTRYS+14	;SET SW2 TO END-OF-SEGMENT
	MVI	A,0FFH
	STA	OPFLAG
	CALL	DIRECT	;WRITE OUT NEW DIRECTORY
	JMP	FINIS
*
*
AGAIN:	CALL	CRLF
	LXI	H,M10	;CP/M FILENAME.TYP=
	CALL	MSG
	MVI	A,9
	STA	COUNT2	;COUNT FOR CP/M'S 8 CHARS +1
	MVI	A,13
	STA	CNTMSK	;MASK FOR TOO MANY CHARS
	CALL	GETNAM	;GET NAME FROM OPERATOR INTO NAMBUF & PAD
	CALL	CRLF
	LXI	H,NAMBUF	;1ST 3 CHARS
	LXI	D,FCB+1	;STORE FILENAME.TYP
	MVI	C,8
LOOP1:	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	C
	JNZ	LOOP1
	INX	H	;GO PAST '.'
	MVI	C,3
LOOP2:	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCR	C
	JNZ	LOOP2	;FILENAME.TYPE STORED
	MVI	C,4
	XRA	A
LOOP3:	STAX	D	;ZERO EX,2 UNUSED BYTES,& RC
	INX	D
	DCR	C
	JNZ	LOOP3
	CALL	CRLF
	LXI	H,M6	;DEC FILNAM.EXT=
	CALL	MSG
	MVI	A,7
	STA	COUNT2	;COUNT FOR DEC'S 6 CHARS +1
	MVI	A,11
	STA	CNTMSK	;MASK FOR TOO MANY CHARS
	CALL	GETNAM
	CALL	CRLF
	LXI	H,NAMBUF
	MOV	A,M
	INX	H
	MOV	B,M
	INX	H
	MOV	C,M
	CALL	CHR3
	LHLD	R50NUM
	SHLD	FILE	;CONVERT 1ST 3 ASCII CHARS
	LXI	H,NAMBUF+3
	MOV	A,M
	INX	H
	MOV	B,M
	INX	H
	MOV	C,M
	CALL	CHR3
	LHLD	R50NUM
	SHLD	NAME	;CONVERT 2ND 3 ASCII CHARS
	LXI	H,NAMBUF+7
	MOV	A,M
	INX	H
	MOV	B,M
	INX	H
	MOV	C,M
	CALL	CHR3
	LHLD	R50NUM
	SHLD	EXT
GOON:	LXI	H,M14	;IS DEC DISK INTERLEAVED (Y/N)?
	CALL	MSG
	CALL	CHIN
	CPI	'Y'
	JNZ	NO2
	MVI	A,1
	STA	INTLEV	;SET INTERLEAVE FLAG
	JMP	GOON2
NO2:	CPI	'N'
	JNZ	GOON
	XRA	A
	STA	INTLEV
*
GOON2:	CALL	CRLF
	LXI	H,M0	;PLACE DESTINATION (DEC) DISK ON DRIVE B
	CALL	MSG
	LXI	H,M0A	;READY (Y/N)?
	CALL	MSG
	CALL	CHIN
	CPI	'Y'
	JNZ	AGAIN
*GET DIRECTORY INTO DRBUFF
*
	XRA	A
	STA	OPFLAG	;SET FLAG FOR READ
	CALL	DIRECT	;READ IN DIRECT.
*DIRECTORY READY-SEARCH FOR END
	XRA	A
	STA	ENTCNT	;INIT. ENTRY COUNT
	LHLD	HDWD5
	SHLD	BLKCNT	;  "   BLOCK COUNT
	LHLD	ENTRYS
	SHLD	ENTRY	;  "   ENTRY POINTER
	LXI	H,ENTRYS
	SHLD	BUFFPT	;  "   BUFFER PT.
DRLOOP:	LHLD	ENTRY
	MVI	A,08
	CMP	H
	CNZ	FILBLK	;UPDATE BLKCNT,ETC.
	JNZ	DRLOOP
	LDA	ENTCNT
	CPI	70
	JNZ	DIROK
	LXI	H,M9	;?DIR FULL?
	CALL	MSG
	JMP	FINIS
DIROK:	LHLD	BUFFPT
	LXI	D,0-6
	DAD	D	;GO BACK TO LAST FILE LENGTH
	MOV	E,M
	INX	H
	MOV	D,M
	XCHG
	SHLD	LENGTH
	XCHG
	CALL	NEGDE
	PUSH	H
	LHLD	BLKCNT
	DAD	D
	SHLD	BLKCNT	;SUBTRACT EMPTY FILE LENGTH FROM BLKCNT
	POP	H
	LXI	D,0-8
	DAD	D
	MOV	A,M
	CPI	02
	JZ	DIROK2
	LXI	H,M9
	CALL	MSG
	JMP	FINIS
DIROK2:	DCX	H
	SHLD	BUFFPT	;LEAVE POINT. IN POS. FOR LATER
*
*DEC DIRECTORY HAS BEEN SET UP-NOW OPEN CP/M FILE FOR INPUT
*
	MVI	C,SELDSK
	MVI	E,0
	CALL	BDOS
	MVI	C,OPENF
	LXI	D,FCB
	CALL	BDOS
	CPI	0FFH
	JNZ	OPENOK
	LXI	H,M4	;FIL NOT FND
	CALL	MSG
	JMP	AGAIN
OPENOK:	XRA	A
	STA	FCB+32	;ZERO NEXT RECORD
	LHLD	BLKCNT
	SHLD	BLOCKS
	CALL	TRSEC	;LOAD STARTING LOG. TR & SEC TO VARIABLES
	CALL	CRLF
*
	MVI	A,0FFH
	STA	OPFLAG	;SET TO WRITE ON DISK B
*
*
*CALCULATE BUFFER SIZE
*
	LXI	H,PRGEND
	XCHG
	CALL	NEGDE
	LHLD	6	;GET BDOS ADDR
	DAD	D
	MVI	C,7
DIV128:	MOV	A,H
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A
	DCR	C
	JNZ	DIV128
	MOV	A,H
	ANI	01
	MOV	H,A	;DIFFERENCE/128 IN HL
*
*
	DCX	H
	DCX	H
	SHLD	TOPCNT	;SAVE # OF BUFFERS
	LXI	H,0
	SHLD	RCRDS
*
*BEGIN TRANSFER-SET UP BUFFER POINTER
*
XFER0:	LXI	H,PRGEND
	SHLD	XFBFPT
	LXI	H,0
	SHLD	PASSCT
	LHLD	TOPCNT
	SHLD	COUNT3
	MVI	C,SELDSK
	MVI	E,0
	CALL	BDOS	;SELECT DISK A
	LXI	D,BUFF
	MVI	C,SETDMA
	CALL	BDOS	;SET DMA TO DEFAULT BUFFER
	LXI	D,0
*
*
XFER:	LHLD	XFBFPT
	DAD	D
	SHLD	XFBFPT
	MVI	C,READF
	LXI	D,FCB
	CALL	BDOS
	CPI	255
	JZ	CPMERR
	CPI	1
	JZ	EOFFND
	MVI	C,80H
	LHLD	XFBFPT
	LXI	D,BUFF
XFER3:	LDAX	D
	CPI	1AH
	JZ	EOF
	MOV	M,A
	INX	D
	INX	H
	DCR	C
	JNZ	XFER3
	LHLD	PASSCT
	INX	H
	SHLD	PASSCT
	LHLD	RCRDS
	INX	H
	SHLD	RCRDS
	LXI	D,128
	LHLD	COUNT3
	CALL	DCR16
	SHLD	COUNT3
	JC	XFER
*
*OUT OF BUFFER ROOM-WRITE OUT BUFFER
*
	LHLD	TOPCNT
	SHLD	COUNT4	;DO ALL SECTORS IN BUFFER
	LXI	H,PRGEND
	SHLD	XFBFPT
	MVI	C,SELDSK
	MVI	E,1
	CALL	BDOS
	LXI	D,0
*
XFER1:	LHLD	XFBFPT
	DAD	D
	SHLD	XFBFPT
	XCHG
	MVI	C,SETDMA
	CALL	BDOS
	CALL	RDWRT
	CALL	REGMOD
	LXI	D,128
	LHLD	COUNT4
	CALL	DCR16
	SHLD	COUNT4
	JC	XFER1
*
	JMP	XFER0
*
*EOF CHAR FOUND-CHANGE IT & REST OF BUFFER TO 00'S
*
EOF:	XRA	A
	MOV	M,A
	INX	H
	DCR	C
	JNZ	EOF+1
	LHLD	RCRDS
	INX	H
	SHLD	RCRDS
	LHLD	PASSCT
	INX	H
	SHLD	PASSCT
*
*WRITE OUT BUFFER
*
EOFFND:	LXI	H,PRGEND
	SHLD	XFBFPT
	LHLD	PASSCT
	DCX	H
	SHLD	COUNT4
	MVI	C,SELDSK
	MVI	E,1
	CALL	BDOS
	LXI	D,0
*
XFER2:	LHLD	XFBFPT
	DAD	D
	SHLD	XFBFPT
	XCHG
	MVI	C,SETDMA
	CALL	BDOS
	CALL	RDWRT
	CALL	REGMOD
	LXI	D,128
	LHLD	COUNT4
	CALL	DCR16
	SHLD	COUNT4
	JC	XFER2
*
*FILE WRITTEN OUT-NOW CALC. # OF BLOCKS,ETC.
*
*
	LHLD	RCRDS
	CALL	DIV4	;DIVIDE RCRDS BY 4 TO GET BLOCKS
	CPI	0
	JZ	NOXTRA
	CPI	4
	JM	XTRA
	LXI	H,M16	;DIV4 ERROR
	CALL	MSG
	JMP	FINIS
XTRA:	INX	H
NOXTRA:	SHLD	BLKNUM
	STA	EXTRA
*
*NOW WRITE "EXTRA" SECTORS OF 00'S (TO FILL PHYSICAL BLOCK)
*
	MVI	C,SELDSK
	MVI	E,1
	CALL	BDOS
	LDA	EXTRA
	CPI	0
	JZ	NEXTRA
	MOV	B,A
	MVI	A,4
	SUB	B
	MOV	B,A	;#OF SECT. TO B
	XRA	A
	LXI	H,BUFF
	MVI	C,80H
BFLOOP:	MOV	M,A
	INX	H
	DCR	C
	JNZ	BFLOOP	;FILL BUFFER W/00
	PUSH	B	;SAVE EXTRA COUNT IN B
	LXI	D,BUFF
	MVI	C,SETDMA
	CALL	BDOS	;SET DMA TO BUFF
	POP	B
BFLOP1:	CALL	RDWRT
	CALL	REGMOD
	DCR	B
	JNZ	BFLOP1	;DO B TIMES
*
NEXTRA:	LHLD	BLKNUM
	XCHG
	CALL	NEGDE
	LHLD	LENGTH
	DAD	D
	JC	LNTHOK
	LXI	H,M17	;FILE WON'T FIT
	CALL	MSG
	JMP	FINIS
LNTHOK:	SHLD	LENGTH	;SAVE NEW EMPTY LENGTH
*
*
*CAN CLOSE DEC FILE NOW
*
CLOSE:	LHLD	BUFFPT	;HL PT. @ NEW FILE SW
	INX	H
	MVI	A,04
	MOV	M,A	;CHANGE SW TO PERM. FILE
	INX	H
	LDA	FILE	;PUT NEW FILNAM.EXT IN ENTRY
	MOV	M,A
	INX	H
	LDA	FILE+1
	MOV	M,A
	INX	H
	LDA	NAME
	MOV	M,A
	INX	H
	LDA	NAME+1
	MOV	M,A
	INX	H
	LDA	EXT
	MOV	M,A
	INX	H
	LDA	EXT+1
	MOV	M,A
	INX	H
	LDA	BLKNUM	;PUT NEW FILE LENGTH IN ENTRY
	MOV	M,A
	INX	H
	LDA	BLKNUM+1
	MOV	M,A
	INX	H
	INX	H
	INX	H	;HL PT.@ DATE
	XRA	A
	MOV	M,A
	INX	H
	MOV	M,A	;ZERO DATE
	INX	H
	MOV	M,A	;SET UP NEXT ENTRY (EMPTY)
	INX	H
	MVI	A,02
	MOV	M,A
	LXI	D,7
	DAD	D	;PT.@ NEW EMPTY FILE LENGTH
	LDA	LENGTH
	MOV	M,A
	INX	H
	LDA	LENGTH+1
	MOV	M,A
	LXI	D,5
	DAD	D	;HL PT.@ NEW EOS SW
	XRA	A
	MOV	M,A
	INX	H
	MVI	A,08
	MOV	M,A	;WRITE END OF SEGMENT CODE
*
*DIRECTORY IS MODIFIED-NOW WRITE IT ON DEC DISK
	MVI	A,0FFH
	STA	OPFLAG	;TO BE SURE
	CALL	DIRECT
	JMP	FINIS
*
*
*
*SUBROUTINES
*
REGMOD:	;MODIFY DRIVE B REGISTERS AFTER SECTOR READ
	LDA	SECTOR
	CPI	26
	JZ	RM1
	INR	A
	STA	SECTOR
	RET
RM1:	MVI	A,1
	STA	SECTOR
	LDA	TRACK
	INR	A
	STA	TRACK
	CPI	75
	RM		;RET IF LESS THAN 75
	LXI	H,M17
	CALL	MSG
	JMP	FINIS
*
DCR16:	;DECREMENT HL BY 1 & SET FLAG C IF RESULT NOT ZERO
	; NC IF RESULT 0
	PUSH	D
	LXI	D,0FFFFH	;-1
	DAD	D
	POP	D
	RET
*
DIV4:	;DIVIDES HL BY 4-RESULT IN HL W/ REM. IN A
	PUSH	B
	MVI	C,0
	MVI	B,2
DIV4A:	MOV	A,H
	RAR
	MOV	H,A
	MOV	A,L
	RAR
	MOV	L,A
	MOV	A,C
	RAR
	MOV	C,A
	DCR	B
	JNZ	DIV4A
	MOV	A,H
	ANI	3FH	;STRIP EXTRA BITS
	MOV	H,A
	MOV	A,C
	RAR
	RAR
	RAR
	RAR
	RAR
	RAR
	ANI	3	;STRIP EXTRA BITS
	POP	B
	RET
*
NEGDE:	;NEGATE (2'S COMP.) DE REGISTER
	PUSH	PSW
	MOV	A,D
	CMA
	MOV	D,A
	MOV	A,E
	CMA
	MOV	E,A
	INX	D
	POP	PSW
	RET
FILBLK:	;UPDATE BLOCK COUNT & SET UP ENTRIES
	; CHANGE PERM SW TO EMPTY SW IF NAMES MATCH
	PUSH	PSW
	MVI	A,4
	CMP	H
	JNZ	FLBLK1
	LHLD	BUFFPT
	INX	H
	INX	H
	MOV	A,M
	STA	FILELO
	INX	H
	MOV	A,M
	STA	FILEHI
	INX	H
	MOV	A,M
	STA	NAMELO
	INX	H
	MOV	A,M
	STA	NAMEHI
	INX	H
	MOV	A,M
	STA	EXTLO
	INX	H
	MOV	A,M
	STA	EXTHI
	CALL	NAMCOM
	LDA	MATCH
	RAR
	JC	MTCHES
	LXI	D,0-7
	DAD	D
	SHLD	BUFFPT
	JMP	FLBLK1
MTCHES:	LXI	D,0-6
	DAD	D	;PTER @ SW LO BYTE
	MVI	A,2
	MOV	M,A	;CHANGE SW TO EMPTY FILE
	DCX	H
	SHLD	BUFFPT
FLBLK1:	LHLD	BUFFPT
	LXI	D,8
	DAD	D	;PT.@ LENGTH BYTE1
	MOV	E,M
	INX	H
	MOV	D,M
	PUSH	H
	LHLD	BLKCNT
	DAD	D
	SHLD	BLKCNT
	POP	H
	LXI	D,5
	DAD	D	;PT.@NEXT ENTRY BYTE1
	SHLD	BUFFPT
	MOV	A,M
	STA	ENTRY
	INX	H
	MOV	A,M
	STA	ENTRY+1
	LDA	ENTCNT
	INR	A
	STA	ENTCNT	;INR ENTRY COUNT
	POP	PSW
	RET
*
CMP16:	;COMPARES HL &DE & SETS USUAL FLAGS
	MOV	A,H
	CMP	D
	RNZ
	MOV	A,L
	CMP	E
	RET
*
*
CPMERR:	LXI	H,M12	;CP/M WRITE ERROR
	CALL	MSG
	JMP	FINIS
*
*
FINIS:	LXI	H,M15	;ANOTHER TRANSFER?
	CALL	MSG
	CALL	CHIN
	CPI	'Y'
	JZ	AGAIN
	JMP	0	;REBOOT CP/M AND GO TO IT
*
*
*VARIABLES
INTLEV:	DS	1	;INTERLEAVE FLAG
OPFLAG:	DS	1	;OPERATION FLAG- 0>READ,FF>WRITE
EXTRA:	DS	1	;# OF EXTRA SECTORS TO XFER
BLKNUM:	DS	2	;LENGTH OF NEW FILE
ENTCNT:	DS	1	;# OF ENTRIES IN DEC DIRECTORY
X2:	DS	2	;HL*2
TOPCNT:	DS	2	;# OF BUFFERS IN MEMORY SPACE
XFBFPT:	DS	2	;TRANSFER BUFFER POINTER
PASSCT:	DS	2	;PASS COUNT IN BUFFER
COUNT3:	DS	2	;COUNTER
COUNT4:	DS	2	;   "
RCRDS:	DS	2	;#OF FULL SECTORS TO TRANSFER
BSECT:	DS	1	;NEW PHYSICAL SECTOR
CNTMSK:	DS	1	;COUNT MASK (IN GETNAM)
COUNT2:	DS	1	;SECOND UTILITY COUNTER
R50NUM:	DS	2	;RADIX 50 CONVERSION OF 3 ASCII CHARS
X8:	DS	2	;HL*8
ENTRY:	DS	2	;ENTRY STATUS WORD POINTER
BLKCNT:	DS	2	;BLOCK COUNT (UPDATED EVERY ENTRY)
BLOCKS:	DS	2	;# OF BLOCKS TO FILE (VALID ONLY IF FOUND)
LENGTH:	DS	2	;LENGTH OF FILE FOUND (IN BLOCKS)
TRACK:	DS	1	;TRACK OF FOUND FILE
SECTOR:	DS	1	;SECTOR OF FOUND FILE
FLBFPT:	DS	2	;FILE BUFFER POINTER
FLNMPT:	DS	2	;FILE NAME POINTER
MATCH:	DS	1	;MATCH FLAG
FILELO:	DS	1	;PERM FILE NAME STORAGE
FILEHI:	DS	1
NAMELO:	DS	1
NAMEHI:	DS	1
EXTLO:	DS	1
EXTHI:	DS	1
FILE:	DS	2	;FILE NAME
NAME:	DS	2	; & EXT. OF
EXT:	DS	2	;  REQUESTED FILE (DEC)
BTRACK:	DS	1	;PHYSICAL TRACK
COUNT:	DS	1	;UTILITY COUNTER LOCATION
BUFFPT:	DS	2	;DIRECTORY BUFFER POINTER
DRBUFF:			;DIRECTORY BUFFER
HDWD1:	DS	2	;SEGMENTS AVAILABLE
HDWD2:	DS	2	;NEXT SEGMENT
HDWD3:	DS	2	;HIGHEST OPEN SEGMENT
HDWD4:	DS	2	;EXTRA WORDS/ENTRY
HDWD5:	DS	2	;FILE STARTING BLOCK
ENTRYS:	DS	1014	;ENTRIES
ENDBUF:	DS	1
*
*
*MESSAGES
*
SIGNON:	DB	0DH,0AH,'THIS PROGRAM TRANSFERS A FILE TO A DEC STANDARD (INTERLEAVED)'
	DB	0DH,0AH,'OR A "CONSECUTIVE" FORMATTED DISK FROM THE CP/M SYSTEM DISK',0FFH
M0:	DB	0DH,0AH,'PLACE DESTINATION (DEC) DISK ON DRIVE B',0DH,0AH,0FFH
M0A:	DB	0DH,0AH,'READY (Y/N)?',0FFH
M1:	DB	0DH,0AH,'SEEK ERROR-DISK B',0DH,0AH,0FFH
M2:	DB	0DH,0AH,'I/O ERROR ON B',0DH,0AH,0FFH
M3:	DB	0DH,0AH,'DIRECTORY ERROR',0DH,0AH,0FFH
M4:	DB	0DH,0AH,'?FIL NOT FND?',0DH,0AH,0FFH
M5:	DB	0DH,0AH,'NON-RAD50 CHAR-TRY AGAIN',0DH,0AH,0FFH
M6:	DB	0DH,0AH,'DEC:FILNAM.EXT=',0FFH
M7:	DB	'SYNTAX ERROR',0FFH
M8:	DB	0DH,0AH,'?NO EOF?',0FFH
M9:	DB	0DH,0AH,'?DIR FULL?',0FFH
M10:	DB	0DH,0AH,'CP/M:FILENAME.TYP=',0FFH
M12:	DB	0DH,0AH,'CP/M WRITE ERROR',0FFH
M14:	DB	'IS DEC DISK INTERLEAVED (Y/N)?',0FFH
M15:	DB	0DH,0AH,'ANOTHER TRANSFER (Y/N)?',0FFH
M16:	DB	0DH,0AH,'DIV4 ERROR',0FFH
M17:	DB	0DH,0AH,'NO ROOM FOR FILE',0FFH
M18:	DB	0DH,0AH,0DH,0AH,'ZERO DEC DISK (Y/N)?',0FFH
M19:	DB	'    ARE YOU SURE (Y/N)?',0FFH
*
BYTBUF:	DS	4	;ISOLATE PROGRAM FROM XFER BUFFER
*
PRGEND	EQU	$
*
	END