;*******************************************************************
;
; Frequency display
; Crystal freq. 4.000MHz +/- a bit
;
;*******************************************************************
;
; FM000.TXT Originally from FM3/4 9:39pm 14 May 2002
; As implemented in experimental 3.5MHz receiver
; www.Qariya.com By Phil Rice
;
;*******************************************************************
;
; FM003 Fixed? major silliness in LO-IF code
; Re-wrote USB/LSB suffix code
; Added #defines for crook displays
; Added #defines for two line displays
; Wrapped #ifdef ... endif around debugging code
;
;*******************************************************************
;#define testing 1 ; Comment out when testing finished
;#define Bad_Display 1 ; Un-comment for "stop at 8" displays
;#define Two_Line 1 ; Un-comment for two line displays
;*******************************************************************
;
; CPU configuration
; It's a 16F84, HS oscillator,
; watchdog timer off, power-up timer on
;
processor 16f84
include <p16f84.inc>
__config _HS_OSC & _PWRTE_ON & _WDT_OFF
#define S_out PORTA,0x00 ; 9600 baud serial out
#define PUFF PORTA,0x00 ; Future stabiliser
#define HUFF PORTA,0x01 ; Ditto.
#define ENA PORTA,0x02 ; Display "E"
#define RS PORTA,0x03 ; Display "RS"
#define PORTA4 PORTA,0x04 ; From LS393 divider chip
#define RESET PORTB,0x01 ; Pin 7, Counter RESET
#define UP_CNT PORTB,0x02 ; Pin 8, Counter FLUSH
#define GATE PORTB,0x03 ; Pin 9, Counter GATE
#define Store PORTB,0x04 ; Pin 10, 0 = Measure BFO
#define Add_LO PORTB,0x05 ; Pin 11, 0 = RF := LO + IF
; 1 = RF := | LO + (-IF) |
#define BFO_Lo PORTB,0x06 ; Pin 12, 0 = BFO on lower freq.
#define BFO_Hi PORTB,0x07 ; Pin 13, 0 = BFO on higher freq.
#define LOK_FLG FLAGS,0x06
#define Prg_FLG FLAGS,0x05
#define Ovr_Rng FLAGS,0x04
#define AMflag FLAGS,0x03 ; 0 = Don't print USB/LSB suffix
#define BANKSEL STATUS,RP0
#define beq bz ; Motorola syntax branches
#define BEQ bz
#define BNE bnz
#define bne bnz
#define BCC bnc
#define bcc bnc
#define BCS bc
#define bcs bc
#define BRA goto
#define bra goto
;*******************************************************************
;
; file register declarations: use only registers in bank0
; bank 0 file registers begin at 0x0c in the 16F84
;
;*******************************************************************
cblock 0x0c
COUNT ; Bin to BCD convert (bit count)
TEMP
cnt ; (BCD BYTES)
COUNT1 ; Used by delay routines
; and "prescaler flush"
COUNT2 ; Timing (100ms)
COUNT3 ; Timing (100ms)
COUNT4 ; Timing (400ms)
CHR
AccA:3 ; Binary, MSB first
AccB:3 ; Intermediate frequency
bcd:4 ; BCD, MSD first
FLAGS
SBflag ; 0 = Lower BFO frequency
; 1 = Higher
W_TEMP ; W saved here by ISR
STATUS_TEMP ; Status Register saved here by ISR
dbg0:3 ; Debugging stuff
dbg1:3
dbg2:3
dbg3:3
dbg4:3
dbg5:3
S_Wtemp ; "debug" Variables
S_count
D_Wtemp
D_Stemp
D_FSR
D_hex
endc
;**********************************************************
;
; Begin Executable Stuff(tm)
;
org 0
GO clrwdt ; 0 << Reset
call InitIO ; 1 INITIALISE PORTS
CLRF PORTA ; 2
goto START ; 3
INTRUPT goto ISR ; 4 << Interrupt
;**********************************************************
;
; Text Strings (stored in RETLWs)
;
mhz dt " MHz ",0
Spaces dt " ",0
USB dt "USB",0
LSB dt "LSB",0
Prog dt "PRG",0
adv1 dt "DFM 3.0 ",0
adv2 dt "- VK3BHR",0
ovr1 dt " Over ",0
ovr2 dt "Range ",0
#ifdef Two_Line
adv3 dt "1234567890ABCDEF",0
endif
;**********************************************************
;
; Main Program
;
START CLRF PORTB
#ifdef testing
bsf PUFF
endif
CALL LCDINIT ; INITIALIZE LCD MODULE
MOVLW adv1 ; Sign on
call pmsg
#ifdef Bad_Display
CALL LINE2
endif
movlw adv2
call pmsg
MOVLW 0x28 ; Delay for 4 sec.
CALL DECI
CALL CLEAR
; goto newbit ; fire up full thing
;CNT_AGN bcf INTCON,T0IF ; Clear timer interrupt
; bsf INTCON,T0IE ; Enable timer overflow interrupt
; bsf INTCON,GIE ; Global enable all enabled ints.
;
; call Measure
; call Display
; CALL HOME
; GOTO CNT_AGN ; ALL DONE , START AGAIN
;**********************************************************
;
; Begin a new measurement cycle
;
newbit call HOME ; Display ready
clrf SBflag ; 0 = Lower BFO frequency
; 1 = Higher
bcf AMflag ; 0 = No USB/LSB suffix
bcf INTCON,T0IF ; Clear timer interrupt
bsf INTCON,T0IE ; Enable timer overflow interrupt
bsf INTCON,GIE ; Global enable all enabled ints.
bcf Prg_FLG
btfsc Store ; Doing "BFO STORE"?
goto GetOffs
movlw 0x05 ; Delay 0.5 sec
call DECI
btfsc Store ; De-bounce
goto GetOffs
GetIf call Measure
btfss Ovr_Rng ; Set = Counter overflow?
goto GetIf1
MOVLW ovr1 ; Over-range message
call pmsg
#ifdef Bad_Display
CALL LINE2
endif
movlw ovr2
call pmsg
CALL HOME
goto GetIf ; & keep trying
GetIf1 movf AccA+0,W ; Copy measurement
movwf AccB+0 ; To "IF offset"
movf AccA+1,W
movwf AccB+1
movf AccA+2,W
movwf AccB+2
call Display
movlw Prog ; Say "we're programming"
call pmsg
CALL HOME
btfss Store ; Ready to store it?
goto GetIf
movlw 0x05 ; Delay 0.5 sec
call DECI
btfss Store ; De-bounce
goto GetIf
bsf Prg_FLG ; Flag "to be stored"
GetOffs btfss BFO_Hi ; Which Offset??
goto Get2 ; Point @ EEPROM
btfss BFO_Lo ; 3 bytes each
goto Ch2 ; BFO low link only
goto Ch3 ; No links
Get2 btfss BFO_Lo
goto Ch0 ; Both links
goto Ch1 ; BFO high link only
Ch0 movlw 0x00 ; Offset channel 0 (both links fitted)
goto EndOff
Ch1 bsf AMflag ; We're gunna print
comf SBflag,f ; that BFO is on higher frequency
movlw 0x03 ; Offset channel 1 (BFO_Hi link fitted)
goto EndOff
Ch2 bsf AMflag ; We're gunna print
; that BFO is on lower frequency
movlw 0x06 ; Offset channel 2 (BFO_Lo link fitted)
goto EndOff
Ch3 movlw 0x09 ; Offset channel 3 (no links fitted)
; goto EndOff
EndOff btfsc Prg_FLG ; Storing Offset?
goto Do_St ; If not, then
call EE_RD ; must be reading.
goto Do_Meas
Do_St call EE_WR
;
; Now have IF in AccB
;
Do_Meas call Measure ; Measure Local Osc Freq.
btfss Ovr_Rng ; Set = Counter overflow?
goto Add_Sub
MOVLW ovr1 ; Over-range message
call pmsg
#ifdef Bad_Display
CALL LINE2
endif
movlw ovr2
goto EndMsg
;
; Now have LO in "AccA"
; and IF in "AccB"
;
Add_Sub btfss Add_LO ; Add or Sub LO freq?
goto AddLSB ; Clear = just add
call MinusA ; RF := IF - LO
; SBflag is OK
;
; AccA := AccA + AccB
;
AddLSB movf AccB+2,W ; Process LSB
addwf AccA+2,F
bcc AddISB ; If no carry,do next
incf AccA+1,f ; Else roll over higher
bne AddISB ; bytes as appropriate
incf AccA+0,f ; may roll over MSByte
AddISB movf AccB+1,W ; Process middle byte
addwf AccA+1,F
bcc AddMSB ; If no carry,do next
incf AccA+0,f ; Else roll over higher
AddMSB movf AccB+0,W ; Process MSB
addwf AccA+0,F
;
; Fix overflow
;
btfss AccA+0,7 ; Add Overflowed?
goto OK2go ; Clear = OK 2 print
call MinusA ; Make positive and
comf SBflag,f ; Swap USB/LSB
;
; Display resulting number in AccA
;
OK2go call Display ; display result at last
;
; Print suffix - USB, LSB or nuffin
;
btfsc AMflag ; Do we print at all?
goto trySBf
movlw Spaces ; nuffin = spaces
goto EndMsg
trySBf btfsc SBflag,0 ; Which sideband?
goto pLSB
movlw USB ; USB obviously
goto EndMsg
pLSB movlw LSB ; LSB
; goto EndMsg
EndMsg call pmsg ; Print selected trailer
#ifdef Two_Line
CALL LINE2 ; WRITE second LINE
movlw adv3
call pmsg
endif
goto newbit ; Start next measurement
;**********************************************************
;
; Negate number in AccA (2's complement form)
;
MinusA comf AccA+0,f ; Complement all bits
comf AccA+1,f ; of number
comf AccA+2,f
incf AccA+2,f ; Add 1
bne N_xit
incf AccA+1,f
bne N_xit
incf AccA+0,f
N_xit return
;**********************************************************
;
; Print String addressed by W
; Note: Strings are in program space
;
pmsg movwf EEADR ; Temp for pointer
pm1 movf EEADR,W ; Get current pointer
call pmsub
andlw 0xff ; Test returned value
beq pm_end ; NULL = All done
call DATS
incf EEADR,F
goto pm1
pmsub movwf PCL ; Goto W
nop ; Just in case
nop ; Second may not be needed
pm_end return
;**********************************************************
;
; Delay for W x 100ms (untrimmed)
;
DECI MOVWF COUNT4 ;DELAY 100MS X CONTENTS (W)
NXT6 CALL MS100
DECFSZ COUNT4,F
GOTO NXT6
RETLW 0
;**********************************************************
;
; Delay for 100ms (trimmed for actual clock freq)
;
MS100 MOVLW 0xff ; 100 MS DELAY LOOP
MOVWF COUNT1 ; 4 MHZ XTAL
MOVLW 0x7e ; Count up
MOVWF COUNT2 ; to roll-over
MOVLW 0x19 ; (was 1B)
MOVWF COUNT3
L3 INCFSZ COUNT3,F
GOTO L3
INCFSZ COUNT2,F
GOTO L3
INCFSZ COUNT1,F
GOTO L3
RETLW 0
;**********************************************************
;
; Put 4 bits to LCD & wait (untrimmed)
;
PB_dly ANDLW 0x0F ; MASK OFF UPPER 4 BITS
MOVWF PORTB ; SEND DATA TO DISPLAY
BSF ENA ; ENA HIGH
NOP
BCF ENA ; ENA LOW
; Fall into DELAY subroutine
;**********************************************************
;
; Delay for 200us (untrimmed)
;
D200us
DELAY MOVLW 0x42 ; DELAY 200us
MOVWF COUNT1
NXT5 DECFSZ COUNT1,F
GOTO NXT5
RETLW 0
;**********************************************************
;
; Delay for 2ms (untrimmed)
;
MS2 MOVLW 0x0A ; DELAY 2ms
MOVWF COUNT2
LP15 MOVLW 0x42
MOVWF COUNT1
LP16 DECFSZ COUNT1,F
GOTO LP16
DECFSZ COUNT2,F
GOTO LP15
RETLW 0
;******************************************************************
;
; Convert 24-bit binary number at <AccA> into a bcd number
; at <bcd>. Uses Mike Keitz's procedure for handling bcd
; adjust; Modified Microchip AN526 for 24-bits.
;
B2_BCD
b2bcd movlw .24 ; 24-bits
movwf COUNT ; make cycle counter
clrf bcd+0 ; clear result area
clrf bcd+1
clrf bcd+2
clrf bcd+3
b2bcd2 movlw bcd ; make pointer
movwf FSR
movlw .4
movwf cnt
; Mike's routine:
b2bcd3 movlw 0x33
addwf INDF,f ; add to both nybbles
btfsc INDF,3 ; test if low result > 7
andlw 0xf0 ; low result >7 so take the 3 out
btfsc INDF,7 ; test if high result > 7
andlw 0x0f ; high result > 7 so ok
subwf INDF,f ; any results <= 7, subtract back
incf FSR,f ; point to next
decfsz cnt,f
goto b2bcd3
rlf AccA+2,f ; get another bit
rlf AccA+1,f
rlf AccA+0,f
rlf bcd+3,f ; put it into bcd
rlf bcd+2,f
rlf bcd+1,f
rlf bcd+0,f
decfsz COUNT,f ; all done?
goto b2bcd2 ; no, loop
return ; yes
;*********** INITIALISE LCD MODULE 4 BIT MODE ***********************
LCDINIT CALL MS100 ; WAIT FOR LCD MODULE HARDWARE RESET
BCF RS ; REGISTER SELECT LOW
BCF ENA ; ENABLE LINE LOW
MOVLW 0x03 ; 1
call PB_dly
CALL MS100 ; WAIT FOR DISPLAY TO CATCH UP
MOVLW 0x03 ; 2
call PB_dly
MOVLW 0x03 ; 3
call PB_dly
MOVLW 0x02 ; Fn set 4 bits
call PB_dly
MOVLW 0x0C ; 0x0C DISPLAY ON
CALL STROBE
CALL DELAY
MOVLW 0x06 ; 0x06 ENTRY MODE SET
CALL STROBE
CALL DELAY
MOVLW 0x01 ; 0x01 CLEAR DISPLAY
CALL STROBE
CALL MS2
RETLW 0
;**********************************************************
;
; SENDS DATA TO LCD DISPLAY MODULE (4 BIT MODE)
;
STROBE BCF RS ; SELECT COMMAND REGISTER
GOTO CM
;**********************************************************
;
; Put a BCD nybble to display
;
PutNyb ANDLW 0x0F ; MASK OFF OTHER PACKED BCD DIGIT
ADDLW 0x30 ; Convert BIN to ASCII
DATS BSF RS ; SELECT DATA REGISTER
CM MOVWF CHR ; STORE CHAR TO DISPLAY
SWAPF CHR,W ; SWAP UPPER AND LOWER NIBBLES (4 BIT MODE)
call PutN_1
MOVF CHR,W ; GET CHAR AGAIN
PutN_1 ANDLW 0x0F ; MASK OFF UPPER 4 BITS
MOVWF PORTB ; SEND DATA TO DISPLAY
BSF ENA ; ENA HIGH
NOP
BCF ENA ; ENA LOW
goto D200us ; DELAY 200us
;************ MOVE TO START OF LINE 2 *****************
LINE2 MOVLW 0xC0 ; ADDRESS FOR SECOND LINE OF DISPLAY
CALL STROBE
goto DELAY
;************ CLEAR DISPLAY ***************************
CLEAR MOVLW 0x01 ; COMMAND TO CLEAR DISPLAY
CALL STROBE
goto MS2 ; LONGER DELAY NEEDED WHEN CLEARING DISPLAY
;*********** MOVE TO HOME *****************************
HOME MOVLW 0x02 ; COMMAND TO HOME DISPLAY
CALL STROBE
goto MS2
;********************************************************************
; Initialise Input & Output devices
;********************************************************************
InitIO bsf BANKSEL ; Select Bank1
movlw 0x37 ; Option register
movwf OPTION_REG ; Port B weak pull-up enabled
; INTDEG Don't care
; Count RA4/T0CKI
; Count on falling edge
; Prescale Timer/counter
; divide Timer/counter by 256
; PORTA:-
movlw 0x10 ; initialise data direction
; 1 = input
; 0 = output
;
; PORTA has 5 pins 4 3 2 1 0
; 0x10 = 0 0 0 1 0 0 0 0
;
movwf TRISA ; PORTA<0> = Huff'n puff
; PORTA<1> = Huff'n puff
; PORTA<2> = LCD "E"
; PORTA<3> = LCD "RS"
; PORTA<4> = Input
; PORTA<5:7> = not implemented in 16F84
;
; PORTB:-
movlw 0xf0 ; initialise data direction
; PORTB has 8 pins
; port pin 7 6 5 4 3 2 1 0
; 0xf0 = 1 1 1 1 0 0 0 0
;
movwf TRISB ; PORTB<0> = LCD "DB4"
; PORTB<1> = "DB5"
; PORTB<2> = "DB6"
; PORTB<3> = "DB7"
; PORTB<4> = Input
; PORTB<5> = Input
; PORTB<6> = Input
; PORTB<7> = Input
bcf BANKSEL ; Re-select Bank0
return
;**********************************************************
;
; Measure Frequency. Stash in "AccA:3"
;
Measure bcf Ovr_Rng ; Declare "Not yet Over-range"
BCF GATE ; Ready for counting
BSF UP_CNT
BSF RESET ; RESET EXTERNAL COUNTER (393)
NOP
BCF RESET
CLRF TMR0 ; RESET INTERNAL COUNT (INCLUDING PRESCALER)
; See page 27 Section 6.0
CLRF AccA ; Ready to receive 24 bit number
CLRF AccA+1
CLRF AccA+2
BSF GATE ; OPEN GATE'S
#ifdef testing
call ctest ; Test counter or
else
CALL MS100 ; 100MS DELAY
CALL MS100 ; & again
CALL MS100
CALL MS100
endif
BCF GATE ; CLOSE GATE (COUNT COMPLETE)
MOVF TMR0,W ; GET HIGH BYTE
MOVWF AccA ; Copy to Big end of 24 bit result
MT0_393 btfsc PORTA4 ; Test 393 output
goto MT1_393 ; 128 <= count <=255
BCF UP_CNT ; Clock the 393 once
NOP
BSF UP_CNT
DECF AccA+2,F ; Decrement the counter
goto MT0_393
MT1_393 btfss PORTA4 ; Test 393 output
goto Do_PSC ; It's Rolled over!( 255->0)
BCF UP_CNT ; Clock the 393 once
NOP
BSF UP_CNT
DECF AccA+2,F ; Decrement the counter
goto MT1_393
; At this point, we have got the MSbyte & the LS byte.
; ie. AccA:AccA+1:AccA+2 = MSbyte:??:LSbyte
; The 393 counter is outputting a 0 'cos we've just rolled
; it over, so T0CKI=0.
Do_PSC MOVF TMR0,W ; Used only to check for
MOVWF COUNT1 ; Prescaler roll over
PSC1 bsf BANKSEL ; Select Bank1
bcf OPTION_REG,T0SE ; Clock the prescaler
nop
bsf OPTION_REG,T0SE
bcf BANKSEL ; Re-select Bank0
DECF AccA+1,F ; Decrement the counter
movf TMR0,W ; Has TMR0 changed?
xorwf COUNT1,W ; if unchanged, XOR -> 0
bz PSC1
DECF AccA+1,F ; Because we flushed 393
; AccA : AccA+1 : AccA+2 now holds 24 bit result
rrf AccA+0,f ; Divide AccA:3 by 4
rrf AccA+1,f ; cos gate = 400ms
rrf AccA+2,f
bcf AccA+0,7 ; Possible bad carry in.
rrf AccA+0,f
rrf AccA+1,f
rrf AccA+2,f
bcf AccA+0,7 ; Possible bad carry in.
return
;**********************************************************
;
; Display frequency
;
; Display contents of AccA...AccA+3 on LCD
; First convert to BCD, Then ASCII (nybble at a time)
Display CALL B2_BCD ; CONVERT COUNT TO BCD
MOVLW 0x30
MOVWF TEMP ; AMOUNT TO ADD TO CONVERT TO ASCII
MOVF bcd,W ; GET FIRST BCD DIGIT. It's LSB of bcd
ANDLW 0x0F ; MASK OFF OTHER PACKED BCD DIGIT
BTFSS STATUS,Z ; IS IT A '0' ?
GOTO NoBlank
MOVLW 0x20 ; YES PRINT A BLANK SPACE
CALL DATS
GOTO NxtDig
NoBlank CALL PutNyb
NxtDig swapf bcd+1,W ; GET NEXT DIGIT
CALL PutNyb ; DISPLAY IT
MOVLW '.' ; Obvious!
CALL DATS
MOVF bcd+1,W ; GET OTHER BCD DIGIT
CALL PutNyb
SWAPF bcd+2,W ; GET NEXT DIGIT
CALL PutNyb ; DISPLAY IT
MOVF bcd+2,W ; GET OTHER BCD DIGIT
CALL PutNyb
SWAPF bcd+3,W ; GET NEXT DIGIT
CALL PutNyb ; DISPLAY IT
MOVF bcd+3,W ; GET OTHER BCD DIGIT
CALL PutNyb ; DISPLAY IT
#ifdef Bad_Display
CALL LINE2 ; WRITE "Mhz" AT end OF LINE
endif
movlw mhz
goto pmsg ; was CALL then RETURN
; call pmsg
; return
;********************************************************************
; Read EEPROM into "AccB"
; W -> memory to read
;********************************************************************
EE_RD BCF BANKSEL ; Bank 0
MOVWF EEADR ; Address to read
XORLW 0x09 ; Special case (no links)
BEQ AVERAGE
CALL EE_R
MOVWF AccB
INCF EEADR,F ; Address to read
CALL EE_R
MOVWF AccB+1
INCF EEADR,F ; Address to read
CALL EE_R
MOVWF AccB+2
RETURN
AVERAGE movlw 0x03 ; AM - use avg BFO freq.
call EE_RD ; Read in one BFO freq
#ifdef testing
movf AccB+0,w ; Debugging copy
movwf dbg0+0
movf AccB+1,w ; Debugging copy
movwf dbg0+1
movf AccB+2,w ; Debugging copy
movwf dbg0+2
endif
if_LSB movlw 0x08 ; Then add second
movwf EEADR
call EE_R
#ifdef testing
movwf dbg1+2 ; Debugging copy
endif
addwf AccB+2,f ; handle carry
bcc if_ISB
incf AccB+1,f
bne if_ISB
incf AccB+0,f
if_ISB
; call debug
decf EEADR,f
call EE_R
#ifdef testing
movwf dbg1+1 ; Debugging copy
endif
addwf AccB+1,f ; & carry again
bcc if_MSB
incf AccB+0,f
if_MSB
; call debug
decf EEADR,f
call EE_R
#ifdef testing
movwf dbg1+0 ; Debugging copy
endif
addwf AccB+0,f
#ifdef testing
movf AccB+0,w ; Debugging copy
movwf dbg2+0
movf AccB+1,w ; Debugging copy
movwf dbg2+1
movf AccB+2,w ; Debugging copy
movwf dbg2+2
endif
rrf AccB+0,f ; Divide by 2
rrf AccB+1,f
rrf AccB+2,f
bcf AccB+0,7 ; Clear carry in bit
#ifdef testing
movf AccB+0,w ; Debugging copy
movwf dbg3+0
movf AccB+1,w ; Debugging copy
movwf dbg3+1
movf AccB+2,w ; Debugging copy
movwf dbg3+2
endif
; call debug
return
EE_R BSF BANKSEL ; Bank 1
BSF EECON1,RD ; EE Read
BCF BANKSEL ; Bank 0
MOVF EEDATA,W ; W = EEDATA
RETURN
;********************************************************************
; Write EEPROM from "AccB"
; W -> memory to write
;********************************************************************
EE_WR BSF BANKSEL ; Bank 1
BCF INTCON,GIE ; Disable INTs.
BCF BANKSEL ; Bank 0
MOVWF EEADR ; Address to write
MOVF AccB+0,W ; Get data byte #1
CALL EE_W
INCF EEADR,F ; Fix address
MOVF AccB+1,W ; Get data byte #2
CALL EE_W
INCF EEADR,F
MOVF AccB+2,W ; Get data byte #3
CALL EE_W
BSF BANKSEL ; Bank 1
BSF INTCON,GIE ; Enable INTs.
BCF BANKSEL ; Bank 0
RETURN
EE_W MOVWF EEDATA
BSF BANKSEL ; Bank 1
BSF EECON1,WREN ; Enable Write
MOVLW 0x55 ;
MOVWF EECON2 ; Write 0x55
MOVLW 0xAA ;
MOVWF EECON2 ; Write 0xAA
BSF EECON1,WR ; Set WR bit (begin write)
EE_W2 BTFSC EECON1,WR ; Wait for write to finish
GOTO EE_W2
BCF EECON1,EEIF ; clear interrupts
BCF BANKSEL ; Bank 0
RETURN
;********************************************************************
; Timer Interrupt service. First save W and STATUS
;********************************************************************
ISR
PUSH MOVWF W_TEMP ; Copy W to temp register,
SWAPF STATUS,W ; Swap status to be saved into W
MOVWF STATUS_TEMP ; Save status to STATUS_TEMP register
; Timer interrupt stuff
btfsc INTCON,T0IF ; Has timer interrupted?
bsf Ovr_Rng ; Yes = Over-range
bcf INTCON,T0IF ; Clear timer interrupt anyway
POP SWAPF STATUS_TEMP,W ; Swap nibbles in STATUS_TEMP register
; and place result into W
MOVWF STATUS ; Move W into STATUS register
; (sets bank to original state)
SWAPF W_TEMP,F ; Swap nibbles in W_TEMP and place result in W_TEMP
SWAPF W_TEMP,W ; Swap nibbles in W_TEMP and place result into W
bcf INTCON,2 ; Clear timer interrupt bit
retfie ; TOS -> PC, 1 -> GIE
;********************************************************************
; Testing counter
;********************************************************************
#ifdef testing
ctest movlw 0xfe ; MS byte of loop count
movwf COUNT2 ; Counted upward till it overflows
movlw 0x1d
movwf COUNT1
movlw 0xc0
movwf COUNT0
cloop bcf PUFF ; Toggle counter input once
bsf PUFF
incfsz COUNT0,f
goto cloop
incfsz COUNT1,f
goto cloop
incfsz COUNT2,f
goto cloop
return
;***********************************************************************
;
; Debugging Memory & Register dump
;
debug
MOVWF D_Wtemp ; Copy W to temp register,
SWAPF STATUS,W ; Swap status to be saved into W
MOVWF D_Stemp ; Save status to D_Stemp register
movf FSR,W ; Save FSR
movwf D_FSR
movlw 0x57 ; W=
call putchr
movlw 0x3d
call putchr
movf D_Wtemp,w
call hex_2
movlw 0x20 ; 2 spaces, just to be neat
call putchr
movlw 0x20
call putchr
movlw 0x53 ; SR=
call putchr
movlw 0x52
call putchr
movlw 0x3d
call putchr
movf D_Stemp,w
call hex_2
movlw 0x0d ; CRLF
call putchr
movlw 0x0a
call putchr
clrf FSR ; Ready for memory dump
D_loop movf 0,W ; Read indirect
call hex_2
movlw 0x20
call putchr
incf FSR,f ; to next byte
movf FSR,w ; end of line?
andlw 0x0F
bne next_ln
movlw 0x0d ; CRLF
call putchr
movlw 0x0a
call putchr
bra chk4end
next_ln andlw 0x03 ; Groups of 4
bne chk4end
movlw 0x20
call putchr
chk4end movf FSR,w ; All done?
addlw 0xB0
bne D_loop
movlw 0x0d ; CRLF
call putchr
movlw 0x0a
call putchr
movlw 0x0d ; CRLF
call putchr
movlw 0x0a
call putchr
movf D_FSR,W ; Restore FSR
movwf FSR
SWAPF D_Stemp,W ; Swap nibbles in D_Stemp register
; and place result into W
MOVWF STATUS ; Move W into STATUS register
; (sets bank to original state)
SWAPF D_Wtemp,F ; Swap nibbles in D_Wtemp and place result in D_Wtemp
SWAPF D_Wtemp,W ; Swap nibbles in D_Wtemp and place result into W
return
;***********************************************************************
;
; Print W as 2 Hex digits
;
hex_2 movwf D_hex
swapf D_hex,w ; Get big bit
call hex_3
movf D_hex,w ; Get little bit
hex_3 andlw 0x0f ; keep bottom 4 bits
addlw 0xF6
bcc hex_4
addlw 0x07 ; binary A -> ASCII A
hex_4 addlw 0x3A ; binary 0 -> ASCII 0
;********************************************************
;
; Output Routines for PIC16F84
;
; Clock is 4.0 MHz.
; ie. 1.0 us per cycle = 4/Fosc.
;
; 9600 Baud = 104.17 us
; = 104.17 CPU cycles
;
;********************************************************
;
; Output the character in W. Assumes Mac is ready.
;
; Uses W
;
putchr movwf S_Wtemp ; Character being output
movlw 0x08 ; Bit count
movwf S_count
bcf S_out ; Send a 0 - Start bit
put_clp movlw 0xE7 ; Delay "104" cycles
txd_0 addlw 0x01
bne txd_0
rrf S_Wtemp,f ; Transmit a bit
bcs t_0
bcf S_out ; Send a 0
bra tx_1
t_0 bsf S_out ; Send a 1
tx_1 decfsz S_count,f ; Done all bits?
goto put_clp
movlw 0xE7 ; Delay for last data
txd_1 addlw 0x01
bne txd_1
bsf S_out ; Transmit two stop bit
movlw 0xCD
txd_9 addlw 0x01
bne txd_9
return
endif
;********************************************************************
; Tail End Charlie
;********************************************************************
END
http://www.qariya.com/electronics/frequency_meter.htm