*THIS PROGRAM TRANSFERS A FILE FROM A DEC FORMAT DISK TO A
* CP/M 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
*
DISKRD:	;READ FROM DISK B-TRACK IN "TRACK",SECTOR IN "SECTOR"
	PUSH	B	;SAVE LOGICAL TRACK & SECTOR
	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
*
	PUSH	D	;SAVE DMA ADDR
	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
	POP	D	;RESTORE DMA ADDR
CONSEC:	LDA	BSECT
	MOV	C,A
	CALL	SETSEC
	LDA	BTRACK
	MOV	C,A
	CALL	SETTRK
	CALL	RDSEC
	POP	B
	RET
*
GETDIR:	;GET DIRECTORY SEGMENT 1 INTO THE DIRECTORY BUFFER
	; ASSUME FILE WILL BE IN SEGMENT 1
	MVI	C,SELDSK
	MVI	E,1
	CALL	BDOS	;SEL DISK B
	MVI	A,2
	STA	COUNT
	LXI	D,0
	MVI	A,01H
	STA	TRACK
	MVI	A,19H
	STA	SECTOR
	LXI	H,DRBUFF
	SHLD	BUFFPT	;INIT. BUFFPT
GTDIR1:	LHLD	BUFFPT
	DAD	D
	SHLD	BUFFPT
	XCHG
	MVI	C,SETDMA
	CALL	BDOS
	CALL	DISKRD	;READ SECTOR FROM 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	DISKRD
	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 & EXT. W/ DESIRED FILE NAME
	; & EXT. & 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
*
*
DIRSCH:	;SEARCH DEC DIRECT. FOR FILE ENTRY MATCHING FILNAM.EXT
	; FROM COMMAND
*
	CALL	GETDIR	;GET DIRECTORY INTO DRBUFF
	LHLD	HDWD5	;FILE STARTING BLOCK
	SHLD	BLKCNT
	LHLD	ENTRYS
	SHLD	ENTRY
	LXI	H,ENTRYS
	SHLD	BUFFPT
*
DRLOOP:	LHLD	ENTRY
	MVI	A,2
	CMP	H
	JZ	EMPTY	;THIS ENTRY AN EMPTY FILE
	MVI	A,4
	CMP	H
	JZ	PERM	;THIS ENTRY IS A PERMANENT FILE
	MVI	A,8
	CMP	H
	JZ	ENDDIR	;END OF DIRECTORY
	LXI	H,M3	;DIRECTORY ERROR
	CALL	MSG
	JMP	FINIS
*
EMPTY:	LHLD	BUFFPT
	LXI	D,8
	DAD	D
	MOV	E,M
	INX	H
	MOV	D,M	;FILE LENGTH IN DE
	PUSH	H	;SAVE POINTER
	LHLD	BLKCNT
	DAD	D
	SHLD	BLKCNT	;UPDATE BLOCK COUNT
	POP	H
	LXI	D,5
	DAD	D	;IGNORE REST OF ENTRY INFO
	SHLD	BUFFPT
	MOV	A,M
	STA	ENTRY
	INX	H
	MOV	A,M
	STA	ENTRY+1
	JMP	DRLOOP	;CHECK NEXT ENTRY
*
PERM:	LHLD	BUFFPT
	INX	H
	INX	H
	MOV	A,M
	STA	FILELO	;GET FILNAM.EXT FOR COMPARISON
	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	;FILNAM.EXT STORED
	CALL	NAMCOM	;CHECK THIS ENTRY FOR MATCH
	INX	H
	MOV	E,M
	INX	H
	MOV	D,M	;FILE LENGTH IN DE
	XCHG
	SHLD	LENGTH	;SAVE FILE LENGTH
	XCHG
	PUSH	H	;SAVE POINTER
	LHLD	BLKCNT
	SHLD	BLOCKS	;# OF BLOCKS TO THIS FILE
	DAD	D
	SHLD	BLKCNT	;UPDATE BLOCK COUNT
	POP	H
	LDA	MATCH
	RAR
	JC	FOUND	;JUMP IF MATCH TO FOUND
	LXI	D,5
	DAD	D	;IGNORE REST OF ENTRY INFO.
	SHLD	BUFFPT
	MOV	A,M
	STA	ENTRY
	INX	H
	MOV	A,M
	STA	ENTRY+1	;SET UP FOR NEXT ENTRY
	JMP	DRLOOP	; & GO TO IT
*
ENDDIR:	LXI	H,M4	;?FIL NOT FND?
	CALL	MSG
	MVI	A,1
	RET
*
FOUND:	CALL	TRSEC	;CALCULATE TR#,SEC#  WHERE FILE BEGINS
	CALL	CRLF
	XRA	A
	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	MAIN
*
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
AGAIN:	CALL	CRLF
	MVI	C,SELDSK
	MVI	E,0	;SEL. DK A
	CALL	BDOS
	LXI	H,M6	;DEC FILE NAME&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	;GET NAME FROM OPERATOR INTO NAMBUF & PAD
	CALL	CRLF
	LXI	H,NAMBUF	;1ST 3 CHARS
	MOV	A,M
	INX	H
	MOV	B,M
	INX	H
	MOV	C,M
	CALL	CHR3
	LHLD	R50NUM
	SHLD	FILE
	LXI	H,NAMBUF+3	;NEXT 3 CHARS
	MOV	A,M
	INX	H
	MOV	B,M
	INX	H
	MOV	C,M
	CALL	CHR3
	LHLD	R50NUM
	SHLD	NAME
	LXI	H,NAMBUF+7	;EXT. (ACCOUNT FOR '.')
	MOV	A,M
	INX	H
	MOV	B,M
	INX	H
	MOV	C,M
	CALL	CHR3
	LHLD	R50NUM
	SHLD	EXT
ASCII:	LXI	H,M13	;ASCII(Y/N)?
	CALL	MSG
	CALL	CHIN
	CPI	'Y'
	JNZ	NO
	XRA	A
	STA	ASCFLG
	JMP	GOON
	CPI	'N'
	JNZ	ASCII	;WANT EITHER Y OR N
NO:	MVI	A,1
	STA	ASCFLG
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:	MVI	A,9
	STA	COUNT2	;COUNT FOR FILENAME+1
	MVI	A,13
	STA	CNTMSK	;TOTAL CHAR MASK
	CALL	CRLF
	LXI	H,M10	;CP/M FILENAME.TYP=
	CALL	MSG
	CALL	GETNAM	;GET CP/M FILENAME.TYP
	CALL	CRLF
	LXI	H,NAMBUF
	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.TYP STORED
	MVI	C,4
	XRA	A
LOOP3:	STAX	D
	INX	D
	DCR	C
	JNZ	LOOP3	;ZERO EX,2 UNUSED BYTES,RC
*
	LXI	H,M0	;PLACE SOURCE (DEC) DISK ON DRIVE B
	CALL	MSG
NRDY:	LXI	H,M0A	;READY (Y/N)?
	CALL	MSG
	CALL	CHIN
	CPI	'Y'
	JNZ	AGAIN
*
*DELETE OLD FILE BY SAME NAME IF IT EXISTS
	MVI	C,DELETF
	LXI	D,FCB
	CALL	BDOS
*CREATE A FILE FILENAME.TYP REQUESTED
	MVI	C,MAKEF
	LXI	D,FCB
	CALL	BDOS
	CPI	0FFH
	JNZ	MAKEOK
	LXI	H,M11	;CP/M DIRECTORY FULL
	CALL	MSG
	JMP	FINIS
MAKEOK:	XRA	A
	STA	FCB+32	;ZERO RECORD COUNT
*
	CALL	DIRSCH
	CPI	0
	JZ	OPENOK
	MVI	C,SELDSK
	MVI	E,0
	CALL	BDOS	;SEL DISK A
	LXI	D,FCB
	MVI	C,DELETF
	CALL	BDOS	;IF FILE NOT FOUND, DELETE OPENED FILE
	JMP	AGAIN	; AND START AGAIN
*
*READY FOR DATA TRANSFER FROM DEC DISK TO CP/M DISK
*IF FILE TO BE TRANSFERRED IS AN ASCII FILE,THE LAST BLOCK
*WILL BE SEARCHED FOR A DEC EOF CHAR AND 1AH (^Z=CP/M EOF)
*WILL BE INSERTED. OTHERWISE ALL BLOCKS WILL BE 
*TRANSFERRED AS IS.
*
*CALCULATE BUFFER SIZE
*
OPENOK:	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	1
	MOV	H,A	;DIFFERENCE/128 IN HL
*
	LXI	D,0-5
	DAD	D
	SHLD	TOPCNT	;SAVE # OF BUFFERS (+ MARGIN)
*
*CALCULATE NUMBER OF SECTORS FROM NUMBER 0F BLOCKS
*
	LHLD	LENGTH
	LXI	D,1
	CALL	CMP16
	JNZ	SECTS
	LXI	D,0-128
	LXI	H,PRGEND
	DAD	D
	SHLD	XFBFPT
	LXI	H,0
	SHLD	PASSCT
	LDA	ASCFLG
	ORA	A
	JZ	LSTBLK
	LXI	H,3
	SHLD	SECTRS
	JMP	DATFIL
*
*
SECTS:	MVI	B,2
LNTHX4:	MOV	A,L
	ADD	A
	MOV	L,A
	MOV	A,H
	RAL
	MOV	H,A
	DCR	B
	JNZ	LNTHX4
	DCX	H
	SHLD	SECTRS	;SAVE TOTAL # OF SECTORS
*
	LDA	ASCFLG
	ORA	A
	JNZ	DATFIL
	LXI	D,0-4
	DAD	D
	SHLD	SECTRS	;SUB 4 FROM SECTRS IF ASCII (FOR MONITORING)
*
DATFIL:	LXI	H,PRGEND
	SHLD	XFBFPT
	LXI	H,0
	SHLD	PASSCT
	LHLD	TOPCNT
	SHLD	COUNT3
	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	DISKRD	;READ A SECTOR,STORE IN LARGE BUFFER
	CALL	REGMOD
	LHLD	PASSCT
	INX	H
	SHLD	PASSCT
	LHLD	SECTRS
	CALL	DCR16
	SHLD	SECTRS
	JNC	LSTBLK	;JUMP OUT IF DONE WITH ALL BUT LAST BLOCK
	LXI	D,128
	LHLD	COUNT3
	CALL	DCR16
	SHLD	COUNT3
	JC	XFER1
*
*BUFFER FULL-WRITE IT OUT
*
	LXI	H,PRGEND
	SHLD	XFBFPT
	LHLD	TOPCNT
	SHLD	COUNT3
	MVI	C,SELDSK
	MVI	E,0
	CALL	BDOS	;SELECT DISK A
	LXI	D,0
*
XFER2:	LHLD	XFBFPT
	DAD	D
	SHLD	XFBFPT
	XCHG
	MVI	C,SETDMA
	CALL	BDOS	;SET DMA ADDR
	MVI	C,WRITEF
	LXI	D,FCB
	CALL	BDOS	;WRITE OUT SECTOR
	CPI	0
	JNZ	CPMERR
	LXI	D,128
	LHLD	COUNT3
	CALL	DCR16
	SHLD	COUNT3
	JC	XFER2
*
*BUFFER WRITTEN OUT-GO BACK & GET MORE DATA
*
	JMP	DATFIL
*
*ALL BUT LAST BLOCK HAS BEEN WRITTEN-CHECK LAST 4 SECTORS FOR EOF
*
LSTBLK:	MVI	A,4
	STA	COUNT3
	LDA	ASCFLG
	ORA	A
	JZ	LSTBL1
	LHLD	LENGTH
	LXI	D,1
	CALL	CMP16
	JNZ	CLOSE	;IF NON-ASCII FILE >1 BLOCK, CLOSE IT
	LXI	H,PRGEND
	SHLD	XFBFPT
	MVI	C,SELDSK
	MVI	E,0
	CALL	BDOS	;SEL DISK A
	LXI	D,0
*
XFER5:	LHLD	XFBFPT
	DAD	D
	SHLD	XFBFPT
	XCHG
	MVI	C,SETDMA
	CALL	BDOS
	MVI	C,WRITEF
	LXI	D,FCB
	CALL	BDOS	;WRITE SECTOR
	CPI	0
	JNZ	CPMERR
	LXI	D,128
	LDA	COUNT3
	DCR	A
	STA	COUNT3
	JNZ	XFER5
	JMP	CLOSE	;GO CLOSE 1 BLOCK DATA FILE
*
*
LSTBL1:	MVI	C,SELDSK
	MVI	E,1
	CALL	BDOS	;SEL DISK B
	LXI	D,128
*
*
XFER3:	LHLD	XFBFPT
	DAD	D
	SHLD	XFBFPT
	XCHG
	MVI	C,SETDMA
	CALL	BDOS
	CALL	DISKRD
	CALL	REGMOD
	MVI	D,80H
	LHLD	XFBFPT
CONT:	MOV	A,M
	CPI	0	;DEC EOF 1
	JZ	EOF
	CPI	10H	;DEC EOF 2
	JZ	EOF
	INX	H
	DCR	D
	JNZ	CONT
*NO EOF IN THIS BUFFER- INC. PASS COUNT & REPEAT
	LHLD	PASSCT
	INX	H
	SHLD	PASSCT
	LXI	D,128
	LDA	COUNT3
	DCR	A
	STA	COUNT3
	JNZ	XFER3
*ASSUME FILE ENDS ON PHYSICAL BOUNDARY-WRITE OUT BUFFER
	JMP	EOFFND
*
*EOF CHAR FOUND-CHANGE REST OF BUFFER TO 1AH
*
EOF:	MVI	A,1AH
	MOV	M,A
	INX	H
	DCR	D
	JNZ	EOF+2
	LHLD	PASSCT
	INX	H
	SHLD	PASSCT	;INC PASS COUNT
*
*WRITE OUT LAST BUFFER
*
EOFFND:	LXI	H,PRGEND
	SHLD	XFBFPT
	LHLD	PASSCT
	DCX	H
	SHLD	COUNT3
	MVI	C,SELDSK
	MVI	E,0
	CALL	BDOS	;SEL DISK A
	LXI	D,0
*
XFER4:	LHLD	XFBFPT
	DAD	D
	SHLD	XFBFPT
	XCHG
	MVI	C,SETDMA
	CALL	BDOS	;SET DMA ADDR
	MVI	C,WRITEF
	LXI	D,FCB
	CALL	BDOS	;WRITE OUT SECTOR
	CPI	0
	JNZ	CPMERR
	LXI	D,128
	LHLD	COUNT3
	CALL	DCR16
	SHLD	COUNT3
	JC	XFER4
*
*CAN CLOSE CP/M FILE NOW
CLOSE:	MVI	C,SELDSK
	MVI	E,0
	CALL	BDOS	;SEL DISK A
	MVI	C,CLOSEF
	LXI	D,FCB
	CALL	BDOS
	CPI	0FFH
	JNZ	FINIS
	LXI	H,M9	;CLOSE ERROR
	CALL	MSG
	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
	RET
*
CMP16:	;COMPARES HL & DE & SETS USUAL FLAGS
	MOV	A,H
	CMP	D
	RNZ
	MOV	A,L
	CMP	E
	RET
*
NEGDE:	;NEGATE DE REGISTER (2'S COMP)
	PUSH	PSW
	MOV	A,D
	CMA
	MOV	D,A
	MOV	A,E
	CMA
	MOV	E,A
	INX	D
	POP	PSW
	RET
*
DCR16:	;DECREMENT HL BY 1 & SET FLAG C IF RESULT >= 0
	; NC IF RESULT < 0
	PUSH	D
	LXI	D,0FFFFH	;-1
	DAD	D
	POP	D
	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 & GO TO IT
*
*
*VARIABLES
TOPCNT:	DS	2	;TOTAL # OF BUFFERS IN MEMORY SPACE
XFBFPT:	DS	2	;TRANSFER BUFFER POINTER
PASSCT:	DS	2	;PASS COUNT
COUNT3:	DS	2	;COUNTER
INTLEV:	DS	1	;INTERLEAVE FLAG
X2:	DS	2	;HL*2
SECTRS:	DS	2	;#OF FULL SECTORS TO TRANSFER
BSECT:	DS	1
ASCFLG:	DS	1	;ASCII FLAG
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
FILELO:	DS	1	;PERMANENT FILE NAME & EXT. STORAGE
FILEHI:	DS	1
NAMELO	DS	1
NAMEHI	DS	1
EXTLO	DS	1
EXTHI	DS	1	;END OF PERM. NAME STORAGE
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)
MATCH:	DS	1	;FILE FOUND FLAG (SET IF FOUND)
TRACK:	DS	1	;TRACK OF FOUND FILE
SECTOR:	DS	1	;SECTOR OF FOUND FILE
FILE:	DS	2	;FILE NAME
NAME:	DS	2	; & EXT. OF
EXT:	DS	2	;  REQUESTED FILE (DEC)
FLNMPT:	DS	2	;FILE NAME POINTER
FLBFPT:	DS	2	;PERM. FILE NAME POINTER
BTRACK:	DS	1	;PHYSICAL TRACK
ERRCNT:	DS	1	;ERROR COUNT
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 FROM A DEC STANDARD (INTERLEAVED)'
	DB	0DH,0AH,'OR A "CONSECUTIVE" FORMATTED DISK TO THE CP/M SYSTEM DISK',0FFH
M0:	DB	0DH,0AH,'PLACE SOURCE (DEC) DISK ON DRIVE B',0DH,0AH,0FFH
M0A:	DB	0DH,0AH,'READY (Y/N)?',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,'CLOSE ERROR',0FFH
M10:	DB	0DH,0AH,'CP/M:FILENAME.TYP=',0FFH
M11:	DB	0DH,0AH,'CP/M DIRECTORY FULL',0FFH
M12:	DB	0DH,0AH,'CP/M WRITE ERROR',0FFH
M13:	DB	'ASCII(Y/N)?',0FFH
M14:	DB	0DH,0AH,'IS DEC DISK INTERLEAVED (Y/N)?',0FFH
M15:	DB	0DH,0AH,'ANOTHER TRANSFER (Y/N)?',0FFH
*
*
PAD:	DS	4
*
PRGEND	EQU	$
*
*
*
	END
