; Acorn PROM Programmer Board (200.007) Software
; From Technical Manual Issue 2 Jan-1981
;
; Chris Oddy February 2019
;
; Execute from $2840 (START)
;
; Zeropage Registers
;
bflip	:=	$80
ck		:=	$81
hl		:=	$81
ve		:=	$82
bl		:=	$83
howvec	:=	$84
toblow	:=	$86
temp	:=	$88
regmap	:=	$8A
job		:=	$8B
from	:=	$8C
point	:=	$8E
mask	:=	$8E
tries	:=	$8F
extra	:=	$90
count	:=	$90
curent	:=	$91
number	:=	$92
crc		:=	$93
buff	:=	$0100
;
; Hardware Address's
;
kb		:=	$0E21	; keyboard
blower	:=	$1980	; base address for 8255 PIA
porta	:=	$1980	; 8255 port A
portb	:=	$1981	; 8255 port B
portc	:=	$1982	; 8255 port C
cwr		:=	$1983	; 8255 control register
;
; ASCII
;
CR		:=	$0D		; Carriage Return
ESC		:=	$1B		; ESCape
SPACE	:=	$20		; SPACE
;
; Vectors
;
brkvec	:=	$0202	; BRK Vector
;
; OS Calls
;
OSWRCH	:=	$FFF4	; WRite CHaracter to output channel
OSASCI	:=	$FFE9	; WRite CHaracter to output channel (adds LF if CR)
OSRDCH	:=	$FFE3	; ReaD CHaracter from input channel
OSCRLF	:=	$FFED	; write CRLF to output channel
OSECHO	:=	$FFE6	; reads character from Input channel and ECHOs it to output channel
OSCLI	:=	$FFF7	; call Command Line Interpreter
;
		.org $2800
;
VSTRNG:	pla
		sta		temp
		pla
		sta		temp+1
vstrlp:	ldy		#$00
		inc		temp
		bne		inctpc
		inc		temp+1
inctpc:	lda		(temp),y
		cmp		#$EA
		beq		vstrnx
		jsr		OSASCI
		jmp		vstrlp
vstrnx:	jmp		(temp)

BUFFIN:	ldx		#$00		; Input Buffer Routine
answer:	jsr		OSECHO
		sta		buff,x
		cmp		#$7F		; check for delete
		bne		enterd
buffa:	dex
		bmi		BUFFIN
		bpl		answer
enterd:	cmp		#$0D		; terminated by CR
		bne		notdun
		rts
notdun:	inx
		cpx		#$28		; limit buffer length
		bne		answer
		lda		#$7F
		jsr		OSWRCH
		jmp		buffa

START:	lda		#<START		; Entry Point
		sta		brkvec		; initialise for errors
		lda		#>START
		sta		brkvec+1
		jsr		VSTRNG
		.byte	CR,"Which PROM ?"
		nop
		jsr		BUFFIN		; get reply
		ldy		#$00
find:	ldx		#$00
which:	lda		buff,x		; find entry in table
		cmp		TABLE,y
		bne		next		; not this entry
		inx
		iny
		cpx		#$04		; for all four characters
		bne		which
		ldx		#$07		; good we have found it
found:	lda		TABLE,y		; so put parameters in page zero
		sta		bflip,x
		iny
		dex
		bpl		found
		bmi		what		; and go to next step
next:	inx
		iny
		cpx		#$0C
		bne		next
		cpy		#$44		; check for end of table
		bcc		find
		lda		buff
		cmp		#'*'		; check for OS command
		bne		START		; unknown command
		lda		#SPACE
		sta		buff
		jsr		OSCLI		; and hand to OS
		jmp		START

what:	jsr		VSTRNG
		.byte	"BLOW : READ : VERIFY : CLEAR",CR
		.byte	"Enter initial letter ?"
		nop
		jsr		BUFFIN		; get reply
		lda		buff
		sta		job
		cmp		#'C'
		beq		nonum
where:	jsr		VSTRNG		; get number of needed
		.byte	"From ?"
		nop
		jsr		BUFFIN		; get reply
		ldx		#$00		; and translate from ASCII
		stx		from
		stx		from+1
		dex
numlop:	inx
		lda		buff,x
		cmp		#'0'
		bcc		nonum
		cmp		#$3A
		bcc		numcon
		sbc		#$07
		bcc		nonum
		cmp		#$40
		bcs		nonum
numcon:	and		#$0F
		asl		a
		asl		a
		asl		a
		asl		a
		ldy		#$04
numcin:	asl		a
		rol		from
		rol		from+1
		dey
		bne		numcin
		beq		numlop
nonum:	jmp		(toblow)

							; PROM/EPROM Programming Data
TABLE:	.byte	"571H"
		.byte	>FUSE		; what to blow
		.byte	<FUSE
		.byte	$00,$00,$00,$00,$00,$00	; blank entries for 74LS571

		.byte	"571L"
		.byte	>FUSE
		.byte	<FUSE
		.byte	$00,$00,$00,$00,$FF,$00

		.byte	"2716"
		.byte	>EPROM		; what to blow
		.byte	<EPROM
		.byte	>DOTWO		; how to blow it - no of Kbytes
		.byte	<DOTWO
		.byte	$90			; control word for BLOW
		.byte	$80			; control word for VERIFY
		.byte	$00			; control word for READ
		.byte	$07			; control word for program pulse
		
		.byte	"2758"
		.byte	>EPROM		; what to blow
		.byte	<EPROM
		.byte	>CORE		; how to blow it - no of Kbytes
		.byte	<CORE
		.byte	$90			; control word for BLOW
		.byte	$80			; control word for VERIFY
		.byte	$00			; control word for READ
		.byte	$07			; control word for program pulse		
		
		.byte	"2532"
		.byte	>EPROM		; what to blow
		.byte	<EPROM
		.byte	>DOFOUR		; how to blow it - no of Kbytes
		.byte	<DOFOUR
		.byte	$90			; control word for BLOW
		.byte	$00			; control word for VERIFY
		.byte	$00			; control word for READ
		.byte	$08			; control word for program pulse
		
		.byte	"2516"
		.byte	>EPROM		; what to blow
		.byte	<EPROM
		.byte	>DOTWO		; how to blow it - no of Kbytes
		.byte	<DOTWO
		.byte	$90			; control word for BLOW
		.byte	$80			; control word for VERIFY
		.byte	$00			; control word for READ
		.byte	$07			; control word for program pulse		
		
EPROM:	lda		job
		cmp		#'B'
		bne		anotbl
		jsr		ACHECK		; blow PROM so check for blank
		jsr		BLOWQR		; and query for continue
							; **** Blow PROM ****
		lda		bl			; load control word
		ldy		#$00		; and control flags
		jsr		STARTR		; initialise pointers
		jsr		HOW			; and do it
							; Now Verify Blowing
							; **** Verify PROM ****
							; as for check PROM
anotc:	lda		ve			; load control word
		ldy		#$80		; and control flags
		jsr 	STARTR		; initialise pointers
		jsr		HOW			; and do it
		jsr		crcout		; print out CRC check
		jmp		repeat		; and exit
							; **** Read PROM ****
anotbl:	cmp		#'R'
		bne		anotrd
		lda		ck			; load control word
		ldy		#$40		; and control flags
		jsr		STARTR		; initialise pointers
		jsr		HOW			; and do it
		jsr		crcout		; print out CRC check
		jmp		repeat		; and exit
							; **** Check For Blank ****
anotrd:	cmp		#'C'
		bne		anotc
		jsr		ACHECK		; do check for blank
		jmp		repeat		; and exit
ACHECK:	lda		ck			; load control word
		ldy		#$C0		; and control flags
		jsr		STARTR		; initialise pointers

HOW:	jmp		(howvec)	; jump depends on size of PROM

STARTR:	ldx		from		; this initialises pointers
		stx		point
		ldx		from+1
		stx		point+1
		sty		curent
		ldx		#$00
		stx		number
		stx		crc
		stx		crc+1
		rts

DOFOUR:	jsr		DOTWO		; 4K bytes to blow
		eor		#$0C

DOTWO:	jsr		CORE		; 2K bytes to blow

DOONE:	ora		#$04
CORE:	sta		regmap
		pha
		lda		#$80
		ldy		curent		; now check control flags
		beq		wcwr		; blow so all output
		ora		#$10		; set data to input
wcwr:	sta		cwr
		lda		#$00
		sta		count
		pha					; clear error flag
		tay
corelp:	sty		portb
		lda		kb			; check for escape key
		cmp		#ESC
		bne		noesc
		jmp		repeat
noesc:	lda		count		; set upper address limit
		ora		regmap
		sta		portc
		lda		#$FF
		bit		curent		; check what to do
		bne		read

BLOW:	lda		(point),y	; blowing so load data
		sta		porta		; send to port
		jsr		FLIPBT		; and apply program pulse
goon:	iny					; next location
		bne		corelp
		inc		point+1		; adjust pointers
		inc		count
		lda		curent
		bne		notell
		lda		number		;print out number if blowing
		jsr		DIGIT
		inc		number
notell:	lda		count
		cmp		#$04
		bne		corelp		; do 4 quarter K bytes
		bit		curent
		bmi		notblw		; if blowing no testing is done
		lda		#$90
		sta		cwr			; switch things off
		pla					; ignore flags
		pla					; reload regmap
		rts
read:	bmi		VERIFY		; still checking what to do
		lda		porta		; reading so get data
		sta		(point),y	; store it
		jsr		PUTCRC		; increment CRC
		jmp		goon		; and continue

PUTCRC:	ldx		#$08		; this calculates CRC
		pha
crclp:	lsr		A
		rol		crc
		rol		crc+1
		bcc		noc
		pha
		lda		crc
		eor		#$2D
		sta		crc
		pla
noc:	dex
		bne		crclp
		pla
		rts					; end of CRC calculation

VERIFY:	bvs		check		; check what we are doing
		lda		porta		; verify so get data
		jsr		PUTCRC		; update CRC
		cmp		(point),y	; and verify data
		beq		goon		; continue if OK
flag:	pla					; otherwise flag error
		ora		#$FF
		pha
		bne		goon		; and then continue
check:	lda		porta		; load data
		cmp		#$FF		; check for blank location
		beq		goon		; continue if blank
		bne		flag		; otherwise flag not blank
notblw:	bvs		notver		; not check, see what to print
		pla					; verifying so get flag
failq:	bne		nogood		; and print OK/Fail
		jsr		VSTRNG
		.byte	CR,"OK"
		nop
		pla					; reload regmap
		rts
nogood:	jsr		VSTRNG		
		.byte	CR,"FAIL"
		nop
		pla					; reload regmap
		rts
notver:	pla					; check for blank so get flag
fchkx:	beq		blank		; and print Blank/Not blank
		jsr		VSTRNG
		.byte	"Not "
		nop
blank:	jsr		VSTRNG
		.byte	"Blank",CR
		nop
		pla					; reload regmap
		rts

FLIPBT:	lda		bflip		; programming pulse
		sta		cwr			; flip bit defined in BFLIP
		ldx		#$19		; now wait 50mS
dlylp:	dec		temp
		bne		dlylp
		dex
		bne		dlylp
		eor		#$01
		sta		cwr			; return bit to previous level
		rts

							; **** FUSE ****
FUSE:	lda		job
		cmp		#'B'
		bne		fnotbl
							; **** Blow 74LS571 ****
		jsr		FCHECK		; check for blank
		jsr		BLOWQR		; query for continue
		jsr		FPROG		; blow PROM, fall into verify
							; **** Verify 74LS571 ****
fnotc:	jsr		FVERIF		; Verify PROM
		jmp		repeat		; and exit
fnotbl:	cmp		#'R'		; check what to do
		bne		fnotrd
							; **** Read 74LS571 ****
		jsr		FREAD
		jmp		repeat		; and exit
fnotrd:	cmp		#'C'
		bne		fnotc
							; **** Check For Clear 74LS571 ****
		jsr		FCHECK
		jmp		repeat

FCHECK:	ldx		#$01
		ldy		#$00
		sty		number		; clear flag location
		lda		#$90		; program port for reading
		sta		cwr
		lda		#$30		; value of port C lower half
halfk:	sta		portc
quark:	sty		portb		; set up address
		lda		porta		; load data
		and		#$0F		; mask relevant bits
		ora		number
		sta 	number		; and save in flag location
		iny
		bne		quark		; for 256 bytes
		lda		#$31		; value of port c upper half
		dex
		beq		halfk		; and do other half
		lda		number		; put flag in stack
		pha
		jmp		fchkx		; and output report

FPROG:	ldx		#$00
		ldy		#$00
halfb:	lda		#$08		; start on most significant bit
		sta		mask
forbit:	lda		#$80		; no of tries at blow bad locations
		sta 	tries
		lda		#$10		; no of pulses after blow location
		sta		extra
		jsr		FCORE		; go and blow a bit
		lsr		mask		; step to next bit in byte
		bcc		forbit		; for four bits
		iny
		bne		halfb		; for 256 bytes
		txa
		bne		fprogx
		inc		from+1		; increment pointer
		inx
		bne		halfb		; and do other half of PROM
fprogx:	dec		from+1		; reset pointer
		rts					; and exit

FCORE:	lda		#$80		; set up port for programming
		sta		cwr
		sty		portb		; set up address
		txa
		eor		#$18		; add control bits
		sta		portc
		lda		(from),y	; load data to blow
		bit		hl			; check blowing upper or lower half
		bmi		low
		ror		a			; shift upper half down
		ror		a
		ror		a
		ror		a
low:	and		mask		; mask of current bit
		beq		fcorx		; nothing to program so exit
		sta		porta		; set bit to program
		lda		#$0D		; flip power on
		sta		cwr
		nop					; delay for program pulse width
		nop
		nop
		nop
		nop
		lda		#$06		; flip enable on
		sta		cwr
		nop					; delay for program pulse width
		nop
		lda		#$07		; enable off
		sta		cwr
		lda		#$0C
		sta		cwr			; power off
		lda		#$90		; set port a input to verify bit
		sta		cwr
		sty		portb		; set address again
		txa					; get upper address bit
		ora		#$30		; set other control bits
		sta		portc
		lda		porta		; get bit
		and		mask
		bne		blown		; good the bit blown
		dec		tries		; try to blow again
		bne		FCORE
		tya
		pha
		jsr		VSTRNG		; print a. for each failed bit
		.byte	"."
		nop
		pla
		tay
		rts					; and give up
blown:	dec		extra		; 16 extra blows for luck
		bne		FCORE
fcorx:	rts					; and return

FVERIF:	ldx		#$01
		ldy		#$00
		sty		number		; clear flag location
		lda		#$90		; value of control word for read
		sta		cwr
		lda		#$30		; value of port c for lower half
allve:	sta		portc
halfc:	sty		portb		; setup address
		lda		(from),y	; get data from memory
		bit		hl			; check for upper or lower half
		bmi		lowc
		lsr		a			; shift upper half down
		lsr		a
		lsr		a
		lsr		a
lowc:	eor		porta		; match against data in PROM
		and		#$0f		; mask bits of interest
		ora		number		; and store in flag location
		sta		number
noflg:	iny					; do for 256 bytes
		bne		halfc
		dex
		bne		dun
		inc		from+1		; increment pointer
		lda		#$31		; value of port c for upper half
		bne		allve		; and do upper half
dun:	dec		from+1		; reset pointer
		lda		number		; put flag on stack
		pha
		jmp		failq		; and print out result

FREAD:	ldy		#$00
		ldx		#$01
		lda		#$90		; value of control word for read
		sta		cwr
		lda		#$30		; value of port c for lower half
halfrd:	sta		portc
fredlp:	sty		portb		; set up address
		lda		(from),y	; get data
		bit		hl			; check for upper or lower half
		bmi		lowrf
		and		#$0F		; upper mask and save lower half
		sta		number		; of current data
		lda		porta		; load half byte from PROM
		asl		a			; shift it up
		asl		a
		asl		a
		asl		a
		jmp		posit		; now assemble byte
lowrf:	and		#$F0		; save up half of current data
		sta		number
		lda		porta		; load half byte from PROM
		and		#$0F		; mask of bits
posit:	ora		number		; assemble new data
		sta		(from),y	; and save it
		iny
		bne		fredlp		; do for 256 bytes
		dex
		bne		dunfrd
		inc		from+1		; increment pointer
		lda		#$31		; value of port c for upper half
		bne		halfrd		; and do upper half
dunfrd:	dec		from+1		; restore pointer
		rts					; and return

BLOWQR:	jsr		VSTRNG		; send prompt
		.byte	"Blow ?"
		nop
		jsr		OSECHO		; get answer
		cmp		#'Y'
		bne		repeat		; not yes so escape
		jsr		VSTRNG
		.byte	CR,"Blowing",CR
		nop
		rts
repeat:	ldx		#$FF		; reset stack
		txs
		jsr		VSTRNG
		.byte	CR,"Repeat ?"
		nop
		lda		#$98		; release all control lines
		sta		cwr
		jsr		OSECHO		; get reply
		cmp		#'Y'
		bne		end
		jsr		OSCRLF		; new line
		jmp		(toblow)	; and do it again
end:	jmp		START
crcout:	jsr		VSTRNG		; print out CRC header
		.byte	CR,"CRC: "
		nop
		lda		crc+1		; first byte
		jsr		BYTOUT
		lda		crc			; and second byte

BYTOUT:	pha					; print out byte in hex
		lsr		a
		lsr		a
		lsr		a
		lsr		a
		jsr		DIGIT
		pla

DIGIT:	and		#$0F		; print out half byte
		cmp		#$0A
		bcc		itdigt
		adc		#$06
itdigt:	adc		#$30
		jmp		OSWRCH