; RAMU ; ; (c) Cumbria Designs 2007 ; ; ;========================================================================================== ; ; Remote Antenna Matching Unit ; ;========================================================================================== ; ; This software is copyright of Cumbria Designs and provided free for non commerical use. ; Licences for the commercial use of this software or any of the modules from which it is comprised, ; may be obtained by applying to sales@cumbriadesigns.co.uk ; ; The program has been written to provide those new to PIC programming with an insight into ; MPLAB assembler use and in particular program structure an use of flags to control program ; flow. The modular nature of the program provides a useful source of subroutines that may ; be adapted for use in other programs. Rather than attempt to streamline code to improve ; execution speed or reduce memory usage, we have deliberately avoided the use of clever ; tricks or shortcuts, using extra lines of code where appropriate to provide clarity. This ; should make the program, and the modules that comprise it easier for the newcomer to follow ; and adapt for their own use. ; ; The software is provided without warranty or licence and no liability is accepted by the ; author or Cumbria Designs for any loss, injury, mishap, inconvenience or misdemeanor ; arising from the use of the software in whole or part. In using this software and the ; code compiled from it, you agree to these terms. ; ; ; ; Ron Taylor G4GXO ; ; ; Now lets get on with the fun bit... ; ; ;========================================================================================== ; ; 16F877A Target Prcoessor Pin Out ; ;========================================================================================== ; ; PORT A ; 0 RESERVED FOR ANALOGUE EXPANSION ; 1 ; 2 ; 3 ; 4 ; 5 ; ; PORT B ; 0 SPARE ; 1 LCD_RS ; 2 LCD_RW ; 3 LCD_E ; 4 LCD Data 4 ; 5 LCD Data 5 ; 6 LCD Data 6 ; 7 LCD Data 7 ; ; PORT C ; 0 RESERVED FOR EXPANSION ; 1 ; 2 ; 3 ; 4 Auxilliary Latch Out Channel 2 ; 5 Auxilliary Latch Out Channel 3 ; 6 Auxilliary Latch Out Channel 4 ; 7 Auxilliary Latch Out Channel 5 ; ; PORT D ; 0 A Capacitor Encoder ; 1 B ; 2 A Inductor Encoder ; 3 B ; 4 DOWN/SLOW Button ; 5 UP/FAST Button ; 6 SELECT Button ; 7 UP Button ; ; Port E ; 0 Serial Data Out ; 1 Serial Clock Out ; 2 Latch Out Channel 1 ; ;========================================================================================== ; ; Revision History ; ;========================================================================================== ; Rev:1.0 ; Rev:1.1 2 Nov 2007 ; Correction to step size set up routines to halt increments at maximum value. ; Context save and restore modified to prevent unwanted changes to STATUS its. ; My thanks to Francis Dupont F6HSI for spotting these and offering solutions. ;========================================================================================== ; ; Processor ; ;========================================================================================== list p=16f877A , r = dec ; list directive to define processor #include ; processor specific variable definitions errorlevel -302 ; suppress message 302 from list file ;========================================================================================== ; ; CONFIGURATION BITS ; ;========================================================================================== ;_CP_ALL EQU H'0FCF' ;_CP_HALF EQU H'1FDF' ;_CP_UPPER_256 EQU H'2FEF' ;_CP_OFF EQU H'3FFF' ;_DEBUG_ON EQU H'37FF' ;_DEBUG_OFF EQU H'3FFF' ;_WRT_ENABLE_ON EQU H'3FFF' ;_WRT_ENABLE_OFF EQU H'3DFF' ;_CPD_ON EQU H'3EFF' ;_CPD_OFF EQU H'3FFF' ;_LVP_ON EQU H'3FFF' ;_LVP_OFF EQU H'3F7F' ;_BODEN_ON EQU H'3FFF' ;_BODEN_OFF EQU H'3FBF' ;_PWRTE_OFF EQU H'3FFF' ;_PWRTE_ON EQU H'3FF7' ;_WDT_ON EQU H'3FFF' ;_WDT_OFF EQU H'3FFB' ;_LP_OSC EQU H'3FFC' ;_XT_OSC EQU H'3FFD' ;_HS_OSC EQU H'3FFE' ;_RC_OSC EQU H'3FFF' __config (_CP_OFF & _PWRTE_ON & _DEBUG_OFF & _WDT_OFF & _LVP_OFF & _HS_OSC) ;========================================================================== ; ; Definitions ; ; The DEFINE command provides a flexible naming system for Variables, Ports, ; Bits and Sub Routine names.Where DEFINE is used, a name is assigned to the ; item or resource described. Thereafter when the compiler sees the assigned ; name it recognises what it refers to and uses the value or resource name ; when forming the object code. A typical application might be for naming of an ; individual port pin etc. For example instead of writing; ; ; btfss PORTB, 7 we could define PORTB, 7 as say, INPUT. Our code could then ; be written as; ; ; btfss PORTB INPUT ; ;========================================================================== ; RAMU Assignments ; PORT A #DEFINE PORTA_DIR 0xFF ; Port Direction values used during initialisation ; PORT B #DEFINE PORTB_DIR 0x00 ; Port Direction values used during initialisation #DEFINE LCD_PORT PORTB ; LCD Connected to PORT B #DEFINE LCD_DIR TRISB ; LCD Port Direction Register #DEFINE LCD_INPUTS 0xF0 ; Template to set direction of LCD data lines to inputs #DEFINE LCD_OUTPUTS 0x00 ; Template to set direction of LCD data lines to outputs #DEFINE LCD_30 0x30 ; Initialisation value - set by position of data lines on port #DEFINE LCD_20 0x20 ; Initialisation value - set by position of data lines on port #DEFINE BUSY_FLAG PORTB,7 ; LCD Busy Flag #DEFINE LCD_RS PORTB,1 ; RAM Select bit #DEFINE LCD_RW PORTB,2 ; Read/Write bit #DEFINE LCD_E PORTB,3 ; Enable bit #DEFINE LCD_PORT_ZERO 0x00; Clear LCD PORT, LCD Power Switching not used on R-AMU ; PORT C #DEFINE PORTC_DIR 0x0F ; Port Direction values used during initialisation ; PORT D #DEFINE PORTD_DIR 0xFF ; Port Direction values used during initialisation #DEFINE ENCODERS PORTD ; Encoder on PORT D #DEFINE SWITCHES PORTD ; Control switches on PORT D #DEFINE SWITCH_MASK 0xF0 ; Mask for switches on PORT D ; PORT E #DEFINE PORTE_DIR 0x00 ; Port Direction values used during initialisation #DEFINE Data_Out PORTE,0 ; Data to remote switching unit #DEFINE Data_Clock PORTE,1 ; Data Clock to remote switching unit #DEFINE Data_Latch PORTE,2 ; Data Latch to remote switching unit ; LCD Routine Names #DEFINE LCD_chr LCD_CHR_RAMU #DEFINE LCD_ins LCD_INS_RAMU ;-------------------------------------------------------------------------- ; Flags #DEFINE Man_Mem Mode,0 ; Flag to record Manual or Memory operating mode #DEFINE data_new data_flags,0 ; Flag used outside ISR to trigger a data send ; Common Equates, used as add on labels to register names when identifying a bit ; or port pin associated with the register ; Encoder Flags step_flag equ 0x00 ; Step flag bit 1= step required, 0 = no step required dir_flag equ 0x01 ; Direction flag 1 = up, 0 = down ; Count Flags #DEFINE LimitC_flag count_flags,0 ; Flag to mark if we have exceeded upper count limit for C #DEFINE LimitL_flag count_flags,1 ; Flag to mark if we have exceeded upper count limit for L ; Switch bits #DEFINE UP controls,4 #DEFINE DOWN controls,5 #DEFINE SEL controls,6 #DEFINE MODE controls,7 ; Step Limit for step size changes in Set Up #DEFINE STEPLIMIT 0x14 ; Set maximum value of step adjustment range ; EEPROM Data ORG 0x2100 ; Intialise step rates in EEPROM DATA 0x01 ; Rate1 DATA 0x02 ; Rate2 DATA 0x04 ; Rate3 DATA 0x08 ; Rate4 DATA 0x10 ; Rate5 ;========================================================================================== ; ; FILE REGISTER EQUATES ; ;========================================================================================== ; List all the variable names here so that MPLAB can assign register addresses to them CBLOCK 0x20 ; Start Data Block aux_ch ; Auxiliary output channel adress ch_no ; Auxiliary channel number in decimal for display address ; Address counter for EEPROM L_byte ; Binary inputs for H_byte ; binary to BCD conversion BCD0 ; BCD addresses, keep them together and in BCD1 ; ascending order to support FSR addressing BCD2 ; used in conversion algorithm count ; General purpose counter counter_1 ; Delay Counters counter_2 counter_3 outputC0 ; C output count low byte (used within interrupt routine) outputC1 ; C output count high byte (used within interrupt routine) outputL0 ; L output count low byte (used within interrupt routine) outputL1 ; L output count high byte (used within interrupt routine) C0 ; Working C registers C1 ; L0 ; Working L registers L1 ; count_flags ; Flags used to control counter limits overcountC0 ; Stores for overcount values overcountC1 overcountL0 overcountL1 limitC0 ; Count upper limits limitC1 limitL0 limitL1 controls ; Button inputs bit_count ; Serial data output counter data_0 ; Serial output word data_1 ; data_2 ; data_flags ; Flag to mark that there is data ready for transmission data_refresh ; Counter to invoke data send to relay unit display_refresh ; Counter to control display refresh rate EncoderC ; C Channel ; Encoder output flag word Bit0 step flag, Bit1 dir flag encoder_oldC ; Previous encoder state encoder_newC ; Current encoder state encoder_dir_oldC ; Old direction bit (bit 1, 1= up 0 = down) encoder_dir_newC ; Current direction bit ----------"------------ EncoderL ; L Channel ; Encoder output flag word Bit0 step flag, Bit1 dir flag encoder_oldL ; Previous encoder state encoder_newL ; Current encoder state encoder_dir_oldL ; Old direction bit (bit 1, 1= up 0 = down) encoder_dir_newL ; Current direction bit ----------"------------ step0 ; Step size step1 ; stemp0 ; Temporary step size stores stemp1 ; steprate1 ; Steprate registers steprate2 ; steprate3 ; steprate4 ; steprate5 ; LCD_data temp ; Temporary stores temp0 ; temp1 ; zeroflag ; used for display leading zero supression w_temp ; Temporary store for w register contents during Interrupt STATUS_temp ; Temporary store for Status register contents during interrup ENDC ; End of Data Block ;========================================================================================== ; ; MACRO AREA ; ;========================================================================================== ; Bank Select Macros to simplify memory bank changes Bank0 MACRO bcf STATUS,RP0 ; Select Bank 0 bcf STATUS,RP1 ; ENDM Bank1 MACRO bsf STATUS,RP0 ; Select Bank 1 bcf STATUS,RP1 ; ENDM Bank2 MACRO bcf STATUS,RP0 ; Select Bank 2 bsf STATUS,RP1 ; ENDM Bank3 MACRO bsf STATUS,RP0 ; Select Bank 3 bsf STATUS,RP1 ; ENDM ;========================================================================================== ; ; RESET ENTRY ; ;========================================================================================== ORG 0x000 ; Processor reset vector clrf PCLATH ; Ensure page bits are cleared goto Start ; Go to beginning of program ;========================================================================================== ; ; INTERRUPT ROUTINE ; ; Look for changes in the Rotary Encoder. Each encoder has two channels A and B on PORTC ; pins 0..1 and 2..3. In one direction channel A leads channel B in the opposite direction ; channel A lags channel B. ; ; Direction 1 Direction 2 ; B A B A ; 0 0 0 0 ; 0 1 1 0 ; 1 1 1 1 ; 1 0 0 1 ; ; To determine direction, shift the previous result left one bit and xor the 3 bit result ; with the current 2 bit result. For Direction 1 bit1 will always be zero, for Direction 2 ; bit 1 will always be 1. Any detected change represents a step. ; ; e.g Second and third samples; ; bit 2 1 0 bit 2 1 0 ; ; 0 1 0 1 0 0 ; 1 1 1 1 ; XOR 0 0 1 XOR 1 1 1 ; ; Bit 1 = 0 Bit 1 = 1 ; ; Direction bits from each change are compared with the previous bit. When a mismatch ; (change of direction) is seen no action is taken until the direction bits match ; confirming correct operation. ; ; The output from the encoder routine is the encoder word flag word; ; Encoder,0 Step flag 0 = no step, 1 = step required ; Encoder,1 Direction flag 0 = down, 1 = up ; ; ; STEP ROUTINES ; ; The routines in this section add or subtract the selected step size from the the output ; word. As the output word is only 10 bits long 16 bit arithmetic is used.Two identical ; routines are used to generate the Capacitor and Inductor output words. These add or ; subtract step increments in repsonse to encoder changes. The resulting 10 bit words ; are held in outputC0, outputC1 and outputL0 and outputL1. These are assembled into a ; bit data stream and sent to the remote end by the Data Send routine. ; ;========================================================================================== ORG 0x004 Interrupt_entry ; Context save avoiding unwanted change to flag bits (notably Z) movwf w_temp ; movwf does not modify STATUS swapf STATUS,w ; swapf does not modify STATUS -> w = old one, but bits are swapped 3210 7654 movwf STATUS_temp ; status_Save = old status but swapped Rate_select ; Set tuning step size according to binary break points in output word btfss outputC1,1 ; Test 512 bit goto $+4 movf steprate5,w ; Set rate 5 movwf step0 goto Encoder_ScanC btfss outputC1,0 ; Test 256 bit goto $+4 movf steprate4,w ; Set rate 4 movwf step0 goto Encoder_ScanC btfss outputC0,7 ; Test 128 bit goto $+4 movf steprate3,w ; Set rate 3 movwf step0 goto Encoder_ScanC btfss outputC0,6 ; Test 64 bit goto $+4 movf steprate2,w ; Set rate 2 movwf step0 goto Encoder_ScanC btfss outputC0,5 ; Test 32 bit goto $+4 movf steprate1,w ; Set rate 1 movwf step0 goto Encoder_ScanC movlw 0x01 ; Else set unity rate movwf step0 Encoder_ScanC movf ENCODERS,w ; Get the current encoder value andlw 0x03 ; Mask encoder bits 00000011 movwf encoder_newC ; Save it xorwf encoder_oldC,w ; Has it changed? btfsc STATUS,Z ; goto Rate_select_L ; No, check inductor channel Encoder_directionC rlf encoder_oldC,w ; Yes, evaluate change, shift left one bit, save in w xorwf encoder_newC,w ; XOR with new value, save in w andlw 0x02 ; Mask direction bit 00000010 movwf encoder_dir_newC ; Save for testing ; Check for encoder error due to missed sample or overspeed ; XOR with previous direction to see if there is a change ; in direction. If seen take no action until next sample ; confirms direction. xorwf encoder_dir_oldC,w btfsc STATUS,Z ; Do last and new directions match (result zero, Z=1)? goto EncoderC_good ; Yes, encoder direction unchanged, proceed with step Encoder_dir_changeC ; No, encoder error or change or direction seen movf encoder_dir_newC,w ; Save new direction bit setting movwf encoder_dir_oldC ; for next pass goto Rate_select_L ; Test Inductor channel EncoderC_good movf encoder_newC,w ; Yes, save the new encoder bits for next sample movwf encoder_oldC ; (Direction bit still valid, no need to update) btfss encoder_dir_oldC,1 ; Test direction bit goto Step_SubC16 ; Subtract step ;----------------------------------------------------------------------------------------------------------------------- ; Addition Routine ; Add step size to capacitor output word ;----------------------------------------------------------------------------------------------------------------------- Step_AddC16 ; We're going up, add step btfsc LimitC_flag ; Are we at the limit? goto Rate_select_L ; Yes, go to inductor channel movf step0,w ; No, get low byte of the increment addwf outputC0,f ; Add it to the low byte of output word btfss STATUS,C ; Any carry? goto Step_AddC1 ; No, add next byte incf outputC1,f ; Yes, ripple carry up to the next byte Step_AddC1 movf step1,w ; Get the next increment byte addwf outputC1,f ; Add it to the next higher byte ; Check to see that output count does not exceed the 10 bit control range, if it has ; overwrite count value with limitC to hold count at max value and save overcount value ; for next subtraction to keep counting in sync.. Step_LimitC movf outputC0,w ; Make a working copy of the output word movwf temp0 movf outputC1,w movwf temp1 movf temp0,w ; Has the output count exceeded the limit value? subwf limitC0,w ; Subtract limit from output (temp) btfss STATUS,C ; Did we go negative? (C=0) incf temp1,f ; Yes, increment the higher order byte (rather than decrement limit which we want to preserve) movf temp1,w ; No, carry out subtraction on higher byte subwf limitC1,w btfsc STATUS,C ; Did we go negative? (C=0) goto Rate_select_L ; no, go to inductor channel LimitC ; Yes, at limit, prevent any further increments and display limit value bsf LimitC_flag ; Set limit flag movf outputC0,w ; Save over count value for calculating next decrement movwf overcountC0 movf outputC1,w movwf overcountC1 movf limitC0,w ; Send limit value to display and relay set movwf outputC0 movf limitC1,w movwf outputC1 goto Rate_select_L ; Test inductor channel ;----------------------------------------------------------------------------------------------------------------------- ; Subtraction uses 2s compliment method. make one value negative by complimenting ; it and add it to the other value. Equivalent to +A +(-B) ;----------------------------------------------------------------------------------------------------------------------- Step_SubC16 ; Subtraction of step from output is done by adding 2s compliment of step to output btfss LimitC_flag ; Are we counting down from an overflow? goto $+6 ; No, continue movf overcountC0,w ; Yes, load up the overcount value to provide the point to start subtracting from movwf outputC0 movf overcountC1,w movwf outputC1 bcf LimitC_flag ; Clear the over count flag movf step0,w ; Make a copy of step to conserve the setting during calculation movwf stemp0 ; movf step1,w ; movwf stemp1 ; comf stemp0,f ; comf stemp1,f ; Complement stemp incfsz stemp0,f ; Increment least significant byte, if it goes to zero increment stemp1 goto Step_SubC1 ; Non-zero, continue incf stemp1,f ; First byte went to zero (overflow), increment next byte Step_SubC1 ; Step has now been made negative movf stemp0,w ; Get low byte of the increment, add to output count addwf outputC0,f ; Add it to the low byte of output word btfss STATUS,C ; Any carry? goto Step_SubC2 ; No, add next byte incf outputC1,f ; Yes, ripple carry up to the next byte Step_SubC2 movf stemp1,w ; Get the next increment byte addwf outputC1,f ; Add it to the next higher byte ; If we have gone below zero count will be negative, if this happens load output registers ; with zero to hold output at minimum value. btfss outputC1,7 ; Is MSB of upper byte 1 indicating negative value? goto Rate_select_L ; No, result is positive, no need to do anything clrf outputC0 ; Result negative, set output registers to minimum value clrf outputC1 ; of zero by clearing them ; Finished with Capacitor Channel, test Inductor Channel ;----------------------------------------------------------------------------------------------------------------------- ; Inductor Channel ;----------------------------------------------------------------------------------------------------------------------- Rate_select_L ; Set tuning step size according to binary break points in output word ; Test 512 bit btfss outputL1,1 goto $+4 movf steprate5,w ; Set rate 5 movwf step0 goto Encoder_ScanL ; Test 256 bit btfss outputL1,0 goto $+4 movf steprate4,w ; Set rate 4 movwf step0 goto Encoder_ScanL ; Test 128 bit btfss outputL0,7 goto $+4 movf steprate3,w ; Set rate 3 movwf step0 goto Encoder_ScanL ; Test 64 bit btfss outputL0,6 goto $+4 movf steprate2,w ; Set rate 2 movwf step0 goto Encoder_ScanL ; Test 32 bit btfss outputL0,5 goto $+4 movf steprate1,w ; Set rate 1 movwf step0 goto Encoder_ScanL movlw 0x01 ; Else set unity rate movwf step0 Encoder_ScanL movf ENCODERS,w ; Get the current encoder value andlw 0x0C ; Mask encoder bits 00001100 movwf encoder_newL ; Save it xorwf encoder_oldL,w ; Has it changed? btfss STATUS,Z ; goto Encoder_directionL ; Yes goto Interrupt_exit ; No Encoder_directionL rlf encoder_oldL,w ; Shift left one bit, save in w xorwf encoder_newL,w ; XOR with new value, save in w andlw 0x08 ; Mask direction bit 00001000 movwf encoder_dir_newL ; Save for testing ; Check for encoder error due to missed sample or overspeed ; XOR with previous direction to see if there is a change ; in direction. If seen take no action until next sample ; confirms direction. xorwf encoder_dir_oldL,w btfsc STATUS,Z ; Do last and new directions match (result zero, Z=1)? goto EncoderL_good ; Yes, encoder direction unchanged, proceed with step Encoder_dir_changeL ; No, encoder error or change or direction seen movf encoder_dir_newL,w ; Save new direction bit setting movwf encoder_dir_oldL ; for next pass goto Interrupt_exit ; Exit EncoderL_good movf encoder_newL,w ; Yes, save the new encoder bits for next sample movwf encoder_oldL ; (Direction bit still valid, no need to update) btfss encoder_dir_oldL,3 ; Test direction bit (masked earlier by 0x08) goto Step_SubL16 ; Subtract step ;----------------------------------------------------------------------------------------------------------------------- ; Addition Routine ; Add step size to capacitor output word ;----------------------------------------------------------------------------------------------------------------------- Step_AddL16 ; We're going up, add step btfsc LimitL_flag ; Are we at the limit? goto Interrupt_exit ; Yes, exit movf step0,w ; Get low byte of the increment addwf outputL0,f ; Add it to the low byte of output word btfss STATUS,C ; Any carry? goto Step_AddL1 ; No, add next byte incf outputL1,f ; Yes, ripple carry up to the next byte Step_AddL1 movf step1,w ; Get the next increment byte addwf outputL1,f ; Add it to the next higher byte ; Check to see that output count does not exceed the 10 bit control range, if it has ; overwrite count value with limitL to hold count at max value and save overcount value ; for next subtraction to keep counting in sync. Step_LimitL movf outputL0,w ; Make a working copy of the output word movwf temp0 movf outputL1,w movwf temp1 movf temp0,w ; Has the output count exceeded the limit value? subwf limitL0,w ; Subtract limit from output (temp) btfss STATUS,C ; Did we go negative? (C=0) incf temp1,f ; Yes, increment the higher order byte (rather than decrement limit which we want to preserve) movf temp1,w ; No, carry out subtraction on higher byte subwf limitL1,w btfsc STATUS,C ; Did we go negative? (C=0) goto Interrupt_exit ; No, exit LimitL ; At limit, prevent any further increments and display limit value bsf LimitL_flag ; Set limit flag movf outputL0,w ; Save over count value for calculating next decrement movwf overcountL0 movf outputL1,w movwf overcountL1 movf limitL0,w ; Send limit value to display and relay set movwf outputL0 movf limitL1,w movwf outputL1 goto Interrupt_exit ; Exit ;----------------------------------------------------------------------------------------------------------------------- ; Subtraction uses 2s compliment method. make one value negative by complimenting ; it and add it to the other value. Equivalent to +A +(-B) ;----------------------------------------------------------------------------------------------------------------------- Step_SubL16 ; Subtraction of step from output is done by btfss LimitL_flag ; Are we counting down from an overflow? goto $+6 ; No, continue movf overcountL0,w ; Yes, load up the overcount value to provide the point to start subtracting from movwf outputL0 movf overcountL1,w movwf outputL1 bcf LimitL_flag ; Clear the over count flag movf step0,w ; Make a copy of step to conserve the setting during calculation movwf stemp0 ; movf step1,w ; movwf stemp1 ; comf stemp0,f ; adding the 2s compliment of step to output comf stemp1,f incfsz stemp0,f ; Increment last byte goto Step_SubL1 ; Non-zero, continue incf stemp1,f ; First byte went to zero (overflow), increment next byte Step_SubL1 ; Step has now been made negative, add to output count movf stemp0,w ; Get low byte of the increment addwf outputL0,f ; Add it to the low byte of output word btfss STATUS,C ; Any carry? goto Step_SubL2 ; No, add next byte incf outputL1,f ; Yes, ripple carry up to the next byte Step_SubL2 movf stemp1,w ; Get the next increment byte addwf outputL1,f ; Add it to the next higher byte ; If we have gone below zero count will be negative, if this happens load output registers ; with zero to hold output at minimum value. btfss outputL1,7 ; Is MSB of upper byte 1 indicating negative value? goto Interrupt_exit ; No, result is positive, no need to do anything clrf outputL0 ; Result negative, set output registers to minimum value clrf outputL1 ; of zero by clearing them Interrupt_exit bcf INTCON,T0IF ; Reset TMR0 Interrupt flag ; Context restore without changing STATUS flag bits swapf STATUS_temp,w ; w = old status in right order 7654 3210 movwf STATUS ; STATUS = old status -> OK swapf w_temp,f ; w_Save = old w, but swapped -> 3210 7654 swapf w_temp,w ; w = old w, in right order 7654 3210 -> OK retfie ; Return from Interrupt ;************************************************************** ; START OF PROGRAM ;************************************************************** org 0x100 Start ; Initialise Ports Bank0 clrf PORTA Bank1 ; Switch to Bank 1 movlw b'00000110' ; PORTA Digital movwf ADCON1 movlw PORTA_DIR ; PORTA direction movwf TRISA movlw PORTB_DIR ; PORTB direction movwf TRISB movlw PORTC_DIR ; PORTC direction movwf TRISC movlw PORTD_DIR ; PORTD direction movwf TRISD movlw PORTE_DIR ; PORTE direction movwf TRISE bcf OPTION_REG,7 ; Enable weak pull ups Bank0 ; Switch to Bank0 clrf PORTA ; Initialise the LCD and prepare the ports and variables clrf PORTB ; clrf PORTC ; clrf PORTD ; clrf PORTE ; call LCD_init ; Initialise LCD on PORTB 4 bit interface, no busy flag check movlw 0x01 ; Set up unity step size movwf display_refresh movwf aux_ch ; Set Auxiliary Output channel to 1 movwf ch_no ; Set displayed channel number to 1 clrf step1 ; Clear higher order step register (lor order is loaded from EEPROM) call Start_msg call Delay_long call Start_msg2 ; Display second start up message ; Load preferences from EEPROM Bank2 clrf EEADR ; Reset the EEPROM read address Bank0 ; Get Step Rates call Read_EEPROM ; Get Rate 1 movf EEDATA,w ; On return we are in Bank1 for EEDATA instruction, set to Bank0 Bank0 ; movwf steprate1 ; Save call Read_EEPROM ; Get Rate 2 movf EEDATA,w ; On return we are in Bank1 for EEDATA instruction, set to Bank0 Bank0 ; movwf steprate2 ; Save call Read_EEPROM ; Get Rate 3 movf EEDATA,w ; On return we are in Bank1 for EEDATA instruction, set to Bank0 Bank0 ; movwf steprate3 ; Save call Read_EEPROM ; Get Rate 4 movf EEDATA,w ; On return we are in Bank1 for EEDATA instruction, set to Bank0 Bank0 ; movwf steprate4 ; Save call Read_EEPROM ; Get Rate 5 movf EEDATA,w ; On return we are in Bank1 for EEDATA instruction, set to Bank0 Bank0 ; movwf steprate5 ; Save ; Set upper count limits to 1000 movlw 0xE8 movwf limitC0 movwf limitL0 movlw 0x03 movwf limitC1 movwf limitL1 ; Test for set up mode movlw 0x14 ; Load 20d movwf temp ; into temp movf PORTD,w ; Get switch inputs andlw 0xF0 ; Isolate switch inputs movwf controls ; Save xorlw 0xF0 ; Are any of the switch states at zero (operated)? btfss STATUS,Z ; 1= no change, 0 = change goto Set_Up ; Jump to Set Up routine call Delay_100mS ; Call 100mS delay decfsz temp,f ; Decrement counter, have we reached zero? goto $-8 ; No, retest ; Yes continue with initialisation ; Configure Display call LCD_clear ; Clear the LCD ; clrf Mode ; Normal operating display mode call Binary_to_BCD call Display_LC ; Bring up normal operating display call Aux_msg ; Show Auxiliary Output Channel ; Configure TMR0 interrupt Bank1 movlw b'10000000' ; Set up Option Register ; No Pull Ups, TMR0 Internal Clock, movwf OPTION_REG ; Prescaler assigned to TMR0 movlw b'10100000' ; Set up Interrupt source, GIE enabled, Peripheral interrupts disabled, movwf INTCON ; TMR0 overflow interrupt enabled Bank0 call Delay_100mS ; Delay to allow ISR to run and scan encoders, allowing the counts to be ; set to zero without the ISR incrementing on first reading the ; encoder states clrf outputC0 ; Clear count words clrf outputC1 clrf outputL0 clrf outputL1 clrf C0 ; Clear output words clrf C1 clrf L0 clrf L1 clrf overcountC0 ; Clear overcount stores clrf overcountC1 clrf overcountL0 clrf overcountL1 bcf LimitC_flag ; Clear limit flags bcf LimitL_flag ;========================================================================================== ; ; MAIN ROUTINE ; ; Now we are initialised control is passed to Main. This is the heart of the program, all ; routines are called from here. Main forms a continuous loop ; ; ;========================================================================================== Main ; To keep the display and relays synchronised with the encoder counts, the count data is ; checked for changes outside of the ISR with every cycle of the main program loop. If a ; change is seen the data_new flag is set to trigger data transmission. This ensures that ; the relay states always match the newest data count. If an ISR generated flag were used ; the relay states would lag the actual count as the ISR routine could run part way ; through the slow data send routine causing a mismatch between relay and count data. bcf INTCON,GIE ; Halt interrupts whilst we copy output counts bcf data_new ; Clear new data to send flag movf C0,w ; Look for changes between stored and current counts xorwf outputC0,w btfss STATUS,Z ; If Z=1 then no change seen bsf data_new ; Change seen, set new data to send flag movf C1,w ; Look for changes between stored and current counts xorwf outputC1,w btfss STATUS,Z ; If Z=1 then no change seen bsf data_new ; Change seen, set new data to send flag movf L0,w ; Look for changes between stored and current counts xorwf outputL0,w btfss STATUS,Z ; If Z=1 then no change seen bsf data_new ; Change seen, set new data to send flag movf L1,w ; Look for changes between stored and current counts xorwf outputL1,w btfss STATUS,Z ; If Z=1 then no change seen bsf data_new ; Change seen, set new data to send flag movf outputC0,w ; Update working registers movwf C0 movf outputC1,w movwf C1 movf outputL0,w movwf L0 movf outputL1,w movwf L1 bsf INTCON,GIE ; Resume interrupts Main_display ; To speed up the program, only perform the slow display refresh very "n" passes of the ; main program loop. decfsz display_refresh,f ; Decrement display refresh counter goto Main_controls ; Not zero yet, skip display and goto control scan call Display_LC ; display current settings movlw 0x0A ; Zero, reload refresh counter with "n" and display movwf display_refresh ; L and C values Main_controls ; Look for operation of control buttons movf SWITCHES,w ; Get switch inputs andlw SWITCH_MASK ; Isolate switch inputs movwf controls ; Save xorlw 0xF0 ; Are any of the switch states at zero (operated)? btfss STATUS,Z ; 1= no change, 0 = change call Switches ; Change seen btfss data_new ; New data to send? call Data_Send ; Yes, send data goto Main ; Back round again ;--------------------------------------------------------------------------------------------- Switches ; Identify switch operation and call associated routine Aux_Channels ; Routine for changing Aux Output channel ; ; Four output channels are available within the 24 bit output word for controlling remote ; relays. Each channel is addressed by a 1 in 4 binary code; 1, 2, 4, and 8. The display ; uses a channel number counter ch_no to represent each channel as a number in the range ; of 1 to 4. ; btfss UP ; Look for Up Button operation goto Aux_up ; Increment step size btfss DOWN ; Look for Down Button operation goto Aux_down ; Decrement step size return ; No valid button operation seen, return ;--------------------------------------------------------------------------------------------- Aux_up incf ch_no,f ; Increment channel number bcf STATUS,C ; Clear carry flag to prevent unwanted carry-in rlf aux_ch,f ; Increase count movlw 0x10 ; Load maximum limit subwf aux_ch,w ; Subtract and store result in w btfss STATUS,Z ; Is aux_ch at 16? (Z=1) goto $+5 ; No, display and return movlw 0x08 ; Yes, hold at limit movwf aux_ch movlw 0x04 ; Max decimal channel address movwf ch_no ; Set channel number for display call Aux_msg ; Display channel number call Debounce call Data_Send ; Send data return ;--------------------------------------------------------------------------------------------- Aux_down decf ch_no,f ; Decrement channel number bcf STATUS,C ; Clear carry flag to prevent unwanted carry-in rrf aux_ch,f ; Decrease count movlw 0x00 ; Test for zero addwf aux_ch,w ; btfss STATUS,Z ; Is aux_ch at 0? (Z=1) goto $+4 ; No, display and return movlw 0x01 ; Yes, hold at 1 movwf aux_ch ; Min decimal channel address movwf ch_no ; Set channel number for display call Aux_msg ; Display channel number call Debounce call Data_Send ; Send data return ;========================================================================================== ; ; DATA SEND ; ; Send Data words to output ports as a 24 bit word. C is sent first, L second. The signal ; lines comprise data, clock and latch and are designed to drive three 74HC595 serial to ; parallel decoders. The data rate is set by the value of data_delay, see note below. ; ;========================================================================================== Data_Send ; Form the data word ; ; L9,L8,L7,L6,L5,L4,L3,L2 || L1,L0,C9,C8,C7,C6,C5,C4 || C3,C2,C1,C0,A3,A2,A1,A0 ; clrf data_0 clrf data_1 clrf data_2 ; Aux Channel address movf aux_ch,w ; Move auxiliary control word into data_0 0..3 movwf data_0 ; C Value swapf C0,w ; Swap C0 nibbles, mask and add lower value into data_0 4..7 andlw b'11110000' iorwf data_0,f ; Merge lower nibble into upper nibble of C0 swapf C0,w ; Swap C0 nibbles and copy higher nibble into data_1 0..3 andlw b'00001111' ; Mask movwf data_1 ; swapf C1,w ; Get upper two bits of C andlw b'00110000' ; Mask higher byte to limit to 10 bits iorwf data_1,f ; and merge into data_1 ; L Value btfsc L0,0 ; bsf data_1,6 btfsc L0,1 bsf data_1,7 ; Data word complete and ready for sending movf L0,w ; Copy L1 into temp movwf temp rrf temp,f ; Shift right and save in temp rrf temp,w ; Shift value in temp two bits to the right to occupy 6 bits and mask andlw b'00111111' movwf data_2 ; Place in data_2 btfsc L1,0 ; Add upper two bits to complete 10 bit range bsf data_2,6 btfsc L1,1 bsf data_2,7 ; Data word complete and ready for sending ; ; Serial data transmission routine configured to send 24 bits. The bit rate is set ; by the data_delay value, forlong cable connections this may need to be increased ; for reliable communications. ; ; Bit Period = 4 x data_delay (approx) ; ; Bit Rate = 1/Bit Rate bits/sec ; ; ; ; Data Out ____/''\____ ; ; ; Data Clock _____/'\_/'\_/'\__ ; ; ; Data Latch _________________/'\__ ; ; bcf Data_Out ; Prepare serial port bcf Data_Clock bcf Data_Latch movlw 0x18 ; Load 24d to count each bit movwf bit_count Send_data rrf data_2,f ; Rotate data word right through carry 24 times rrf data_1,f rrf data_0,f btfss STATUS,C ; Was the carry bit 1? goto data_zero ; No, send a zero data_one ; Yes, send a 1 bsf Data_Out ; Set output high goto send_bit ; Send the bit data_zero bcf Data_Out ; Set output low send_bit call data_delay ; Wait bsf Data_Clock ; Clock the data call data_delay ; Wait bcf Data_Clock ; Drop clock call data_delay ; Wait decfsz bit_count,f goto Send_data ; Back round for next bit data_latch ; Finished, latch in the new word bsf Data_Latch ; Raise latch to present data to outputs bsf PORTB,0 call data_delay ; Wait bcf Data_Latch ; Drop latch call data_delay ; Wait bcf Data_Out ; Clear data line bsf PORTB,0 return ; Back to caller data_delay call Delay return ; Next bit unused, save for future development to optimise data rate speed movlw 0x3 ; Load 3 into w, multiples of 1uSec movwf counter_1 timing1 ; 5 x 200nS = 1uS per pass at 20MHz nop ; 1 nop ; 2 decfsz counter_1,f ; 3 Decrement goto timing1 ; 5 return ;========================================================================================== ; ; BINARY TO BCD ROUTINE ; ; Based upon Microchip AN526 converts a 16 bit binary number into a 5 digit decimal value. ; Input is held in L_byte and H_byte, output is a packed BCD number in BCD..BCD2. ; ; The "Shift and Add 3 Algorithm" is used for this routine. Each successive binary shift is ; a multiplication by 2. Our BCD digits cannot hold numbers at 10 or greater. To identify ; a value on the next shift that will equal 10 or more we test the result in a nibble to see ; if it is 5 or more by adding 3 and testing the state of bit3 (result=>8). If the result is ; =>8 then the new value is accumulated into the output register, if less than 8 then the ; original value (0-4) is left unchanged. ; ; Shifting the accumulated result doubles it, so the added value of 3 becomes 6 taking any ; original value of 5 or more to 16 or more. This introduces a carry in the form of an ; overflow into the lower bit of the next higher BCD digit. e.g. ; ; 0000 0101 (5) ; 0011 +3 ; 1000 8, bit set, accumulate ; 0001 0000 BCD Result on next doubling (2x5=10) ; ;========================================================================================== Binary_to_BCD bcf STATUS,C ; clear the carry bit movlw 0x10 ; Load count with 16d movwf count ; clrf BCD0 ; Clear output registers clrf BCD1 ; clrf BCD2 ; loop16 rlf L_byte, f ; Shift the binary number rlf H_byte, f ; left through the BCD registers rlf BCD0, f rlf BCD1, f rlf BCD2, f decfsz count, f ; Count each pass, have we reached zero? goto adjDEC ; No, continue with conversion return ; Yes, back to caller adjDEC movlw BCD0 ; Point to BCD0 register address movwf FSR call adjBCD incf FSR,f ; Point to BCD1 register address call adjBCD incf FSR,f ; Point to BCD2 register address call adjBCD goto loop16 ; Back round again adjBCD ; See if shifted result in each nibble is 5 or greater, if not ; leave result in place, if so put result +3 into register movlw 3 ; Put 3 into w addwf INDF,w ; Add it to contents of selected BCD address movwf temp ; Save the result for testing btfsc temp,3 ; See if bit 3 (binary 8) is set, if so lower nibble contents+3 > 7 movwf INDF ; >7, put result back into BCD register movlw 30 ; Now work on upper nibble addwf INDF,w ; Add 3 to upper nibble movwf temp ; Save the result for testing btfsc temp,7 ; See if bit 7 (binary 8 for upper nibble) is set movwf INDF ; Yes, save as MSD return ; Return to caller ;========================================================================================== ; ; L AND C DISPLAY ROUTINE ; ; This routine displays the normal operating information on the LCD. ; The 4 decade BCD word is stored as follows ; BCD1 ddddcccc ; BCD0 bbbbaaaa ; ; where a is binary value of the decimal units and d is that of the 10,000 value ; ;========================================================================================== Display_LC Display_C ; Capacitance Value movlw 0x80 ; Set display address for C character call LCD_ins ; position, line 1 movlw 'C' ; Send "Output" to display call LCD_chr movlw '=' call LCD_chr ; Convert Capacitance value to BCD movf C0,w ; Copy current 16 bit count movwf L_byte ; into input registers movf C1,w ; for binary to BCD movwf H_byte ; conversion call Binary_to_BCD ; Convert count to BCD call Display ; Display the BCD count at the defined address ; return ; Future development for separate calls for L and C display Display_L movlw 0x8A ; Set display address for L character call LCD_ins ; position, line 1 movlw 'L' ; Send "Output" to display call LCD_chr movlw '=' call LCD_chr ; Convert Inducatance value to BCD movf L0,w ; Copy current 16 bit count movwf L_byte ; into input registers movf L1,w ; for binary to BCD movwf H_byte ; conversion call Binary_to_BCD ; Convert count to BCD call Display return Display clrf zeroflag ; Reset zero blanking flag swapf BCD1,w ; Put 1000 digit (upper nibble dddd) into lower 4 bits of w andlw 0x0F ; Mask lower 4 bits btfsc STATUS,Z ; Is the value zero? goto Blank1000 ; Yes, blank the digit addlw 0x30 ; No, add ASCII offset call LCD_chr ; Send to display goto Digit100 Blank1000 bsf zeroflag,4 ; Set the 1000's flag to mark it was blanked movlw ' ' ; Load a space call LCD_chr ; Send to display Digit100 ; 100s movf BCD1,w ; Put 100 digit (cccc) into lower 4 bits of w andlw 0x0F ; Mask lower 4 bits btfss STATUS,Z ; Is the value zero? goto Show100 ; No, display normally Blank100 btfss zeroflag,4 ; Yes, was the next higher value also zero? goto Show100 ; No, display as "0" movlw ' ' ; Load a space call LCD_chr ; Send to display bsf zeroflag,3 ; Mark the digit was blanked goto Digit10 Show100 addlw 0x30 ; Add ASCII offset call LCD_chr ; Send to display ;******************************************************************************************************** Step_Display ; Entry point for displaying 2 digit step size during Set Up ; zeroflag,3 is set to invoke blanking of 10s digit if necessary ;******************************************************************************************************** Digit10 ; 10s swapf BCD0,w ; Put 10 digit (bbbb) into lower 4 bits of w andlw 0x0F ; Mask lower 4 bits btfss STATUS,Z ; Is the value zero? goto Show10 ; No, display normally Blank10 btfss zeroflag,3 ; Yes, was the next higher value also zero? goto Show10 ; No, display as "0" movlw ' ' ; Load a space call LCD_chr ; Send to display goto Digit1 Show10 addlw 0x30 ; Add ASCII offset call LCD_chr ; Send to display Digit1 ; 1s Do not apply zero blanking to LSD movf BCD0,w ; Put 10 digit (aaaa) into lower 4 bits of w andlw 0x0F ; Mask addlw 0x30 ; Add ASCII offset call LCD_chr ; Send to display return ; Inductance Display ; Convert Inductance value to BCD movf L0,w ; Copy current 16 bit count movwf L_byte ; into input registers movf L1,w ; for binary to BCD movwf H_byte ; conversion call Binary_to_BCD ; Convert count to BCD clrf zeroflag ; Reset zero blanking flag movlw 0x8A ; Set display address for first character call LCD_ins ; position, line 1 movlw 'L' ; Send "Output" to display call LCD_chr movlw '=' call LCD_chr clrf zeroflag ; Clear the sero blanking flag word DigitL1000 ; 1000s swapf BCD1,w ; Put 1000 digit (upper nibble dddd) into lower 4 bits of w andlw 0x0F ; Mask lower 4 bits btfsc STATUS,Z ; Is the value zero? goto BlankL1000 ; Yes, blank the digit addlw 0x30 ; No, add ASCII offset call LCD_chr ; Send to display goto DigitL100 BlankL1000 bsf zeroflag,4 ; Set the 1000's flag to mark it was blanked movlw ' ' ; Load a space call LCD_chr ; Send to display DigitL100 ; 100s movf BCD1,w ; Put 100 digit (cccc) into lower 4 bits of w andlw 0x0F ; Mask lower 4 bits btfss STATUS,Z ; Is the value zero? goto L100 ; No, display normally BlankL100 btfss zeroflag,4 ; Yes, was the next higher value also zero? goto L100 ; No, display as "0" movlw ' ' ; Load a space call LCD_chr ; Send to display bsf zeroflag,3 ; Mark the digit was blanked goto DigitL10 L100 addlw 0x30 ; Add ASCII offset call LCD_chr ; Send to display DigitL10 ; 10s swapf BCD0,w ; Put 10 digit (bbbb) into lower 4 bits of w andlw 0x0F ; Mask lower 4 bits btfss STATUS,Z ; Is the value zero? goto L10 ; No, display normally BlankL10 btfss zeroflag,3 ; Yes, was the next higher value also zero? goto L10 ; No, display as "0" movlw ' ' ; Load a space call LCD_chr ; Send to display goto DigitL1 L10 addlw 0x30 ; Add ASCII offset call LCD_chr ; Send to display DigitL1 ; 1s Do not apply zero blanking to LSD movf BCD0,w ; Put 10 digit (aaaa) into lower 4 bits of w andlw 0x0F ; Mask addlw 0x30 ; Add ASCII offset call LCD_chr ; Send to display return ;========================================================================================== ; ; PICDEM 2 Plus LCD ROUTINES ; ; These routiens have been adaptd to drive the PICDEM 2 Plus demo board. See the LCD ; connections below. Note that Bit 7 of PORTD switched power to the LCD and is used ; to power up and initialise the LCD module. ; ;========================================================================================== ; ; PICDEM 2 PLUS LCD CONNECTIONS ; ; PORTD 0 D4 ; 1 D5 ; 2 D6 ; 3 D7 ; 4 RS ; 5 RW ; 6 E ; 7 POWER ON LCD_init ; Initialise LCD Module ; Belt and Braces Initialisation Routine movlw LCD_PORT_ZERO ; Clear PORT LCD data and controls (leaving PICDEM2 LCD on) movwf LCD_PORT call Delay_100mS ; Allow LCD Processor to start up call Pause call Pause bsf LCD_E ; Raise Enable call Pause ; Wait call Pause movlw LCD_30 ; Load intialisation value 0x30 configured for port pin presentation iorwf LCD_PORT,f ; Place 30 on Port data call Delay_30mS ; First delay > 4.1 mSec bcf LCD_E call Pause call Pause movlw LCD_PORT_ZERO ; Clear PORT LCD data and controls (leaving PICDEM2 LCD on) movwf LCD_PORT bsf LCD_E call Pause call Pause movlw LCD_30 iorwf LCD_PORT,f ; Place 30 on PortB data call Delay ; Second delay > 100uSec bcf LCD_E call Pause ; Wait call Pause movlw LCD_PORT_ZERO ; Clear PORT LCD data and controls (leaving PICDEM2 LCD on) movwf LCD_PORT bsf LCD_E call Pause call Pause movlw LCD_30 ; Load intialisation value 0x30 configured for port pin presentation iorwf LCD_PORT,f ; Place 30 on PortB data call Delay ; Delay > 100uSec bcf LCD_E call Pause call Pause movlw LCD_PORT_ZERO ; Clear PORT LCD data and controls (leaving PICDEM2 LCD on) movwf LCD_PORT bsf LCD_E call Pause call Pause movlw LCD_20 ; Load intialisation value 0x20 configured for port pin presentation iorwf LCD_PORT,f ; Place 20 on PortB data call Delay ; Delay > 100uSec bcf LCD_E ; LCD now in 4 bit mode movlw LCD_PORT_ZERO ; Clear PORTD LCD data and controls (leaving LCD Power on for PICDEM2) movwf LCD_PORT ; Busy Flag now Active call LCD_busy_chk ; Wait for LCD to be free movlw 0x28 ; 4 Bit 2 Line call LCD_ins ; Send Command movlw 0x0C ; Display ON, cursor OFF call LCD_ins ; Send Command movlw 0x06 ; Increment right with each write call LCD_ins ; Send Command movlw 0x01 ; Clear display and reset cursor call LCD_ins ; Send Command return ; Initialisation complete ;========================================================================================== ; ; BUSY FLAG CHECK ROUTINE ; ; Read Data Bit & from LCD, if 1 LCD is busy if 0 LCD is free ; ; ; Use this routine to speed up LCD read/write actions, additional encoder calls and step ; calls have been inserted in the rotuine to make use of waiting time during busy states. ; This speeds up the manual tuning rate. In memory mode we require the output value to ; remain fixed and the encoder to step the memory address counter. The Man_Mem flag ; indicatres hwich mode we're in and branches the routine to prevent unwanted encoder calls ; and steps in memory mode. ; ;========================================================================================== LCD_busy_chk Bank1 ; Switch to Bank1 movlw LCD_INPUTS movwf LCD_DIR ; Set PORT LCD Data Lines to Inputs Bank0 ; Switch back to Bank0 bcf LCD_RS bsf LCD_RW ; Set up LCD for Busy Flag read nop ; Pause for LCD processor to complete LCD_busy bsf LCD_E ; Read ; Pause for LCD processor to complete nop btfss BUSY_FLAG ; Test Busy Flag goto LCD_free ; Clear, LCD is free bcf LCD_E ; Clear Enable line nop bsf LCD_E ; Dummy enable cycle for 4 bit operation nop ; This is needed for busy check to work bcf LCD_E goto LCD_busy ; Set, LCD busy, re-test LCD_free bcf LCD_E nop bsf LCD_E ; Dummy enable cycle for 4 bit operation nop ; Two cycles are needed for busy check to complete ; This branch provides a second enable cyle on exit ; when busy flag is found to be clear bcf LCD_E bcf LCD_RW ; Clear Read/Write Line Bank1 ; Switch to Bank1 clrf LCD_DIR ; Set PORT LCD Data Lines to Outputs Bank0 ; Switch back to Bank0 return ;------------------------------------------------------------------------------------------ ; ; LCD WRITE INSTRUCTION FOR R-AMU HARDWARE (4 bit Mode) ; ; Writes an instruction to the LCD, e.g. for cursor position etc, using LCD ; interface on PORT B ; ; This routine is designed for an 4 Bit interface, instruction is ; placed in w register prior to calling this routine. The PORT B must be ; in Output State (TRISD=0)on entry to routine. ; ; Data is transferred over PORTB 4..7 LCD_INS_RAMU movwf temp ; Save data to be sent to LCD movwf LCD_data ; Load data call LCD_INS_RAMU1 ; Send swapf temp,w ; Place lower nibble in upper 4 bits movwf LCD_data ; Load data LCD_INS_RAMU1 ; call LCD_busy_chk ; Wait for the LCD to become free movlw LCD_PORT_ZERO ; Clear PORT LCD data and controls movwf LCD_PORT bcf LCD_RS ; Prepare LCD for an instruction call Pause bcf LCD_RW ; write call Pause bsf LCD_E ; Raise Enable Line call Pause movf LCD_data,w andlw 0xF0 ; Mask upper 4 bits iorwf LCD_PORT,f ; Put character on PORT call Pause bcf LCD_E ; Drop Enable Line to latch in Command return ; LCD WRITE CHARACTER FOR R-AMU HARDWARE(4 bit Mode) ; ; Writes a character to the LCD using LCD interface on PORT B ; ; This routine is designed for an 4 Bit interface, character is ; placed in w register prior to calling this routine. PORTB must be ; in Output State on entry to routine. ; ; ; Data is transferred over PORTD 4..7 LCD_CHR_RAMU movwf temp ; Save data to be sent to LCD movwf LCD_data ; Load data call LCD_CHR_RAMU1 ; Send swapf temp,w ; Place lower nibble in upper 4 bits movwf LCD_data ; Load data LCD_CHR_RAMU1 ; call LCD_busy_chk movlw LCD_PORT_ZERO ; Clear PORT LCD data and controls movwf LCD_PORT bsf LCD_RS ; Prepare LCD for a character call Pause bcf LCD_RW ; write call Pause bsf LCD_E ; Raise Enable Line call Pause movf LCD_data,w andlw 0xF0 ; Mask upper 4 bits iorwf LCD_PORT,f ; Put character on PORT call Pause bcf LCD_E ; Drop Enable Line to latch in Command call Pause bcf LCD_RS return Pause ; Brief delay of several machine cycles nop ; to allow read write transactions to nop ; complete nop nop nop nop nop return ;========================================================================================== ; ; SET UP ROUTINES ; ; User configuration of variable parameters. ; ;========================================================================================== Set_Up call Setup_msg ; Display set Up message call Delay_long ; Hold message for about 2 seconds ; Wait for buttons to be released movf PORTD,w ; Get switch inputs andlw 0xF0 ; Isolate switch inputs movwf controls ; Save xorlw 0xF0 ; Are any of the switch states at zero (operated)? btfss STATUS,Z ; 1= no change, 0 = change goto $-5 ; Wait until clear call Delay_100mS ; Debounce call LCD_clear ; Clear LCD call Rate_msg ; Show rate diplay call Step_msg ; Set_Rate1 call Rate1_msg movf steprate1,w movwf step0 ; Load first step rate call Step_display ; Show current setting call Debounce ; wait until buttons released call Buttons_step ; Button check movf step0,w ; Move new step rate movwf steprate1 ; into associated register Set_Rate2 call Rate2_msg movf steprate2,w movwf step0 ; Load next step rate call Step_display ; Show current setting call Debounce ; wait until buttons released call Buttons_step ; Button check movf step0,w ; Move new step rate movwf steprate2 ; into associated register Set_Rate3 call Rate3_msg movf steprate3,w movwf step0 ; Load next step rate call Step_display ; Show current setting call Debounce ; wait until buttons released call Buttons_step ; Button check movf step0,w ; Move new step rate movwf steprate3 ; into associated register Set_Rate4 call Rate4_msg movf steprate4,w movwf step0 ; Load next step rate call Step_display ; Show current setting call Debounce ; wait until buttons released call Buttons_step ; Button check movf step0,w ; Move new step rate movwf steprate4 ; into associated register Set_Rate5 call Rate5_msg movf steprate5,w movwf step0 ; Load next step rate call Step_display ; Show current setting call Debounce ; wait until buttons released call Buttons_step ; Button check movf step0,w ; Move new step rate movwf steprate5 ; into associated register Save_step_rates ; Save the new step rates to EEPROM Bank2 clrf EEADR ; Clear EEPROM address, this will sequentially Bank0 ; increment on all subsequent saves movf steprate1,w ; Load rate 1 into w Bank2 movwf EEDATA call Write_EEPROM Bank0 ; increment on all subsequent saves movf steprate2,w ; Load rate 1 into w Bank2 movwf EEDATA call Write_EEPROM Bank0 ; increment on all subsequent saves movf steprate3,w ; Load rate 1 into w Bank2 movwf EEDATA call Write_EEPROM Bank0 ; increment on all subsequent saves movf steprate4,w ; Load rate 1 into w Bank2 movwf EEDATA call Write_EEPROM Bank0 ; increment on all subsequent saves movf steprate5,w ; Load rate 1 into w Bank2 movwf EEDATA call Write_EEPROM Bank0 call LCD_clear ; Clear LCD call Saved_msg ; Show Saved message call Delay_long ; Hold emssage for a couple of seconds goto Start ; Restart program to load in new settings ;--------------------------------------------------------------------------------------------- ; Subroutines associated with step change Buttons_step ; Routine for changing step value movf PORTD,w ; Get switch inputs andlw 0xF0 ; Isolate switch inputs movwf controls ; Save btfss UP ; Look for Up Button operation call Step_up ; Increment step size btfss DOWN ; Look for Down Button operation call Step_down ; Decrement step size btfss SEL ; Look for Select Button operation goto $+2 ; Got to exit test goto Buttons_step Select ; Look for select action call Delay_100mS ; Call 100mS delay movf PORTD,w ; Get switch inputs andlw 0xF0 ; Isolate switch inputs movwf controls ; Save btfsc SEL ; Is Select still pressed? goto Select ; Yes, back round again return ; No,back to caller ;--------------------------------------------------------------------------------------------- Step_up movlw STEPLIMIT ; Load maximum limit subwf step0,w ; Subtract and store result in w btfss STATUS,Z ; Is step at max limit? (Z=1) goto Step_inc ; No, increment, display and return movlw STEPLIMIT ; Yes, hold at limit movwf step0 call Step_display call Debounce return Step_inc ; Increment step incf step0,f call Step_display call Debounce return ;--------------------------------------------------------------------------------------------- Step_down movlw 0x01 subwf step0,w ; Test value of step to see if it is at 1 btfss STATUS,Z ; Is result 0? (Z=1) goto Step_dec ; No, decrement, display and return movlw 0x01 ; Yes, hold at 1 movwf step0 call Step_display call Debounce return Step_dec ; Decrement step decf step0,f call Step_display call Debounce return ;--------------------------------------------------------------------------------------------- Debounce movf PORTD,w ; Get switch inputs andlw 0xF0 ; Isolate switch inputs xorlw 0xF0 ; Are any of the switch states at zero (operated)? btfss STATUS,Z ; 1= all high, 0 = operated goto $-4 ; Wait until clear call Delay_100mS ; Debounce return ;--------------------------------------------------------------------------------------------- Step_display ; Display step size in decimal movlw 0xCA ; Point to first address call LCD_ins ; Convert Step size to BCD movf step0,w ; Copy current 16 bit count movwf L_byte ; into input registers clrf H_byte ; for BCD conversion call Binary_to_BCD ; Convert count to BCD clrf zeroflag ; Reset zero blanking flag bsf zeroflag,3 ; Set bit three to allow blankning of 10s if required call Step_Display ; Enter common display routine at 10s digit point return ; Back to caller ;--------------------------------------------------------------------------------------------- ; Set Up Messages Rate_msg call Msg_line1 ; Point to beginning of line 1 movlw 'R' call LCD_chr movlw 'a' call LCD_chr movlw 't' call LCD_chr movlw 'e' call LCD_chr movlw ' ' call LCD_chr return Step_msg call Msg_line2 movlw 'S' call LCD_chr movlw 't' call LCD_chr movlw 'e' call LCD_chr movlw 'p' call LCD_chr movlw ' ' call LCD_chr movlw 's' call LCD_chr movlw 'i' call LCD_chr movlw 'z' call LCD_chr movlw 'e' call LCD_chr movlw ' ' call LCD_chr return Rate1_msg movlw 0x85 call LCD_ins ; Adress count area movlw '0' call LCD_chr movlw '>' call LCD_chr movlw '6' call LCD_chr movlw '3' call LCD_chr return Rate2_msg movlw 0x85 call LCD_ins ; Adress count area movlw '6' call LCD_chr movlw '4' call LCD_chr movlw '>' call LCD_chr movlw '1' call LCD_chr movlw '2' call LCD_chr movlw '7' call LCD_chr return Rate3_msg movlw 0x85 call LCD_ins ; Adress count area movlw '1' call LCD_chr movlw '2' call LCD_chr movlw '8' call LCD_chr movlw '>' call LCD_chr movlw '2' call LCD_chr movlw '5' call LCD_chr movlw '5' call LCD_chr return Rate4_msg movlw 0x85 call LCD_ins ; Adress count area movlw '2' call LCD_chr movlw '5' call LCD_chr movlw '6' call LCD_chr movlw '>' call LCD_chr movlw '5' call LCD_chr movlw '1' call LCD_chr movlw '1' call LCD_chr return Rate5_msg movlw 0x85 call LCD_ins ; Address count area movlw '5' call LCD_chr movlw '1' call LCD_chr movlw '2' call LCD_chr movlw '>' call LCD_chr movlw '1' call LCD_chr movlw '0' call LCD_chr movlw '0' call LCD_chr movlw '0' call LCD_chr return Setup_msg call LCD_clear ; Clear LCD movlw 0x83 call LCD_ins ; Start position movlw 'S' call LCD_chr movlw 'e' call LCD_chr movlw 't' call LCD_chr movlw 'u' call LCD_chr movlw 'p' call LCD_chr movlw ' ' call LCD_chr movlw 'M' call LCD_chr movlw 'o' call LCD_chr movlw 'd' call LCD_chr movlw 'e' call LCD_chr return Saved_msg call LCD_clear ; Clear LCD call Msg_line1 ; Point to beginning of line 1 movlw ' ' ; Spaces to centre text call LCD_chr movlw ' ' call LCD_chr movlw ' ' call LCD_chr movlw 'S' call LCD_chr movlw 'A' call LCD_chr movlw 'V' call LCD_chr movlw 'E' call LCD_chr movlw 'D' call LCD_chr return ; Operational Message Aux_msg ; Auxiliary Output call Msg_line2 ; Point to start of line 2 movlw 'A' call LCD_chr movlw 'u' call LCD_chr movlw 'x' call LCD_chr movlw ' ' call LCD_chr movlw 'O' call LCD_chr movlw 'u' call LCD_chr movlw 't' call LCD_chr movlw 'p' call LCD_chr movlw 'u' call LCD_chr movlw 't' call LCD_chr movlw ' ' call LCD_chr movf ch_no,w ; Get decimal channel number addlw 0x30 ; ASCII Offset call LCD_chr return ;========================================================================================== ; ; EEPROM ROUTINES ; ; Read and write data at EEPROM location held in EEADR, results held in EEDATA. ; Based upon 16F877 Datasheet example. ; ;========================================================================================== ; ; Read EEPROM data at address EEADR into EEDATA ; Read_EEPROM Bank3 ; Select Bank 3 bcf EECON1,EEPGD ; Point to EEPROM Memory bsf EECON1,RD ; Request the read Bank2 ; Select Bank 2 incf EEADR,f ; Increment the read address return ; Return to the caller ; ; Write the byte of data at EEdata to the EEPROM at address EEADR ; Write_EEPROM Bank3 ; Select Bank 3 bcf EECON1,EEPGD ; Point to EEPROM Memory bsf EECON1,WREN ; Enable Write movlw 0x55 ; Write 0x55 and 0xAA to EEPROM movwf EECON2 ; control register2, as required movlw 0xAA ; for the write movwf EECON2 ; bsf EECON1,WR ; Set WR to initiate write bit_check btfsc EECON1,WR ; Has the write completed? goto bit_check ; No, keep checking bcf EECON1,WREN ; Clear the EEPROM write enable bit Bank2 ; Select Bank 2 incf EEADR,f ; Increment the EE write address Bank0 ; Select Bank 0 return ; Return to the caller ;========================================================================================== ; ; DELAY ROUTINES ; ; Libary of delays used during start up and sequencing ; ; 20MHz Clock gives a 200nS instruction cycle, 5000 cycles = 1mS ; ;========================================================================================== ; Basic 0.5mS Delay used as a building block by other delay routines ; 250 x 2uS = 0.5mS (Approx) Delay movlw 0xFA ; Load 250 into w movwf counter_1 loop1 ; 10x1uSec = 10uSec per pass at 4MHz; 10 x 200nS = 2uS per pass nop ; 1 nop ; 2 nop ; 3 nop ; 4 nop's to pad out delay nop ; 5 nop ; 6 nop ; 7 decfsz counter_1,f ; 8 Decrement goto loop1 ; 10 return ; Longer delays use multiples of basic 0.5 mS delay Delay_1mS ; 2 x Delay call Delay call Delay return Delay_10mS ; 20 x Delay movlw 0x14 ; Load 20 into w movwf counter_2 loop102 call Delay ; Call 0.5mS Delay decfsz counter_2,f goto loop102 return Delay_30mS ; 60 x Delay movlw 0x3C ; Load 60 into w movwf counter_2 loop302 call Delay ; Call 0.5mS Delay decfsz counter_2,f goto loop302 return Delay_1Sec ; 1 sec delay movlw 0x0A ; Load d10 movwf counter_3 ; call Delay_100mS ; call 100mS delay decfsz counter_3,f ; Decrement counter goto $-2 ; Go round again return ; All done, back to caller Delay_100mS ; 200 x Delay movlw 0xC8 ; Load 200 into w movwf counter_2 loop1002 call Delay ; Call 0.5mS Delay decfsz counter_2,f goto loop1002 return Delay_long ; Delay of around 2 sec movlw 0x14 ; Load 20 into w movwf counter_3 Delay_long1 call Delay_100mS ; Call 100mS Delay decfsz counter_3,f goto Delay_long1 return ;========================================================================================== ; ; MESSAGES ; ; This section hold the message content for the LCD ; ;========================================================================================== LCD_clear ; Clear the display for new message movlw 0x01 ; Load instruction code for clear call LCD_ins ; Send to LCD as an Instruction return ; Back to caller Msg_line1 ; Point cursor to first position on line 1 of LCD movlw 0x80 ; Load address call LCD_ins ; Send to LCD as an Instruction return ; Back to caller Msg_line2 ; Point cursor to first position on line 2 of LCD movlw 0xC0 ; Load address call LCD_ins ; Send to LCD as an Instruction return ; Back to caller Start_msg ; Initialisation Message call LCD_clear ; Clear display (probably not necessary) call Msg_line1 ; Point to beginning of line 1 call LCD_busy_chk movlw 'R' ; Send the following text call LCD_chr movlw 'A' call LCD_chr movlw 'M' call LCD_chr movlw 'U' call LCD_chr movlw ' ' call LCD_chr movlw 'V' call LCD_chr movlw '1' ; Version call LCD_chr movlw '.' call LCD_chr movlw '0' ; Revision call LCD_chr movlw ' ' call LCD_chr movlw '(' call LCD_chr movlw 'c' call LCD_chr movlw ')' call LCD_chr call Msg_line2 ; Point the LCD to first LCD digit location line 2 movlw 'C' call LCD_chr movlw 'u' call LCD_chr movlw 'm' call LCD_chr movlw 'b' call LCD_chr movlw 'r' call LCD_chr movlw 'i' call LCD_chr movlw 'a' call LCD_chr movlw ' ' call LCD_chr movlw 'D' call LCD_chr movlw 'e' call LCD_chr movlw 's' call LCD_chr movlw 'i' call LCD_chr movlw 'g' call LCD_chr movlw 'n' call LCD_chr movlw 's' call LCD_chr Return Start_msg2 call LCD_clear ; Clear display (probably not necessary) call Msg_line1 ; Point to beginning of line 1 call LCD_busy_chk movlw 'G' ; Send the following text call LCD_chr movlw '3' call LCD_chr movlw 'R' call LCD_chr movlw 'O' call LCD_chr movlw 'O' call LCD_chr movlw ' ' call LCD_chr movlw '&' ; Version call LCD_chr movlw ' ' call LCD_chr movlw 'G' ; Revision call LCD_chr movlw '4' call LCD_chr movlw 'G' call LCD_chr movlw 'X' call LCD_chr movlw 'O' call LCD_chr return END