Upload

Digital Research

CPM OPERATING SYSTEMS/CPM 2.X/CPM 2.0/as1io.asm

@@ -0,0 +1,727 @@
+	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
+