**************************
*                        *
*  Mr. Prom Programmer   *
*                        *
*    by Lance L|ewis      *
*                        *
**************************
*
*
* System equates
*
INPUT		EQU	0E003H 		;character input (C0DC on pre 3.0 monitors)
OUT		EQU	0E008H 		;video driver (CO98 on pre 3.0 monitors)
*
* Definitions and Constants
*
PROM		EQU	0EC00H 		;prom address
BLANK		EQU	0FFH 		;erased byte of prom
CRLF		EQU	0D0AH 		;carraige return linefeed
LF		EQU	0AH 		;linefeed
CR		EQU	0DH 		;carriage return
MSB		EQU	80H 		;most significant bit
*
ORIG		REQ	'Program to run at?'
		ORG	ORIG 		;assemble here
*
* Here we go
*
		PUSH	H 		;save HL
		PUSH	D 		;save DE
		PUSH	B 		;saev BC
		PUSH	PSW 		;save AF
		LXI	H,0
		DAD	SP 		;HL=SP
		SHLD	STACK 		;store it
		LXI	SP,0FD00H 	;reset stack pointer
*
		CALL	PRINT 		;send message
		DD	CRLF
		DT	'      Vector Graphic'
		DD	CRLF 		;print CRLF
		DT	'  Prom Programming System'
		DD	CRLF
*
		DB	LF 		;down a line
		DT	'  Program prom'
		DD	CRLF+MSB 	;end of message
*
STARTADRS	CALL	PRINT 		;send message
		DTH	'  Starting from :'
		CALL	ADRS 		;get start address
		JC	STARTADRS 	;if invalid try again
		CALL	PRINT
		DD	CRLF+MSB 	;print CRLF
		CALL	RANGERR 	;check for error
		JC	STARTADRS 	;try again if error
		CALL	MOD 		;check boundery
		JC	STARTADRS 	;no good
		XCHG			;DE=start adrs
*
ENDADRS		CALL	PRINT 		;send message
		DTH	'  Terminating at:'
		CALL	ADRS 		;get end address
		JC	ENDADRS 	;if invalid try again
		CALL	PRINT
		DD	CRLF+MSB 	;carraigre return linefeed
		CALL	RANGERR 	;check for range error
		JC	ENDADRS 	;try again if error
		INX	H 		;compensate
		CALL	MOD 		;check boundery
		JC	ENDADRS 	;no good
		MOV	B,H 		;save end address
		MOV	C,L 		; in register pair BC
*
		MOV	H,D 		;save start address
		MOV	L,E 		; in register pair HL
TFFS		LDAX	D 		;get byte from prom
		CPI	BLANK 		;is it clear
		JNZ	BADPROM 	;print "bad prom"
		INX	D 		;check next location
		CALL	TEST 		;end of area
		JNZ	TFFS 		;more to come
RESTORE		XCHG			;restore registres
*
SOURCEADRS	CALL	PRINT
		DTH	'  Source address:'
		CALL	ADRS 		;get source address
		JC	SOURCEADRS 	;if not valid try again
*
		CALL	PRINT 		;send message
		DD	CRLF
*
		DD	LF 		;format output
		DT	'  Turn on the programming enable switch'
		DD	CRLF 
		DTH	'  Hit return to continue?'
*
STAT		CALL	INPUT 		;check keyboard
		JZ	STAT 		;no character
		CPI	CR 		;is it a return
		JNZ	STAT 		;no try again
*
		CALL	PRINT
		DD	CRLF
		DB	LF
		DT	'  Programming in progress'
		DD	CRLF
		DB	LF+MSB 		;stop sending with linefeed
*
		XRA	A 		;zero 
		STA	PASS 		; pass counter
*
SAVE		PUSH	H 		;save source address
		PUSH	D 		;save it
*
LOOP		MOV	A,M 		;get byte from source
		STAX	D 		;program it to destination
*
		MVI	A,40H
DELAY		DCR	A 		;time up
		JNZ	DELAY 		;keep staling
*
		INX	H
		INX	D 		;advance pointers
		CALL	TEST 		;end of block
		JNZ	LOOP 		;no keep going
*
		LXI	H,PASS 		;point to pass counter
		INR	M 		;256 passes
		PUSH	PSW 		;save Z flag
		PUSH	B 		;save end pointer
*
		CALL	PRINT 		;send message
		DB	CR
		DTH	'  Pass '
		MOV	A,M 		;get pass number
		MVI	C,0 		;clear number of digits
LDIV		MVI	B,-1 		;compensate for increment
DIV		INR	B 		;increment quotient
		SUI	10 		;subtract 10 from dividend
		JNC	DIV 		;can more be subtracted
		ADI	10+'0' 		;adjust remainder 0 to 9 ASCII
		PUSH	PSW 		;add to list of remainders
		INR	C 		;one more digit
		MOV	A,B 		;prepare for next division
		ORA	A 		;was quotient zero
		JNZ	LDIV 		;more to come
LOUT		POP	PSW 		;get a remainder
		CALL	OUT 		;print it
		DCR	C 		;out of digits
		JNZ	LOUT 		;no then keep printing
*
		POP	B 		;restore end
		POP	PSW 		;restore Z flag
		POP	D 		;restore start address
		POP	H 		;restore HL
		JNZ	SAVE 		;more passes to come
*
VERIFY		LDAX	D 		;get byte from prom
		CMP	M 		;is it the same
		JNZ	VERIFYERR 	;print error
		INX	H
		INX	D 		;advance pointers
		CALL	TEST 		;end of block
		JNZ	VERIFY 		;still more to test
*
		CALL	PRINT
		DB	CR
		DT	'  No errors detected'
		DD	CRLF+MSB
*
END		CALL	PRINT
		DT	'  Turn off the programming enable switch'
		DD	CRLF+MSB
*
		LHLD	STACK 		;retrieve SP
		SPHL			;move it back
		POP	PSW 		;restore registers
		POP	B
		POP	D
		POP	H
		RET			;bye-bye
*
TEST		MOV	A,B 		;get end byte
		CMP	D 		;same as start
		RNZ			;no then return
		MOV	A,C
		CMP	E 		;low half same
		RET			;return with Z flag
*
VERIFYERR	CALL	PRINT
		DB	CR
		DTH	'? verification error at '
		XCHG
		CALL	HEX 		;print hex address
		CALL	PRINT
		DD	CRLF+MSB
		JMP	END
*
RANGERR		MOV	A,H 		;get high address
		CPI	PROM/256 	;valid address
		JC	RANGEMES 	;no print message
		CPI	PROM/256+4 	;valid address
		CMC			;compensate
		RNC			;return with C in question
RANGEMES	CALL	PRINT
		DT	'? out of range'
		DD	CRLF+MSB
		STC			;set error flag
		RET
*
PRINT		XTHL			;save HL get SP
LPRINT		MOV	A,M 		;get character
		CALL	OUT 		;print it
		INX	H 		;advance pointer
		ORA	A 		;is MSB set
		JP	LPRINT 		;keep sending
		XTHL			;restore HL and adjusted SP
		RET
*
ADRS		LXI	H,0 		;zero value
LADRS		CALL	INPUT 		;get character
		JZ	LADRS 		;is it there
		CALL	OUT 		;print it
		CPI	CR 		;was it a return
		RZ			;thats it
		SUI	'0' 		;reduce to hex
		JC	INVAL 		;invalid entry
		CPI	10 		;alpha character
		JC	SAB
		SUI	7 		;alpha bias
		JC	INVAL 		;bad character
		CPI	16 		;number out of range
		JNC	INVAL
SAB		DAD	H 		;multiply address by 16
		DAD	H
		DAD	H
		DAD	H
		ADD	L 		;combine new value
		MOV	L,A
		JMP	LADRS 		;keep going
*
INVAL		CALL	PRINT
		DD	CRLF
		DT	'? invalid response'
		DD	CRLF+MSB
		STC			;set error flag
		RET
*
MOD		MOV	A,L 		;get low byte
		ANI	0FH 		;mask low nibble
		RZ			;if zero fine
		CALL	PRINT
		DT	'? bad boundery address'
		DD	CRLF+MSB
		STC			;set error flag
		RET
*
BADPROM		CALL	PRINT
		DT	'? specified portion of prom is not erased'
		DD	CRLF+MSB
		JMP	RESTORE 	;continue and restore registers
*
HEX		MOV	A,H 		;first the high byte
		CALL	BYTE 		;print hex byte
		MOV	A,L 		;now the low byte
*
BYTE		CALL	NIBBLE 		;print nibble
*
NIBBLE		RRC			;swap nibbles
		RRC
		RRC
		RRC
		PUSH	PSW 		;save A
		ANI	0FH 		;mask high nibble
		ADI	90H 		;super whiz-bang
		DAA			;technique for converting
		ACI	40H 		;binary to ASCII
		DAA			;ala NB
		CALL	OUT 		;print it
		POP	PSW 		;restore A
		RET
*
PASS		EQU	0FC40H
STACK		EQU	0FC3EH