TITLE	'GENERATE HEX FILE FROM COM FILE 9/81'
;	HEX DUMP PROGRAM, READS AN INPUT FILE AND PRODUCES A HEX FILE
;
;	COPYRIGHT (C), DIGITAL RESEARCH, 1976, 1977, 1978, 1979, 1980, 1981
;	BOX 579 PACIFIC GROVE, CALIFORNIA
;
;
;	Revised:
;	  14 Sept 81  by Thomas Rolander
;
	ORG	100H
	LXI	SP,STKTOP
	JMP	MAIN
	DB	' COPYRIGHT (C) DIGITAL RESEARCH '
BOOT	EQU	0000H	;REBOOT POINT
BDOS	EQU	0005H	;DOS ENTRY POINT
CONS	EQU	1	;READ CONSOLE
TYPEF	EQU	2	;TYPE FUNCTION
PRNTF	EQU	9	;PRINT BUFFER
OPENF	EQU	15	;FILE OPEN
CLOSF	EQU	16	;FILE CLOSE
DELF	EQU	19	;FILE DELETE
READF	EQU	20	;READ FUNCTION
WRITF	EQU	21	;WRITE RECORD
MAKEF	EQU	22	;MAKE FILE
DMAF	EQU	26	;SET DMA ADDRESS
;
FCB	EQU	5CH	;FILE CONTROL BLOCK ADDRESS
BUFF	EQU	80H	;INPUT DISK BUFFER ADDRESS
CR	EQU	0DH
LF	EQU	0AH
EOF	EQU	1AH	;END OF FILE (CTL-Z)
;
;	SET UP STACK
;	STACK AREA
STACK:	DS	64
STKTOP	EQU	$
;
;	SUBROUTINES
;
;
GETBASE:
;	READ THE OFFSET FROM THE SECOND PARAMETER
	LXI	H,FCB+17
	LXI	D,0
	MVI	B,8	;MAX 8 DIGITS
GET0:	MOV	A,M
	CPI	' '
	JZ	ENDGET
	SUI	'0'
	CPI	10
	JC	GET1
;	MUST BE HEX A-F
	ADI	('0'-'A'+10) AND 0FFH
	CPI	16
	JNC	BADGET
GET1:	;NEXT DIGIT IS IN A
	XCHG
	DAD	H	;*2
	DAD	H	;*4
	DAD	H	;*8
	DAD	H	;*16
	ADD	L
	MOV	L,A
	XCHG
	INX	H	;TO NEXT POSITION
	DCR	B
	JNZ	GET0
;
ENDGET:
	XCHG
	SHLD	OFFSET
	RET
;
BADGET:
	LXI	D,GETMSG
	CALL	PRINT
	JMP	BOOT
;
GETMSG:
	DB	CR,LF,'BAD HEX DIGIT IN BASE$'
;
PRINT:	;PRINT A BUFFER
	MVI	C,PRNTF
	CALL	BDOS
	RET
;
PCHAR:	;SEND CHAR TO OUTPUT FILE
	PUSH	H
	PUSH	D
	LXI	H,OBP	;BUFFER POINTER
	PUSH	H	;SAVE FOR LATER
	MOV	E,M	;LO BYTE
	MVI	D,0
	LXI	H,BUFF
	DAD	D	;BUFF(OBP) IN H,L
	MOV	M,A	;STORE CHARACTER TO BUFFER
	POP	H	;RECALL OBP ADDRESS
	INR	M	;OBP=OBP+1
	MOV	A,M	;PAST END OF BUFFER?
	CPI	128
	JC	EPCHAR
;	WRITE THE BUFFER TO THE DISK FILE
	MVI	M,0	;CLEARS OBP
	PUSH	B	;SAVE ENVIRONMENT
	MVI	C,WRITF
	LXI	D,FCB
	CALL	BDOS
	ORA	A	;ERROR?
	JNZ	BADPR
;	NO ERROR, RETURN TO CALLER
	POP	B
EPCHAR:	POP	D
	POP	H
	RET
;
BADPR:	;BAD WRITE
	MVI	C,CLOSF
	LXI	D,FCB
	CALL	BDOS	;TRY TO CLOSE THE FILE
	LXI	D,PRMSG
	CALL	PRINT
	JMP	BOOT
PRMSG:	DB	CR,LF,'DISK IS FULL$'
;
CRLF:
	MVI	A,CR
	CALL	PCHAR
	MVI	A,LF
	CALL	PCHAR
	RET
;
;
PNIB:	;PRINT NIBBLE IN REG A
	ANI	0FH	;LOW 4 BITS
	CPI	10
	JNC	P10
;	LESS THAN OR EQUAL TO 9
	ADI	'0'
	JMP	PRN
;
;	GREATER OR EQUAL TO 10
P10:	ADI	'A' - 10
PRN:	CALL	PCHAR
	RET
;
MAIN:	; READ AND PROCESS SUCCESSIVE BUFFERS
	CALL	GETBASE	;GET BASE ADDRESS FOR DUMP
	CALL	SETUP	;SET UP INPUT FILE
;	LOAD COM FILE TO MEMORY
	LXI	D,IBUFF
LOAD:	;READ DISK RECORD TO MEMORY
	PUSH	D	;SAVE DMA ADDRESS
	MVI	C,DMAF
	CALL	BDOS	;DMA SET
	LXI	D,FCB
	MVI	C,READF
	CALL	BDOS
	POP	D
	ORA	A
	JNZ	FINIS
	LXI	H,128
	DAD	D
	XCHG
	JMP	LOAD	;FOR ANOTHER RECORD
;
FINIS:
	DCR	A	;EOF=1
	JZ	BUILDHEX
	LXI	D,RERR
	CALL	PRINT	;BAD DISK READ
	JMP	BOOT
;
BUILDHEX:
;BUILD HEX FILE FROM IBUFF THROUGH EBUFF
	PUSH	D
	CALL	SETHEX	;SET UP HEX FILE
	POP	D
	DCX	D	;LAST ADDRESS
	LXI	H,IBUFF	;D,E HOLDS HIGH ADDRESS, H,L HOLDS LOW ADDRESS
W0:	MOV	A,L	;GET LOW/NEXT ADDRESS
	ADI	16	;COMPUTE NEXT ADDRESS
	MOV	C,A	;SAVE TEMP IN B,C
	MOV	A,H
	ACI	0
	MOV	B,A	;LOW ADDRESS+16 IN B,C
	MOV	A,E	;COMPARE HIGH ADDRESS
	SUB	C
	MOV	C,A	;SAVE DIFFERENCE
	MOV	A,D
	SBB	B
	JC	W1	;'CAUSE LESS THAN 16
;	OTHERWISE 16 BYTE RECORD
	MVI	A,16
	JMP	W2
;
W1:	;SHORT RECORD
	MOV	A,C	;-DIFF
	ADI	17	;MAKE IT POSITIVE
W2:	;CHECK FOR LAST RECORD
	ORA	A
	JZ	HDONE	;IF LAST
;	OTHERWISE WRITE RECORD
	PUSH	D	;SAVE HIGH ADDRESS
	MOV	E,A	;SAVE LENGTH
	MVI	D,0	;CLEAR CS
	CALL	CRLF	;WRITE CRLF
	MVI	A,':'
	CALL	PCHAR
	MOV	A,E	;LENGTH
	CALL	WRC	;WRITE CHARACTER
;	APPLY OFFSET TO BASE ADDRESS
	PUSH	H
	PUSH	D
	XCHG		;ABSOLUTE ADDRESS TO D,E
	LXI	H,-IBUFF
	DAD	D	;ABSOLUTE-IBUFF TO H,L
	XCHG
	LHLD	OFFSET
	DAD	D	;ABSOLUTE-IBUFF+OFFSET
	POP	D
	MOV	A,H	;HO ADDRESS
	CALL	WRC
	MOV	A,L	;LO ADDRESS
	CALL	WRC
	POP	H	;ABSOLUTE ADDRESS
	XRA	A
	CALL	WRC	;RECORD TYPE
;
;	WRITE RECORD
W3:	MOV	A,M
	INX	H
	CALL	WRC
	DCR	E
	JNZ	W3	;FOR MORE
;
	XRA	A	;COMPUTE CHECKSUM
	SUB	D
	CALL	WRC
	POP	D	;RESTORE HIGH ADDR
	JMP	W0
;
WRC:	;WRITE CHAR WITH CHECK SUM IN D
	PUSH	PSW
	RRC
	RRC
	RRC
	RRC
	ANI	0FH
	CALL	PNIB
	POP	PSW
	PUSH	PSW
	ANI	0FH
	CALL	PNIB
	POP	PSW
	ADD	D
	MOV	D,A
	RET
;
HDONE:
;	FINISH BUFFER OUTPUT
	CALL	CRLF
	MVI	A,':'
	CALL	PCHAR
	MVI	B,8
ZLOOP:	;SEND 8 ZEROES TO OUTPUT
	XRA	A
	CALL	WRC
	DCR	B
	JNZ	ZLOOP
;
	CALL	CRLF
;
;	FILL OUTPUT WITH END OF FILE CHARACTERS
FILLE:	LDA	OBP
	ORA	A
	JZ	EFILL	;WRITE 'TIL ZERO POINTER
	MVI	A,EOF
	CALL	PCHAR
	JMP	FILLE
;	CLEARED, NOW CLOSE THE FILE
EFILL:	MVI	C,CLOSF
	LXI	D,FCB
	CALL	BDOS
	CPI	255
	JZ	BADCLOSE
	LXI	D,ENDMSG
	CALL	PRINT
	JMP	BOOT
ENDMSG:	DB	CR,LF,'HEX FILE WRITTEN$'
;
BADCLOSE:
;	CANNOT CLOSE THE FILE
	LXI	D,CLMSG
	CALL	PRINT
	JMP	BOOT
CLMSG:	DB	CR,LF,'CANNOT CLOSE FILE, CHECK WRITE PROTECT$'
;
;	FILE CONTROL BLOCK DEFINITIONS
FCBDN	EQU	FCB+0	;DISK NAME
FCBFN	EQU	FCB+1	;FILE NAME
FCBFT	EQU	FCB+9	;DISK FILE TYPE (3 CHARACTERS)
FCBRL	EQU	FCB+12	;FILE'S CURRENT REEL NUMBER
FCBRC	EQU	FCB+15	;FILE'S RECORD COUNT (0 TO 128)
FCBCR	EQU	FCB+32	;CURRENT (NEXT) RECORD NUMBER (0 TO 127)
FCBLN	EQU	FCB+33	;FCB LENGTH
;
;
FILLTYPE:
;	SET THE TYPE FIELD FOR THE CURRENT FCB TO VALUE AT D,E
	LXI	H,FCBFT
	MVI	B,3
FILL0:	LDAX	D
	INX	D
	MOV	M,A
	INX	H
	DCR	B
	JNZ	FILL0
;	mvi	m,0	;*** Bug fix: zeroes the extent
	RET
;
SETUP:	;SET UP FILE 
	LXI	D,COMTYPE
	CALL	FILLTYPE
;	OPEN THE FILE FOR INPUT
	LXI	D,FCB
	MVI	C,OPENF
	CALL	BDOS
;	CHECK FOR ERRORS
	CPI	255
	JNZ	OPNOK
	LXI	D,OPERR
	CALL	PRINT
	JMP	BOOT
OPERR:	DB	CR,LF,'NO INPUT FILE PRESENT$'
COMTYPE:
	DB	'COM'
;
SETHEX:
;	SET UP HEX FILE
	XRA	A
	STA	OBP	;OUTPUT POINTER SET TO BEGINNING
	LXI	D,BUFF
	MVI	C,DMAF	;RESET DMA ADDRESS
	CALL	BDOS
;
	LXI	D,HEXTYPE
;	CALL	FILLTYPE	;SET TO .HEX
	call	patch	;*** bug fix ***
	LXI	D,FCB
	PUSH	D
	MVI	C,DELF		;DELETE OLD COPIES
	CALL	BDOS
	POP	D
	MVI	C,MAKEF		;MAKE A NEW ONE
	CALL	BDOS
	CPI	255
	JNZ	OPNOK
;
;	CANNOT CREATE THE FILE
	LXI	D,NOSPACE
	CALL	PRINT
	JMP	BOOT
NOSPACE:
	DB	CR,LF,'NO DIRECTORY SPACE$'
HEXTYPE:
	DB	'HEX'
;
OPNOK:	;OPEN IS OK.
	XRA	A
	STA	FCBCR
	RET
;
RERR:	DB	CR,LF,'DISK READ ERROR$'
;
OBP	DS	1	;OUTPUT BUFFER POINTER
OFFSET	DS	2	;DISPLACEMENT TO ADD IN HEX TAPE

	ds	3
patch:
	call	filltype
	mvi	a,0
	sta	fcb+0ch
	ret

IBUFF	EQU	($ AND 0FF00H)+100H
	END