;; ;; rc_translate_v0.asm ;; Experimental assembler version of PIC18F2220 convertor from 2.4GHz Spektrum DX7 with the AR7000 receiver ;; to Wolferl UAVP. It works for me with the DX7 in airplane mode with no mixing etc. ;; ;; Structure and routines modified from James Cameron (ds1820.asm) with many thanks. ;; Refer to http://quozl.netrek.org/ts/ or http://quozl.linux.org.au/ts/ ;; original was ds1820.asm, a PIC 12C509 or 16F84 based DS1820 translator ;; Copyright (C) 2002 James Cameron (quozl@us.netrek.org) ;; ;; Yes the code looks horrible - it is really a concept demonstrator! ;; There are lots of bits of code and comments that no longer apply ;; Now I am confident that it works I plan to convert it to C and use sdcc ;; see http://sdcc.sourceforge.net/ ;;; ;;; It does 3 things: a) collects the timing data from the AR7000 in the same way as Wolferl irq.c ;;; b) re-orders the 7 servo signals and outputs a single pulse stream in Wolferl format ;;; c) outputs a serial data stream that FMS simulator understands ;;; ;;; To Do: ;;; Serious tidy up of old code and code originally designed for PIC16 that won't work for PIC18 ;;; remove usused functions (many of these don't actually work in PIC18) ;;; remove unused storage ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ;; include "P18F2220.INC" __CONFIG _CONFIG1H, _IESO_OFF_1H & _FSCM_OFF_1H & _INTIO2_OSC_1H __CONFIG _CONFIG2L, _PWRT_ON_2L & _BOR_OFF_2L & _BORV_20_2L __CONFIG _CONFIG2H, _WDT_OFF_2H & _WDTPS_32K_2H __CONFIG _CONFIG3H, _MCLRE_ON_3H & _PBAD_DIG_3H & _CCP2MX_C1_3H __CONFIG _CONFIG4L, _DEBUG_OFF_4L & _LVP_OFF_4L & _STVR_OFF_4L __CONFIG _CONFIG5L, _CP0_OFF_5L & _CP1_OFF_5L __CONFIG _CONFIG5H, _CPB_OFF_5H & _CPD_OFF_5H __CONFIG _CONFIG6L, _WRT0_OFF_6L & _WRT1_OFF_6L __CONFIG _CONFIG6H, _WRTC_OFF_6H & _WRTB_OFF_6H & _WRTD_OFF_6H __CONFIG _CONFIG7L, _EBTR0_OFF_7L & _EBTR1_OFF_7L __CONFIG _CONFIG7H, _EBTRB_OFF_7H base equ 0x0 ; first free file register address irq_stack equ 0x1FF data_stack equ 0x180 irq_data equ 0x100 stack equ 0x80 ; end address of stack + 1 ;; PORTA bit allocations ;; a_out equ 0 ; a_led equ 1 ; a_warn equ 2 ; ;; 6,7 don't exist ;; Setup TRIS bits - 1 means high impedance (= input) m_a equ b'11111000' ;; PORTB bit allocations ;; ch0 equ 0 ; ch1 equ 1 ch2 equ 2 ch3 equ 3 ch4 equ 4 ch5 equ 5 ch6 equ 6 ;; 6 and 7 used by ICSP ;; Setup TRIS bits - 1 means high impedance (= input) m_b equ b'11111111' ;; PORTC bit allocations ;; c_out equ 1 ; ccp2 output on pin 12 ;; CCP1 is input on pin 13 ;; bit 6 is serial output Tx on pin 17 ;; bit 7 is serial input Rx on pin 18 ;; Setup TRIS bits - 1 means high impedance (= input) m_c equ b'11000100' ;; data stack macros, to reduce memory use ;; fsr0l points to top element of stack ;; stack grows downward in memory addresses (upward on paper) ;; initial fsr0l high in register space popw macro ; pop to w from stack movf indf0,w incf fsr0l,f endm pushw macro ; push from w to stack decf fsr0l,f movwf indf0 endm popl macro ; pop literal (aka drop) from stack incf fsr0l,f endm pushl macro m_literal ; push literal to stack movlw m_literal pushw endm popf macro m_to ; pop to file addresss (uses w) popw movwf m_to endm pushf macro m_from ; push from file address (uses w) movf m_from,w pushw endm popf16 macro m_to ; pop 16-bit value popf m_to+1 popf m_to endm copyf16 macro m_to ; pop 16-bit value popf m_to+1 popf m_to decf fsr0l,f decf fsr0l,f endm pushf16 macro m_from ; push 16-bit value pushf m_from pushf m_from+1 endm pushl16 macro m_literal ; push literal to stack pushl m_literal pushl 0 endm popl16 macro ; pop literal (aka 2drop) popl popl endm mov16 macro m_from,m_to ; move 16 bit value movf m_from+0,w movwf m_to+0 movf m_from+1,w movwf m_to+1 endm clr16 macro m_from clrf m_from+0 clrf m_from+1 endm ;; static register allocation cblock base throttle throttle_msb roll roll_msb nick nick_msb yaw yaw_msb sw sw_msb camera camera_msb aux aux_msb work work_msb NewK1 NewK1_msb NewK2 NewK2_msb NewK3 NewK3_msb NewK4 NewK4_msb NewK5 NewK5_msb NewK6 NewK6_msb NewK7 NewK7_msb r_ephemeral ; lowest stack level temporary storage r_temporary ; middle stack level temporary storage local_in local_out my_flags ; flag register data_mask rec_flags loop_count irq_loop irq_fsr0 irq_snap irq_snap_msb irq_last irq_last_msb led_count portB_snap ; snapshot of PORTB portB_last ; previous snapshot of PORTB portB_tmp ; local store of PortB r_work r_work_msb received_cmd ; command byte received over serial my_test endc ;;; flag definitions for my_flags new_data equ 0 data_bit equ 1 firsttimeout equ 2 data_mask_set equ 1<?) ;; To send bits 0 & 1 to PORTA, first send 0x55 ('U') then send 0x70 - 0x77 (p-w) ; check to see if last received command was 0x55 movlw 0x55 subwf received_cmd,w btfss STATUS,Z ; jump if it is not 0x55 goto end_ReceiveSer ; check if current received command is 0x3X movlw 0xF0 ; mask the bits we want andwf r_ephemeral,w ; result in w sublw 0x30 btfss STATUS,Z ; jump if it is not 0x30 goto skip_data_flash_0 ;; Store byte in flash data memory location 0 pushf r_ephemeral movlw d'0' call write_flash skip_data_flash_0 ; check if current received command is 0x50 - 0x51 movlw b'11111110' ; mask the bits we want andwf r_ephemeral,w ; result in w sublw 0x50 btfss STATUS,Z ; jump if it is not 0x70 goto skip_data_0x50 ;; do something here when the received data was 0x55 then 0x50 or 0x51 skip_data_0x50 ; check if current received command is 0x7X movlw 0xF0 ; mask the bits we want andwf r_ephemeral,w ; result in w sublw 0x70 btfss STATUS,Z ; jump if it is not 0x70 goto end_ReceiveSer ;; do something here when the received data was 0x55 then 0x70 to 0x7F ; Store byte in flash data memory location 1 pushf r_ephemeral movlw d'1' call write_flash end_ReceiveSer movf r_ephemeral,w ; store current command to received_cmd for next time movwf received_cmd retlw 0 ;;error because OERR overrun error bit is set ;;can do special error handling here - this code simply clears and continues ErrSerialOverr: bcf RCSTA,CREN ;reset the receiver logic bsf RCSTA,CREN ;enable reception again return ;;error because FERR framing error bit is set ;;can do special error handling here - this code simply clears and continues ErrSerialFrame: movf RCREG,W ;discard received data that has error return ;;; ;;; sb_bcd, convert accumulator to binary coded decimal for output ;;; ;;; data stack: ( lsb msb -- d0 d1 d2 ) [total 5] ;;; stack: calls others that do not call ;;; sb_bcd ;; ( lsb msb ) popf r_ephemeral ; msb popf r_temporary ; lsb movlw 0 pushw ; d0 (lsd) pushw ; d1 pushw ; d2 (msd) pushf r_temporary ; lsb pushf r_ephemeral ; msb pushl d'16' ; count ;; ( d0 d1 d2 msb lsb count ) bcf status,c sb_bcd_loop incf fsr0l,f ; ( d0 d1 d2 lsb msb ^ count ) incf fsr0l,f ; ( d0 d1 d2 lsb ^ msb count ) rlcf indf0,f ; lsb decf fsr0l,f ; ( d0 d1 d2 lsb msb ^ count ) rlcf indf0,f ; msb incf fsr0l,f incf fsr0l,f incf fsr0l,f incf fsr0l,f ; ( d0 ^ d1 d2 lsb msb count ) rlcf indf0,f ; d0 (lsd) decf fsr0l,f ; ( d0 d1 ^ d2 lsb msb count ) rlcf indf0,f ; d1 decf fsr0l,f ; ( d0 d1 d2 ^ lsb msb count ) rlcf indf0,f ; d2 (msd) movlw d'3' subwf fsr0l,f ; ( d0 d1 d2 lsb msb count ) decfsz indf0,f ; count goto sb_bcd_adjust movlw d'3' addwf fsr0l,f ; drop drop drop ;; ( d0 d1 d2 ) retlw 0 sb_bcd_adjust ;; ( d0 d1 d2 lsb msb count ) movlw d'3' addwf fsr0l,f ; ( d0 d1 d2 ^ lsb msb count ) call sb_bcd_fix ; d2 call sb_bcd_fix ; d1 call sb_bcd_fix ; d0 ; ( ^ d0 d1 d2 lsb msb count ) movlw d'6' subwf fsr0l,f ; ( d0 d1 d2 lsb msb count ) goto sb_bcd_loop sb_bcd_fix movlw 3 addwf indf0,w ; add 3 to low nibble movwf r_ephemeral ; test bits btfsc r_ephemeral,3 ; if bit three is set movwf indf0 ; store the adjusted value movlw 0x30 addwf indf0,w ; add 3 to high nibble movwf r_ephemeral ; test bits btfsc r_ephemeral,7 ; if bit seven is set movwf indf0 ; store the adjusted value incf fsr0l,f ; move to next digit pair retlw 0 ;;; ;;; sb_*, sixteen bit math functions ;;; ;;; ;;; sb_add, sixteen bit addition ;;; ;;; data stack: ( a b -- a+b ) [total 4] ;;; stack: none ;;; sb_add ; ( lsb1 msb1 lsb2 msb2 -- lsb3 msb3 ) movf indf0,w ; msb2 incf fsr0l,f ; ( lsb1 msb1 lsb2 ^ msb2 ) incf fsr0l,f ; ( lsb1 msb1 ^ lsb2 msb2 ) addwf indf0,f ; msb3 = msb1 + msb2 decf fsr0l,f ; ( lsb1 msb3 lsb2 ^ msb2 ) movf indf0,w ; lsb2 incf fsr0l,f ; ( lsb1 msb3 ^ lsb2 msb2 ) incf fsr0l,f ; ( lsb1 ^ msb3 lsb2 msb2 ) addwf indf0,f ; lsb3 = lsb1 + lsb2 btfsc status,c ; carry? goto sb_add_end decf fsr0l,f ; ( lsb3 msb3 ^ lsb2 msb2 ) retlw 0 ; ( lsb3 msb3 ) sb_add_end decf fsr0l,f ; ( lsb3 msb3 ^ lsb2 msb2 ) incf indf0,f ; msb3 retlw 0 ; ( lsb3 msb3 ) ;;; ;;; sb_subtract, sixteen bit subtraction ;;; ;;; data stack: ( a b -- a-b ) [total 4] ;;; stack: none ;;; sb_subtract ; ( lsb1 msb1 lsb2 msb2 -- lsb3 msb3 ) movf indf0,w ; msb2 incf fsr0l,f ; ( lsb1 msb1 lsb2 ^ msb2 ) incf fsr0l,f ; ( lsb1 msb1 ^ lsb2 msb2 ) subwf indf0,f ; msb3 = msb1 - msb2 decf fsr0l,f ; ( lsb1 msb3 lsb2 ^ msb2 ) movf indf0,w ; lsb2 incf fsr0l,f ; ( lsb1 msb3 ^ lsb2 msb2 ) incf fsr0l,f ; ( lsb1 ^ msb3 lsb2 msb2 ) subwf indf0,f ; lsb3 = lsb1 - lsb2 ; decf fsr0l,f ; ( lsb3 msb3 ^ lsb2 msb2 ) btfss status,c ; underflow? goto sb_sub_end decf fsr0l,f ; ( lsb3 msb3 ^ lsb2 msb2 ) retlw 0 sb_sub_end decf fsr0l,f ; ( lsb3 msb3 ^ lsb2 msb2 ) decf indf0,f ; msb3 retlw 0 ;;; ;;; sb_abs, sixteen bit absolute value ;;; ;;; data stack: ( a -- |a| ) [total 2] ;;; stack: none ;;; sb_abs btfss indf0,7 ; is it negative? retlw 0 ; no, so return ; fall through to negate ;;; ;;; sb_negate, sixteen bit negate ;;; ;;; data stack: ( a -- 0-a ) [total 2] ;;; stack: none ;;; sb_negate ; ( lsb msb -- lsb msb ) incf fsr0l,f ; ( lsb ^ msb ) comf indf0,f ; lsb incf indf0,f ; lsb decfsz fsr0l,f ; ( lsb msb ^ ) nop ; [decrement without losing z] btfsc status,z decf indf0,f ; msb comf indf0,f ; msb retlw 0 ; ( lsb msb ) ;;; ;;; sb_nip, sixteen bit nip, remove item under current item ;;; ;;; data stack: ( a b -- b ) [total 4] ;;; stack: none ;;; sb_nip ; ( a b c d -- c d ) movf indf0,w ; d @ incf fsr0l,f ; ->c incf fsr0l,f ; ->b movwf indf0 ; b ! decf fsr0l,f ; ->c movf indf0,w ; c @ incf fsr0l,f ; ->b incf fsr0l,f ; ->a movwf indf0 ; a ! decf fsr0l,f ; ->b retlw 0 ;;; ;;; sb_over, sixteen bit over, copy item under current item ;;; ;;; data stack: ( a b -- a b a ) [total 6] ;;; stack: none ;;; sb_over ; ( a b c d -- a b c d a b ) incf fsr0l,f ; ( a b c ^ d ) incf fsr0l,f ; ( a b ^ c d ) incf fsr0l,f ; ( a ^ b c d ) movf indf0,w ; a decf fsr0l,f ; ( a b ^ c d ) decf fsr0l,f ; ( a b c ^ d ) decf fsr0l,f ; ( a b c d ^ ) decf fsr0l,f ; ( a b c d ? ^ ) movwf indf0 ; a incf fsr0l,f ; ( a b c d ^ a ) incf fsr0l,f ; ( a b c ^ d a ) incf fsr0l,f ; ( a b ^ c d a ) movf indf0,w ; b decf fsr0l,f ; ( a b c ^ d a ) decf fsr0l,f ; ( a b c d ^ a ) decf fsr0l,f ; ( a b c d a ^ ) decf fsr0l,f ; ( a b c d a ? ^ ) movwf indf0 ; b retlw 0 ;;; ;;; sb_multiply, sixteen bit multiply ;;; ;;; data stack: ( multiplicand multiplier -- product ) [total 7] ;;; stack: calls others that do not call ;;; sb_multiply ; ( al ah bl bh -- cl ch ) pushl16 d'0' ; clear product ;; ( al ah bl bh cl ch ) pushl d'16' ; count of bits to process ;; ( al ah bl bh cl ch count ) sb_multiply_loop ; for each bit ;; ( al ah bl bh cl ch count ) ;; shift multiplier down by one movlw 5 addwf fsr0l,f ; ->ah rrncf indf0,f incf fsr0l,f ; ->al rrncf indf0,f decf fsr0l,f ; ->ah decf fsr0l,f ; ->bl ;; ( al ah bl ^ bh cl ch count ) ;; if the bit is set ... btfss status,c goto sb_multiply_skip ;; add the multiplicand to the product decf fsr0l,f ; ->bh movf indf0,w decf fsr0l,f ; ->cl decf fsr0l,f ; ->ch addwf indf0,f movlw 3 addwf fsr0l,f ; ->bl movf indf0,w decf fsr0l,f ; ->bh decf fsr0l,f ; ->cl addwf indf0,f decf fsr0l,f ; ->ch btfsc status,c incf indf0,f movlw 3 addwf fsr0l,f ; ->bl sb_multiply_skip ;; ( al ah bl ^ bh cl ch count ) ;; shift up multiplicand bcf status,c rlncf indf0,f decf fsr0l,f ; ->bh rlncf indf0,f ;; ( al ah bl bh ^ cl ch count ) ;; and loop for remainder of bits movlw 3 subwf fsr0l,f ; ->count decfsz indf0,f goto sb_multiply_loop ;; ( al ah bl bh cl ch count ) popl ; count call sb_nip ; bl bh goto sb_nip ; al ah ;;; ;;; sb_divide, sixteen bit divide ;;; ;;; data stack: ( numerator denominator -- remainder quotient ) [total 10] ;;; stack: calls others that do not call ;;; sb_divide ; ;; ( nl nh dl dh -- rl rh ql qh ) ;; prepare stack for results ;; ( nl nh dl dh ) call sb_over ;; ( nl nh dl dh nl nh ) call sb_over ;; ( nl nh dl dh nl nh dl dh ) ;; ( rl rh ql qh nl nh dl dh ) movlw d'4' addwf fsr0l,f ; ->qh clrf indf0 ; qh incf fsr0l,f ; ->ql clrf indf0 ; ql incf fsr0l,f ; ->rh clrf indf0 ; rh incf fsr0l,f ; ->rl clrf indf0 ; rl movlw d'7' subwf fsr0l,f ; ->dh ;; ( rl rh ql qh nl nh dl dh ) ;; save effective sign difference ;; sign = xor(nh,dh) ;; ( nl nh dl dh ) movf indf0,w ; dh incf fsr0l,f ; incf fsr0l,f ; ->nh xorwf indf0,w ; nh decf fsr0l,f ; decf fsr0l,f ; ->dh pushw ;; ( nl nh dl dh sign ) ;; force arguments to positive ;; n = abs (n) ;; ( nl nh dl dh sign ) movlw d'3' addwf fsr0l,f ; ->nh call sb_abs decf fsr0l,f ; ->dl decf fsr0l,f ; ->dh ;; d = abs (d) ;; ( nl nh dl dh ^ sign ) call sb_abs decf fsr0l,f ; ->sign ;; set the bit counter pushl d'16' ; for 16 shifts ;; ( nl nh dl dh sign count ) ;; ( rl rh ql qh nl nh dl dh sign count ) sb_divide_loop ;; ( rl rh ql qh nl nh dl dh sign count ) ;; shift bits left from numerator to remainder movlw d'5' addwf fsr0l,f ; ->nl bcf status,c ; clear status.c rlncf indf0,f ; nl decf fsr0l,f ; ->nh rlncf indf0,f ; nh incf fsr0l,f ; (must keep status.c) incf fsr0l,f ; incf fsr0l,f ; incf fsr0l,f ; incf fsr0l,f ; ->rl rlncf indf0,f ; rl decf fsr0l,f ; ->rh rlncf indf0,f ; rh ;; ( rl rh ^ ql qh nl nh dl dh sign count ) ;; check if remainder is greater than denominator movlw d'6' subwf fsr0l,f ; ->dh movf indf0,w ; dh movwf r_ephemeral movlw d'6' addwf fsr0l,f ; ->rh movf r_ephemeral,w subwf indf0,w ; rh btfss status,z goto sb_divide_skip_1 ;; ( rl rh ^ ql qh nl nh dl dh sign count ) ;; msb equal, so check lsb movlw d'5' subwf fsr0l,f ; ->dl movf indf0,w ; dl movwf r_ephemeral movlw d'6' addwf fsr0l,f ; ->rl movf r_ephemeral,w subwf indf0,w ; rl decf fsr0l,f ; ->rh ;; ( rl rh ^ ql qh nl nh dl dh sign count ) sb_divide_skip_1 btfss status,c goto sb_divide_skip_2 ; remainder is less ;; ( rl rh ^ ql qh nl nh dl dh sign count ) ;; carry set, remainder is greater than denominator ;; subtract denominator from remainder and save in remainder movlw d'5' subwf fsr0l,f ; ->dl movf indf0,w ; dl movwf r_ephemeral movlw d'6' addwf fsr0l,f ; ->rl movf r_ephemeral,w subwf indf0,f ; rl decf fsr0l,f ; ->rh btfss status,c decf indf0,f ; rh movlw d'6' subwf fsr0l,f ; ->dh movf indf0,w ; dh movwf r_ephemeral movlw d'6' addwf fsr0l,f ; ->rh movf r_ephemeral,w subwf indf0,f ; rh bsf status,c ; shift a 1 into quotient ;; ( rl rh ^ ql qh nl nh dl dh sign count ) sb_divide_skip_2 ;; shift the quotient left decf fsr0l,f ; ->ql rlncf indf0,f ; ql decf fsr0l,f ; ->qh rlncf indf0,f ; qh ;; loop until all bits checked movlw d'6' subwf fsr0l,f ; ->count decfsz indf0,f ; count goto sb_divide_loop popl ; drop count ;; ( rl rh ql qh nl nh dl dh sign ) ;; adjust stack popf r_ephemeral movlw d'4' addwf fsr0l,f ; drop nl nh dl dh ;; ( rl rh ql qh ) ;; check effective sign difference and adjust quotient btfss r_ephemeral,7 retlw 0 ; signs were same ;; signs different, negate quotient goto sb_negate ;;; ;;; sub-routine to print 16 as bcd ;;; consumes 2 bytes of stack ;;; print_sb call sb_bcd ; +1 byte ;; transmit the bcd output buffer call tx_byte_hex ; d2 (msd) call tx_byte_hex ; d1 call tx_byte_hex ; d0 (lsd) pushl 0x20 call tx_byte return ;;; end of subroutine to print sb ;;; ;;; Subroutine to read data from flash ;;; load location into W before calling ;;; flash value is returned in W ;;; get_flash MOVWF EEADR ;location was started in W before calling BCF EECON1,EEPGD ;Point to Data memory BSF EECON1,RD ;Start read operation MOVF EEDATA,W ;W = EEDATA return ;;; ;;; subroutine to print space 0x hex_char ;;; drops one byte off the stack ;;; tx_0x_hex pushl '0' call tx_byte pushl 'x' call tx_byte call tx_byte_hex return ;;; end of subroutine ;;; ;;; main program ;;; main movlw b'01110010' ; movwf OSCCON ; set internal oscillor at 8MHz CLRF INTCON ; Disable interrupts and clear T0IF clrf RCON ; switch off prioritisation of interrupts ;; clear stack - uses fsr0 and indf0 lfsr 0,stack ;; clear output ports clrf PORTA clrf PORTB clrf PORTC ;; initialise variables CLRF PIE1 ; Disable peripheral interrupts CLRF PIE2 ; movlw b'11011111' ;; no pull-ups on PORTB, bit 3 sets prescaler to WDT and bits 0-2 set prescaler to 1:128 ; movwf OPTION_REG clrf INTCON2 movlw d'25' ;; set baud rate generator 25 -> 19200 baud (high speed) 12 -> 38400 movwf SPBRG movlw b'00100100' movwf TXSTA ;; Serial transmit: 8 bit, asynchronous, high speed movlw 0x0F ;; configure all inputs digital (not needed) movwf ADCON1 movlw m_a ;;setup port A movwf TRISA movlw m_b ;;setup port B movwf TRISB movlw m_c ;;setup port C movwf TRISC ; movlw b'01000001' ;; enable analogue conversion on RA0/AN0, Fosc/8 ; movwf ADCON0 bsf RCSTA,SPEN ;; enable USART bsf RCSTA,CREN ;; enable receive clrf received_cmd ;;; pause for 0.5s to let supply stabilise before chatting pushl d'195' pause_loop pushl d'0' ; 2.65ms call us10 decfsz indf0,f goto pause_loop popl ;;; end of pause ;;; initialise TIMER1 movlw b'10000000' movwf T1CON ; inits and stops timer off clrf TMR1H clrf TMR1L bsf T1CON,TMR1ON movlw b'10001000' ; 16 bit read/writes, TMR1 feeds CCP1, TMR3 feeds CCP2 movwf T3CON ; inits and stops timer off clrf TMR3H clrf TMR3L bsf T3CON,TMR3ON clrf CCP1CON movlw b'00000101' ; configure capture mode - every rising edge movwf CCP1CON clrf CCP2CON movlw b'00000010' ; configure compare mode - toggle CCP2 output movwf CCP2CON ;;; initialise TIMER2 clrf T2CON clrf TMR2 ; Clear Timer2 movlw b'00111111' ; enable TMR2, 1:16 prescaler, 1:8 postscaler (64us clock - 0xFF is 16ms) movwf T2CON MOVLW d'80' ; Set PR2 for 5ms - d'218' is 14ms MOVWF PR2 ; CLRF PIR1 ; Clear peripheral interrupts Flags ;;; ;;; lfsr 1,data_stack ; start with fsr0l pointing to first register movlw d'24' movwf loop_count clear_loop movff loop_count,POSTINC1 decfsz loop_count goto clear_loop lfsr 1,data_stack movlw d'24' movwf loop_count print_t_l pushf POSTINC1 call tx_byte_hex pushl 0x20 call tx_byte decfsz loop_count goto print_t_l ;; initialise irq loop movlw d'07' movwf irq_loop movlw 0xd0 movwf TMR3H movwf TMR3L ;; ;; but don't enable interrupts until there is sensible data in the irq_stack ;; pushl 0x0a call tx_byte pushl 0x0d call tx_byte bcf my_flags,firsttimeout clrf PIR1 CLRF PIR2 ; Clear peripheral interrupts Flags bsf PIE1,TMR2IE bsf PIE1,CCP1IE bsf PIE2,CCP2IE bcf PORTA,a_out bsf INTCON,GIE bsf INTCON,PEIE movlw d'200' movwf loop_count ;; ;; main loop begins here ;; loop_test btfss my_flags,new_data goto loop_test pushl 0xFF call tx_byte pushf16 throttle pushl 0xD0 pushl 0x07 call sb_subtract popf16 r_work bcf STATUS,C rrcf r_work_msb rrcf r_work,f bcf STATUS,C rrcf r_work_msb rrcf r_work,f bcf STATUS,C rrcf r_work_msb rrcf r_work,f pushf16 r_work popl call tx_byte_hex pushf16 roll pushl 0xD0 pushl 0x07 call sb_subtract popf16 r_work bcf STATUS,C rrcf r_work_msb rrcf r_work,f bcf STATUS,C rrcf r_work_msb rrcf r_work,f bcf STATUS,C rrcf r_work_msb rrcf r_work,f pushf16 r_work popl call tx_byte_hex pushf16 nick pushl 0xD0 pushl 0x07 call sb_subtract popf16 r_work bcf STATUS,C rrcf r_work_msb rrcf r_work,f bcf STATUS,C rrcf r_work_msb rrcf r_work,f bcf STATUS,C rrcf r_work_msb rrcf r_work,f pushf16 r_work popl call tx_byte_hex pushf16 yaw pushl 0xD0 pushl 0x07 call sb_subtract popf16 r_work bcf STATUS,C rrcf r_work_msb rrcf r_work,f bcf STATUS,C rrcf r_work_msb rrcf r_work,f bcf STATUS,C rrcf r_work_msb rrcf r_work,f pushf16 r_work popl call tx_byte_hex ;pushl 0x0a ; call tx_byte ; pushl 0x0d ; call tx_byte bcf my_flags,new_data goto loop_test loop ; btfss PIR2,CCP2IF ; bcf PORTA,a_out ; btfsc PIR2,CCP2IF ; bsf PORTA,a_out ; btfss my_flags,new_data goto loop pushf16 throttle call tx_byte_hex call tx_byte_hex pushl 0x20 call tx_byte pushf16 roll call tx_byte_hex call tx_byte_hex pushl 0x20 call tx_byte pushf16 throttle pushf16 roll call sb_add call tx_byte_hex call tx_byte_hex pushl 0x20 call tx_byte pushf16 nick call tx_byte_hex call tx_byte_hex pushl 0x20 call tx_byte pushf16 yaw call tx_byte_hex call tx_byte_hex pushl 0x20 call tx_byte pushf16 sw call tx_byte_hex call tx_byte_hex pushl 0x20 call tx_byte pushf16 camera call tx_byte_hex call tx_byte_hex pushl 0x20 call tx_byte pushf16 aux call tx_byte_hex call tx_byte_hex pushl 0x20 call tx_byte pushl 0x0a call tx_byte pushl 0x0d call tx_byte skip_print1 bcf my_flags,new_data ; bcf PORTA,a_out goto loop ;; flash the LED incf led_count,f btfss led_count,7 bcf PORTA,a_out btfsc led_count,7 bsf PORTA,a_out goto loop ;; send some diagnostic data ;goto skip_print lfsr 1,irq_stack ; start with fsr1 pointing to first data address movlw d'07' movwf loop_count print_loop pushf POSTINC1 call tx_byte_hex pushf POSTINC1 call tx_byte_hex pushl 0x20 call tx_byte decfsz loop_count goto print_loop pushl 0x0a call tx_byte pushl 0x0d call tx_byte skip_print ;; clear watchdog timer! ; clrwdt bcf my_flags,new_data ;; and do it all again goto loop end