;******************************************************************* ; ; Inductance & Capacitance Meter ; ;******************************************************************* ; ; LC002 - THIS ONE WORKS FINE WITH A WELL BEHAVED DISPLAY ; ; Deleted CpyBin subroutine and one call to it ; ; Modified B2_BCD to take its input directly from ; ; Modified "oscillator test" so it copies F3 to ; ; Fixed Get_Lcal so it gets the correct number ; ; Minor adjustment to MS100 timing to correct frequency display ; ; Check for oscillator too slow when measuring L or C. ; ; ;******************************************************************* ; ; LC003 - Optimised / Modified to handle "bad" displays ; ; Removed duplicated code in PRINTCHAR subroutine ; ; Added code to fix crook display (select by jumper on B4 - 10) ; ; Optimised L & C formatting code ; ; Optimised "Display" subroutine ; ; Cleaned up LCDINIT ; ; ;******************************************************************* ; ; LC004 - Deleted timer Interrupt Service Routine ; ; Modified way oscillator "out of range" condition is detected ; ; ;******************************************************************* ; ; LC628 - LC004 code ported to 16F628 by Egbert Jarings PA0EJH. ; Mem starts now at 0x20 ; InitIO modified , 628 PortA start's up in Analog Mode ; So changed to Digital Mode (CMCON) ; ; Display's "Calibrating" to fill up dead Display time ; when first Powerd Up. ; ; Changed pmsg Routine, EEADR trick wont work with 628, ; PCL was always 0x00 so restart occurs. EEADR is now Etemp. ; ; Also changed EEADR in FP routine to Etemp ; ; Bad Display isn't bad at all, its a Hitachi HD44780, as ; 80% of all Display's are. Adress as 2 Lines x 8 Char. ; So LCDINIT modified for 2 x 8 Display's. (0x28 added) ; ;******************************************************************* ; ; LC005 - Cosmetic rewrite of RAM allocation from LC004 ; ; No change to address of anything - I hope ; Identified unused RAM & marked for later removal. ; ; ;******************************************************************* ; ; LC006 - Merge LC005 and LC628 ; ; All "#ifdef" F628 parts by Egbert Jarings PA0EJH. ; (or derived from his good work) ; ; Cleaned up RAM allocation. ; ; Added message re: processor type, just to verify selection ; ; Included extra initialisation (2 line) command by PA0EJH ; ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& ;^& LC006d 11/26/2006 by Cristi Morariu cmorariu@yahoo.com ;^& Second LC Oscillator added to extend inductance accuracy to 1nH ;^& and measure capacitors above 1uF : ;^& ^C1 = 10000pF, ^L1 = 6.4uH, ^Ce = 10000pF. Switch of oscillators ;^& done by PORTB5 (pin 11 16F84) ;^& Added a second push button "RANGE" to switch between oscillators ;^& "RANGE"is connected at PORTB6 (pin12) ;^& Added Calibration Constants For Each Of 4 scales in EEPROM ;^& Lbase, Lext, Cbase and Cext. The reasult of measure will be ;^& multiplied by this constant and then divided by 100 ;^& Added test sequence accesable by holding down "RANGE" while ;^& pushing "CAL". At every push of "RANGE" the display will ;^& show F1, F2, ^F1, ^F2 to calibrate oscillators ;^& Added single pulese formatter for RESET, using MC4093 to avoid ;^& display stalling and true NAND gate to timer/counter ;&* NOTE - gate opening signal PORTA0 is reversed! ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& ; ;******************************************************************* ; First, let us choose our weapon - 16F84 or 16F628 ; ; Comment out the next line [;#define F84] if using a 16F628 #define F84 #ifndef F84 #define F628 #endif ;******************************************************************* ; ; CPU configuration ; #ifdef F84 MESSG "Processor = 16F84" #define RAMStart 0x0C ; by VK3BHR processor 16f84 include __config _HS_OSC & _PWRTE_ON & _WDT_OFF #endif #ifdef F628 MESSG "Processor = 16F628" #define RAMStart 0x20 ; by PA0EJH processor 16f628 include __CONFIG _CP_OFF & _WDT_OFF & _PWRTE_ON & _HS_OSC & _BODEN_ON & _LVP_OFF #endif BANK0 macro bcf STATUS,RP0 endm BANK1 macro bsf STATUS,RP0 endm ;********************************************************** ; ; I/O Assignments. Luckily, the same assignments ; work on both the 16F84 and the 16F628. ; #define ENA PORTA,0x02 ; Display "E" #define RS PORTA,0x03 ; Display "RS" #define relay PORTA,0x01 ; 0 = energise relay #define FIXIT PORTB,0x04 ; Pin 10, 0 = "fix bad display" ; Floating 1 = "good display" #define RANGE PORTB,0x05 ;^& Pin11, OUTPUT: 0 = 0.001 uH range #define setup PORTB,0x06 ; Pin 12, 0 = "Setup" #define functn PORTB,0x07 ; Pin 13, 0 = "Inductor" #define INITSTATUSMASK b'10000000' #define BANKSEL STATUS,RP0 ;******************************************************************* ; ; file register declarations: uses only registers in bank0 ; bank 0 file registers begin at 0x0c in the 16F84 ; and at 0x20 in the 16F628 ; ;******************************************************************* cblock RAMStart ; ; Floating Point Stack and other locations used by FP.TXT ; ; FP Stack: TOS A = AEXP:AARGB0:AARGB1:AARGB3:AARGB4 ; B = BEXP:BARGB0:BARGB1:BARGB2 ; C = CEXP:CARGB0:CARGB1 AARGB4 AARGB3 AARGB2 AARGB1 AARGB0 AEXP ; 8 bit biased exponent for argument A BARGB2 BARGB1 BARGB0 BEXP ; 8 bit biased exponent for argument B CARGB2 CARGB1 CARGB0 ; most significant byte of argument C CEXP ; 8 bit biased exponent for argument C SIGN ; save location for sign in MSB FPFLAGS ; floating point library exception flags TEMPB3 ; 1 Unused byte TEMPB2 ; 1 Unused byte TEMPB1 ; Used TEMPB0 ; 1 Unused byte ; LOOPCOUNT ; loop counter (Unused ??) ; ; "Main" Program Storage ; ; NotUsed ; 1 Unused byte COUNT ; Bin to BCD convert (bit count) cnt ; (BCD BYTES) COUNT1 ; Used by delay routines ; and "prescaler flush" COUNT2 ; Timing (100ms) INITSTATUS ; Function (PORTB) at Init CHR F1:2 F2:2 F3:2 bcd:4 ; BCD, MSD first Calib:2 ; FLAGS ; 1 Unused byte! TabStop ; Used to fix bad displays. TabTemp Charcount ; number of chars displayed Etemp ; Repalces use of EEADR - PA0EJH TMP_REG ; just as scratch ;^&*************************************************************** ;^& Display Digits Routine Variables ;^& ; Variables to be initialised before calling routine ; Sbunit_Text ; pointer to greatest subunits' text table Sbunit_Sw ; Number of digits till first subunit changes MUnit ; Pointer to measure unit's text Disp_Digits ; Number of digits to display ; ; Working variables ; Digit_Number ; Number of results' digits Disp_Digits_Sav ; Temporary save value from disp_Digits Digit_Flag ; flag =1 if a least one number was displayed ;^&************************************************************** ;^& Range manipulation variables ;^& Tank ; 0 => LC with C=1000pf, 1=> LC with C=10000pf Tank_Relay ; Used To Display Osc Frequencies endc EXP equ AEXP ; Used by FP.TXT TEMP equ TEMPB0 ;AARG equ AARGB0 ; Unused ;BARG equ BARGB0 ; Unused ;CARG equ CARGB0 ; Unused ;******************************************************************* ; ; GENERAL MATH LIBRARY DEFINITIONS ; ; ; define assembler constants B0 equ 0 B1 equ 1 B2 equ 2 B3 equ 3 B4 equ 4 B5 equ 5 B6 equ 6 B7 equ 7 MSB equ 7 LSB equ 0 ; STATUS bit definitions #define _C STATUS,0 #define _Z STATUS,2 ;******************************************************************* ; ; FLOATING POINT literal constants ; EXPBIAS equ D'127' ; ; floating point library exception flags ; IOV equ 0 ; bit0 = integer overflow flag FOV equ 1 ; bit1 = floating point overflow flag FUN equ 2 ; bit2 = floating point underflow flag FDZ equ 3 ; bit3 = floating point divide by zero flag NAN equ 4 ; bit4 = not-a-number exception flag DOM equ 5 ; bit5 = domain error exception flag RND equ 6 ; bit6 = floating point rounding flag, 0 = truncation ; 1 = unbiased rounding to nearest LSB SAT equ 7 ; bit7 = floating point saturate flag, 0 = terminate on ; exception without saturation, 1 = terminate on ; exception with saturation to appropriate value #define BADFPFLAGS b'1111' ;********************************************************** ; ; Motorola syntax branches ; #define beq bz #define BEQ bz #define BNE bnz #define bne bnz #define BCC bnc #define bcc bnc #define BCS bc #define bcs bc #define BRA goto #define bra goto org H'2100' ; Initialize EEPROM Data eestart Unit1 de "m",0 Unit2 de "u",0 Unit3 de "n",0 Unit4 de "p",0 Cap de "F",0 Ind de "H",0 Freq de "kHz",0 Cintro de " C = ",0 Lintro de " L = ",0 ovr de "*???*",0 ovrmax de "*max*",0 Calibr de "calibrating",0 Null_Txt de 0 ;^&**************************************** ;^& Scale calibration constants ;^& Adjust these constants after comparing each scale measurements ;^& with a "trustfull" meter or using high accuracy and small tolerance ;^& components to calibrate. The displayed result will be multiplied ;^& by this constant and divided by 100 ;^&^ Lbase_Ct de .101 ; 0.001 uH scale ( L ) Lext_Ct de .102 ; 0.01 uH scale ( ^L ) Cext_Ct de .108 ; 1 pF scale ( ^C ) Cbase_Ct de .100 ; 0.1 pF scale ( C ) ;********************************************************** ; ; Begin Executable Stuff(tm) ; org 0 GO clrwdt ; 0 << Reset ;******************************************************************** ; Initialise Input & Output devices ;******************************************************************** InitIO: #ifdef F628 BSF CMCON, CM0 ; By PA0EJH BSF CMCON, CM1 ; Set Comp to digital I/O BSF CMCON, CM2 ; #endif bsf BANKSEL ; Select Bank1 errorlevel -302 ; Dont complain about BANK 1 Registers ; cos we know exactly what we are doing? movlw B'00100111' ;^& 0x37 ; Option register movwf OPTION_REG ; Port B weak pull-up enabled ; INTDEG Don't care ; Count RA4/T0CKI ; Count on falling edge ; Prescale Timer/counter ; divide Timer/counter by 256 ; PORTA:- movlw 0x10 ; initialise data direction ; 1 = input ; 0 = output ; ; PORTA has 5 pins 4 3 2 1 0 ; 0x10 = 0 0 0 1 0 0 0 0 ; movwf TRISA ; PORTA<0> = CLAMP count input ; PORTA<1> = Relay. 0 = energise ; PORTA<2> = LCD "E" ; PORTA<3> = LCD "RS" ; PORTA<4> = Count Input ; PORTA<5:7> = not implemented in 16F84 ; ; PORTB:- movlw B'11010000' ;^& B5 used to change RANGE 0xf0 ; initialise data direction ; PORTB has 8 pins ; port pin 7 6 5 4 3 2 1 0 ; 0xf0 = 1 1 1 1 0 0 0 0 ; movwf TRISB ; PORTB<0> = LCD "DB4" ; PORTB<1> = "DB5" ; PORTB<2> = "DB6" ; PORTB<3> = "DB7" ; PORTB<4> = Input ; PORTB<5> = RANGE select ;^& Input ; PORTB<6> = Input ; PORTB<7> = Input errorlevel +302 bcf BANKSEL ; Re-select Bank0 clrf PORTA ;********************************************************** ; ; Main Program ; call Chk_functn_Sw ; save PORTB initial status (L/C mode switch) CALL LCDINIT_PWR ; INITIALIZE LCD MODULE For The First Time bsf relay ; de energize Calibration capacitor relay call Set_Range ; Set RANGE output according to Tank Bit0 btfsc setup ; Doing initial oscillator test? goto Calibrate ; Start Measuring ;^&******************************************************** ;^& ;^& Measure & display osc freq for initial setup ;^& clrf Tank clrf Tank_Relay incf Tank_Relay,f ; Set First Loop Display To " F1: " Disp_Freq_Loop: ; If RANGE button pressed actvate relay btfss setup call Range_Button ; Change Range And Set Range Output ; call Measure_Closed ; Measure Local Osc Freq. and Don't read any buttons ; btfss INTCON,T0IF ; Set = Counter overflow? goto Do_Disp MOVLW ovr-eestart ; Over-range message call pmsg goto Disp_Freq_Loop Do_Disp: call LCDINIT ; clear display and home cursor call Print_Range ; Display "^" for 10000pF Oscillator and " " for 1000pF osc In "C" Mode and revers in "L" Mode call Print_Blank movlw Cap-eestart ; Display Test Message "F" call pmsg movlw '1' btfsc Tank_Relay,0x0 movlw '2' call PRINTCHAR ; Print '%' If Calibration Relay Activated movlw ':' call PRINTCHAR call Print_Blank clrf AARGB0 ; Copy to 24 bit number movf F3,W ; in AARGB0, 1, 2 movwf AARGB1 ; for display movf F3+1,W movwf AARGB2 CALL B2_BCD ; CONVERT COUNT TO BCD call Display_Freq goto Disp_Freq_Loop Range_Button: incf Tank_Relay,f bcf Tank_Relay,0x2 ; keep in range 0 - 3 bcf Tank,0x0 btfsc Tank_Relay,0x1 bsf Tank,0x0 bsf relay btfsc Tank_Relay,0x0 bcf relay call Set_Range ; wait for button to settle call MS300 goto MS300 ;^&********************************************************** ;^& ;^& Routine For PORTB PIN6 Set (Select oscillator) ;^& LC_Swap: ; Get Tank Value Upon R/L switch and set appropriate osscillator bcf Tank,0x0 btfsc functn ;^& Test C/L switch and set Range Output bsf Tank,0x0 comf Tank,f Range_Pressed: comf Tank,f ; Change Range call Set_Range call MS300 ; wait for button to settle call MS300 ; ; Calibrate The Meter ; Calibrate: CALL LCDINIT_PWR ; INITIALIZE LCD MODULE call MS200 call Print_Range ; display ' ' for Lower range, '^' for upper call Print_L_or_C ; Print Device To Be Measured ("L" or "C" ) movlw ':' call PRINTCHAR MOVLW Calibr-eestart ; Display's " Calibrating " call pmsg ; to entertain the punters call Measure ; Dummy Run to stabilise oscillator. call MS200 ; was MS300 movf F3,W ; Copy to F1 bz Calibrate ; F < 2560Hz ? call Measure ; Get freq in F3:F3+1 movf F3,W ; Copy to F1:F1+1 bz Calibrate ; F < 2560Hz ? movwf F1 movf F3+1,W movwf F1+1 bcf relay ; Add standard capacitor call MS200 call Measure movf F3,W ; Copy to F2:F2+1 bz Calibrate ; F < 2560Hz ? movwf F2 movf F3+1,W movwf F2+1 bsf relay ; Remove standard capacitor call MS200 CALL LCDINIT ; INITIALIZE LCD MODULE ; ; Now we resume our regular pogrom ; M_F3 call CLEARREST ; Cler Display After Value Or Error Message, C=/L= Will Be Printerd Again call Home_Disp call Print_Range movlw Cintro-eestart ; C = btfss functn ; 0=Inductor movlw Lintro-eestart ; L = call pmsg call Measure ; Measure F3 & leave it there movf F3,w ; test for "too low" frequency bz OORange ; F < 2560Hz ? btfss INTCON,T0IF ; test for "too high" frequency goto OK2GO ; F > 655359Hz ? OORange MOVLW ovr-eestart ; Over/Under range message *???* M_F3_1: call pmsg goto M_F3 O1Range MOVLW ovrmax-eestart ; Over/Under range message goto M_F3_1 Print_L_or_C: movlw 'C' btfss functn ; 0=Inductor movlw 'L' goto PRINTCHAR ;********************************************************** ; ; Measure Frequency. Stash in "F3 and F3+1" ; Measure: call Chk_functn_Sw btfss STATUS,Z goto LC_Swap ; L/C switch changed btfss setup goto Range_Pressed Measure_Closed: ; measure but don't read push buttons bcf INTCON,T0IF ; Declare "Not yet Over-range" CLRF TMR0 ; RESET INTERNAL COUNT (INCLUDING PRESCALER) ; See page 27 Section 6.0 bsf PORTA,0x0 ; Open Time Gate CALL MS100 ; 100MS DELAY bcf PORTA,0x0 ; Close Time Gate MOVF TMR0,W ; GET HIGH BYTE MOVWF F3 ; Copy to Big end of 16 bit result CLRF F3+1 ; prepare counter to get the prescaler value PSC1 bsf BANKSEL ; Select Bank1 errorlevel -302 ; Dont complain about BANK 1 Registers ; cos we know exactly what we are doing? bsf OPTION_REG,T0SE ; Clock the prescaler nop bcf OPTION_REG,T0SE errorlevel +302 bcf BANKSEL ; Re-select Bank0 DECF F3+1,F ; Decrement the counter movf TMR0,W ; Has TMR0 changed? xorwf F3,W ; if unchanged, XOR -> 0 bz PSC1 return ; F3 : F3+1 now holds 16 bit result Chk_functn_Sw: ; Test If L/C signal changed status movlw INITSTATUSMASK andwf PORTB,w subwf INITSTATUS,f ; Returns NZ If Status changed movwf INITSTATUS ; Save New Status return ;^&******************************************** ;^& ;^& Print Range Sign ;^& for C capacitors 1000pF oscillator is Basic (low) Range ;^& for L inductors 10000pF oscillator is Basic (LOW) Range ;^& Print_Range: movlw A' ' btfss functn goto Cap_Range btfss Tank,0x0 movlw A'^' goto PRINTCHAR Cap_Range: btfsc Tank,0x0 movlw A'^' goto PRINTCHAR ; ; Precompute major bracketed terms cos ; we need 'em both for all calculations ; OK2GO call F1_F2 call F1_F3 clrf FPFLAGS ; ; See what mode we are in ; btfss functn ; 0=Inductor goto Do_Ind ; ; OK, we've been told it's a capacitor ; Do_Cap ;******************************************************************** ; ; Calculate Unknown Capacitance OR inductance ; ; Output: 24 bit positive integer (scaled) ; right justified in AARGB0, AARGB1, AARGB2 ; also as BCD in bcd:bcd+1:bcd+2:bcd+3 ; ;******************************************************************** ;--------------------- C_calc call divide call Get_Ccal ; Times 10,000 ( = 1000.0pF) call multiply call PorM ;-------------------- movlw BADFPFLAGS andwf FPFLAGS,w btfss STATUS,Z goto O1Range ; Display Value Of C call C_disp goto M_F3 ; ; Now, they reckon it's a @#$*! inductor ; Do_Ind: call L_calc movlw BADFPFLAGS andwf FPFLAGS,w btfss STATUS,Z goto O1Range ; Display Value Of L call L_disp goto M_F3 ;^&*********************************************************** ;^& ;^& SETTING RANGE (switch oscillator) - According To Tank BIT0 ;^& Set_Range: btfsc Tank,0x0 bsf RANGE btfss Tank,0x0 bcf RANGE ; goto MS200 ;^& Wait For Oscillator To Stabilise ;********************************************************** ; ; Delay for about 200ms or 300ms (untrimmed) ; MS300 call MS100 MS200 call MS100 ;********************************************************** ; ; Delay for exact 100ms (measure of inductance requires accurate gate timing ; MS100 MOVLW 0x7e ;D'93' ;D'223' ;0x7e ; Count up MOVWF COUNT1 ; to roll-over MOVLW 0x24 ; 0x20 was 0x19, then 0x25, then 1f MOVWF COUNT2 DLY_LOOP INCFSZ COUNT2,F GOTO DLY_LOOP INCFSZ COUNT1,F GOTO DLY_LOOP RETLW 0 ;********************************************************** ; ; PRINT STRING addressed by W ; Note: Strings are in EEPROM space ; pmsg ; uses EEDATA and EEADR movwf EEADR pm1: call Get_EE btfsc STATUS,Z ; NULL = All done return call PRINTCHAR incf EEADR,F goto pm1 ;^& ;^& Get EEPROM byte ;^& Get_EE_Byte: ; EE Address In W movwf EEADR Get_EE: ; EE Addr Already Set BANK1 BSF EECON1, RD ; EE Read BANK0 movfw EEDATA return #ifdef Write_Constants ;^& ;^& Write EEPROM Byte ;^& Wr_EE_Byte: ; W brings EE_Addr, EE_Wr_Data brings byte to be written BANK1 btfsc EECON1,WR ; Wait For Previous Write To end goto Wr_EE_Byte movwf EEADR bsf EECON1,WREN movlw 0x55 ;--------REQUESTED--------- movwf EECON2 movlw 0xaa movfw EECON2 bsf EECON1,WR bsf INTCON,GIE ;-------------------------- bcf INTCON,GIE BANK0 return #endif ;************ MOVE TO START OF LINE 2 ***************** SEL_LINE2 MOVLW 0xC0 ; ADDRESS FOR SECOND LINE OF DISPLAY Put_Cmd_Word_D200us: CALL Put_Cmd_Word_Dly goto D200us ;********************************************************** ; ; Put a byte to display ; PRINTCHAR: incf Charcount,f decfsz TabStop,F ; Time to tickle bad display? goto DAT1 ; Not yet 9-th char movwf TabTemp ; Save character btfss FIXIT ; Check if we got a crook display CALL SEL_LINE2 ; Skip this if good movf TabTemp,W ; Restore character DAT1 BSF RS ; SELECT DISPLAY'S DATA REGISTER ; STORE CHAR TO DISPLAY Put_Word_Dly: MOVWF CHR SWAPF CHR,W ; SWAP UPPER AND LOWER NIBBLES (4 BIT MODE) call Put_Nibble_Dly MOVF CHR,W ; GET CHAR AGAIN ;********************************************************** ; ; Put 4 bits to LCD & wait (untrimmed) ; Put_Nibble_Dly: ANDLW 0x0F ; MASK OFF UPPER 4 BITS ; SET PORTB RANGE BIT TO CORRECT VALUE ; ==================================== MOVWF TMP_REG ;^& BTFSC Tank,0x0 ;^& Keep Range BSF TMP_REG,0x5 ;^& Keep Range To "C" MOVFW TMP_REG ;^& ; ==================================== MOVWF PORTB ; SEND DATA TO DISPLAY ; Strobe ENA BSF ENA ; ENA HIGH NOP BCF ENA ; ENA LOW ;********************************************************** ; ; Delay for 200us (untrimmed) ; D200us: MOVLW 0x42 ; DELAY 200us MOVWF COUNT1 NXT5 DECFSZ COUNT1,F GOTO NXT5 RETLW 0 ;*********** INITIALISE LCD MODULE 4 BIT MODE *********************** LCDINIT_PWR: CALL MS100 ; WAIT FOR LCD MODULE HARDWARE RESET BCF RS ; REGISTER SELECT LOW BCF ENA ; ENABLE LINE LOW MOVLW 0x03 ; 1 call Put_Nibble_Dly CALL MS100 ; WAIT FOR DISPLAY TO CATCH UP MOVLW 0x03 ; 2 call Put_Nibble_Dly MOVLW 0x03 ; 3 call Put_Nibble_Dly MOVLW 0x02 ; Fn set 4 bits call Put_Nibble_Dly MOVLW 0x0C ; 0x0C DISPLAY ON CALL Put_Cmd_Word_D200us MOVLW 0x28 ; DISPLAY 2 Line , 5x7 Dot's CALL Put_Cmd_Word_D200us ; New in LC628/LC006 version MOVLW 0x06 ; 0x06 ENTRY MODE SET CALL Put_Cmd_Word_D200us ; Fall into CLEAR ;************ CLEAR DISPLAY *************************** LCDINIT: ; Clear Display and Set Cursor To Home CLEAR: MOVLW 0x01 ; CLEAR DISPLAY CALL Put_Cmd_Word_D200us ; LONGER DELAY NEEDED WHEN CLEARING DISPLAY ;*********** MOVE TO HOME ***************************** Home_Disp: movlw 0x09 ; Count characters movwf TabStop ; before tickling display. MOVLW 0x02 ; HOME DISPLAY CALL Put_Cmd_Word_Dly clrf Charcount ;********************************************************** ; ; Delay for 2ms (untrimmed) ; MS2 MOVLW 0xFD ; DELAY 2ms MOVWF COUNT1 MOVLW 0x66 MOVWF COUNT2 goto DLY_LOOP CLEARREST: btfsc Charcount,4 ; 16 chars displayed? return call Print_Blank goto CLEARREST ;********************************************************** ; ; SENDS DATA TO LCD DISPLAY MODULE (4 BIT MODE) ; Put_Cmd_Word_Dly: BCF RS ; SELECT COMMAND REGISTER GOTO Put_Word_Dly ;^&******************************************************** ;^& ;^& Display Frequency (contents of AARGB0,1,2) on LCD ;^& Display_Freq: movlw 0x6 movwf Sbunit_Sw ; dot after 2 digits movlw 0x5 movwf Disp_Digits ; 5 digits to display movlw Null_Txt-eestart ; Text terminator (no subunit needed) movwf Sbunit_Text movlw Freq-eestart movwf MUnit ; unit "Hz" goto Display_Digits ;^&********************************************************** ;^& ;^& Formatted display of BCD work area for Capacitor ;^& C_disp: movlw Unit2-eestart ; Biggest subunit, "u" movwf Sbunit_Text movlw 0x1 movwf Sbunit_Sw ; base C range d.ddd.ddd.d btfss Tank,0x0 incf Sbunit_Sw,f ; Extended Range dd.ddd.ddd movlw Cap-eestart movwf MUnit ; unit "C" goto Display_Result ;^&********************************************************** ;^& ;^& Formatted display of BCD work area for Inductor ;^& L_disp: movlw Unit1-eestart ; Biggest subunit, "m" movwf Sbunit_Text movlw 0x2 movwf Sbunit_Sw ; base L range dd.ddd.ddd btfsc Tank,0x0 incf Sbunit_Sw,f ; extended L range ddd.ddd.dd movlw Ind-eestart movwf MUnit ; unit "H" ;^&++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;^& ;^& Display BCD Result, Dot Point And Measure Subunit And Unit ;^& Display_Result: movlw 0x4 movwf Disp_Digits ; number Of Digits To Display Display_Digits: movlw 0x8 ; Number of digits unprelucrated in result movwf Digit_Number clrf Digit_Flag ; Clear Flags (Dot Printed(1) and Digit displayed(0) ) movlw bcd+0 movwf FSR ; FSR points to first digit movfw Disp_Digits movwf Disp_Digits_Sav ; Save Number Of Digits To Display D_Loop: movfw INDF ; get current digit btfss Digit_Number,0x0 ; Odd digits requires swap swapf INDF,w andlw 0x0f ; Mask lower digit bz Digit_Null ; digit contains null value ; Print nonzero value ADDLW 0x30 ; Convert BIN to ASCII call PRINTCHAR goto Digit_Was_Displayed Digit_Null: ;^& ;^& When Null Digit Print Zero Exceptions, Blank Exceptions Or don't print anything ;^& ; if printing number already started, print zero btfsc Digit_Flag,0x0 goto Pr_Zero ; print "0" if last digit to display decf Digit_Number,w bz Pr_Zero ; Print "0" If last digit of a unit and next unit has left less than 3 digits Chk_Zero: decfsz Sbunit_Sw,w goto Chk_Zero_1 movlw 0x4 subwf Digit_Number,w bnc Pr_Zero ; Print Blank If Current digit number > number of digits to display Chk_Zero_1: movfw Digit_Number subwf Disp_Digits_Sav,w bnc Next_Digit ; don't write anything goto Pr_Blank Pr_Zero: movlw A'0' ; Print "0" call PRINTCHAR Digit_Was_Displayed: bsf Digit_Flag,0x0 ; Set Flag "at least one digit printed" decf Disp_Digits,f ; decrement digits to display bz Put_Unit ; if was last digit to display - exit loop and print subunit and unit goto Next_Digit Pr_Blank: call Print_Blank Next_Digit: decf Digit_Number,f ; goto next digit to analize bz Put_Unit ; it was last digit in number - exit loop and print subunit-unit btfsc Digit_Flag,0x1 goto No_Unit_Chg ; if unit dot was printed freeze unit ; Advance to next digit of subunit decfsz Sbunit_Sw,f goto No_Unit_Chg ; Was last digit of subunit - print dot point if at least one digit displayed btfsc Digit_Flag,0x0 call Print_Dot btfsc Digit_Flag,0x1 goto No_Unit_Chg ; If Dot Printed Freeze Subunit ; Was last digit of subunit - goto next lower subunit movlw 0x3 movwf Sbunit_Sw ; Reset Unit Switch to first digit in unit incf Sbunit_Text,f ; Go To nexts' lower unit text incf Sbunit_Text,f No_Unit_Chg: btfss Digit_Number,0x0 ; if even digit goto next bcd location incf FSR,f goto D_Loop Put_Unit: call Print_Blank movfw Sbunit_Text call pmsg ; Print subunit movfw MUnit goto pmsg ; Print unit Print_Dot: bsf Digit_Flag,0x1 movlw A'.' ; Print Dot Point "." goto PRINTCHAR Print_Blank: movlw A' ' ; Print " " goto PRINTCHAR ;^& ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ;******************************************************************** ; ; Stack operations ; ;******************************************************************** ;#define addition ;add call FPA24 ; goto S_fix divide call FPD24 goto S_fix multiply call FPM24 ; goto S_fix ; ; Fix stack after add, subtract, divide & multiply (C ->B) ; S_fix MOVF CARGB1,W ; C -> B MOVWF BARGB1 MOVF CARGB0,W MOVWF BARGB0 MOVF CEXP,W MOVWF BEXP return ; ; Push stack (duplicates TOS) ; S_push MOVF BARGB1,W ; B -> C MOVWF CARGB1 MOVF BARGB0,W MOVWF CARGB0 MOVF BEXP,W MOVWF CEXP MOVF AARGB1,W ; A -> B MOVWF BARGB1 MOVF AARGB0,W MOVWF BARGB0 MOVF AEXP,W MOVWF BEXP return ; ; Swap A and B ; S_swap MOVF AARGB1,W ; A -> Etemp (temp) MOVWF Etemp MOVF BARGB1,W ; B -> A MOVWF AARGB1 MOVF Etemp,W ; Etemp (temp) -> B MOVWF BARGB1 ;-------------------------------------------------- MOVF AARGB0,W ; A -> Etemp (temp) MOVWF Etemp MOVF BARGB0,W ; B -> A MOVWF AARGB0 MOVF Etemp,W ; Etemp (temp) -> B MOVWF BARGB0 ;-------------------------------------------------- MOVF AEXP,W ; A -> Etemp (temp) MOVWF Etemp MOVF BEXP,W ; B -> A MOVWF AEXP MOVF Etemp,W ; Etemp (temp) -> B MOVWF BEXP return ;-------------------------------------------------------------------- L_calc: call multiply call Get_Lcal ; Precomputed 1/(Ccal*4*PI*PI) call multiply L_divF1: call Get_F1 ; Divide by F1^2 call S_push call multiply call S_swap call divide ; ; Handle space or - in front of FP number ; PorM: ;^&********************************************************** ;^& ;^& Apply Scale Correction ;^& ; get currents' scale correction constant movlw Lbase_Ct-eestart ; First Scale Constant btfsc functn movlw Cext_Ct-eestart btfsc Tank,0x0 addlw 0x1 call Get_EE_Byte movwf Calib+1 clrf Calib call Get_Calib call multiply ; Multiply With Calibration Constant movlw .100 movwf Calib+1 call Get_Calib call S_swap call divide ; Divide By 100 ; movlw A' ' ; blank for plus btfsc AARGB0,7 ; test sign movlw A'-' ; minus call PRINTCHAR ; print it bcf AARGB0,7 ; make plus anyway ; ; Format as raw BCD string in bcd:bcd+1:bcd+2:bcd+3 ; call INT2424 ; To INT in AARGB0 etc. ; goto B2_BCD ; includes return ;****************************************************************** ; ; Convert 24-bit binary number at into a bcd number ; at . Uses Mike Keitz's procedure for handling bcd ; adjust; Modified Microchip AN526 for 24-bits. ; B2_BCD b2bcd movlw .24 ; 24-bits movwf COUNT ; make cycle counter clrf bcd+0 ; clear result area clrf bcd+1 clrf bcd+2 clrf bcd+3 b2bcd2 movlw bcd ; make pointer movwf FSR movlw .4 movwf cnt ; Mike's routine: b2bcd3 movlw 0x33 addwf INDF,f ; add to both nybbles btfsc INDF,3 ; test if low result > 7 andlw 0xf0 ; low result >7 so take the 3 out btfsc INDF,7 ; test if high result > 7 andlw 0x0f ; high result > 7 so ok subwf INDF,f ; any results <= 7, subtract back incf FSR,f ; point to next decfsz cnt,f goto b2bcd3 rlf AARGB2,f ; get another bit rlf AARGB1,f rlf AARGB0,f rlf bcd+3,f ; put it into bcd rlf bcd+2,f rlf bcd+1,f rlf bcd+0,f decfsz COUNT,f ; all done? goto b2bcd2 ; no, loop return ; yes ;******************************************************************** ; ; Calculate (F1/F3)^2-1, leave result on stack ; ;******************************************************************** F1_F3 call Get_F3 goto F1_F1 ;******************************************************************** ; ; Calculate (F1/F2)^2-1, leave result on stack ; ;******************************************************************** F1_F2 call Get_F2 F1_F1 call Get_F1 call divide ; F1/Fx call S_push call multiply ; (F1/Fx)^2 call Get_One call S_swap ; goto subtract ; (F1/Fx)^2-1 ; includes return call FPS24 goto S_fix ;******************************************************************** ; Fetch assorted things used for the calculation ; of Unknown L and C ; ;******************************************************************** Get_Lcal call S_push ; make room first movlw 0xab ; 2.53303e+13 movwf AEXP ; Create FP version of movlw 0x38 ; Precomputed 1/(Ccal*4*PI*PI) movwf AARGB0 ; times any needed movlw 0x4d ; fiddle factor (1/100) goto B1_2_stak Get_Ccal call S_push ; make room first movlw 0x8c ; 10,000 movwf AEXP ; Create FP version of movlw 0x1C ; Precomputed Ccal movwf AARGB0 ; times any needed movlw 0x40 ; fiddle factor B1_2_stak movwf AARGB1 return Get_One call S_push ; make room first clrf AEXP ; Create a binary 1 clrf AARGB0 clrf AARGB1 movlw 0x01 goto LSB2stak Get_Calib: movlw Calib goto W2stak Get_F1 movlw F1 ; Includes stack push goto W2stak Get_F2 movlw F2 ; Includes stack push goto W2stak Get_F3 movlw F3 ; Includes stack push ; goto W2stak ;******************************************************************** ; Copy 16 bit number, pointed to by W, to stack ; and convert to FP (positive value only) ; via a 24 bit number in AARGB0,1,2 ;******************************************************************** W2stak movwf FSR call S_push ; make room first clrf AEXP clrf AARGB0 movf INDF,W ; Big Byte first movwf AARGB1 incf FSR,F ; then little byte movf INDF,W LSB2stak movwf AARGB2 goto FLO2424 ; 24 bit int -> 24 bit FP ;******************************************************************** INCLUDE END