Digital-Research-Source-Code/CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/as1io.asm

	TITLE	'ASM IO MODULE'
;	I/O MODULE FOR CP/M ASSEMBLER
;
	ORG	200H
BOOT	EQU	000H	;REBOOT LOCATION
;	I/O MODULE ENTRY POINTS
	JMP	INIT	;INITIALIZE, START ASSEMBLER
	JMP	SETUP	;FILE SETUP
	JMP	GNC	;GET NEXT CHARACTER
	JMP	PNC	;PUT NEXT OUTPUT CHARACTER
	JMP	PNB	;PUT NEXT HEX BYTE
	JMP	PCHAR	;PRINT CONSOLE CHARACTER
	JMP	PCON	;PRINT CONSOLE BUFFER TO CRLF
	JMP	WOBUFF	;WRITE OUTBUFFER
	JMP	PERR	;PLACE ERROR CHARACTER INTO PBUFF
	JMP	DHEX	;PLACE HEX BYTE INTO OUTPUT BUFFER
	JMP	EOR	;END OF ASSEMBLY
;	DATA FOR I/O MODULE
BPC:	DS	2	;BASE PC FOR CURRENT HEX RECORD
DBL:	DS	1	;HEX BUFFER LENGTH
DBUFF:	DS	16	;HEX BUFFER
;
;	DISK NAMES
CDISK:	DS	1	;CURRENTLY SELECTED DISK
ADISK:	DS	1	;.ASM DISK
PDISK:	DS	1	;.PRN DISK
HDISK:	DS	1	;.HEX DISK
;
;
;
;	COMMON EQUATES
QBMAX	EQU	120	;MAX PRINT SIZE
QBUFF	EQU	10CH	;PRINT BUFFER
QBP	EQU	QBUFF+QBMAX	;PRINT BUFFER POINTER
;
TOKEN	EQU	QBP+1	;CURRENT TOKEN UDER SCAN
VALUE	EQU	TOKEN+1	;VALUE OF NUMBER IN BINARY
ACCLEN	EQU	VALUE+2	;ACCUMULATOR LENGTH
ACMAX	EQU	64	;MAX ACCUMULATOR LENGTH
ACCUM	EQU	ACCLEN+1
;
EVALUE	EQU	ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
;
SYTOP	EQU	EVALUE+2	;CURRENT SYMBOL TOP
SYMAX	EQU	SYTOP+2		;MAX ADDRESS+1
;
PASS	EQU	SYMAX+2	;CURRENT PASS NUMBER
FPC	EQU	PASS+1	;FILL ADDRESS FOR DHEX ROUTINE
ASPC	EQU	FPC+2	;ASSEMBLER'S PSEUDO PC
;
CR	EQU	0DH	;CARRIAGE RETURN
LF	EQU	0AH	;LINE FEED
EOF	EQU	1AH	;END OF FILE MARK
;
;
;	DOS ENTRY POINTS
BDOS	EQU	5H	;DOS ENTRY POINT
READC	EQU	1	;READ CONSOLE DEVICE
WRITC	EQU	2	;WRITE CONSOLE DEVICE
REDYC	EQU	11	;CONSOLE CHARACTER READY
SELECT	EQU	14	;SELECT DISK SPECIFIED BY REGISTER E
OPENF	EQU	15	;OPEN FILE
CLOSF	EQU	16	;CLOSE FILE
DELEF	EQU	19	;DELETE FILE
READF	EQU	20	;READ FILE
WRITF	EQU	21	;WRITE FILE
MAKEF	EQU	22	;MAKE A FILE
CSEL	EQU	25	;RETURN CURRENTLY SELECTED DISK
SETDM	EQU	26	;SET DMA ADDRESS
;
;	FILE AND BUFFERING PARAMETERS
NSB	EQU	8	;NUMBER OF SOURCE BUFFERS
NPB	EQU	6	;NUMBER OF PRINT BUFFERS
NHB	EQU	6	;NUMBER OF HEX BUFFERS
;
SSIZE	EQU	NSB*128
PSIZE	EQU	NPB*128
HSIZE	EQU	NHB*128
;
;	FILE CONTROL BLOCKS
SCB:	DS	9	;FILE NAME
	DB	'ASM'	;FILE TYPE
SCBR:	DS	1	;REEL NUMBER (ZEROED IN SETUP)
	DS	19	;MISC AND DISK MAP
SCBCR:	DS	1	;CURRENT RECORD (ZEROED IN SETUP)
;
PCB:	DS	9
	DB	'PRN',0
	DS	19
	DB	0	;RECORD TO WRITE NEXT
;
HCB:	DS	9
	DB	'HEX',0
	DS	19
	DB	0
;
;	POINTERS AND BUFFERS
SBP:	DW	SSIZE	;NEXT CHARACTER POSITION TO READ
SBUFF:	DS	SSIZE
;
PBP:	DW	0
PBUFF:	DS	PSIZE
;
HBP:	DW	0
HBUFF:	DS	HSIZE
FCB	EQU	5CH	;FILE CONTROL BLOCK ADDRESS
FNM	EQU	1	;POSITION OF FILE NAME
FLN	EQU	9	;FILE NAME LENGTH
BUFF	EQU	80H	;INPUT DISK BUFFER ADDRESS
;
SEL:	;SELECT DISK IN REG-A
	LXI	H,CDISK
	CMP	M	;SAME?
	RZ
	MOV	M,A	;CHANGE CURRENT DISK
	MOV	E,A
	MVI	C,SELECT
	CALL	BDOS
	RET
;
SCNP:	;SCAN THE NEXT PARAMETER
	INX	H
	MOV	A,M
	CPI	' '
	JZ	SCNP0
	SBI	'A'	;NORMALIZE
	RET
SCNP0:	LDA	CDISK
	RET
;
PCON:	;PRINT MESSAGE AT H,L TO CONSOLE DEVICE
	MOV	A,M
	CALL	PCHAR
	MOV	A,M
	INX	H
	CPI	CR
	JNZ	PCON
	MVI	A,LF
	CALL	PCHAR
	RET
;
FNAME:	;FILL NAME FROM DEFAULT FILE CONTROL BLOCK
	LXI	D,FCB
	MVI	B,FLN
FNAM0:	LDAX	D	;GET NEXT FILE CHARACTER
	CPI	'?'
	JZ	FNERR	;FILE NAME ERROR
	MOV	M,A	;STORE TO FILE CNTRL BLOCK
	INX	H
	INX	D
	DCR	B
	JNZ	FNAM0	;FOR NEXT CHARACTER
	RET
;
INIT:	;SET UP STACK AND FILES, START ASSEMBLER
	LXI	H,TITL
	CALL	PCON
	JMP	SET0
;
OPEN:	;OPEN FILE ADDRESSED BY D,E
	MVI	C,OPENF
	CALL	BDOS
	CPI	255
	RNZ
;	OPEN ERROR
	LXI	H,ERROP
	CALL	PCON
	JMP	BOOT
;
CLOSE:	;CLOSE FILE ADDRESSED BY D,E
	MVI	C,CLOSF
	CALL	BDOS
	CPI	255
	RNZ		;CLOSE OK
	LXI	H,ERRCL
	CALL	PCON
	JMP	BOOT
;
DELETE:	;DELETE FILE ADDRESSED BY D,E
	MVI	C,DELEF
	JMP	BDOS
;
MAKE:	;MAKE FILE ADDRESSED BY D,E
	MVI	C,MAKEF
	CALL	BDOS
	CPI	255
	RNZ
;	MAKE ERROR
	LXI	H,ERRMA
	CALL	PCON
	JMP	BOOT
;
SELA:	LDA	ADISK
	CALL	SEL
	RET
;
NPR:	;RETURN ZERO FLAG IF NO PRINT FILE
	LDA	PDISK
	CPI	'Z'-'A'
	RZ
	CPI	'X'-'A'	;CONSOLE
	RET
;
SELP:	LDA	PDISK
	CALL	SEL
	RET
;
SELH:	LDA	HDISK
	CALL	SEL
	RET
;
SET0:	;SET UP FILES FOR INPUT AND OUTPUT
	LDA	FCB	;GET FIRST CHARACTER
	CPI	' '	;MAY HAVE FORGOTTEN NAME
	JZ	FNERR	;FILE NAME ERROR
	MVI	C,CSEL	;CURRENT DISK?
	CALL	BDOS	;GET IT TO REG-A
	STA	CDISK
;
;	SCAN PARAMETERS
	LXI	H,FCB+FLN-1
	CALL	SCNP
	STA	ADISK
	CALL	SCNP
	STA	HDISK
	CALL	SCNP
	STA	PDISK
;
	LXI	H,SCB	;ADDRESS SOURCE FILE CONTROL BLOCK
	CALL	FNAME		;FILE NAME OBTAINED FROM DEFAULT FCB
;
	CALL	NPR	;Z OR X?
	JZ	NOPR
	LXI	H,PCB	;ADDRESS PRINT FILE CONTROL BLOCK
	PUSH	H	;SAVE A COPY FOR OPEN
	PUSH	H	;SAVE A COPY FOR DELETE
	CALL	FNAME	;FILL PCB
	CALL	SELP
	POP	D	;FCB ADDRESS
	CALL	DELETE
	POP	D	;FCB ADDRESS
	CALL	MAKE
;
NOPR:	;TEST FOR HEX FILE
	LDA	HDISK
	CPI	'Z'-'A'
	JZ	NOHEX
	LXI	H,HCB
	PUSH	H
	PUSH	H
	CALL	FNAME
	CALL	SELH
	POP	D
	CALL	DELETE
	POP	D
	CALL	MAKE
;
;	FILES SET UP, CALL ASSEMBLER
NOHEX:	JMP	ENDMOD
;
SETUP:	;SETUP INPUT FILE FOR SOURCE PROGRAM
	LXI	H,SSIZE
	SHLD	SBP	;CAUSE IMMEDIATE READ
	XRA	A	;ZERO VALUE
	STA	SCBR	;CLEAR REEL NUMBER
	STA	SCBCR		;CLEAR CURRENT RECORD
	STA	DBL		;CLEAR HEX BUFFER LENGTH
	CALL	SELA
	LXI	D,SCB
	CALL	OPEN
;
	RET
;
FNERR:	;FILE NAME ERROR
	LXI	H,ERRFN
	CALL	PCON
	JMP	BOOT
;
;
GCOMP:	;COMPARE D,E AGAINS H,L
	MOV	A,D
	CMP	H
	RNZ
	MOV	A,E
	CMP	L
	RET
;
GNC:	;GET NEXT CHARACTER FROM SOURCE BUFFER
	PUSH	B
	PUSH	D
	PUSH	H	;ENVIRONMENT SAVED
	LHLD	SBP
	LXI	D,SSIZE
	CALL	GCOMP
	JNZ	GNC2
;
;	READ ANOTHER BUFFER
	CALL	SELA
	LXI	H,0
	SHLD	SBP
	MVI	B,NSB	;NUMBER OF SOURCE BUFFERS
	LXI	H,SBUFF
GNC0:	;READ 128 BYTES
	PUSH	B	;SAVE COUNT
	PUSH	H	;SAVE BUFFER ADDRESS
	MVI	C,READF
	LXI	D,SCB
	CALL	BDOS	;PERFORM THE READ
	POP	H	;RESTORE BUFFER ADDRESS
	POP	B	;RESTORE BUFFER COUNT
	ORA	A	;SET FLAGS
	MVI	C,128
	JNZ	GNC1
;	NORMAL READ OCCURRED
	LXI	D,BUFF	;SOURCE BUFFER ADDRESS
	MVI	C,128
MOV0:	LDAX	D	;GET CHARACTER
	MOV	M,A	;STORE CHARACTER
	INX	D
	INX	H
	DCR	C
	JNZ	MOV0
;	BUFFER LOADED, TRY NEXT BUFFER
;
	DCR	B
	JNZ	GNC0
	JMP	GNC2
;
GNC1:	;EOF OR ERROR
	CPI	3	;ALLOW 0,1,2
	JNC	FRERR	;FILE READ ERROR
GNCE:	MVI	M,EOF	;STORE AND END OF FILE CHARACTER
	INX	H
	DCR	C
	JNZ	GNCE	;FILL CURRENT BUFFER WITH EOF'S
;
GNC2:	;GET CHARACTER TO ACCUMULATOR AND RETURN
	LXI	D,SBUFF
	LHLD	SBP
	PUSH	H	;SAVE CURRENT SBP
	INX	H	;READY FOR NEXT READ
	SHLD	SBP
	POP	H	;RESTORE PREVIOUS SBP
	DAD	D	;ABSOLUTE ADDRESS OF CHARACTER
	MOV	A,M	;GET IT
	POP	H
	POP	D
	POP	B
	RET
;
FRERR:	LXI	H,ERRFR
	CALL	PCON	;PRINT READ ERROR MESSAGE
	JMP	BOOT
;
PNC:	;SAME AT PNCF, BUT ENVIRONMENT IS SAVED FIRST
	PUSH	B
;	CHECK FOR CONSOLE OUTPUT / NO OUTPUT
	MOV	B,A	;SAVE CHARACTER
	LDA	PDISK	;Z OR X?
	CPI	'Z'-'A'	;Z NO OUTPUT
	JZ	PNRET
;
	CPI	'X'-'A'
	MOV	A,B	;RECOVER CHAR FOR CON OUT
	JNZ	PNGO
	CALL	PCHAR
	JMP	PNRET
;
;	NOT X OR Z, SO PRINT IT
PNGO:	PUSH	D
	PUSH	H
	CALL	PNCF
	POP	H
	POP	D
PNRET:	POP	B
	RET
;
PNCF:	;PRINT NEXT CHARACTER
	LHLD	PBP
	XCHG
	LXI	H,PBUFF
	DAD	D
	MOV	M,A	;CHARACTER STORED AT PBP IN PBUFF
	XCHG		;PBP TO H,L
	INX	H	;POINT TO NEXT CHARACTER
	SHLD	PBP	;REPLACE IT
	XCHG
	LXI	H,PSIZE
	CALL	GCOMP	;AT END OF BUFFER?
	RNZ		;RETURN IF NOT
;
;	OVERFLOW, WRITE BUFFER
	CALL	SELP
	LXI	H,0
	SHLD	PBP
	LXI	H,PBUFF
	LXI	D,PCB	;D,E ADDRESS FILE CONTROL BLOCK
	MVI	B,NPB	;NUMBER OF BUFFERS TO B
;	(DROP THROUGH TO WBUFF)
;
WBUFF:	;WRITE BUFFERS STARTING AT H,L FOR B BUFFERS
;	CHECK FOR EOF'S
	MOV	A,M
	CPI	EOF
	RZ		;DON'T DO THE WRITE
;
	PUSH	B	;SAVE NUMBER OF BUFFERS
	PUSH	D	;SAVE FCB ADDRESS
	MVI	C,128	;READY FOR MOVE
	LXI	D,BUFF
WBUF0:	;MOVE TO BUFFER
	MOV	A,M	;GET CHARACTER
	STAX	D	;PUT CHARACTER
	INX	H
	INX	D
	DCR	C
	JNZ	WBUF0
;
;	WRITE BUFFER
	POP	D	;RECOVER FCB ADDRESS
	PUSH	D	;SAVE IT AGAIN FOR LATER
	PUSH	H	;SAVE BUFFER ADDRESS
	MVI	C,WRITF	;DOS WRITE FUNCTION
	CALL	BDOS
	POP	H	;RECOVER BUFFER ADDRESS
	POP	D	;RECOVER FCB ADDRESS
	POP	B	;RECOVER BUFFER COUNT
	ORA	A	;SET ERROR RETURN FLAGS
	JNZ	FWERR
;
;	WRITE OK
	DCR	B
	RZ		;RETURN IF NO MORE BUFFERS TO WRITE
	JMP	WBUFF
;
FWERR:	;ERROR IN WRITE
	LXI	H,ERRFW
	CALL	PCON	;ERROR MESSAGE OUT
	JMP	EORC	;TO CLOSE AND REBOOT
;
;
PNB:	;PUT NEXT HEX BYTE
	PUSH	B
	PUSH	D
	PUSH	H
	CALL	PNBF
	POP	H
	POP	D
	POP	B
	RET
;
PNBF:	;PUT NEXT BYTE
;	(SIMILAR TO THE PNCF SUBROUTINE)
	LHLD	HBP
	XCHG
	LXI	H,HBUFF
	DAD	D
	MOV	M,A	;CHARACTER STORED AT HBP IN HBUFF
	XCHG
	INX	H	;HBP INCREMENTED
	SHLD	HBP
	XCHG		;BACK TO D,E
	LXI	H,HSIZE
	CALL	GCOMP	;EQUAL?
	RNZ
;
;	OVERFLOW, WRITE BUFFERS
	CALL	SELH
	LXI	H,0
	SHLD	HBP
	LXI	H,HBUFF
	LXI	D,HCB	;FILE CONTROL BLOCK FOR HEX FILE
	MVI	B,NHB
	JMP	WBUFF	;WRITE BUFFERS
;
PCHAR:	;PRINT CHARACTER IN REGISTER A
	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,WRITC
	MOV	E,A
	CALL	BDOS
	POP	H
	POP	D
	POP	B
	RET
;
WOCHAR:	;WRITE CHARACTER IN REG-A WITH REFLECT AT CONSOLE IF ERROR
	MOV	C,A	;SAVE THE CHAR
	CALL	PNC	;PRINT CHAR
	LDA	QBUFF
	CPI	' '
	RZ
;	ERROR IN LINE
	LDA	PDISK
	CPI	'X'-'A'
	RZ		;ALREADY PRINTED IF 'X'
;
	MOV	A,C	;RECOVER CHARACTER
	CALL	PCHAR	;PRINT IT
	RET
;
WOBUFF:	;WRITE THE OUTPUT BUFFER TO THE PRINT FILE
	LDA	QBP	;GET CHARACTER COUNT
	LXI	H,QBUFF	;BASE OF BUFFER
WOB0:	ORA	A	;ZERO COUNT?
	JZ	WOBE
;	NOT END, SAVE COUNT AND GET CHARACTER
	MOV	B,A	;SAVE COUNT
	MOV	A,M
	CALL	WOCHAR	;WRITE CHARACTER
	INX	H	;ADDRESS NEXT CHARACTER OF BUFFER
	MOV	A,B	;GET COUNT
	DCR	A
	JMP	WOB0
;
WOBE:	;END OF PRINT - ZERO QBP
	STA	QBP
;	FOLLOW BY CR LF
	MVI	A,CR
	CALL	WOCHAR
	MVI	A,LF
	CALL	WOCHAR
	LXI	H,QBUFF
	MVI	A,QBMAX	;READY TO BLANK OUT
WOB2:	MVI	M,' '
	INX	H
	DCR	A
	JNZ	WOB2
	RET
;
;
PERR:	;FILL QBUFF ERROR MESSAGE POSITION
	MOV	B,A	;SAVE CHARACTER
	LXI	H,QBUFF
	MOV	A,M
	CPI	' '
	RNZ	;DON'T CHANGE IT IF ALREADY SET
	MOV	M,B	;STORE ERROR CHARACTER
	RET
;
EOR:	;END OF ASSEMBLER
	CALL	NPR	;Z OR A?
	JZ	EOPR
;	FILL OUTPUT FILES WITH EOF'S
EOR2:	LHLD	PBP
	MOV	A,L
	ORA	H	;VALUE ZERO?
	JZ	EOPR
	MVI	A,EOF	;CTL-Z IS END OF FILE
	CALL	PNC	;PUT ENDFILES IN PRINT BUFFER
	JMP	EOR2	;EVENTUALLY BUFFER IS WRITTEN
;
EOPR:	;END OF PRINT FILE, CHECK HEX
	LDA	HDISK
	CPI	'Z'-'A'
	JZ	EORC
EOR0:	;WRITE TERMINATING RECORD INTO HEX FILE
	LDA	DBL	;MAY BE ZERO ALREADY
	ORA	A
	CNZ	WHEX	;WRITE HEX BUFFER IF NOT ZERO
	LHLD	FPC	;GET CURRENT FPC AS LAST ADDRESS
	SHLD	BPC	;RECORD LENGTH ZERO, BASE ADDRESS 0000
	CALL	WHEX	;WRITE HEX BUFFER
;
;	NOW CLEAR OUTPUT BUFFER FOR HEX FILE
EOR1:	LHLD	HBP
	MOV	A,L
	ORA	H
	JZ	EORC
	MVI	A,EOF
	CALL	PNB
	JMP	EOR1
;
;	CLOSE FILES AND TERMINATE
EORC:
	CALL	NPR
	JZ	EORPC
	CALL	SELP
	LXI	D,PCB
	CALL	CLOSE
EORPC:
	LDA	HDISK
	CPI	'Z'-'A'
	JZ	EORHC
	CALL	SELH
	LXI	D,HCB
	CALL	CLOSE
;
EORHC:
	LXI	H,ENDA
	CALL	PCON
	JMP	BOOT
;
TITL:	DB	'CP/M ASSEMBLER - VER 1.4',CR
ERROP:	DB	'NO SOURCE FILE PRESENT',CR
ERRMA:	DB	'NO DIRECTORY SPACE',CR
ERRFN:	DB	'SOURCE FILE NAME ERROR',CR
ERRFR:	DB	'SOURCE FILE READ ERROR',CR
ERRFW:	DB	'OUTPUT FILE WRITE ERROR',CR
ERRCL:	DB	'CANNOT CLOSE FILES',CR
ENDA:	DB	'END OF ASSEMBLY',CR
;
DHEX:	;DATA TO HEX BUFFER (BYTE IN REG-A)
	PUSH	B
	MOV	B,A	;HOLD CHARACTER FOR 'Z' TEST
	LDA	HDISK
	CPI	'Z'-'A'
	MOV	A,B	;RECOVER CHARACTER
	JZ	DHRET
	PUSH	D	;ENVIRONMENT SAVED
	PUSH	PSW	;SAVE DATA BYTE
	LXI	H,DBL	;CURRENT LENGTH
	MOV	A,M	;TO ACCUM
	ORA	A	;ZERO?
	JZ	DHEX3
;
;	LENGTH NOT ZERO, MAY BE FULL BUFFER
	CPI	16
	JC	DHEX1	;BR IF LESS THAN 16 BYTES
;	BUFFER FULL, DUMP IT
	CALL	WHEX	;DBL = 0 UPON RETURN
	JMP	DHEX3	;SET BPC AND DATA BYTE
;
DHEX1:	;PARTIAL BUFFER IN PROGRESS, CHECK FOR SEQUENTIAL BYTE LOAD
	LHLD	FPC
	XCHG
	LHLD	BPC	;BASE PC IN H,L
	MOV	C,A	;CURRENT LENGTH OF BUFFER
	MVI	B,0	;IS IN B,C
	DAD	B	;BPC+DBL TO H,L
	MOV	A,E	;READY FOR COMPARE
	CMP	L	;EQUAL?
	JNZ	DHEX2	;BR IF NOT
	MOV	A,D	;CHECK HO BYTE
	CMP	H
	JZ	DHEX4	;BR IF SAME ADDRESS
;
DHEX2:	;NON SEQUENTIAL ADDRESS, DUMP AND CHANGE BASE ADDRESS
	CALL	WHEX
DHEX3:	;SET NEW BASE
	LHLD	FPC
	SHLD	BPC
;
DHEX4:	;STORE DATA BYTE AND INC DBL
	LXI	H,DBL
	MOV	E,M	;LENGTH TO REG-E
	INR	M	;DBL=DBL+1
	MVI	D,0	;HIGH ORDER ZERO FOR DOUBLE ADD
	LXI	H,DBUFF
	DAD	D	;DBUFF+DBL TO H,L
	POP	PSW	;RESTORE DATA BYTE
	MOV	M,A	;INTO DATA BUFFER
	POP	D
DHRET:	POP	B	;ENVIRONMENT RESTORED
	RET
;
WRC:	;WRITE CHARACTER WITH CHECK SUM IN D
	PUSH	PSW
	RRC
	RRC
	RRC
	RRC
	ANI	0FH
	CALL	HEXC	;OUTPUT HEX CHARACTER
	POP	PSW	;RESTORE BYTE
	PUSH	PSW	;SAVE A VERSION
	ANI	0FH
	CALL	HEXC	;WRITE LOW NIBBLE
	POP	PSW	;RESTORE BYTE
	ADD	D	;COMPUTE CHECKSUM
	MOV	D,A	;SAVE CS
	RET
;
HEXC:	;WRITE CHARACTER
	ADI	90H
	DAA
	ACI	40H
	DAA
	JMP	PNB	;PUT BYTE
;
WHEX:	;WRITE CURRENT HEX BUFFER
	MVI	A,':'	;RECORD HEADER
	CALL	PNB	;PUT BYTE
	LXI	H,DBL	;RECORD LENGTH ADDRESS
	MOV	E,M	;LENGTH TO REG-E
	XRA	A	;ZERO TO REG-A
	MOV	D,A	;CLEAR CHECKSUM
	MOV	M,A	;LENGTH IS ZEROED FOR NEXT WRITE
	LHLD	BPC	;BASE ADDRESS FOR RECORD
	MOV	A,E	;LENGTH TO A
	CALL	WRC	;WRITE HEX VALUE
	MOV	A,H	;HIGH ORDER BASE ADDR
	CALL	WRC	;WRITE HO BYTE
	MOV	A,L	;LOW ORDER BASE ADDR
	CALL	WRC	;WRITE LO BYTE
	XRA	A	;ZERO TO A
	CALL	WRC	;WRITE RECORD TYPE 00
	MOV	A,E	;CHECK FOR LENGTH 0
	ORA	A
	JZ	WHEX1
;
;	NON - ZERO, WRITE DATA BYTES
	LXI	H,DBUFF
WHEX0:	MOV	A,M	;GET BYTE
	INX	H
	CALL	WRC	;WRITE DATA BYTE
	DCR	E	;END OF BUFFER?
	JNZ	WHEX0
;
;	END OF DATA BYTES, WRITE CHECK SUM
WHEX1:	XRA	A
	SUB	D	;COMPUTE CHECKSUM
	CALL	WRC
;
;	SEND CRLF AT END OF RECORD
	MVI	A,CR
	CALL	PNB
	MVI	A,LF
	CALL	PNB
	RET
;
;
;
ENDMOD	EQU	($ AND 0FFE0H)+20H
	END