ATmega8 Microcontroller Programmer

This project describes how to build a simple programmer for the Atmel ATmega8 single-chip microcontrollers.   This should be considered a "hobby grade" programmer as it does not use a variable Vcc and uses the "Serial Programming Algorithm."   The ATmega8 can be configured (through programmable fuses) to disable the Serial Programming mode.   Once disabled, a parallel programmer is required to re-enable the serial programming fuse.

The programmer hardware consists of a 28 pin socket for the ATmega8 and a 14 pin header for connecting to the SBC2's onboard 65C22.   Please note that this can be adapted for use with any 65C22.   The ATmega8 uses 5 pins for serial programming (in addition to Vcc and Gnd):

  ATmega8 (DIP28)                          SBC2      65C22 (DIP40)
Port Pin Function Description J1 PIN PORT PB5 19 (sck) shift clock 5 11 PB1 PB4 18 (MISO) data output 3 12 PB2 PB3 17 (MOSI) data input 4 10 PB0 PC6 1 (/RES) /Reset 9 16 PB6 PB6 9 (CLK IN) External Clock 10 17 PB7

The Atmega8 requires a valid clock input during programming.   If the fuses are set to use an external clock source, then one will need to be provided.   I chose to use the 65C22 Timer 1 output through PB7 to supply the clock.   This ensures a valid clock is always present.   Therefore, we will use Port B of the 65C22 to access the Programmer.

This programmer should also work for other processors in the Atmel family.

Here is the programmer schematic:
Schematic

Programming the ATmega8 is done by placing the part into RESET and applying serial commands and data to the data in pin while clocking the sck pin.   Data read back from the part is clocked in on the data out pin.

There are commands to read and write program memory, EEPROM memory, and the configuration area (fuse bytes, lock bits, signature bytes, and calibration bytes).   Since the AVR Development tools create an Intel-Hex formatted output file, I decided to incorporate a modified version of Ross Archer's "Intel Hex Downloader" which allows for seemless operation.

Here is the source code for the programmer:

;=======================================================================
;                                                                      |
;          SSSSSSS    BBBBBB     CCCCCC                222222          |
;         S      S   B      B   C      C              2      2         |
;        SS         B      B   C                           2           |
;         SSSS     BBBBBBB    C          ========       2              |
;            SS   B      B   C                       2                 |
;     S      S   B      B   C      C              2                    |
;     SSSSSSS   BBBBBBB     CCCCCCC               22222222             |
;                                                                      |
;=======================================================================
;//******************************************************************//
;// Routine to program a ATMega8 using 5 lines from a 65C22 VIA      //
;// By Daryl Rictor  (c) Dec 19, 2003   http://65c02.tripod.com/     //
;//******************************************************************//
;
; VIA - FUNCTION - ATMega8 
; PB0 - MISO     - PB4 (ATM8 data out)
; PB1 - MOSI     - PB3 (ATM8 data in)
; PB2 - SCK      - PB5
; PB6 - /RESET   - PC6
; PB7 - OSC in   - PB6 (System Clock)	
;
; This is a hobby-grade programmer using the LV serial programming algorithm.  
;
; Program Data is loaded from $1000 - $2FFF (16 bits, lo, hi))
; EEPROM data is loaded from $3000 - $31FF (8 bits)
; Memory Lock bits are loaded @ $3200 (6 bits)
; Fuse Lo Byte is loaded @ $3201 (8 bits)
; Fuse Hi Byte is loaded @ #3202 (8 bits)

; During compare cycles, data read from the ATMega8 is stored here:
; Program Data is loaded into $4000 - $5FFF (16 bits, lo, hi))
; EEPROM data is loaded from $6000 - $61FF (8 bits)
; Memory Lock bits are loaded @ $6200 (6 bits)
; Fuse Lo Byte is loaded @ $6201 (8 bits)
; Fuse Hi Byte is loaded @ #6202 (8 bits)
; Signature & Calibration bytes are stored at $6203-$6209 (read only)
; 	$6203 <- Signature byte 1
; 	$6204 <- Calibration byte 1MHz
; 	$6205 <- Signature byte 2
; 	$6206 <- Calibration byte 2MHz
; 	$6207 <- Signature byte 3
; 	$6208 <- Calibration byte 4MHz
; 	$6209 <- Calibration byte 8MHz
;
;
; MENU OPTIONS
;
; 1 - Write Flash Memory
; 2 - Compare Flash Memory (read back stored in $4000-$5FFF)
; 3 - Write EEPROM Data
; 4 - Compare EEPROM Data (read back stored in $6000-$61FF)
; 5 - Write Lock Bits and Fuse Data
; 6 - Compare Lock Bits and Fuse Data (read back stored in $6200-$6202)
; 8 - Fill Mem with $FF's
; 9 - Chip Erase Flash & EEPROM
; L - Do Intel Hex download (offset to $1000)
; Q - Quit

;//****************************************************************
; VIA definitions
;//****************************************************************
Via1DDRB	=	$7F52			; Data Direction Register B
Via1PRB		=	$7F50			; Port B Data Register
Via1T1CL	=	$7F54			; Timer 1 Latch High
Via1T1CH	=	$7F55			; Timer 1 Latch Low
Via1ACR		=	$7F5B			; VIA Aux Control Reg
DIN		=	$01			; Port B - data in pin
DOUT		=	$02			; Port B - data out pin
SCK		=	$04			; Port B - clock pin
RES		=	$40			; Port B - /reset pin

;//****************************************************************
; Zero Page Variables
;//****************************************************************
memptr		=	$30			; 2 byte memory pointer
shout		=	$32			; 4 byte temp shift cmd out
shin		=	$36			; 4 byte temp shift cmd in
;addr		=	$3a			; 1 byte address pointer
;page		=	$3b			; 1 byte page pointer
flag		=	$3c			; 1 byte flag variable
spsav		= 	$ee			; sav SP (restores stack on exit)
						; needed by abort code in HEX upload cmd
;//****************************************************************
; init code
;//****************************************************************
	 	*=  	$0800			; beginning of code

		tsx
		stx	spsav			; save the stack pointer
		lda	#$FE			; pin 0 input, all other outputs
		sta	Via1DDRB		; 
		lda	#$C0			; square wave out on PB7
		sta	Via1ACR			; provides a SBC Clk/4 square wave to ATM8
		lda	#$01			;
		sta	Via1T1CL		; low latch of counter
		lda	#$00			; 
		sta	Via1T1CH		; hi latch, begin counting
;
; set up T-1 to provide clock on PB7
;
		jsr	SetRES			; set ATM8 in RESET mode

;//****************************************************************
; Main Program
;//****************************************************************
main		ldx	#$00			; set display pointer
prtmenu		lda	menudat,x		
		beq	getcmd
		jsr	output			; print then command menu
		inx
		bra	prtmenu
getcmd		jsr	input			; wait for a keypress
		cmp	#"Q"			; is it Q?
		bne	getc1
		jsr	SetRES			; ensure ATM8 is reset
		rts				; exit program
getc1		cmp	#"1"			; is it 1?	
		bne	getc2
		jsr	wfm			; write flash program memory
		bra	main
getc2		cmp	#"2"			; is it 2?
		bne	getc3
		jsr	cfm			; compare flash program memory
		bra	main
getc3		cmp	#"3"			; is it 3?
		bne	getc4
		jsr	wem			; write EEPROM
		bra	main
getc4		cmp	#"4"			; is it 4?
		bne	getc5
		jsr	cem			; compare EEPROM
		bra	main
getc5		cmp	#"5"			; is it 5?
		bne	getc6
		jsr	wcd			; write config bytes
		bra	main
getc6		cmp	#"6"			; is it 6?
		bne	getc8
		jsr	ccd			; compare config bytes
		bra	main
getc8		cmp	#"8"			; is it 9?
		bne	getc9			; 
		jsr	memfill			; fill flash & EEPROM with $FF's
		bra	main
getc9		cmp	#"9"			; is it 9?
		bne	getcL			; 
		jsr	erase			; remove code protection and erase ATM8
		bra	main
getcL		cmp	#"L"			; is it L?
		bne	getcmd			; no, not valid key
		jsr	HexDnLd			; Do Intel Hex download
		bra	main

;//****************************************************************
;  Write Flash Memory
;//****************************************************************
wfm		jsr	SetPRG			; set program mode
		stz	memptr
		lda	#$10
		sta	memptr+1
		ldy	#0			; page #
wfm1		ldx	#0			; byte # on page
		stz	flag			; zero flag
wfm2		lda	(memptr)
		sta	shout+3
		inc	memptr
		bne	wfm3
		inc	memptr+1
wfm3		cmp	#$FF			; is data $FF
		beq	wfms1			; yes, skip write
		inc	flag			; no, mark write req
wfms1		stz	shout+1
		txa
		lsr				; div byte by 2 = word
		sta	shout+2
		bcs	wfm4			; cc = low byte, cs=hi byte
		lda	lpmdat
		bra	wfm5
wfm4		lda	lpmhdat
wfm5		sta	shout
		jsr	SendCmd
		inx				; all 32 words done?
		cpx	#64			; 32 words per page = 64 bytes
		bne	wfm2			; no, get next
		lda	#"."
		jsr	output			; give progress
		lda	flag			; yes; are all 32 words $FF?
		beq	wfms2			; yes, we can skip the page write too!	
		lda	wpmdata			; no, do page write
		sta	shout
		tya
		lsr
		ror	shout+2
		lsr
		ror	shout+2
		lsr
		ror	shout+2
		sta	shout+1
		jsr	SendCmd			; write page cmd		
		lda	#9
		jsr	delay_ms		; wait 9ms (double minimum time req)		
wfms2		iny
		cpy	#128			; last page?
		bne	wfm1
		jsr	print_cr		;
		jsr	SetRES			; done, Reset ATM8
		rts				; done
lpmdat		.byte	$40
lpmhdat		.byte	$48
wpmdata		.byte	$4C

;//****************************************************************
;  Compare Flash Memory
;//****************************************************************
cfm		jsr	SetPRG			; set program mode
		stz	memptr
		lda	#$40
		sta	memptr+1		; start of read buffer
		ldx	#0
		ldy	#0			; reset counters
cfm1		txa
		and	#$1F
		bne	cfm2
		lda	#"."
		jsr	output			; give progress
cfm2		lda	rpmdat
		sta	shout
		sty	shout+1
		stx	shout+2
		jsr	SendCmd
		lda	shin+3
		sta	(memptr)		
		inc	memptr
		bne	cfm3
		inc	memptr+1
cfm3		lda	rpmhdat
		sta	shout
		sty	shout+1
		stx	shout+2
		jsr	SendCmd
		lda	shin+3
		sta	(memptr)		
		inc	memptr
		bne	cfm4
		inc	memptr+1
cfm4		inx
		bne	cfm1
		iny
		cpy	#$10			; top of memory?
		bne	cfm1			; no
		jsr	print_cr		;
		stz	memptr
		stz	shout
		lda	#$10
		sta	memptr+1
		lda	#$40			; init pointers for compare
		sta	shout+1
cfm5		lda	(memptr)
		cmp	(shout)
		beq	cfm6
		tay				; save write byte
		lda	(shout)			; save read byte
		jsr	CompErr
cfm6		inc	memptr
		inc	shout
		bne	cfm7
		inc	memptr+1
		inc	shout+1
cfm7		lda	memptr+1
		cmp	#$30
		bne	cfm5
		jsr	SetRES			; done, Reset ATM8
		rts				; done

rpmdat		.byte	$20
rpmhdat		.byte	$28

;//****************************************************************
;  Write EEPROM Memory
;//****************************************************************
wem		jsr	SetPRG			; set PRG mode
		stz	memptr
		lda	#$30
		sta	memptr+1
		ldy	#0			; 
		ldx	#0			; reset counters
wem1		txa
		and	#$1F
		bne	wem11
		lda	#"."
		jsr	output			; give progress
wem11		lda	(memptr)
		cmp	#$FF			; is data $FF
		beq	wem2			; yes, skip write
		sta	shout+3
		sty	shout+1
		stx	shout+2
		lda	#$C0			; write EEPROM Data command
		sta	shout
		jsr	SendCmd
		lda	#14
		jsr	delay_ms		; wait 14ms (1.5x minimum time req)		
wem2		inc	memptr
		bne	wem3
		inc	memptr+1
wem3		inx				
		bne	wem1
		iny
		cpy	#$02
		bne	wem1
		jsr	print_cr		;
		jsr	SetRES			; done, Reset ATM8
		rts				; done

;//****************************************************************
;  Compare EEPROM Memory
;//****************************************************************
cem		jsr	SetPRG			; set PRG mode
		stz	memptr
		lda	#$60
		sta	memptr+1
		ldy	#0			; 
		ldx	#0			; reset counters
cem1		txa
		and	#$1F
		bne	cem11
		lda	#"."
		jsr	output			; give progress
cem11		sty	shout+1
		stx	shout+2
		lda	#$A0			; Read EEPROM Data command
		sta	shout
		jsr	SendCmd
		lda	shin+3
		sta	(memptr)
cem2		inc	memptr
		bne	cem3
		inc	memptr+1
cem3		inx				
		bne	cem1
		iny
		cpy	#$02
		bne	cem1
		stz	memptr
		stz	shout
		lda	#$30
		sta	memptr+1
		lda	#$60			; init pointers for compare
		sta	shout+1
		jsr	print_cr		;
		ldx	#0
		ldy	#0
cem4		lda	(memptr)
		cmp	(shout)
		beq	cem5
		tay
		lda	(shout)
		jsr	CompErr
cem5		inc	memptr
		inc	shout
		bne	cem6
		inc	memptr+1
		inc	shout+1
cem6		inx				
		bne	cem4
		iny
		cpy	#$02
		bne	cem4
		jsr	SetRES			; done, Reset ATM8
		rts				; done

;//****************************************************************
;  Write Configuration Words
;//****************************************************************
wcd		jsr	SetPRG			; set PRG mode
		ldx	#$03
wcd1		lda	wlbdat,x
		sta	shout,x
		dex
		bpl	wcd1
		lda	$3200			; lock bit source
		ora	shout+3			; lock bit dest	
		sta	shout+3			;
		jsr	SendCmd			; Write Lock Bits
		lda	#10
		jsr	delay_ms		; wait 10ms
		ldx	#$03
wcd2		lda	wfdat,x
		sta	shout,x
		dex
		bpl	wcd2
		lda	$3201			; fuse lo byte source
		ora	shout+3			; fuse lo byte dest	
		sta	shout+3			;
		jsr	SendCmd			; Write Fuse Lo bits cmd
		lda	#10
		jsr	delay_ms		; wait 10ms
		ldx	#$03
wcd3		lda	wfhdat,x
		sta	shout,x
		dex
		bpl	wcd3
		lda	$3202			; fuse hi byte source
		ora	shout+3			; fuse hi byte dest	
		sta	shout+3			;
		jsr	SendCmd			; Write Fuse Hi bits cmd
		lda	#10
		jsr	delay_ms		; wait 10ms
		jsr	SetRES			; done, Reset ATM8
		rts				; done
wlbdat		.byte	$AC, $FF, $FF, $C0
wfdat		.byte	$AC, $A0, $FF, $00
wfhdat		.byte	$AC, $A8, $FF, $00

;//****************************************************************
;  Compare Configuration Words
;//****************************************************************
ccd		jsr	SetPRG			; set PRG mode
		ldx	#$03
ccd1		lda	clbdat,x
		sta	shout,x
		dex
		bpl	ccd1
		jsr	SendCmd			; read lock bits cmd
		lda	shin+3
		and	#$3F			; mask 6 lsb's
		sta	$6200			; save lock byte
		ldx	#$03
ccd2		lda	cfdat,x
		sta	shout,x
		dex
		bpl	ccd2
		jsr	SendCmd			; read lock bits cmd
		lda	shin+3
		sta	$6201			; save lock byte
		ldx	#$03
ccd3		lda	cfhdat,x
		sta	shout,x
		dex
		bpl	ccd3
		jsr	SendCmd			; read lock bits cmd
		lda	shin+3
		sta	$6202			; save lock byte
		ldy	#$00
ccd4		ldx	#$03
		cpy	#$03
		beq	ccd6
ccd5		lda	rdsig,x
		sta	shout,x
		dex
		bpl	ccd5
		tya	
		ora	shout+2
		sta	shout+2 
		jsr	SendCmd			; read signature bits cmd
		tya	
		asl
		tax
		lda	shin+3
		sta	$6203,x			; save signature byte
		ldx	#$03
ccd6		lda	rdcal,x
		sta	shout,x
		dex
		bpl	ccd6
		jsr	SendCmd			; read calibration bits cmd
		tya	
		asl
		tax
		lda	shin+3
		sta	$6204,x			; save calibration byte
		iny
		cpy	#$04
		bne	ccd4			; get 4 calibration bytes
		ldx	#$00
		stz	memptr+1		; for address print on error
ccd7		lda	$3200,x
		cmp	$6200,x
		beq	ccd8
		stx	memptr
		tay
		lda	$6200,x		
		jsr	CompErr			; print error message
ccd8		inx
		cpx	#$03
		bne	ccd7
		jsr	SetRES			; done, Reset ATM8
		rts				; done

clbdat		.byte	$58, $00, $00, $00
cfdat		.byte	$50, $00, $00, $00
cfhdat		.byte	$58, $08, $00, $00
rdsig		.byte	$30, $00, $00, $00
rdcal		.byte	$38, $00, $00, $00

;//****************************************************************
; erase - Unprotect and erase the ATM8
;//****************************************************************
erase		jsr	SetPRG			; set PRG mode
		lda	#$AC			; Chip Erase byte 1
		sta	shout
		lda	#$80			; Chip Erase byte 2
		sta	shout+1
		jsr	SendCmd			; do chip erase
		lda	#10
		jsr	delay_ms		; wait 10ms
		jsr	SetRES			; reset the ATM8
		rts				; done

;//****************************************************************
; MemFill - fill FLASH & EEPROM mem with $FF's
;//****************************************************************
MemFill		stz	memptr
		lda	#$10
		sta	memptr+1
		lda	#$FF
		ldy	#$0
memfill1	sta	(memptr),y
		dey
		bne	memfill1
		inc	memptr+1
		ldx	memptr+1
		cpx	#$32			; top?
		bne	memfill1
		rts

;###################################################################
;
; Subroutines
;
;###################################################################

;//****************************************************************
; sendcmd - send a programming command to the ATM8
;//****************************************************************
sendcmd		phx				; save x reg
		ldx	#32			; # of bits to shift						
Sendlp		asl	shout+3
		rol	shout+2
		rol	shout+1
		rol	shout			; shift 4 byte cmd left
		lda	#DOUT
		eor	#$FF			; mask out DOUT bit
		and	Via1PRB			; with PORT A
		bcc	send1
		ora	#DOUT			; if carry set, raise DOUT bit
send1		sta	Via1PRB			; 
		ora	#SCK			; Raise SCK 
		nop				; pause
		sta	Via1PRB			; send data to ATM8
		nop				; pause
		lda	Via1PRB			; get dat from ATM8 (read from Bit 0)
		lsr				; move into Carry flag
		rol	shin+3
		rol	shin+2
		rol	shin+1
		rol	shin			; shift 4 byte data in from ATM8
		lda	#SCK			; 	
		eor	#$FF			; mask out SCK bit
		and	Via1PRB			; from PORT A
		sta	Via1PRB			; SCK pin=0
		dex
		bne	Sendlp			; do it 32 times
		lda	#DOUT
		ora	#SCK
		eor	#$FF			; mask out DOUT & SCK bits
		and	Via1PRB
		sta	Via1PRB			; ensure DOUT & SCK are low on exit
		plx				; restore x reg
		rts				; 32 bits shifted out and 32 bits shifted in

;//****************************************************************
; delay_ms - delay milliseconds in A reg
;//****************************************************************
delay_ms	phx				; 
		phy				;  1MHz clk = $01C0 
delayms1	ldy	#$02			;  2MHz clk = $0288 
		ldx	#$88			;  4MHz clk = $0416 
delayms2	dex				;  8MHz clk = $0734 
		bne	delayms2		; 10MHz clk = $08C3
		dey				; 14MHz clk = $0BE0
		bne	delayms2
		dec
		bne	delayms1
		ply
		plx
		rts	

;//****************************************************************
;  Compare Error 
;//****************************************************************
CompErr		phx				; save x reg
		pha				; outputs error message
		ldx	memptr
		lda	memptr+1		; formatted as such:
		jsr	print2byte		; AAAA:RR - WW
		lda	#":"			;
		jsr 	output			; AA=address (from memptr)
		pla				; RR=data read from ATM8 (Acc Reg)
		jsr	print1byte		; WW=data written (from Y reg)	
		lda	#"-"
		jsr	output
		tya
		jsr	print1byte
		ldx	#$00
Cerr		lda	Cerrtxt,x
		beq	Cerr1
		jsr	output
		inx
		bra	Cerr
Cerr1		plx				; restore x reg
		rts				; done

Cerrtxt		.byte	" - BYTE MISMATCH", $0d, $0a, $00

;//****************************************************************
;  SetRES - Set the ATM8 into RESET mode
;//****************************************************************
SetRES		lda	#$00
		sta	Via1PRB			; set ATM8 into RESET mode
		lda	#RES			; raise /RES (run mode)
		sta	Via1PRB			; set ATM8 into RUN mode
		ldx	#$20			; 
SetR1		dex
		bne	SetR1			; pause 128 clocks
		lda	#$00			; lower /RES 
		sta	Via1PRB			; set ATM8 into RESET mode
		rts

;//****************************************************************
;  SetPGM - Set the ATM8 into PROGRAM mode
;//****************************************************************
SetPRG		lda	#25
		jsr	delay_ms		; wait for 25ms
		ldx	#$03
SetP1		lda	prgdata,x
		sta	shout,x			; set up command DWORD
		dex
		bpl	Setp1
		jsr	SendCmd			; execute it
		lda	shin+2
		cmp	#$53			; did byte 3 come back as $53?
		beq	Setp6			; yes, good cmd
		ldx	#$0			; no, failed to enter PRG mode
Setp2		lda	prgbad,x
		beq	Setp3
		jsr	output
		inx
		bra	Setp2
Setp3	;	pla
	;	pla				; pop return address from stack
		rts				; go back to main program

Setp6		ldx	#prggood-prgbad		; PRG mode Passed
Setp7		lda	prgbad,x
		beq	Setp8
		jsr	output
		inx
		bra	Setp7
Setp8		rts

prgdata		.byte	$AC, $53, $00, $00
prgbad		.byte	"PRG MODE FAILED.", $0d, $0a, $00
prggood		.byte	"PRG MODE PASSED.", $0d, $0a, $00

;//****************************************************************
;  Menudat - Programming Menu text 
;//****************************************************************
menudat		.byte	$0d, $0a
		.byte	"Flash Memory", $0d, $0a
		.byte	" 1 - Write", $0d, $0a
		.byte	" 2 - Compare", $0d, $0a
		.byte	"EEPROM Data", $0d, $0a
		.byte	" 3 - Write", $0d, $0a
		.byte	" 4 - Compare", $0d, $0a
		.byte	"Configuration Data", $0d, $0a
		.byte	" 5 - Write", $0d, $0a
		.byte	" 6 - Compare", $0d, $0a
		.byte	" 8 - Fill Mem w/$FF", $0d, $0a
		.byte	" 9 - Chip Erase ATMega8", $0d, $0a
		.byte	"(L)oad Intel Hex File", $0d, $0a		
m0		.byte	"(Q)uit Program", $0d, $0a, $0d, $0a, $00

;//****************************************************************
;  Jump Table into the SBC Monitor's Jump Table
;//****************************************************************
output		jmp	$e824			; send to SBC output port
input		jmp	$e821			; wait for chr from SBC input port
scan		jmp	$e81e			; get chr from SBC input port (no wait)
print_cr        jmp	$e803			; print CR-LF to SBC output port
print2sp        jmp	$e809			; print 2 spaces
print1sp        jmp	$e806			; print 1 space
print1byte      jmp	$e812			; print one byte (AA) to SBC output port
print2byte      jmp	$e815			; print one word (AAXX) to SBC output port

;//****************************************************************
; END
;//****************************************************************

;//****************************************************************
; Ross Archer's Intel Hex downloader added to reduce steps
;//****************************************************************
;  add an Intel-Hex Downloader to get program code for target ATM8
;  I'm using Ross Archer's code, with slight modifications to use
;  some of the SBC's commands.
;
; zero page variables (Its ok to stomp on the monitor's zp vars)
;
;
reclen    	=   	$39        	; record length in bytes
chksum    	=   	$3A        	; record checksum accumulator
start_lo  	=   	$3b
start_hi  	=   	$3c
rectype   	=   	$3d
dlfail    	=   	$3e     	; flag for upload failure
temp      	=   	$3f     	; save hex value
strptr      	=     	$40
strptrh		=     	$41		; temporary string pointer (not preserved across calls)

;
;  tables and constants
;
CR		=	13
LF		=	10
ESC         	=     	27          ; ESC to exit

HexDnLd		jsr	print_cr
		lda    	#0
        	sta	dlfail          ;Start by assuming no D/L failure
HdwRecs 	jsr     GetSer          ; Wait for start of record mark ':'
        	cmp     #":"
        	bne     HdwRecs         ; not found yet
        	; Start of record marker has been found
IHex    	jsr     GetHex          ; Get the record length
        	sta     reclen          ; save it
       	 	sta     chksum          ; and save first byte of checksum
        	jsr     GetHex          ; Get the high part of start address
        	sta     start_hi
        	clc
        	adc     chksum          ; Add in the checksum       
        	sta     chksum          ; 
        	jsr     GetHex          ; Get the low part of the start address
        	sta     start_lo
        	clc
        	adc     chksum
        	sta     chksum  
		clc
		lda	#$10
		adc	start_hi
		sta	start_hi	; adjust storage base 
        	jsr     GetHex          ; Get the record type
        	sta     rectype         ; & save it
        	clc
        	adc     chksum
        	sta     chksum   
        	lda     rectype
        	bne     HdEr1           ; end-of-record
        	ldx     reclen          ; number of data bytes to write to memory
        	ldy     #0              ; start offset at 0
HdLp1   	jsr     GetHex          ; Get the first/next/last data byte
        	sta     (start_lo),y    ; Save it to RAM
        	clc
        	adc     chksum
        	sta     chksum          ; 
        	iny                     ; update data pointer
        	dex                     ; decrement count
        	bne     HdLp1
        	jsr     GetHex          ; get the checksum
        	clc
        	adc     chksum
        	bne     HdDlF1          ; If failed, report it
        	; Another successful record has been processed
        	lda     #"#"            ; Character indicating record OK = '#'
		jsr	output
        	jmp     HdwRecs         ; get next record     
HdDlF1  	lda     #"F"            ; Character indicating record failure = 'F'
        	sta     dlfail          ; upload failed if non-zero
		jsr	output
        	jmp     HdwRecs         ; wait for next record start
HdEr1   	cmp     #1              ; Check for end-of-record type
        	beq     HdEr2
		cmp	#2
		beq	HdwRecs		; skip this type 
		lda	#>MsgUnknownRecType
		ldx	# upload has failed
        	jsr     Print1Byte      ; print it
		jsr	print_cr
		jmp	HdwRecs
		; We've reached the end-of-record record
HdEr2   	jsr     GetHex          ; get the checksum 
        	clc
        	adc     chksum          ; Add previous checksum accumulator value
        	beq     HdEr3           ; checksum = 0 means we're OK!
		lda	#>MsgBadRecChksum
		ldx	#MsgUploadFail
		ldx	#MsgUploadOK
		ldx	# 255
PrintStrAXX1    pla
		tay
		rts   
;
; Checksum messages
;					
MsgUnknownRecType  
		.byte   CR,LF,CR,LF
      		.byte   "Unknown record type $"
		.byte	0		; null-terminate every string
MsgBadRecChksum .byte   CR,LF,CR,LF
                .byte   "Bad record checksum!"
        	.byte   0		; Null-terminate  
MsgUploadFail   .byte   CR,LF,CR,LF
                .byte   "Upload Failed",CR,LF
                .byte   "Aborting!"
                .byte   0               ; null-terminate every string or crash'n'burn
MsgUploadOK	.byte   CR,LF,CR,LF
                .byte   "Upload Successful!"
        	.byte   0         	

;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
; END OF PROGRAM
;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


Home
All info provided "as-is" and is Copyright 2003.