;******************************************************************** ;* Termometro 3 cifre LED con sensore Microchip MCP9700 ;* Se l' ingresso di modo è a livello basso ;* la temperatura è sempre presentata a display ;* Se l' ingresso di modo è a livello alto ;* la temperatura è presentata per 10 sec, poi il micro ;* va in sleep e riavvia con il tasto reset ;* ------------------------------------------------------------------ ;* termo3.asm V1.0 del 21-08-2013 ;* ------------------------------------------------------------------ ;* Collegamenti esterni ;* ------------------------------------------------------------------ ;* PORTA: 0 - icsp ;* 1 - icsp ;* 2 - Analog in AN2 - MCP9700 ;* 3 - MCLR ;* 4 - Digital in - mode ;* 5 - DIGIT1--------+ ;* | ;* PORTC: 0 Segment A AAAAA AAAAA AAAAA ;* 1 Segment B F B F B F B ;* 2 Segment C F B F B F B ;* 3 Segment D GGGGG GGGGG GGGGG ;* 4 Segment E E C E C E C ;* 5 Segment F E C E C E C ;* 6 Segment G DDDDD dp DDDDD dp DDDDD dp ;* 7 Segment Dp | | ;* | | ;* PORTB: 4 - DIGIT-----------------------+ | ;* 5 - (eventuale Rx) | ;* 6 - DIGIT-------------------------------------+ ;* 7 - (eventuale Tx) ;* ;******************************************************************** ; ; ;******************************************************************** ; Processor definition List p=18F13k22 #include RADIX DEC ;==================================================================== ; CONFIGURAZIONE = ;==================================================================== debug = 1 CONFIG FOSC = IRC CONFIG MCLRE = ON CONFIG WDTEN = OFF CONFIG LVP = OFF CONFIG BOREN = ON CONFIG BORV = 22 CONFIG WRTD = OFF CONFIG CPD = OFF #if debug==0 CONFIG DEBUG = OFF CONFIG PWRTEN = ON CONFIG CP0 = ON CONFIG CP1 = ON CONFIG CPB = ON #else CONFIG DEBUG = ON CONFIG PWRTEN = OFF #endif ;==================================================================== ;= DEFINIZIONI = ;==================================================================== ;=============== General purpose definitions =============== ; base frequency XTAL_FREQ equ d'4000000' ; INTRC 4 MHz CLOCK equ XTAL_FREQ/4 ; processor clock [Hz] TCYC equ 1000000000/CLOCK ; cycle time [ns] INTPRIORITY = 1 ; interrupt 1 level [0, 1, 2] ;******************************************************************** ; RAM area CBLOCK 0x00 flags ; internal status timeoutcnt:2 ; counter for timeout digits ; which digit is on evaluation display1 ; values to display display2 display3 operand:2 ; for mathematics bin:2 ; for bin to bcd hunds ; hundreds tens ; tens ones ; units d1 ; for delay d2 d3 ee_data ; for eeprom ENDC ; flags ; flags map ;| 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 | ;|------|------|-------|-------|------|------|------|-------| ;|errflg|negflg|timeout|dispend|dp1flg|dp2flg|dp3flg| | ;#define flags,0 #define dp1flg flags,3 ; flags for Dp #define dp2flg flags,2 #define dp3flg flags,1 #define dispend flags,4 ; #define timeoutflg flags,5 ; timeout flag for sleep #define negflg flags,6 ; 1 = negative temperature #define errflg flags,7 ; error flag ;#################################################################### ;==================================================================== ;= ZONA EEPROM = ;==================================================================== ORG 0xF00000 #define EEPROM_ADR_DEFAULT 0x00 ; EEPROM programmed default #define EEPROM_ADR_BAUD_TABLE 0x04 ; EEPROM location for baudrate #define EEPROM_ADR_STD_IF_TABLE 0x10 ; EEPROM location for mode #define EEPROM_ADR_OPTIONS 0x20 ; EEPROM location for options ; Initial contents of DATA EEPROM: org (0xF00000+EEPROM_ADR_BAUD_TABLE) org (0xF00000+EEPROM_ADR_STD_IF_TABLE) ; standard IF table ... org (0xF00000+EEPROM_ADR_OPTIONS) de .0 ; [20] "options" (flags), cleared by default ; ******************* PORT definitions ****************************** ; ;PORTA map mixed analog & digital in ;| 5 | 4 | 3 | 2 | 1 | 0 | ;|-----|-----|-----|-----|-----|-----| ;| kd1 |mode |MCLR | MCP |icsp |icsp | ; ;#define PORTA,0 ; icsp ;#define PORTA,1 ; icsp #define MCPin PORTA,2 ; analog in - MCP9700 ;#define PORTA,3 ; MCLR #define mode PORTA,5 ; digital in - mode selector ; mode = 1 10" timeout ; mode = 0 display non stop #define kd1 PORTA,6 ; out - kathode digit 2 TrisAValue equ b'00011111' ; 4:0=in, 5=out ; ; PORTB map mixed digital ;| 7 | 6 | 5 | 4 | ;|-----|-----|-----|-----| ;| pbS | pbP | bpM | k2 | ; #define kd2 LATB,4 ; out - kathode digit 2 #define btnM PORTB,5 ; (reserved for Rx) #define kd3 LATB,6 ; out - kathode digit 3 #define btnS PORTB,7 ; (reserved for Tx) TrisBValue equ b'10101111' ; 6:4 out, 7:5 in ; ; PORTC map as digital out ; 7 segments + Dp drive ;| 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 | ;|-----|-----|-----|-----|-----|-----|-----|-----| ;| kd1 |segG |segF |segE |segD |segC |segB |segA | ; #define segA LATC,0 ; out - 7 segments drive #define segB LATC,1 #define segC LATC,2 #define segD LATC,3 #define segE LATC,4 #define segF LATC,5 #define segG LATC,6 #define segDp LATC,7 SegmPort equ PORTC TrisCValue equ b'00000000' ; all out ;#################################################################### ;==================================================================== ;=================== CONSTANTS =================== ;==================================================================== codelimit equ 0x2F ; all characters timeout equ .2500 ; timeout save battery - 2500 x 4ms = 10' min9700 equ 0x0A ; minumun ADC read for MCP9700 max9700 equ 0x384 ; maximum ADC read for MCP9700 mcp0 equ 0xFA ; value for 0°C neglimit equ 0xD6 ; limit of negative temp. values adrept equ .4 ; AD read cycles vblimit equ 0x1A3 ; battery limit ;==================================================================== ;#################################################################### ;==================================================================== ;= LOCAL MACROS = ;==================================================================== ; macro for internal clock selection #include C:\PIC\Library\18F\18IntClock_K22.asm #include C:\PIC\Library\18F\18Timer0.asm #include C:\PIC\Library\18F\18FVR1.asm ; MOVLF Move literal to file, 8-bit MOVLF MACRO value, dest movlw value movwf dest ENDM ; CLRF16 Clear 16-bit file CLRF16 MACRO var CLRF var CLRF var+1 ENDM ; MOVLF16 Move 16-bit literal in a 16-bit file ; file = literal ; little endian MOVLF16 MACRO const, var movlw low (const) movwf (var) movlw high (const) movwf (var)+1 ENDM ; MOVFF16 Move file to file, 16 bit ; file2 = file1 ; little endian MOVFF16 MACRO src, dest movff src, dest movff src+1, dest+1 ENDM ; DECF16 Decerement file, 16-bit. Set Z if 0 ; dest = dest - 1 ; little endian DECF16 MACRO dest decf (dest),F ; Decrement low byte incfsz (dest),W ; Check for underflow incf (dest)+1,F ; Update decf (dest)+1,F ; Fixup movf (dest),W iorwf (dest)+1,W ; Set Z bit ENDM ; ADDFF16 Add file to file, 16-bit ; dsta = dst + src ; little endian ADDFF16 MACRO DST,SRC MOVF (SRC),W ; Get low byte ADDWF (DST),F ; Add to destination MOVF (SRC)+1,W ; Get high byte BTFSC STATUS,C ; Check for carry INCF (SRC)+1,W ; Add one for carry ADDWF (DST)+1,F ; Add high byte into DST ENDM ; SUBLF16 Subtract literal from file, 16-bit ; dst = dst - lit ; little endian SUBLF16 MACRO DST, LIT MOVlw Low(LIT) ; Get low byte of subtrahend SUBWF (DST),F ; Subtract DST(low) - SRC(low) MOVlw High(LIT)+1 ; Now get high byte of subtrahend BTFSS STATUS,C ; If there was a borrow, rather than INCF WREG ; decrement high byte of dst we inc src SUBWF (DST)+1,F ; Subtract the high byte and we're done ENDM ; LSRF16 Logical shift right on a 16-bit file ; little endian LSRF16 MACRO VAR16 BCF STATUS, C RRCF (VAR16)+1,F ; Rotate high byte right RRCF (VAR16),F ; Rotate low byte right ENDM ; LSLF16 Logical shift left on a 16-bit file LSLF16 MACRO VAR16 BCF STATUS, C RLCF (VAR16),F ; Rotate low byte left RLCF (VAR16)+1,F ; Rotate upper byte left ENDM ; CPFF16 Compare two 16-bit files ; little endian ; if file1 <= file2, C=1 ; if file1 > file2, C=0 ; if file1 = file2, Z=1 CPFF16 MACRO file1, file2 movf file1+1,w subwf file2+,w ; subtract Y-X skpz bra $+6 ; yes, they are equal -- compare lo movf file1,w subwf file2,w ; subtract Y-X ENDM ; CPFFbeq16 Compare two 16-bit files. ; Branch destinantion if file1 = file2 ; little endian CPFFbeq16 MACRO file1, file2, destination movf file1+1,w subwf file2+,w ; subtract Y-X skpz bra $+6 ; yes, they are equal -- compare lo movf file1,w subwf file2,w ; subtract Y-X bz destination ENDM ; CPFFbgt16 Compare two 16-bit files. ; Branch destinantion if file1 > file2 ; little endian CPFFbgt16 MACRO file1, file2, destination movf file1+1,w subwf file2+,w ; subtract Y-X skpz bra $+6 ; yes, they are equal -- compare lo movf file1,w subwf file2,w ; subtract Y-X bnc destination ENDM ; CPFFblo16 Compare two 16-bit files, branch if low ; Branch destinantion if file1 < file2 ; little endian CPFFblo16 MACRO file1, file2, destination movf file1+1,w subwf file2+,w ; subtract Y-X skpz bra $+6 ; yes, they are equal -- compare lo movf file1,w subwf file2,w ; subtract Y-X bnc $+6 bnz destination ENDM ; CPFFble16 Compare two 16-bit files, branch if low or equal ; Branch destinantion if file1 <= file2 ; little endian CPFFble16 MACRO file1, file2, destination movf file1+1,w subwf file2+,w ; subtract Y-X skpz bra $+6 ; yes, they are equal -- compare lo movf file1,w subwf file2,w ; subtract Y-X bc destination ENDM ; CPFFble16 Compare two 16-bit files, branch if great or equal ; Branch destinantion if file1 > = file2 ; little endian CPFFbge16 MACRO file1, file2, destination movf file1+1,w subwf file2+,w ; subtract Y-X skpz bra $+6 ; yes, they are equal -- compare lo movf file1,w subwf file2,w ; subtract Y-X bc $+6 bz destination ENDM ; compare 16 bit files w/ 16 bit literal ; little endian ; if value <= limit, C=1 ; if value = limit, C=0 ; if value > limit, Z=1 CPFL16 MACRO file, limit movf file+1,w sublw High(limit) ; subtract Y-X btfss STATUS,Z bra $+6 ; yes, they are equal -- compare lo movf file,w subwf Low(limit),w ; subtract Y-X ; if X=Y -> Z=1 ; if X>Y -> C=0 ; if X<=Y -> C=1 ENDM ; Compare file with literal, branch destination if file = literal ; 16-bit, little endian CPFLbeq16 MACRO file, limit, destination movf file+1,w sublw High(limit) ; subtract Y-X btfss STATUS,Z bra $+6 ; yes, they are equal -- compare lo movf file,w subwf Low(limit),w ; subtract Y-X bz destination ENDM ; Compare file with literal, branch destination if file > literal ; 16-bit, little endian CPFLbgt16 MACRO file, limit, destination movf file+1,w sublw High(limit) ; subtract Y-X btfss STATUS,Z bra $+6 ; yes, they are equal -- compare lo movf file,w subwf Low(limit),w ; subtract Y-X bnc destination ENDM ; Compare file with literal, branch destination if file < literal ; 16-bit, little endian CPFLblo16 MACRO file, limit, destination movf file+1,w sublw High(limit) ; subtract Y-X btfss STATUS,Z bra $+6 ; yes, they are equal -- compare lo movf file,w subwf Low(limit),w ; subtract Y-X bnc $+6 bnz destination ENDM ; Compare file with literal, branch destination if file <= literal ; 16-bit, little endian CPFLble16 MACRO file, limit, destination movf file+1,w sublw High(limit) ; subtract Y-X btfss STATUS,Z bra $+6 ; yes, they are equal -- compare lo movf file,w subwf Low(limit),w ; subtract Y-X bc destination ENDM ; Compare file with literal, branch destination if file >= literal ; 16-bit, little endian CPFLbge16 MACRO file, limit, destination movf file+1,w sublw High(limit) ; subtract Y-X btfss STATUS,Z bra $+6 ; yes, they are equal -- compare lo movf file,w subwf Low(limit),w ; subtract Y-X bc $+6 bz destination ENDM ;incipit for read byte from table, pointer in WREG SETTABLE MACRO table, offset ; program memory < 64k clrf TBLPTRU movlw High(table) movwf TBLPTRH movlw Low(table) movwf TBLPTRL movf offset addwf TBLPTRL,f clrf WREG addwfc TBLPTRH,f TBLRD* movf TABLAT,w ENDM ;#################################################################### ;==================================================================== ;= RESET ENTRY = ;==================================================================== ; Program start on Reset ORG 0x00 nop ; for ICD goto START ; to main program ;#################################################################### ;==================================================================== ;= INTERRUPT ENTRY = ;==================================================================== ; ISR vector (hig priority or no priority) ORG 0x08 ;************************************************************** ; Interrupt - TMR0 generate IRQ every 4ms ; Each digit is turned on for 4ms one time every 12ms IRQ nop ; ricarica timer - (1MHz:32):125=250Hz movlw D'131' ; 256-125=131 movwf TMR0L ; clear all digits bcf kd1 bcf kd2 bcf kd3 ;digits=3: refresh digit3 ;digits=2: refresh digit2 ;digits=1: refresh digit1 nextd movf digits, W xorlw 3 bz Int_3 ;refresh digit3 xorlw 2^3 bz Int_2 ;refresh digit2 ;refresh digit1 Int_1 movf display1,w ; pickup digit 0 value call SevenSeg ; convert to 7 segments btfsc dp1flg ; need Dp? bsf WREG,7 ; y - set bit movwf SegmPort ; drive segments Port bsf kd1 ; digit on ;reload counter movlw 3 movwf digits bra Int_end ;refresh digit2 Int_2 movf display2,w ; pickup digit 2 value call SevenSeg btfsc dp2flg bsf WREG,7 movwf SegmPort bsf kd2 decf digits,f bra Int_end ;refresh digit3 Int_3 movf display3,w ; pickup digit 3 value call SevenSeg btfsc dp3flg bsf WREG,7 movwf SegmPort bsf kd3 decf digits,f Int_end ; check for timeout ; DEC16 timeoutcnt nop decf (timeoutcnt),F ; Decrement low byte incfsz (timeoutcnt),W ; Check for underflow incf (timeoutcnt)+1,F ; Update decf (timeoutcnt)+1,F ; Fixup movf (timeoutcnt),W iorwf (timeoutcnt)+1,W ; Set Z bit bnz ontime bsf timeoutflg ontime bcf INTCON, TMR0IF ; clear interrut flag retfie FAST ;******************************************************************** ;* Assegnazioni I/O per il display ;*--------------------------------- ;* PORTC: 0 Segment A AAAAA ;* 1 Segment B F B ;* 2 Segment C F B ;* 3 Segment D GGGGG ;* 4 Segment E E C ;* 5 Segment F E C ;* 6 Segment G DDDDD Dp ;* 7 Segment Dp ;* #define _A 0x01 ; bit0 #define _B 0x02 ; bit1 #define _C 0x04 ; bit2 #define _D 0x08 ; bit3 #define _E 0x10 ; bit4 #define _F 0x20 ; bit5 #define _G 0x40 ; bit6 #define _Dp 0x80 ; bit7 ;******************************************************************** ;#################################################################### ;==================================================================== ;= PAGE 0 tables = ;==================================================================== #include C:\PIC\Library\18F\SevenSegm_RETLWtable.asm ;#################################################################### ;==================================================================== ;= MAIN PROGRAM = ;==================================================================== START: mSetIntClock 4 ; set internal clock 4 MHz ;-------------------------------------------------------------------- ; inizializzazioni I/O al reset ;------------------------------------------------------------------- call IoInit clrf flags ; clear all flags ; check for operation mode btfss mode ;check for display enable bra normop ;y - non sleep operation ; n - set display timeout for 10s before sleep ;INIT16 timeout, timeoutcnt movlw low (timeout) movwf (timeoutcnt) movlw high (timeout) movwf (timeoutcnt)+1 bcf timeoutflg normop: ; preload digit value for test movlw '^'-0x30 ; display --- movwf display1 movwf display2 movwf display3 ; 250Hz Timer0 Interrupt rcall Tmr0_250 ; digit status counter - 4 step (3 digit + spare) movlw 3 movwf digits ; enable TMR0 irq bcf INTCON, T0IF bsf INTCON, T0IE ; Timer0 interupt enable bsf INTCON, GIE ; Global Interupt enable ; main cycle mainloop: call Delay02s ; for 200ms ; Check battery - voltage must be >2.5V mlp1 rcall readVbatt ; if result > VBmin, batt error MOVFF ADRES, operand ;COMPFL16 operand, vblimit movf operand+1,w sublw High(vblimit) ; subtract Y-X btfss STATUS,Z bra $+6 ; yes, they are equal -- compare lo movf operand,w sublw Low(vblimit) bc vbatok vbatlow movlw 'B'-0x30 ; display "bat" movwf display1 movlw 'A'-0x30 movwf display2 movlw 'T'-0x30 movwf display3 call Delay1s call Delay1s goto tosleep vbatok: ; read temperature movlw 4 ; repetitions movwf d3 rcall readMCP9700 ; set ADC for read MCP9700 rd97l rcall adgo ; start conversion ADDFF16 operand, ADRESL ; operand=operand+ADRES call Delay20us decfsz d3 bra rd97l LSRF16 operand ; operand/4 LSRF16 operand ; check for underflow ; if result <= minimum probably short sensor circuit ; will display LLL ;CPFLble16 operand, min9700 movf operand+1,w sublw High(min9700) ; subtract Y-X btfss STATUS,Z bra $+6 ; yes, they are equal -- compare lo movf operand,w sublw Low(min9700) bc ishigh islow movf operand,w addlw 255-min9700 bnc minor bra ishigh minor movlw 'L'-0x30 ; display L from table movwf display1 movwf display2 movwf display3 bra nextcycle ; check for overflow ; if maximum <= result probably sensor open ; will display HHH ishigh ;CPFLble16 operand, max9700 movf operand+1,w sublw High(max9700) ; subtract Y-X btfss STATUS,Z bra $+6 ; yes, they are equal -- compare lo movf operand,w sublw Low(max9700) bnc isok major movlw 'H'-0x30 ; display H from table movwf display1 movwf display2 movwf display3 nextcycle: ; timeout end? btfss timeoutflg bra mainloop ;y - mode ? btfsc mode bra tosleep bra mainloop ; value on the range ; result < 0°C ? isok ;CPFLbgt16 operand, mcp0 ; if operand>limit then now C=0 movf operand+1,w sublw High(mcp0-1) ; subtract Y-X btfss STATUS,Z bra $+6 ; yes, they are equal -- compare lo movf operand,w sublw Low(mcp0-1) bnc positiv negativ: bsf negflg ; r = 500-r MOVLF16 mcp0, bin ;SUBLF16 bin,operand MOVF (bin),W ; Get low byte of subtrahend SUBWF (operand),F ; Subtract DST(low) - SRC(low) MOVF (bin)+1,w ; Now get high byte of subtrahend BTFSS STATUS,C ; If there was a borrow, rather than INCF WREG ; decrement high byte of dst we inc src SUBWF (operand)+1,F ; Subtract the high byte and we're done bra convert positiv bcf negflg ; r = r-500 ;SUBLF16 operand, mcp0 MOVLW Low(mcp0),W ; Get low byte of subtrahend SUBWF (operand),F ; Subtract DST(low) - SRC(low) MOVLW High(mcp0)+1,w ; Now get high byte of subtrahend BTFSS STATUS,C ; If there was a borrow, rather than INCF WREG ; decrement high byte of dst we inc src SUBWF (operand)+1,F ; Subtract the high byte and we're done MOVLF16 operand, bin ; convert to BCD convert call Bin2BCD4 ; convert to BCD ; convert to display ; if negative display1 = - and suppress display 2 if 0 ; if positive dispaly 3 digits, suppress leading zero's btfss negflg bra noneg movlw 0x2F ; negative movwf display1 ; - on first digit movf tens,w ; suppress if 0 bnz n01 movlw 0x10 n01 movwf display2 bra no03 noneg movf hunds, w bz no01 ; suppress if 0 movwf display1 movff tens, display2 no03 movff ones, display3 goto nextcycle no01 movlw 0x10 ; suppress 0 movwf display1 movf tens, w ; suppress if 0 bnz no02 movlw 0x10 no02 movwf display2 bra no03 ;-------------------------------------------------------- ; GOTO SLEEP ;-------------------------------------------------------- ; display time is end - goto sleep mT0_OFF ; stop TIMER0 ; disable all interrupt tosleep bcf INTCON,GIE ; disable global interrupt noint btfsc INTCON,GIE ; check if disabled bra noint ; nope, try again clrf INTCON clrf INTCON2 clrf INTCON3 ; clear output setf TRISA setf TRISB setf TRISC bcf OSCCON,IDLEN ; go to sleep sleep ; wakeup by reset switch. If other source, force reset nop nop reset ;********************************************************** ;********************* SUBROUTINES ********************* ;********************************************************** ; 244 Hz-Timer0-Interupt ; Timer0 on, 8bit, int. clock, prescaler 32:1 Tmr0_250: ;mT0_SET 8, 'i', 'f', 32 movlw B'11000100' movwf T0CON movlw .131 ;256-125=131 [(1MHz:32):125=250 Hz] movwf TMR0 return ; Read Vbatt readVbatt: ;setup ADC for read FVR mFVR_SET 1024 ;Vref=1.024V by FVR movlw b'10111110' ;right, Fosc/64, 20TAD movwf ADCON2 movlw b'00000000' ;Vref from Vdd movwf ADCON1 nop movlw b'00111101' ;FVR, ADC on movwf ADCON0 bra adcg0 ;start conversion ; Read MCP9700 readMCP9700: ;setup ADC for read MCP9700 mFVR_SET 2048 ;Vref=2.048V by FVR nop movlw b'10111110' ;right, Fosc/64, 20TAD movwf ADCON2 movlw b'00001000' ;Vref from FVR movwf ADCON1 nop movlw b'00001001' ;RA2-AN2, ADC on movwf ADCON0 return ;start conversion adcg0 bsf ADCON0, GO adcl nop btfsc ADCON0, GO bra adcl return ; read from EEPROM ; EE address in W ReadEE movwf EEADR ; Data Memory Address to read readee bcf EECON1, EEPGD ; Point to DATA memory bcf EECON1, CFGS ; Access EEPROM bsf EECON1, RD ; EEPROM Read nop movf EEDATA, W ; W = EEDATA return ; wrtite to EEPROM ; EE address on W, EE data on EE_DATA WriteEE movwf EEADR ; Data Memory Address to write movf ee_data,w ; movwf EEDATA ; Data Memory Value to write bcf EECON1, EEPGD ; Point to DATA memory bcf EECON1, CFGS ; Access EEPROM bsf EECON1, WREN ; Enable writes bcf INTCON, GIE ; Disable Interrupts movlw 0x55 ; first key movwf EECON2 ; movlw 0xAA ; second key movwf EECON2 ; bsf EECON1,WR ; Set WR bit to begin write btfsc EECON1,WR bra $-2 bcf EECON1, WREN ; Disable writes on write complete ; verify data bcf errflg ; clear error flag rcall readee ; read at same address cpfseq ee_data ; data equal? bsf errflg ; n - error flag set bsf INTCON, GIE ; Enable Interrupts return ;-------------------------------------------------------------------- ; initialize I/O IoInit: ; no IOCB/IOCA clrf IOCB ; no irq on pin clrf IOCA clrf INTCON ; no any irq ;setup PORTA - A2/4/5 out clrf LATA movlw TrisAValue movwf TRISA ;no comparators clrf CM1CON0 clrf CM2CON0 ;no SR latch clrf SRCON0 clrf SRCON1 ;analog setup clrf VREFCON1 ;no DAC movlw b'00000100' ;A2-AN2 movwf ANSEL clrf ANSELH ;others disabled ;setup PORTB - all out clrf LATB movlw TrisBValue movwf TRISB ;disable wpu portB clrf WPUB ;enable wpu portA,4 movlw b'00010000' movwf WPUA bcf INTCON2,RABPU ;enable bit for wpu ;setup PORTC - all out clrf LATC movlw TrisCValue movwf TRISC return ;-------------------------------------------- ; DELAYS ;-------------------------------------------- Delay20us: movlw 0x05 movwf d1 decfsz d1,f goto $-2 return ;------------------------- Delay02s: movlw 0x3E movwf d1 movlw 0x9D movwf d2 Delay02s_0 decfsz d1, f goto $+6 decfsz d2, f goto Delay02s_0 goto $+4 nop return ;------------------------- Delay1s movlw 0x07 movwf d1 movlw 0x2F movwf d2 movlw 0x03 movwf d3 Delay1s_0 decfsz d1, f goto $+6 decfsz d2, f goto $+6 decfsz d3, f goto Delay1s_0 goto $+4 goto $+4 goto $+4 return ;************************************************************** ;* Mathematcs ;************************************************************** ;************************************************************** ; convert AD result from 1 HEX to 3 BCD ; and format data for display Hex1BCD3: clrf hunds swapf bin, W ; swap the nibbles addwf bin, W ; so we can add the upper to the lower andlw B'00001111' ; and lose the upper nibble (W is in BCD from now on) btfsc STATUS, DC ; if we carried a one (upper + lower > 16) addlw 0x16 ; add 16 (the place value) (1s + 16 * 10s) daw ; check for digit overflows btfsc bin, 4 ; 16's place addlw 0x16 - 1 ; add 16 - 1 btfsc bin, 5 ; 32nd's place addlw 0x30 ; add 32 - 2 btfsc bin, 6 ; 64th's place addlw 0x60 ; add 64 - 4 btfsc bin, 7 ; 128th's place addlw 0x20 ; add 128 - 8 % 100 daw ; check for digit overflows rlcf hunds, F ; pop carry in hundreds' LSB movwf ones btfsc bin,7 ; remember adding 28 - 8 for 128? incf hunds, F ; add the missing 100 if bit 7 is set ;unpack tens and ones swapf ones,w andlw 0x0F movwf tens movlw 0x0F andwf ones, f return ;------------------------------------------- ORG 0x400 ;SETTABLE Table1, operand Table97a clrf TBLPTRU movlw High(table1) movwf TBLPTRH movlw Low(table1) movwf TBLPTRL movf operand,w addwf TBLPTRL,f clrf WREG addwfc TBLPTRH,f TBLRD* movf TABLAT,w return ; A B C D E F ; 0 1 2 3 4 5 6 7 8 9 table1 DB 0xD6,0xD6,0xD6,0xD6,0xD6,0xD6,0xD6,0xD6,0xD6,0xD7 ; 0-9 DB 0xD6,0xD7,0xD8,0xD9,0xD9,0xDA ; A-F DB 0xDB,0xDC,0xDD,0xDD,0xDE,0xDF,0xE0,0xE1,0xE1,0xE2 ; 10-19 DB 0xE3,0xE4,0xE5,0xE5,0xE6,0xE7 ; 1A-1F DB 0xE8,0xE9,0xEA,0xEA,0xEB,0xEC,0xED,0xED,0xEE,0xEF ; 20-39 DB 0xF0,0xF1,0xF1,0xF2,0xF3,0xF4 ; 2A-2F DB 0xF5,0xF5,0xF6,0xF7,0xF8,0xF9,0xF9,0xFA,0xFB,0xFC ; 30-39 DB 0xFD,0xFE,0xFF, 0, 0, 1 ; 3A-3F DB 1, 2, 3, 4, 5, 6, 6, 7, 8, 9 ; 40-49 DB .10, .11, .11, .12, .13, .13 ; 4A-4F DB .14, .15, .16, .17, .17, .18, .19, .20, .21, .21 ; 50-59 DB .22, .23, .24, .25, .25, .26 ; 5A-5F DB .27, .28, .29, .29, .30, .31, .32, .33, .33, .34 ; 60-69 DB .35, .36, .37, .37, .38, .39 ; 6A-6F DB .40, .41, .41, .42, .43, .44, .45, .46, .46, .47 ; 70-79 DB .48, .49, .49, .50, .51, .52 ; 7A-7F DB .53, .54, .55, .56, .56, .57, .57, .58, .59, .60 ; 80-89 DB .61, .61, .62, .63, .64, .65 ; 8A-8F DB .65, .66, .67, .68, .69, .69, .70, .71, .72, .73 ; 90-99 DB .73, .74, .75, .76, .77, .77 ; 9A-9F DB .78, .79, .80, .81, .81, .82, .83, .84, .85, .85 ; A0-A9 DB .86, .87, .88, .89, .89, .90 ; AA-AF DB .91, .92, .93, .93, .94, .95, .96, .97, .97, .98 ; B0-B9 DB .99,.100,.101,.101,.102,.103 ; BA-BF DB .104,.105,.105,.106,.107,.108,.109,.109,.110,.111 ; C0-C9 DB .112,.113,.113,.114,.115,.116 ; CA-CF DB .117,.117,.118,.119,.120,.121,.121,.122,.123,.124 ; D0-D9 DB .125,.125,.125,.125,.125,.125 ; DA-DF ;************************************************************** end ;**************************************************************