ca65 V2.17 - Git 582aa41
Main file   : PROMER.ca65
Current file: PROMER.ca65

000000r 1               ; Acorn PROM Programmer Board (200.007) Software
000000r 1               ; From Technical Manual Issue 2 Jan-1981
000000r 1               ;
000000r 1               ; Chris Oddy February 2019
000000r 1               ;
000000r 1               ; Execute from $2840 (START)
000000r 1               ;
000000r 1               ; Zeropage Registers
000000r 1               ;
000000r 1               bflip	:=	$80
000000r 1               ck		:=	$81
000000r 1               hl		:=	$81
000000r 1               ve		:=	$82
000000r 1               bl		:=	$83
000000r 1               howvec	:=	$84
000000r 1               toblow	:=	$86
000000r 1               temp	:=	$88
000000r 1               regmap	:=	$8A
000000r 1               job		:=	$8B
000000r 1               from	:=	$8C
000000r 1               point	:=	$8E
000000r 1               mask	:=	$8E
000000r 1               tries	:=	$8F
000000r 1               extra	:=	$90
000000r 1               count	:=	$90
000000r 1               curent	:=	$91
000000r 1               number	:=	$92
000000r 1               crc		:=	$93
000000r 1               buff	:=	$0100
000000r 1               ;
000000r 1               ; Hardware Address's
000000r 1               ;
000000r 1               kb		:=	$0E21	; keyboard
000000r 1               blower	:=	$1980	; base address for 8255 PIA
000000r 1               porta	:=	$1980	; 8255 port A
000000r 1               portb	:=	$1981	; 8255 port B
000000r 1               portc	:=	$1982	; 8255 port C
000000r 1               cwr		:=	$1983	; 8255 control register
000000r 1               ;
000000r 1               ; ASCII
000000r 1               ;
000000r 1               CR		:=	$0D		; Carriage Return
000000r 1               ESC		:=	$1B		; ESCape
000000r 1               SPACE	:=	$20		; SPACE
000000r 1               ;
000000r 1               ; Vectors
000000r 1               ;
000000r 1               brkvec	:=	$0202	; BRK Vector
000000r 1               ;
000000r 1               ; OS Calls
000000r 1               ;
000000r 1               OSWRCH	:=	$FFF4	; WRite CHaracter to output channel
000000r 1               OSASCI	:=	$FFE9	; WRite CHaracter to output channel (adds LF if CR)
000000r 1               OSRDCH	:=	$FFE3	; ReaD CHaracter from input channel
000000r 1               OSCRLF	:=	$FFED	; write CRLF to output channel
000000r 1               OSECHO	:=	$FFE6	; reads character from Input channel and ECHOs it to output channel
000000r 1               OSCLI	:=	$FFF7	; call Command Line Interpreter
000000r 1               ;
000000r 1               		.org $2800
002800  1               ;
002800  1  68           VSTRNG:	pla
002801  1  85 88        		sta		temp
002803  1  68           		pla
002804  1  85 89        		sta		temp+1
002806  1  A0 00        vstrlp:	ldy		#$00
002808  1  E6 88        		inc		temp
00280A  1  D0 02        		bne		inctpc
00280C  1  E6 89        		inc		temp+1
00280E  1  B1 88        inctpc:	lda		(temp),y
002810  1  C9 EA        		cmp		#$EA
002812  1  F0 06        		beq		vstrnx
002814  1  20 E9 FF     		jsr		OSASCI
002817  1  4C 06 28     		jmp		vstrlp
00281A  1  6C 88 00     vstrnx:	jmp		(temp)
00281D  1               
00281D  1  A2 00        BUFFIN:	ldx		#$00		; Input Buffer Routine
00281F  1  20 E6 FF     answer:	jsr		OSECHO
002822  1  9D 00 01     		sta		buff,x
002825  1  C9 7F        		cmp		#$7F		; check for delete
002827  1  D0 05        		bne		enterd
002829  1  CA           buffa:	dex
00282A  1  30 F1        		bmi		BUFFIN
00282C  1  10 F1        		bpl		answer
00282E  1  C9 0D        enterd:	cmp		#$0D		; terminated by CR
002830  1  D0 01        		bne		notdun
002832  1  60           		rts
002833  1  E8           notdun:	inx
002834  1  E0 28        		cpx		#$28		; limit buffer length
002836  1  D0 E7        		bne		answer
002838  1  A9 7F        		lda		#$7F
00283A  1  20 F4 FF     		jsr		OSWRCH
00283D  1  4C 29 28     		jmp		buffa
002840  1               
002840  1  A9 40        START:	lda		#<START		; Entry Point
002842  1  8D 02 02     		sta		brkvec		; initialise for errors
002845  1  A9 28        		lda		#>START
002847  1  8D 03 02     		sta		brkvec+1
00284A  1  20 00 28     		jsr		VSTRNG
00284D  1  0D 57 68 69  		.byte	CR,"Which PROM ?"
002851  1  63 68 20 50  
002855  1  52 4F 4D 20  
00285A  1  EA           		nop
00285B  1  20 1D 28     		jsr		BUFFIN		; get reply
00285E  1  A0 00        		ldy		#$00
002860  1  A2 00        find:	ldx		#$00
002862  1  BD 00 01     which:	lda		buff,x		; find entry in table
002865  1  D9 19 29     		cmp		TABLE,y
002868  1  D0 13        		bne		next		; not this entry
00286A  1  E8           		inx
00286B  1  C8           		iny
00286C  1  E0 04        		cpx		#$04		; for all four characters
00286E  1  D0 F2        		bne		which
002870  1  A2 07        		ldx		#$07		; good we have found it
002872  1  B9 19 29     found:	lda		TABLE,y		; so put parameters in page zero
002875  1  95 80        		sta		bflip,x
002877  1  C8           		iny
002878  1  CA           		dex
002879  1  10 F7        		bpl		found
00287B  1  30 1C        		bmi		what		; and go to next step
00287D  1  E8           next:	inx
00287E  1  C8           		iny
00287F  1  E0 0C        		cpx		#$0C
002881  1  D0 FA        		bne		next
002883  1  C0 44        		cpy		#$44		; check for end of table
002885  1  90 D9        		bcc		find
002887  1  AD 00 01     		lda		buff
00288A  1  C9 2A        		cmp		#'*'		; check for OS command
00288C  1  D0 B2        		bne		START		; unknown command
00288E  1  A9 20        		lda		#SPACE
002890  1  8D 00 01     		sta		buff
002893  1  20 F7 FF     		jsr		OSCLI		; and hand to OS
002896  1  4C 40 28     		jmp		START
002899  1               
002899  1  20 00 28     what:	jsr		VSTRNG
00289C  1  42 4C 4F 57  		.byte	"BLOW : READ : VERIFY : CLEAR",CR
0028A0  1  20 3A 20 52  
0028A4  1  45 41 44 20  
0028B9  1  45 6E 74 65  		.byte	"Enter initial letter ?"
0028BD  1  72 20 69 6E  
0028C1  1  69 74 69 61  
0028CF  1  EA           		nop
0028D0  1  20 1D 28     		jsr		BUFFIN		; get reply
0028D3  1  AD 00 01     		lda		buff
0028D6  1  85 8B        		sta		job
0028D8  1  C9 43        		cmp		#'C'
0028DA  1  F0 3A        		beq		nonum
0028DC  1  20 00 28     where:	jsr		VSTRNG		; get number of needed
0028DF  1  46 72 6F 6D  		.byte	"From ?"
0028E3  1  20 3F        
0028E5  1  EA           		nop
0028E6  1  20 1D 28     		jsr		BUFFIN		; get reply
0028E9  1  A2 00        		ldx		#$00		; and translate from ASCII
0028EB  1  86 8C        		stx		from
0028ED  1  86 8D        		stx		from+1
0028EF  1  CA           		dex
0028F0  1  E8           numlop:	inx
0028F1  1  BD 00 01     		lda		buff,x
0028F4  1  C9 30        		cmp		#'0'
0028F6  1  90 1E        		bcc		nonum
0028F8  1  C9 3A        		cmp		#$3A
0028FA  1  90 08        		bcc		numcon
0028FC  1  E9 07        		sbc		#$07
0028FE  1  90 16        		bcc		nonum
002900  1  C9 40        		cmp		#$40
002902  1  B0 12        		bcs		nonum
002904  1  29 0F        numcon:	and		#$0F
002906  1  0A           		asl		a
002907  1  0A           		asl		a
002908  1  0A           		asl		a
002909  1  0A           		asl		a
00290A  1  A0 04        		ldy		#$04
00290C  1  0A           numcin:	asl		a
00290D  1  26 8C        		rol		from
00290F  1  26 8D        		rol		from+1
002911  1  88           		dey
002912  1  D0 F8        		bne		numcin
002914  1  F0 DA        		beq		numlop
002916  1  6C 86 00     nonum:	jmp		(toblow)
002919  1               
002919  1               							; PROM/EPROM Programming Data
002919  1  35 37 31 48  TABLE:	.byte	"571H"
00291D  1  2A           		.byte	>FUSE		; what to blow
00291E  1  A9           		.byte	<FUSE
00291F  1  00 00 00 00  		.byte	$00,$00,$00,$00,$00,$00	; blank entries for 74LS571
002923  1  00 00        
002925  1               
002925  1  35 37 31 4C  		.byte	"571L"
002929  1  2A           		.byte	>FUSE
00292A  1  A9           		.byte	<FUSE
00292B  1  00 00 00 00  		.byte	$00,$00,$00,$00,$FF,$00
00292F  1  FF 00        
002931  1               
002931  1  32 37 31 36  		.byte	"2716"
002935  1  29           		.byte	>EPROM		; what to blow
002936  1  61           		.byte	<EPROM
002937  1  29           		.byte	>DOTWO		; how to blow it - no of Kbytes
002938  1  C7           		.byte	<DOTWO
002939  1  90           		.byte	$90			; control word for BLOW
00293A  1  80           		.byte	$80			; control word for VERIFY
00293B  1  00           		.byte	$00			; control word for READ
00293C  1  07           		.byte	$07			; control word for program pulse
00293D  1               
00293D  1  32 37 35 38  		.byte	"2758"
002941  1  29           		.byte	>EPROM		; what to blow
002942  1  61           		.byte	<EPROM
002943  1  29           		.byte	>CORE		; how to blow it - no of Kbytes
002944  1  CC           		.byte	<CORE
002945  1  90           		.byte	$90			; control word for BLOW
002946  1  80           		.byte	$80			; control word for VERIFY
002947  1  00           		.byte	$00			; control word for READ
002948  1  07           		.byte	$07			; control word for program pulse
002949  1               
002949  1  32 35 33 32  		.byte	"2532"
00294D  1  29           		.byte	>EPROM		; what to blow
00294E  1  61           		.byte	<EPROM
00294F  1  29           		.byte	>DOFOUR		; how to blow it - no of Kbytes
002950  1  C2           		.byte	<DOFOUR
002951  1  90           		.byte	$90			; control word for BLOW
002952  1  00           		.byte	$00			; control word for VERIFY
002953  1  00           		.byte	$00			; control word for READ
002954  1  08           		.byte	$08			; control word for program pulse
002955  1               
002955  1  32 35 31 36  		.byte	"2516"
002959  1  29           		.byte	>EPROM		; what to blow
00295A  1  61           		.byte	<EPROM
00295B  1  29           		.byte	>DOTWO		; how to blow it - no of Kbytes
00295C  1  C7           		.byte	<DOTWO
00295D  1  90           		.byte	$90			; control word for BLOW
00295E  1  80           		.byte	$80			; control word for VERIFY
00295F  1  00           		.byte	$00			; control word for READ
002960  1  07           		.byte	$07			; control word for program pulse
002961  1               
002961  1  A5 8B        EPROM:	lda		job
002963  1  C9 42        		cmp		#'B'
002965  1  D0 20        		bne		anotbl
002967  1  20 A5 29     		jsr		ACHECK		; blow PROM so check for blank
00296A  1  20 FE 2B     		jsr		BLOWQR		; and query for continue
00296D  1               							; **** Blow PROM ****
00296D  1  A5 83        		lda		bl			; load control word
00296F  1  A0 00        		ldy		#$00		; and control flags
002971  1  20 AF 29     		jsr		STARTR		; initialise pointers
002974  1  20 AC 29     		jsr		HOW			; and do it
002977  1               							; Now Verify Blowing
002977  1               							; **** Verify PROM ****
002977  1               							; as for check PROM
002977  1  A5 82        anotc:	lda		ve			; load control word
002979  1  A0 80        		ldy		#$80		; and control flags
00297B  1  20 AF 29     		jsr 	STARTR		; initialise pointers
00297E  1  20 AC 29     		jsr		HOW			; and do it
002981  1  20 42 2C     		jsr		crcout		; print out CRC check
002984  1  4C 1D 2C     		jmp		repeat		; and exit
002987  1               							; **** Read PROM ****
002987  1  C9 52        anotbl:	cmp		#'R'
002989  1  D0 10        		bne		anotrd
00298B  1  A5 81        		lda		ck			; load control word
00298D  1  A0 40        		ldy		#$40		; and control flags
00298F  1  20 AF 29     		jsr		STARTR		; initialise pointers
002992  1  20 AC 29     		jsr		HOW			; and do it
002995  1  20 42 2C     		jsr		crcout		; print out CRC check
002998  1  4C 1D 2C     		jmp		repeat		; and exit
00299B  1               							; **** Check For Blank ****
00299B  1  C9 43        anotrd:	cmp		#'C'
00299D  1  D0 D8        		bne		anotc
00299F  1  20 A5 29     		jsr		ACHECK		; do check for blank
0029A2  1  4C 1D 2C     		jmp		repeat		; and exit
0029A5  1  A5 81        ACHECK:	lda		ck			; load control word
0029A7  1  A0 C0        		ldy		#$C0		; and control flags
0029A9  1  20 AF 29     		jsr		STARTR		; initialise pointers
0029AC  1               
0029AC  1  6C 84 00     HOW:	jmp		(howvec)	; jump depends on size of PROM
0029AF  1               
0029AF  1  A6 8C        STARTR:	ldx		from		; this initialises pointers
0029B1  1  86 8E        		stx		point
0029B3  1  A6 8D        		ldx		from+1
0029B5  1  86 8F        		stx		point+1
0029B7  1  84 91        		sty		curent
0029B9  1  A2 00        		ldx		#$00
0029BB  1  86 92        		stx		number
0029BD  1  86 93        		stx		crc
0029BF  1  86 94        		stx		crc+1
0029C1  1  60           		rts
0029C2  1               
0029C2  1  20 C7 29     DOFOUR:	jsr		DOTWO		; 4K bytes to blow
0029C5  1  49 0C        		eor		#$0C
0029C7  1               
0029C7  1  20 CC 29     DOTWO:	jsr		CORE		; 2K bytes to blow
0029CA  1               
0029CA  1  09 04        DOONE:	ora		#$04
0029CC  1  85 8A        CORE:	sta		regmap
0029CE  1  48           		pha
0029CF  1  A9 80        		lda		#$80
0029D1  1  A4 91        		ldy		curent		; now check control flags
0029D3  1  F0 02        		beq		wcwr		; blow so all output
0029D5  1  09 10        		ora		#$10		; set data to input
0029D7  1  8D 83 19     wcwr:	sta		cwr
0029DA  1  A9 00        		lda		#$00
0029DC  1  85 90        		sta		count
0029DE  1  48           		pha					; clear error flag
0029DF  1  A8           		tay
0029E0  1  8C 81 19     corelp:	sty		portb
0029E3  1  AD 21 0E     		lda		kb			; check for escape key
0029E6  1  C9 1B        		cmp		#ESC
0029E8  1  D0 03        		bne		noesc
0029EA  1  4C 1D 2C     		jmp		repeat
0029ED  1  A5 90        noesc:	lda		count		; set upper address limit
0029EF  1  05 8A        		ora		regmap
0029F1  1  8D 82 19     		sta		portc
0029F4  1  A9 FF        		lda		#$FF
0029F6  1  24 91        		bit		curent		; check what to do
0029F8  1  D0 2C        		bne		read
0029FA  1               
0029FA  1  B1 8E        BLOW:	lda		(point),y	; blowing so load data
0029FC  1  8D 80 19     		sta		porta		; send to port
0029FF  1  20 95 2A     		jsr		FLIPBT		; and apply program pulse
002A02  1  C8           goon:	iny					; next location
002A03  1  D0 DB        		bne		corelp
002A05  1  E6 8F        		inc		point+1		; adjust pointers
002A07  1  E6 90        		inc		count
002A09  1  A5 91        		lda		curent
002A0B  1  D0 07        		bne		notell
002A0D  1  A5 92        		lda		number		;print out number if blowing
002A0F  1  20 5C 2C     		jsr		DIGIT
002A12  1  E6 92        		inc		number
002A14  1  A5 90        notell:	lda		count
002A16  1  C9 04        		cmp		#$04
002A18  1  D0 C6        		bne		corelp		; do 4 quarter K bytes
002A1A  1  24 91        		bit		curent
002A1C  1  30 47        		bmi		notblw		; if blowing no testing is done
002A1E  1  A9 90        		lda		#$90
002A20  1  8D 83 19     		sta		cwr			; switch things off
002A23  1  68           		pla					; ignore flags
002A24  1  68           		pla					; reload regmap
002A25  1  60           		rts
002A26  1  30 22        read:	bmi		VERIFY		; still checking what to do
002A28  1  AD 80 19     		lda		porta		; reading so get data
002A2B  1  91 8E        		sta		(point),y	; store it
002A2D  1  20 33 2A     		jsr		PUTCRC		; increment CRC
002A30  1  4C 02 2A     		jmp		goon		; and continue
002A33  1               
002A33  1  A2 08        PUTCRC:	ldx		#$08		; this calculates CRC
002A35  1  48           		pha
002A36  1  4A           crclp:	lsr		A
002A37  1  26 93        		rol		crc
002A39  1  26 94        		rol		crc+1
002A3B  1  90 08        		bcc		noc
002A3D  1  48           		pha
002A3E  1  A5 93        		lda		crc
002A40  1  49 2D        		eor		#$2D
002A42  1  85 93        		sta		crc
002A44  1  68           		pla
002A45  1  CA           noc:	dex
002A46  1  D0 EE        		bne		crclp
002A48  1  68           		pla
002A49  1  60           		rts					; end of CRC calculation
002A4A  1               
002A4A  1  70 10        VERIFY:	bvs		check		; check what we are doing
002A4C  1  AD 80 19     		lda		porta		; verify so get data
002A4F  1  20 33 2A     		jsr		PUTCRC		; update CRC
002A52  1  D1 8E        		cmp		(point),y	; and verify data
002A54  1  F0 AC        		beq		goon		; continue if OK
002A56  1  68           flag:	pla					; otherwise flag error
002A57  1  09 FF        		ora		#$FF
002A59  1  48           		pha
002A5A  1  D0 A6        		bne		goon		; and then continue
002A5C  1  AD 80 19     check:	lda		porta		; load data
002A5F  1  C9 FF        		cmp		#$FF		; check for blank location
002A61  1  F0 9F        		beq		goon		; continue if blank
002A63  1  D0 F1        		bne		flag		; otherwise flag not blank
002A65  1  70 17        notblw:	bvs		notver		; not check, see what to print
002A67  1  68           		pla					; verifying so get flag
002A68  1  D0 09        failq:	bne		nogood		; and print OK/Fail
002A6A  1  20 00 28     		jsr		VSTRNG
002A6D  1  0D 4F 4B     		.byte	CR,"OK"
002A70  1  EA           		nop
002A71  1  68           		pla					; reload regmap
002A72  1  60           		rts
002A73  1  20 00 28     nogood:	jsr		VSTRNG
002A76  1  0D 46 41 49  		.byte	CR,"FAIL"
002A7A  1  4C           
002A7B  1  EA           		nop
002A7C  1  68           		pla					; reload regmap
002A7D  1  60           		rts
002A7E  1  68           notver:	pla					; check for blank so get flag
002A7F  1  F0 08        fchkx:	beq		blank		; and print Blank/Not blank
002A81  1  20 00 28     		jsr		VSTRNG
002A84  1  4E 6F 74 20  		.byte	"Not "
002A88  1  EA           		nop
002A89  1  20 00 28     blank:	jsr		VSTRNG
002A8C  1  42 6C 61 6E  		.byte	"Blank",CR
002A90  1  6B 0D        
002A92  1  EA           		nop
002A93  1  68           		pla					; reload regmap
002A94  1  60           		rts
002A95  1               
002A95  1  A5 80        FLIPBT:	lda		bflip		; programming pulse
002A97  1  8D 83 19     		sta		cwr			; flip bit defined in BFLIP
002A9A  1  A2 19        		ldx		#$19		; now wait 50mS
002A9C  1  C6 88        dlylp:	dec		temp
002A9E  1  D0 FC        		bne		dlylp
002AA0  1  CA           		dex
002AA1  1  D0 F9        		bne		dlylp
002AA3  1  49 01        		eor		#$01
002AA5  1  8D 83 19     		sta		cwr			; return bit to previous level
002AA8  1  60           		rts
002AA9  1               
002AA9  1               							; **** FUSE ****
002AA9  1  A5 8B        FUSE:	lda		job
002AAB  1  C9 42        		cmp		#'B'
002AAD  1  D0 0F        		bne		fnotbl
002AAF  1               							; **** Blow 74LS571 ****
002AAF  1  20 D2 2A     		jsr		FCHECK		; check for blank
002AB2  1  20 FE 2B     		jsr		BLOWQR		; query for continue
002AB5  1  20 FC 2A     		jsr		FPROG		; blow PROM, fall into verify
002AB8  1               							; **** Verify 74LS571 ****
002AB8  1  20 83 2B     fnotc:	jsr		FVERIF		; Verify PROM
002ABB  1  4C 1D 2C     		jmp		repeat		; and exit
002ABE  1  C9 52        fnotbl:	cmp		#'R'		; check what to do
002AC0  1  D0 06        		bne		fnotrd
002AC2  1               							; **** Read 74LS571 ****
002AC2  1  20 BD 2B     		jsr		FREAD
002AC5  1  4C 1D 2C     		jmp		repeat		; and exit
002AC8  1  C9 43        fnotrd:	cmp		#'C'
002ACA  1  D0 EC        		bne		fnotc
002ACC  1               							; **** Check For Clear 74LS571 ****
002ACC  1  20 D2 2A     		jsr		FCHECK
002ACF  1  4C 1D 2C     		jmp		repeat
002AD2  1               
002AD2  1  A2 01        FCHECK:	ldx		#$01
002AD4  1  A0 00        		ldy		#$00
002AD6  1  84 92        		sty		number		; clear flag location
002AD8  1  A9 90        		lda		#$90		; program port for reading
002ADA  1  8D 83 19     		sta		cwr
002ADD  1  A9 30        		lda		#$30		; value of port C lower half
002ADF  1  8D 82 19     halfk:	sta		portc
002AE2  1  8C 81 19     quark:	sty		portb		; set up address
002AE5  1  AD 80 19     		lda		porta		; load data
002AE8  1  29 0F        		and		#$0F		; mask relevant bits
002AEA  1  05 92        		ora		number
002AEC  1  85 92        		sta 	number		; and save in flag location
002AEE  1  C8           		iny
002AEF  1  D0 F1        		bne		quark		; for 256 bytes
002AF1  1  A9 31        		lda		#$31		; value of port c upper half
002AF3  1  CA           		dex
002AF4  1  F0 E9        		beq		halfk		; and do other half
002AF6  1  A5 92        		lda		number		; put flag in stack
002AF8  1  48           		pha
002AF9  1  4C 7F 2A     		jmp		fchkx		; and output report
002AFC  1               
002AFC  1  A2 00        FPROG:	ldx		#$00
002AFE  1  A0 00        		ldy		#$00
002B00  1  A9 08        halfb:	lda		#$08		; start on most significant bit
002B02  1  85 8E        		sta		mask
002B04  1  A9 80        forbit:	lda		#$80		; no of tries at blow bad locations
002B06  1  85 8F        		sta 	tries
002B08  1  A9 10        		lda		#$10		; no of pulses after blow location
002B0A  1  85 90        		sta		extra
002B0C  1  20 21 2B     		jsr		FCORE		; go and blow a bit
002B0F  1  46 8E        		lsr		mask		; step to next bit in byte
002B11  1  90 F1        		bcc		forbit		; for four bits
002B13  1  C8           		iny
002B14  1  D0 EA        		bne		halfb		; for 256 bytes
002B16  1  8A           		txa
002B17  1  D0 05        		bne		fprogx
002B19  1  E6 8D        		inc		from+1		; increment pointer
002B1B  1  E8           		inx
002B1C  1  D0 E2        		bne		halfb		; and do other half of PROM
002B1E  1  C6 8D        fprogx:	dec		from+1		; reset pointer
002B20  1  60           		rts					; and exit
002B21  1               
002B21  1  A9 80        FCORE:	lda		#$80		; set up port for programming
002B23  1  8D 83 19     		sta		cwr
002B26  1  8C 81 19     		sty		portb		; set up address
002B29  1  8A           		txa
002B2A  1  49 18        		eor		#$18		; add control bits
002B2C  1  8D 82 19     		sta		portc
002B2F  1  B1 8C        		lda		(from),y	; load data to blow
002B31  1  24 81        		bit		hl			; check blowing upper or lower half
002B33  1  30 04        		bmi		low
002B35  1  6A           		ror		a			; shift upper half down
002B36  1  6A           		ror		a
002B37  1  6A           		ror		a
002B38  1  6A           		ror		a
002B39  1  25 8E        low:	and		mask		; mask of current bit
002B3B  1  F0 45        		beq		fcorx		; nothing to program so exit
002B3D  1  8D 80 19     		sta		porta		; set bit to program
002B40  1  A9 0D        		lda		#$0D		; flip power on
002B42  1  8D 83 19     		sta		cwr
002B45  1  EA           		nop					; delay for program pulse width
002B46  1  EA           		nop
002B47  1  EA           		nop
002B48  1  EA           		nop
002B49  1  EA           		nop
002B4A  1  A9 06        		lda		#$06		; flip enable on
002B4C  1  8D 83 19     		sta		cwr
002B4F  1  EA           		nop					; delay for program pulse width
002B50  1  EA           		nop
002B51  1  A9 07        		lda		#$07		; enable off
002B53  1  8D 83 19     		sta		cwr
002B56  1  A9 0C        		lda		#$0C
002B58  1  8D 83 19     		sta		cwr			; power off
002B5B  1  A9 90        		lda		#$90		; set port a input to verify bit
002B5D  1  8D 83 19     		sta		cwr
002B60  1  8C 81 19     		sty		portb		; set address again
002B63  1  8A           		txa					; get upper address bit
002B64  1  09 30        		ora		#$30		; set other control bits
002B66  1  8D 82 19     		sta		portc
002B69  1  AD 80 19     		lda		porta		; get bit
002B6C  1  25 8E        		and		mask
002B6E  1  D0 0E        		bne		blown		; good the bit blown
002B70  1  C6 8F        		dec		tries		; try to blow again
002B72  1  D0 AD        		bne		FCORE
002B74  1  98           		tya
002B75  1  48           		pha
002B76  1  20 00 28     		jsr		VSTRNG		; print a. for each failed bit
002B79  1  2E           		.byte	"."
002B7A  1  EA           		nop
002B7B  1  68           		pla
002B7C  1  A8           		tay
002B7D  1  60           		rts					; and give up
002B7E  1  C6 90        blown:	dec		extra		; 16 extra blows for luck
002B80  1  D0 9F        		bne		FCORE
002B82  1  60           fcorx:	rts					; and return
002B83  1               
002B83  1  A2 01        FVERIF:	ldx		#$01
002B85  1  A0 00        		ldy		#$00
002B87  1  84 92        		sty		number		; clear flag location
002B89  1  A9 90        		lda		#$90		; value of control word for read
002B8B  1  8D 83 19     		sta		cwr
002B8E  1  A9 30        		lda		#$30		; value of port c for lower half
002B90  1  8D 82 19     allve:	sta		portc
002B93  1  8C 81 19     halfc:	sty		portb		; setup address
002B96  1  B1 8C        		lda		(from),y	; get data from memory
002B98  1  24 81        		bit		hl			; check for upper or lower half
002B9A  1  30 04        		bmi		lowc
002B9C  1  4A           		lsr		a			; shift upper half down
002B9D  1  4A           		lsr		a
002B9E  1  4A           		lsr		a
002B9F  1  4A           		lsr		a
002BA0  1  4D 80 19     lowc:	eor		porta		; match against data in PROM
002BA3  1  29 0F        		and		#$0f		; mask bits of interest
002BA5  1  05 92        		ora		number		; and store in flag location
002BA7  1  85 92        		sta		number
002BA9  1  C8           noflg:	iny					; do for 256 bytes
002BAA  1  D0 E7        		bne		halfc
002BAC  1  CA           		dex
002BAD  1  D0 06        		bne		dun
002BAF  1  E6 8D        		inc		from+1		; increment pointer
002BB1  1  A9 31        		lda		#$31		; value of port c for upper half
002BB3  1  D0 DB        		bne		allve		; and do upper half
002BB5  1  C6 8D        dun:	dec		from+1		; reset pointer
002BB7  1  A5 92        		lda		number		; put flag on stack
002BB9  1  48           		pha
002BBA  1  4C 68 2A     		jmp		failq		; and print out result
002BBD  1               
002BBD  1  A0 00        FREAD:	ldy		#$00
002BBF  1  A2 01        		ldx		#$01
002BC1  1  A9 90        		lda		#$90		; value of control word for read
002BC3  1  8D 83 19     		sta		cwr
002BC6  1  A9 30        		lda		#$30		; value of port c for lower half
002BC8  1  8D 82 19     halfrd:	sta		portc
002BCB  1  8C 81 19     fredlp:	sty		portb		; set up address
002BCE  1  B1 8C        		lda		(from),y	; get data
002BD0  1  24 81        		bit		hl			; check for upper or lower half
002BD2  1  30 0E        		bmi		lowrf
002BD4  1  29 0F        		and		#$0F		; upper mask and save lower half
002BD6  1  85 92        		sta		number		; of current data
002BD8  1  AD 80 19     		lda		porta		; load half byte from PROM
002BDB  1  0A           		asl		a			; shift it up
002BDC  1  0A           		asl		a
002BDD  1  0A           		asl		a
002BDE  1  0A           		asl		a
002BDF  1  4C EB 2B     		jmp		posit		; now assemble byte
002BE2  1  29 F0        lowrf:	and		#$F0		; save up half of current data
002BE4  1  85 92        		sta		number
002BE6  1  AD 80 19     		lda		porta		; load half byte from PROM
002BE9  1  29 0F        		and		#$0F		; mask of bits
002BEB  1  05 92        posit:	ora		number		; assemble new data
002BED  1  91 8C        		sta		(from),y	; and save it
002BEF  1  C8           		iny
002BF0  1  D0 D9        		bne		fredlp		; do for 256 bytes
002BF2  1  CA           		dex
002BF3  1  D0 06        		bne		dunfrd
002BF5  1  E6 8D        		inc		from+1		; increment pointer
002BF7  1  A9 31        		lda		#$31		; value of port c for upper half
002BF9  1  D0 CD        		bne		halfrd		; and do upper half
002BFB  1  C6 8D        dunfrd:	dec		from+1		; restore pointer
002BFD  1  60           		rts					; and return
002BFE  1               
002BFE  1  20 00 28     BLOWQR:	jsr		VSTRNG		; send prompt
002C01  1  42 6C 6F 77  		.byte	"Blow ?"
002C05  1  20 3F        
002C07  1  EA           		nop
002C08  1  20 E6 FF     		jsr		OSECHO		; get answer
002C0B  1  C9 59        		cmp		#'Y'
002C0D  1  D0 0E        		bne		repeat		; not yes so escape
002C0F  1  20 00 28     		jsr		VSTRNG
002C12  1  0D 42 6C 6F  		.byte	CR,"Blowing",CR
002C16  1  77 69 6E 67  
002C1A  1  0D           
002C1B  1  EA           		nop
002C1C  1  60           		rts
002C1D  1  A2 FF        repeat:	ldx		#$FF		; reset stack
002C1F  1  9A           		txs
002C20  1  20 00 28     		jsr		VSTRNG
002C23  1  0D 52 65 70  		.byte	CR,"Repeat ?"
002C27  1  65 61 74 20  
002C2B  1  3F           
002C2C  1  EA           		nop
002C2D  1  A9 98        		lda		#$98		; release all control lines
002C2F  1  8D 83 19     		sta		cwr
002C32  1  20 E6 FF     		jsr		OSECHO		; get reply
002C35  1  C9 59        		cmp		#'Y'
002C37  1  D0 06        		bne		end
002C39  1  20 ED FF     		jsr		OSCRLF		; new line
002C3C  1  6C 86 00     		jmp		(toblow)	; and do it again
002C3F  1  4C 40 28     end:	jmp		START
002C42  1  20 00 28     crcout:	jsr		VSTRNG		; print out CRC header
002C45  1  0D 43 52 43  		.byte	CR,"CRC: "
002C49  1  3A 20        
002C4B  1  EA           		nop
002C4C  1  A5 94        		lda		crc+1		; first byte
002C4E  1  20 53 2C     		jsr		BYTOUT
002C51  1  A5 93        		lda		crc			; and second byte
002C53  1               
002C53  1  48           BYTOUT:	pha					; print out byte in hex
002C54  1  4A           		lsr		a
002C55  1  4A           		lsr		a
002C56  1  4A           		lsr		a
002C57  1  4A           		lsr		a
002C58  1  20 5C 2C     		jsr		DIGIT
002C5B  1  68           		pla
002C5C  1               
002C5C  1  29 0F        DIGIT:	and		#$0F		; print out half byte
002C5E  1  C9 0A        		cmp		#$0A
002C60  1  90 02        		bcc		itdigt
002C62  1  69 06        		adc		#$06
002C64  1  69 30        itdigt:	adc		#$30
002C66  1  4C F4 FF     		jmp		OSWRCH
002C66  1