Test ; for debugging purposes only #define Frequency ; insert start_up sequence to test oscillator #define Input_Calib ; insert start_up sequence to display ; and modify calibration constants ;******************************************************************* ; ; 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 pulse formatter for RESET, using MC4093 to avoid ;^& display stalling and true NAND gate to timer/counter ;&* NOTE - gate opening signal PORTA0 is reversed! ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& ;^& LC006d32 12/20/2006 by cmorariu@yahoo.com ;^& FEATURES: -32 bit float math ** ;^& -oscillators frequency test ;^& -two range / four scales ;^& -calibration constant for every scale in EEPROM ;^& -display and change calibration constants from LC-meter keys ** ;^& -rounding of displayed result ** ;^& -24 bit (using interrupts) counter for frequency ** ;^& -theoretical precision for .4s gate time .007pF and .05 uH ** ;^& -measure precision extended to 0.01 pF, 0.1nH ** ;^& -input parameters of result display routine initialised by table ;^& ** NEW features ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& ;******************************************************************* ; 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:AARGB5 ; B = BEXP:BARGB0:BARGB1:BARGB2:BARGB3 ; C = CEXP:CARGB0:CARGB1:CARGB2 ; D = DEXP:....:DARGB3 ; used only for swap N1 N2 DARGB3 DARGB2 DARGB1 DEXP AARGB5 ;^& requested by 32 bit math AARGB4 AARGB3 AARGB2 AARGB1 AARGB0 AEXP ; 8 bit biased exponent for argument A BARGB3 ;^& requested by 32 bit math 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 TEMPB1 ; Used TEMPB0 ; ; ; "Main" Program Storage ; cnt ; (BCD BYTES) COUNT1 ; Used by delay routines ; and "prescaler flush" COUNT2 ; Timing (100ms) INITSTATUS ; Function (PORTB) at Init CHR ; ; Frequency measure results area ; ^& extended to 32 bit for compatibility with 32 bit math F3B3 F3B2 F3B1 F3B0 F2B3 F2B2 F2B1 F2B0 F1B3 F1B2 F1B1 F1B0 ; ; BCD result area = result is a fixed point 10 digits decimal number ; bcd:5 ; BCD, MSD first ; ; Calibration constants zone ; Calib3 Calib2 Calib1 Calib0 TabStop ; Used to fix bad displays. TabTemp Charcount ; number of chars displayed ; TMP_REG ; just as scratch SWAP_R ; used for block copy routine ;^&*************************************************************** ;^& Display Digits Routine Variables ;^& ; ; 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 ;^& EEPROM zone EE_Wr_Data ; Data to be written in EEPROM EE_Ct_Addr ; EEPROM address where is located current constant ;^& FREE ; last free RAM location endc ;^&*************************************************************** ;^& Display Digits Routine Variables ;^& ; Variables to be initialised before calling routine ; Disp_Digits equ AEXP ; Number of digits to display Sbunit_Sw equ AARGB0 ; Number of digits till first subunit changes Sbunit_Text equ AARGB1 ; pointer to greatest subunits' text table MUnit equ AARGB2 ; Pointer to measure unit's text EXP equ AEXP ; Used by math routines TEMP equ TEMPB0 ;******************************************************************* ; ; 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 ;^&**************************************** ;^& 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.1 nH scale ( L ) Lext_Ct de .102 ; 1 nH scale ( ^L ) Cext_Ct de .108 ; 0.1 pF scale ( ^C ) Cbase_Ct de .100 ; 0.01 pF scale ( C ) ;^& ;^&*************************************** ;^& Procent de "%" ; procent sign followed by blank Unit0 de " ",0 ; full unit Unit1 de "m",0 Unit2 de "u",0 Unit3 de "n",0 Unit4 de "p",0 Bl_Cap de " " Cap de "F",0 Ind de "H",0 Freq de "kHz",0 Equal de " = ",0 ovr de "????",0 ovrmax de "*max*",0 Calibr de ": zeroing",0 Cal_Txt de " adj: ",0 ;Sav_Txt de " sav." F1_Txt de "1: ",0 F2_Txt de "2: " Null_Txt de 0 ;^&******************************************************** ;^& ;^& Gate opening time ;^& Extending gate time increases theoretical precision of measure ;^& but decreases measure speed ;^& (modification of this constant requires adjustment of Tab_Lcal) ;^& N_Gate equ .4 ; number of 0.1s periods of gate open ;********************************************************** ; ; Begin Executable Stuff(tm) ; org 0 RESET: #ifndef Test call InitIO #else goto Display_Digits #endif call Chk_functn_Sw ; save PORTB initial status (L/C mode switch) CALL LCDINIT_PWR ; INITIALIZE LCD MODULE For The First Time goto Main ;^&********************************************************* ;^& ;^& Counter interrupt routine ;^& org 0x4 Timer_Interrupt: incf F3B1,f ; incremet LSByte of overflow word of counter bcf INTCON,T0IF ; clear overflow bit retfie ; return and enable interrupts ;^& ;^&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ;^& ;^& DATA TABLES FOR DISPLAY ROUTINE ;^& org 0x7 ; !!! table must be in page 0 of program memory (0 - 255) !!! ;^&******************************************************** ;^& ;^& Display Frequency (contents of AARGB0,1,2) on LCD ;^& #ifdef Frequency Tab_Display_Freq: retlw .5 ; # of digits to display retlw .8 ; xxxxxxx.xxx dot after 7 digits retlw Null_Txt-eestart ; s.unit text = Text terminator (no subunit needed) retlw Freq-eestart ; unit "Hz" #endif ;^&******************************************************** ;^& ;^& Display Calibration percentage on LCD ;^& #ifdef Input_Calib Tab_Display_Cal: retlw .2 ; display 2 digits retlw .0 ; no dot retlw Null_Txt-eestart ; Text terminator (no subunit needed) retlw Procent-eestart ; unit "Hz" #endif ;^&********************************************************** ;^& ;^& Formatted display of BCD work area for Capacitor ;^& Tab_C_disp: retlw .4 retlw .2+B'10000000' ; u n p ; base C range dd.ddd.ddd.dd retlw Unit2-eestart ; Biggest subunit, "u" retlw Cap-eestart ; unit "C" ;^&********************************************************** ;^& ;^& Formatted display of BCD work area for Inductor ;^& Tab_L_disp: retlw .4 retlw .3+B'10000000' ; m u n ; base L range ddd.ddd.ddd.d retlw Unit1-eestart ; Biggest subunit, " " (full unit) retlw Ind-eestart ; unit "H" ;^&********************************************************* ;^& ;^& Constant for computing inductances - floating point format ;^& 1/(Ccal*4*PI*PI) * N_Gate^2 Tab_Lcal: retlw 0xb2 ; 2.53303e+13 * 16 (koz gate is open 4*0.1s) retlw 0x66 ; Precomputed 1/(Ccal*4*PI*PI) retlw 0x60 ; fiddle factor (1/100) retlw 0xb1 ; More precise ;^&********************************************************* ;^& ;^& Constant for computing capacitance - floating point format ;^& Ccal * 10^Nd ; Nd = number of digits after dot ;^& 1000pF * 100 = 100.000 for 0.01pF precision Tab_Ccal: retlw 0x8f ; 100,000 retlw 0x43 ; Precomputed Ccal retlw 0x50 ; fiddle factor retlw 0 ;^&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ;********************************************************** ; ; Main Program ; Main: 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 #ifdef Frequency ;^&******************************************************** ;^& ;^& 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 ; movlw .1 ; one .1s period call Measure_Closed ; Measure Local Osc Freq. and Don't read any buttons ; btfss INTCON,T0IF ; Set = Counter overflow? goto Do_Disp MOVLW ovrmax-eestart ; Over-range message "*max*" 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 movlw Bl_Cap-eestart ; Display Test Message " F" call pmsg ; Print '2: ' if calibration relay is activated otherwise '1: ' movlw F1_Txt-eestart btfsc Tank_Relay,0x0 movlw F2_Txt-eestart call pmsg ; Store measured frequency in AARGB0 - AARGB3 movlw AARGB0 call Copy_N1_N2 ; Convert to BCD and display CALL B2_BCD ; CONVERT COUNT TO BCD movlw Tab_Display_Freq call Display_Res goto Disp_Freq_Loop Range_Button: incf Tank_Relay,f ; step to next displayed frequency bcf Tank_Relay,0x2 ; keep in range 0 - 3 ; Set Tank according to Tank_Relay bcf Tank,0x0 btfsc Tank_Relay,0x1 bsf Tank,0x0 ; Set relay according to Tank_Relay bsf relay btfsc Tank_Relay,0x0 bcf relay ; call Set_Range ; include 600ms delay for button to settle btfsc setup ; test if 'RANGE' button is pressed return #endif ; Frequency #ifdef Input_Calib ; Continue if setup is hold down longer ;^&********************************************************** ;^& ;^& Display and set calibration constants ;^& clrf Tank ; Reset Range Get_Ct_Loop_Clr: clrf Tank_Relay ; offset to old calibration constants so the sum is in +115 -85 range Get_Ct_Loop: call LCDINIT call Print_Range ; "^" or " " call Print_L_or_C ; " L" or " C" movlw Cal_Txt-eestart ; call pmsg ; Get calibration constant from EEPROM ; compute EEPROM address regarding functn status and Tank value call Get_EE_Addr movwf EE_Ct_Addr ; save EEPROM address for store new constant sequence call Get_EE_Byte ; Constant in W reg movwf EE_Wr_Data ; save orig value ; Add current offeset addwf Tank_Relay,w ; add offset movwf AARGB3 ; save sum in Byte to be printed movlw .100 ; Subtract 0 offset subwf AARGB3,f ; Print adjustment's sign movfw AARGB3 ; test if zero movlw ' ' btfsc _Z goto Skip_Sign ; if = 0% don't write any sign movlw '+' btfsc AARGB3,MSB ; sign bit movlw '-' Skip_Sign: call PRINTCHAR ; If pecentage is negative negate it btfss AARGB3,MSB goto Print_Percentage ; negate reg comf AARGB3,f incf AARGB3,f ; Convert to BCD and print Print_Percentage: call CLR_AARG ; clear AARGB0 - 2 CALL B2_BCD ; CONVERT COUNT TO BCD movlw Tab_Display_Cal call Display_Res ; display calibration percentage ; Print '*' if displayed constant is the one saved movlw '*' movf Tank_Relay,f btfsc _Z call PRINTCHAR call MS600 ; Test if L/C switch was changed call Chk_functn_Sw btfss _Z goto Save_Ct ; L/C switch changed ; Test if "RANGE" button is pressed btfsc setup goto Get_Ct_Loop ; button not pressed keep displaying same value ;^&------------------------------------- ;^& Setup switch was pressed ;^& movfw EE_Wr_Data ; orig constant value addwf Tank_Relay,w sublw .110 ; test if max value btfsc _Z goto Set_Minim ; don't increment above the max value incf Tank_Relay,f goto Get_Ct_Loop Set_Minim: movlw low(.256+.90) ; .90 = min value subwf EE_Wr_Data,w ; negate W reg xorlw 0xff addlw 0x1 movwf Tank_Relay ; set % to min value goto Get_Ct_Loop ;^&------------------------------------------------ ;^& Save new constant in EEPROM ;^& Save_Ct: movf Tank_Relay,w btfsc _Z goto No_Save ; Don't save again same value ; Write new value in EEPROM addwf EE_Wr_Data,f ; adjust to new value ; Prepare data and address for EEPROM write movfw EE_Wr_Data movwf EEDATA ; Get the EEPROM address to save to movfw EE_Ct_Addr ; ! remember pmsg routine uses EEADR movwf EEADR ;^&------------------------ ;^& Write EEPROM Byte ;^& errorlevel -302 ; Dont complain about BANK 1 Registers bsf STATUS,RP0 ; BANK 1 Wr_EE_Byte: ; Wait For Previous Write To end btfsc EECON1,WR goto Wr_EE_Byte ; Set WR Bit bsf EECON1,WREN ; Begin writing movlw 0x55 ;--------REQUESTED--------- movwf EECON2 movlw 0xaa movwf EECON2 bsf EECON1,WR ;-------------------------- ; call D200us ; Verify if data was written ok ; bsf EECON1,RD bcf STATUS,RP0 ; BANK 0 errorlevel +302 ; Return vigilance to BANK 0 Registers ; movfw EE_Wr_Data ; subwf EEDATA,w ; Compare ; btfss _Z ; goto EE_w_err ; Display some animation to confirm data save ; call LCDINIT ; call D200us ; movlw Sav_Txt-eestart ; call pmsg movlw '*' call PRINTCHAR ; to show this is new saved constant call MS600 call LCDINIT call MS600 No_Save: btfsc functn ; switch Tank only when switching from C to L comf Tank,f ; Go To Next Constant (complement range) goto Get_Ct_Loop_Clr ; Print " = *???*" message to indicate that the EEPROM write failed ;EE_w_err: ; call LCDINIT ; call D200us ; movlw Equal-eestart ; call pmsg ; MOVLW ovr-eestart ; Over-range message ; call pmsg ; sleep ; halt #endif ;^&********************************************************** ;^& ;^& Routine For PORTB PIN6 Set (Select oscillator) ;^& LC_Swap: ; Get Tank Value Upon R/L switch and set appropriate osscillator bsf Tank,0x0 btfss functn ;^& Test C/L switch and set Range Output bcf Tank,0x0 Range_Pressed: comf Tank,f ; Change Range goto RESET ; ; Calibrate The Meter ; Calibrate: call LCDINIT ; clear display and home cursor 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 Calibr-eestart ; Display " Calibrating " - sorry ": zeroing" call pmsg ; to entertain the punters ; call Measure ; Dummy Run to stabilise oscillator. ; bz Calibrate ; F < 2560Hz ? ; call MS200 ; was MS300 ; Measure F1 free oscillator frequency call Measure ; Get freq in F3MSB:F3:F3+1 ; Test if measured freq < 2560 and if not store in F1 bz Calibrate ; F < 2560Hz ? movlw F1B0 call Copy_N1_N2 ; transfer result in F1 area ; Measure F2 with standard capacitor added bcf relay ; Add standard capacitor call MS300 ; wait to stabilize call Measure ; Get freq in F3MSB:F3:F3+1 bz Calibrate ; F < 2560Hz ? movlw F2B0 call Copy_N1_N2 ; transfer result in F2 area ; Prepare to measure F3 unknown capacitor or inductance added bsf relay ; Remove standard capacitor call MS300 CALL LCDINIT ; INITIALIZE LCD MODULE (clear calibration message) ; ; 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 call Print_L_or_C movlw Equal-eestart ; " = " call pmsg call Measure ; Measure F3 & leave it there ; test for "too low" frequency bnz OK2GO ; F < 2560Hz ? 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 ;********************************************************** ; ; Measure Frequency. Stash in F3B0 - F3B3 ; Measure: call Chk_functn_Sw ; check if L/C switch changed status btfss STATUS,Z goto LC_Swap ; L/C switch changed btfss setup ; test "RANGE" switch goto Range_Pressed movlw N_Gate ; number of periods of .1s for gate open Measure_Closed: ; measure but don't read push buttons bcf INTCON,T0IF ; Declare "Not yet Over-range" clrf F3B0 clrf F3B1 ; prepare overflow counter CLRF TMR0 ; RESET INTERNAL COUNT (INCLUDING PRESCALER) ; See page 27 Section 6.0 movwf TMP_REG ; set loop counter bsf INTCON,T0IE bsf INTCON,GIE ; eneble interrupts to collect overflows ;##################################################################### bsf PORTA,0x0 ; Open Time Gate Gate_Delay: CALL MS100 ; 100MS DELAY decfsz TMP_REG,f goto Gate_Delay bcf PORTA,0x0 ; Close Time Gate ;##################################################################### bcf INTCON,GIE ; disable interrupts MOVF TMR0,W ; GET HIGH BYTE MOVWF F3B2 ; Copy to Big end of 16 bit result CLRF F3B3 ; 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 F3B3,F ; Decrement the counter movfw TMR0 ; Has TMR0 changed? xorwf F3B2,W ; if unchanged, XOR -> 0 bz PSC1 ; continue ; Test if Freq < 2560 Hz ( Z => F < 2560Hz) movfw F3B1 iorwf F3B2,w ; Prepare copy to F1 or F2 movlw F3B0 movwf N1 return ; F3B0 - F3B3 now holds 32 bit result ; ; Precompute major bracketed terms cos ; we need 'em both for all calculations ; OK2GO: call F1_F2 ; compute (F1/F2)^2 - 1 call F1_F3 ; compute (F1/F3)^2 - 1 clrf FPFLAGS ; clear math errors, clear round flag ; ; See what mode we are in ; btfss functn ; 0=Inductor #ifndef Test goto L_calc #endif ; ; OK, we've been told it's a capacitor ; ;******************************************************************** ; ; Calculate Unknown Capacitance OR inductance ; ; Output: 32 bit positive integer (scaled) ; right justified in AARGB0, AARGB1, AARGB2, AARGB3 ; also as BCD in bcd:bcd+1:bcd+2:bcd+3:bcd+4 ; ;******************************************************************** ;--------------------- C_calc: call divide call Get_Ccal ; Times 100,000 ( = 1000.00pF) call multiply call Adj_2BCD ;-------------------- ; Prepare Display Value Of C C_disp: movlw Tab_C_disp Test_Mathflags: movwf TMP_REG movlw BADFPFLAGS andwf FPFLAGS,w btfss STATUS,Z goto O1Range call Display_Res+1 ; "+1" skip TMP_REG load goto M_F3 ; ; Now, they reckon it's a @#$*! inductor ; L_calc: call multiply call Get_Lcal ; Precomputed 1/(Ccal*4*PI*PI) call multiply call Get_F1 ; Divide by F1^2 call S_push call multiply call S_swap call divide call Adj_2BCD ; Prepare Display Value Of L movlw Tab_L_disp goto Test_Mathflags ;^&********************************************************** ;^& ;^& Apply Scale Correction and convert result to BCD ;^& Adj_2BCD: ; Put in Calib0 - 3 the calibration constant from EEPROM clrf Calib0 clrf Calib1 clrf Calib2 ; get currents' scale correction constant call Get_EE_Addr call Get_EE_Byte movwf Calib3 ; Multiply result with calibration constant call Get_Calib ; Calib:Calib+1 -> AARGB2:AARGB3 and then converted to float AEXP, AARGB0 - 3 call multiply ; Multiply With Calibration Constant ; Divide by 100 movlw .100 movwf Calib3 call Get_Calib call S_swap call divide ; Divide By 100 ; Print results' sign movlw A' ' ; blank for plus btfsc AARGB0,MSB ; test sign movlw A'-' ; minus call PRINTCHAR ; print it ; ; Format as raw BCD string in bcd:bcd+1:bcd+2:bcd+3 ; bcf AARGB0,MSB ; make plus anyway call INT3232 ; convert to integer ; goto B2_BCD ; includes return ;****************************************************************** ; ; Convert 32-bit binary number at into a bcd number ; at . Uses Mike Keitz's procedure for handling bcd ; adjust; ; B2_BCD: movlw .32 movwf TEMPB1 ; make cycle counter clrf bcd+0 ; clear result area clrf bcd+1 clrf bcd+2 clrf bcd+3 clrf bcd+4 b2bcd2 movlw bcd ; make pointer movwf FSR movlw .5 ; 5*2 digits 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 #ifdef FAST rlf AARGB3,f rlf AARGB2,f ; get another bit rlf AARGB1,f rlf AARGB0,f #else call RL_AARG #endif rlf bcd+4,f rlf bcd+3,f ; put it into bcd rlf bcd+2,f rlf bcd+1,f rlf bcd+0,f decfsz TEMPB1,f ; all done? goto b2bcd2 ; no, loop return ; yes ;^&****************************************** ;^& ;^& Check if L/C switch changed status since last call ;^& 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 ;^&****************************************** ;^& ;^& Get EEPROM address of current scale correction constant ;^& Get_EE_Addr: movlw Cext_Ct-eestart btfss functn ; C or L constant (reversed because the switch was changed to store previous value of constant) movlw Lbase_Ct-eestart btfsc Tank,0x0 addlw 0x1 ; add range offset return ;^&****************************************** ;^& ;^& Test L/C switch and print mode ( " L" or " C" ) ;^& Print_L_or_C: call Print_Blank movlw 'C' btfss functn ; 0=Inductor movlw 'L' goto PRINTCHAR ;^&******************************************** ;^& ;^& Print Range Prefix ;^& for C capacitors 1000pF oscillator is Basic (low) Range ;^& for L inductors 10000pF oscillator is Basic (LOW) Range ;^& Print_Range: call Get_Range movlw ' ' ; normal range btfss _Z movlw '^' ; extended range goto PRINTCHAR ;^&****************************************** ;^& ;^& Test range and returns Z for normal and NZ for extended ;^& Get_Range: clrw btfsc functn movlw 1 xorwf Tank,w andlw 1 return ;^&*********************************************************** ;^& ;^& SETTING RANGE (switch oscillator) - According To Tank BIT0 ;^& and delay to let relay to settle Set_Range: btfsc Tank,0x0 bsf RANGE btfss Tank,0x0 bcf RANGE ; ;^& Wait For Oscillator To Stabilise ;********************************************************** ; ; Delay for about 200ms or 300ms (untrimmed) ; MS600: call MS300 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 [to accurate adjust use a frequency meter and match with displayed freq] 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 addressed by W reg ;^& Get_EE_Byte: ; EE Address In W movwf EEADR Get_EE: ; EE Addr Already Set BANK1 errorlevel -302 ; Dont complain about BANK 1 Registers BSF EECON1, RD ; EE Read BANK0 errorlevel +302 ; Vigilance on. We switched to BANK 0 Registers movfw EEDATA return ;************ 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 MOVWF PORTB ; SEND DATA TO DISPLAY ; SET PORTB RANGE BIT TO CORRECT VALUE ; ==================================== BTFSC Tank,0x0 ;^& Keep Range BSF PORTB,0x5 ;^& Keep Range To "C" ; 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 ;****************************************************** ; ; 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 ; F2 -> A F1_F1: call Get_F1 ; A -> B , F1 -> A call divide ; F1 / F2 call S_push ; F1/F2 -> B call multiply ; (F1/F2)^2 ;^&..................................................... ; call Get_One ; 1 -> A ; Get 1 call S_push ; make room first call CLR_AARG movlw 0x7f movwf AEXP ;^&.................................................... call S_swap ; (F1/F2)^2 -> A, 1 ->B ; goto subtract subtract: call FPS32 goto S_fix divide: call FPD32 goto S_fix multiply: call FPM32 ; goto S_fix ;******************************************************************** ; ; Stack operations ; ;******************************************************************** ; ; Fix stack after add, subtract, divide & multiply (C ->B) ; RESTORE B ; S_fix: movlw CEXP B_Destination: movwf N1 movlw BEXP goto Copy_N1_N2 ; ; Push stack (duplicates TOS) B -> C , A -> B ; SAVE B IN C AND A IN B (also B IN A) ; S_push: movlw BEXP movwf N1 movlw CEXP call Copy_N1_N2 movlw AEXP goto B_Destination ; ; Swap A and B ; S_swap: movlw BEXP movwf N1 movlw DEXP call Copy_N1_N2 movlw AEXP call B_Destination movlw DEXP movwf N1 movlw AEXP ;^&------------------------------------------------------------- ;^& ;^& Copy Number Pointed by N1 Into Number Pointed by W reg ;^& Copy_N1_N2: movwf N2 movlw .4 movwf cnt Copy_Loop: movfw N1 movwf FSR movfw INDF movwf SWAP_R movfw N2 movwf FSR movfw SWAP_R movwf INDF decf N1,f decf N2,f decfsz cnt,f goto Copy_Loop return ;******************************************************************** ; Fetch assorted things used for the calculation ; of Unknown L and C ; ;******************************************************************** Get_Lcal: movlw Tab_Lcal ;^&****************************************************************** ;^& ;^& Get 4 Bytes From Table Pointed By W-reg to AEXP, AARGB0-3 ;^& Get_4Bytes_2ANumb: movwf TMP_REG ; save table address Get_4Bytes: call S_push ; make room first movlw AEXP movwf FSR ; load destination pointer clrf Digit_Flag ; loop counter = 4 bsf Digit_Flag,.2 Get_Byte_Loop: call Get_1Byte movwf INDF ; put byte taken from table incf TMP_REG,f ; next table position decf FSR,f ; next storage position decfsz Digit_Flag,f goto Get_Byte_Loop return Get_Ccal: movlw Tab_Ccal goto Get_4Bytes_2ANumb Get_Calib: movlw Calib0 goto W2stak Get_F1: movlw F1B0 ; Includes stack push goto W2stak Get_F2: movlw F2B0 ; Includes stack push goto W2stak Get_F3: movlw F3B0 ; Includes stack push ;******************************************************************** ; Copy 24 bit number, pointed to by W, to stack ; and convert to FP (positive value only) ; AEXP,AARGB0,1,2 ;******************************************************************** W2stak: movwf TEMPB1 ; save FSR call S_push ; make room first movfw TEMPB1 ; restore FSR movwf N1 movlw AARGB0 call Copy_N1_N2 goto FLO3232 ;******************************************************************** ;******************************************************************** ; 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 return ;^&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ;^& ;^& Display BCD Result, Dot Point And Measure Subunit And Unit ;^& Round Displayed Number According to Hidden Remaining Digits ;^& ;^& INPUT: BCD number in bcd0:4, W reg points to init table ;^& Init Table: Number of digits to display. Number of digits till first ;^& subunit switches, pointer to first subunit text, pointer to units' text Display_Res: movwf TMP_REG ; save table address ; Gets initialisation data from table call Get_4Bytes ; Check if range correction requested for L or C btfss Sbunit_Sw,MSB ; MSB set if correction req goto Display_Digits call Get_Range ; returns Z if normal range btfss _Z incf Sbunit_Sw,f ; add 1 to Sbunit_Sw if extended range bcf Sbunit_Sw,MSB ; clear correction flag Display_Digits: movlw .10 movwf Digit_Number ; number of digits of computed result clrf Digit_Flag ; Clear Flags (Dot Printed(1) and Digit displayed(0) ) movfw Disp_Digits movwf Disp_Digits_Sav ; Save Number Of Digits To Display D_Loop: call Get_Digit ; get digit pointed by Digit_Number bz Digit_Null ; digit contains null value ; Print nonzero value ADDLW 0x30 ; Convert BCD 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 ;=====================rounding sequence=========================== ; check if next digit is nonzero movfw Digit_Number movwf BEXP ; save Digit_Number decf Digit_Number,f call Get_Digit btfsc _Z goto No_Round ; test if any digit left after result incf Disp_Digits,w subwf Digit_Number,f btfss _C goto No_Round ; check if next digit after result is > 4 incf Digit_Number,f ; point to next digit after result call Get_Digit sublw .4 btfsc _C goto No_Round ; next digit < 5 ; adjust result by adding 1 Round_Loop: incf Digit_Number,f call Get_Digit call Inc_Digit btfsc _Z goto Round_Loop movfw BEXP subwf Digit_Number,w btfsc _Z goto D_Loop ; current digit of result was rounded - check again current digit No_Round: movfw BEXP movwf Digit_Number ; Restore and coontinue ;================================================================= ; 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_Blank movlw 0x4 subwf Digit_Number,w bnc Pr_Zero ; Print Blank If Current digit number > number of digits to display Chk_Zero_Blank: movfw Digit_Number subwf Disp_Digits_Sav,w bnc Next_Digit ; don't write anything goto Pr_Blank Pr_Zero: movlw '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: 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 '.' ; Print Dot Point "." goto PRINTCHAR Print_Blank: movlw ' ' ; Print " " goto PRINTCHAR ; Get digit (in W reg) pointed by Digit_Number Get_Digit: movfw Digit_Number addlw 1 ; increment and clear CY movwf FSR rrf FSR,w ; divide by 2 Digit_Number to find Byte number sublw bcd+5 ; compute address of byte movwf FSR movf INDF,w btfss Digit_Number,0 ; test if low or high nibble swapf INDF,w ; byte with digit in LS nibble in W reg movwf BARGB1 ; save for Inc_Digit andlw 0x0f ; clear upper nibble return ; Increment digit at location ponted by Digit_Number Inc_Digit: ; returns Z if displacement results call Get_Digit ; compute FSR and get old value addlw .1 ; increment digit movwf EE_Wr_Data ; save digit to put sublw .10 btfsc _Z clrf EE_Wr_Data ; 0 movfw BARGB1 ; old byte swapped andlw 0xf0 iorwf EE_Wr_Data,w ; replace with new value movwf INDF btfss Digit_Number,0 swapf INDF,f movf EE_Wr_Data,f ; test Z = displacement return ;^&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ;^& Gets in W reg byte from program memory ;^& pointed by TMP_REG-1 Get_1Byte: movfw TMP_REG ; table address movwf PCL ; go to program memory address TMP_REG ;^&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ;^&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ;^& MICROCHIPs' 32 bit floating point math squeezed to be compact ;^& regardless of speed ;^& ; #include ; END ;#define FPROUND ;^& define if round of binary result is used ;#define FAST ;^& define if speed prevails code consimption ; ; RCS Header $Id: fp32.a16 2.8 1996/10/07 13:50:59 F.J.Testa Exp $ ; $Revision: 2.8 $ ; PIC16 32 BIT FLOATING POINT LIBRARY ; ; Unary operations: both input and output are in AEXP,AARG ; ; Binary operations: input in AEXP,AARG and BEXP,BARG with output in AEXP,AARG ; ; All routines return WREG = 0x00 for successful completion, and WREG = 0xFF ; for an error condition specified in FPFLAGS. ; ; All timings are worst case cycle counts ; ; Routine Function ; ; FLO2432 24 bit integer to 32 bit floating point conversion ; FLO32 ; ; Timing: RND ; 0 1 ; ; 0 104 104 ; SAT ; 1 110 110 ; ; NRM3232 32 bit normalization of unnormalized 32 bit floating point numbers ; NRM32 ; ; Timing: RND ; 0 1 ; ; 0 90 90 ; SAT ; 1 96 96 ; ; ; INT3224 32 bit floating point to 24 bit integer conversion ; INT32 ; ; ; Timing: RND ; 0 1 ; ; 0 104 112 ; SAT ; 1 104 114 ; ; FLO3232 32 bit integer to 32 bit floating point conversion ; ; Timing: RND ; 0 1 ; ; 0 129 145 ; SAT ; 1 129 152 ; ; NRM4032 32 bit normalization of unnormalized 40 bit floating point numbers ; ; Timing: RND ; 0 1 ; ; 0 112 128 ; SAT ; 1 112 135 ; ; ; INT3232 32 bit floating point to 32 bit integer conversion ; ; ; Timing: RND ; 0 1 ; ; 0 130 137 ; SAT ; 1 130 137 ; ; FPA32 32 bit floating point add ; ; Timing: RND ; 0 1 ; ; 0 251 265 ; SAT ; 1 251 271 ; ; FPS32 32 bit floating point subtract ; ; Timing: RND ; 0 1 ; ; 0 253 267 ; SAT ; 1 253 273 ; ; FPM32 32 bit floating point multiply ; ; Timing: RND ; 0 1 ; ; 0 574 588 ; SAT ; 1 574 591 ; ; FPD32 32 bit floating point divide ; ; Timing: RND ; 0 1 ; ; 0 932 968 ; SAT ; 1 932 971 ; ; ;********************************************************************************************** ;********************************************************************************************** ; ; 32 bit floating point representation ; ; EXPONENT 8 bit biased exponent ; ; It is important to note that the use of biased exponents produces ; a unique representation of a floating point 0, given by ; EXP = HIGHBYTE = MIDBYTE = LOWBYTE = 0x00, with 0 being ; the only number with EXP = 0. ; ; HIGHBYTE 8 bit most significant byte of fraction in sign-magnitude representation, ; with SIGN = MSB, implicit MSB = 1 and radix point to the right of MSB ; ; MIDBYTE 8 bit middle significant byte of sign-magnitude fraction ; ; LOWBYTE 8 bit least significant byte of sign-magnitude fraction ; ; EXPONENT HIGHBYTE MIDBYTE LOWBYTE ; ; xxxxxxxx S.xxxxxxx xxxxxxxx xxxxxxxx ; ; | ; RADIX ; POINT ; ; ;********************************************************************************************** ;********************************************************************************************** ; Integer to float conversion ; Input: 24 bit 2's complement integer right justified in AARGB0, AARGB1, AARGB2 ; Use: CALL FLO2432 or CALL FLO32 ; Output: 32 bit floating point number in AEXP, AARGB0, AARGB1, AARGB2 ; Result: AARG <-- FLOAT( AARG ) ; Max Timing: 14+90 = 104 clks SAT = 0 ; 14+96 = 110 clks SAT = 1 ; Min Timing: 6+28 = 34 clks AARG = 0 ; 6+18 = 24 clks ; PM: 14+38 = 52 DM: 7 ;---------------------------------------------------------------------------------------------- #ifdef Very_Fast FLO2432 FLO32 MOVLW D'23'+EXPBIAS ; initialize exponent and add bias MOVWF EXP CLRF SIGN BTFSS AARGB0,MSB ; test sign GOTO NRM3232 #ifdef FAST COMF AARGB2,F ; if < 0, negate and set MSB in SIGN COMF AARGB1,F COMF AARGB0,F #else call COM_AARG #endif INCF AARGB2,F BTFSC _Z INCF AARGB1,F BTFSC _Z INCF AARGB0,F BSF SIGN,MSB ;********************************************************************************************** ; Normalization routine ; Input: 32 bit unnormalized floating point number in AEXP, AARGB0, AARGB1, ; AARGB2, with sign in SIGN,MSB ; Use: CALL NRM3232 or CALL NRM32 ; Output: 32 bit normalized floating point number in AEXP, AARGB0, AARGB1, AARGB2 ; Result: AARG <-- NORMALIZE( AARG ) ; Max Timing: 21+6+7*8+7 = 90 clks SAT = 0 ; 21+6+7*8+1+12 = 96 clks SAT = 1 ; Min Timing: 22+6 = 28 clks AARG = 0 ; 5+9+4 = 18 clks ; PM: 38 DM: 7 ;---------------------------------------------------------------------------------------------- NRM3232 NRM32: #IFDEF FAST ;^& CLRF TEMP ; clear exponent decrement MOVF AARGB0,W ; test if highbyte=0 BTFSS _Z GOTO NORM3232 MOVF AARGB1,W ; if so, shift 8 bits by move MOVWF AARGB0 MOVF AARGB2,W MOVWF AARGB1 CLRF AARGB2 BSF TEMP,3 ; increase decrement by 8 MOVF AARGB0,W ; test if highbyte=0 BTFSS _Z GOTO NORM3232 MOVF AARGB1,W ; if so, shift 8 bits by move MOVWF AARGB0 CLRF AARGB1 BCF TEMP,3 ; increase decrement by 8 BSF TEMP,4 MOVF AARGB0,W ; if highbyte=0, result=0 BTFSC _Z GOTO RES032 NORM3232 MOVF TEMP,W SUBWF EXP,F BTFSS _Z BTFSS _C GOTO SETFUN32 #ENDIF ;^& ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& FAST ^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& BCF _C ; clear carry bit NORM3232A BTFSC AARGB0,MSB ; if MSB=1, normalization done GOTO FIXSIGN32 RLF AARGB2,F ; otherwise, shift left and RLF AARGB1,F ; decrement EXP RLF AARGB0,F DECFSZ EXP,F GOTO NORM3232A GOTO SETFUN32 ; underflow if EXP=0 #endif ; Very_Fast FIXSIGN32 BTFSS SIGN,MSB BCF AARGB0,MSB ; clear explicit MSB if positive RETLW 0 RES032: CLRF AARGB3 CLRF EXP #ifdef FAST CLRF AARGB0 ; result equals zero CLRF AARGB1 CLRF AARGB2 RETLW 0 #else goto CLR_AARG #endif ;********************************************************************************************** ;********************************************************************************************** ; Integer to float conversion ; Input: 32 bit 2's complement integer right justified in AARGB0, AARGB1, AARGB2, ; AARGB3 ; Use: CALL FLO3232 ; Output: 32 bit floating point number in AEXP, AARGB0, AARGB1, AARGB2 ; Result: AARG <-- FLOAT( AARG ) ; Max Timing: 17+112 = 129 clks RND = 0 ; 17+128 = 145 clks RND = 1, SAT = 0 ; 17+135 = 152 clks RND = 1, SAT = 1 ; Min Timing: 6+39 = 45 clks AARG = 0 ; 6+22 = 28 clks ; PM: 17+66 = 83 DM: 8 ;---------------------------------------------------------------------------------------------- FLO3232 MOVLW D'31'+EXPBIAS ; initialize exponent and add bias MOVWF EXP CLRF SIGN BTFSS AARGB0,MSB ; test sign GOTO NRM4032 #ifdef FAST COMF AARGB3,F ; if < 0, negate and set MSB in SIGN COMF AARGB2,F COMF AARGB1,F COMF AARGB0,F #else call COM_AARG_PLUS #endif INCF AARGB3,F BTFSC _Z INCF AARGB2,F BTFSC _Z INCF AARGB1,F BTFSC _Z INCF AARGB0,F BSF SIGN,MSB ;********************************************************************************************** ; Normalization routine ; Input: 40 bit unnormalized floating point number in AEXP, AARGB0, AARGB1, ; AARGB2, AARGB3 with sign in SIGN,MSB ; Use: CALL NRM4032 ; Output: 32 bit normalized floating point number in AEXP, AARGB0, AARGB1, AARGB2, ; AARGB3 ; Result: AARG <-- NORMALIZE( AARG ) ; Max Timing: 38+6*9+12+8 = 112 clks RND = 0 ; 38+6*9+12+24 = 128 clks RND = 1, SAT = 0 ; 38+6*9+12+31 = 135 clks RND = 1, SAT = 1 ; Min Timing: 33+6 = 39 clks AARG = 0 ; 5+9+8 = 22 clks ; PM: 66 DM: 8 ;---------------------------------------------------------------------------------------------- NRM4032: ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& FAST ^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& #IFDEF FAST ;^& CLRF TEMP ; clear exponent decrement MOVF AARGB0,W ; test if highbyte=0 BTFSS _Z GOTO NORM4032 MOVF AARGB1,W ; if so, shift 8 bits by move MOVWF AARGB0 MOVF AARGB2,W MOVWF AARGB1 MOVF AARGB3,W MOVWF AARGB2 CLRF AARGB3 BSF TEMP,3 ; increase decrement by 8 MOVF AARGB0,W ; test if highbyte=0 BTFSS _Z GOTO NORM4032 MOVF AARGB1,W ; if so, shift 8 bits by move MOVWF AARGB0 MOVF AARGB2,W MOVWF AARGB1 CLRF AARGB2 BCF TEMP,3 ; increase decrement by 8 BSF TEMP,4 MOVF AARGB0,W ; test if highbyte=0 BTFSS _Z GOTO NORM4032 MOVF AARGB1,W ; if so, shift 8 bits by move MOVWF AARGB0 CLRF AARGB1 BSF TEMP,3 ; increase decrement by 8 MOVF AARGB0,W ; if highbyte=0, result=0 BTFSC _Z GOTO RES032 NORM4032 MOVF TEMP,W SUBWF EXP,F BTFSS _Z BTFSS _C GOTO SETFUN32 #ENDIF ;^& ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& FAST ^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& BCF _C ; clear carry bit NORM4032A BTFSC AARGB0,MSB ; if MSB=1, normalization done GOTO NRMRND4032 #ifdef FAST RLF AARGB3,F ; otherwise, shift left and RLF AARGB2,F ; decrement EXP RLF AARGB1,F RLF AARGB0,F #ELSE call RL_AARG #ENDIF DECFSZ EXP,F GOTO NORM4032A GOTO SETFUN32 ; underflow if EXP=0 NRMRND4032: #IFDEF FPROUND ;^& BTFSC FPFLAGS,RND BTFSS AARGB2,LSB GOTO FIXSIGN32 BTFSS AARGB3,MSB ; round if next bit is set GOTO FIXSIGN32 INCF AARGB2,F BTFSC _Z INCF AARGB1,F BTFSC _Z INCF AARGB0,F BTFSS _Z ; has rounding caused carryout? GOTO FIXSIGN32 RRF AARGB0,F ; if so, right shift RRF AARGB1,F RRF AARGB2,F INCF EXP,F BTFSC _Z ; check for overflow GOTO SETFOV32 #ENDIF ;^& GOTO FIXSIGN32 ;********************************************************************************************** ;********************************************************************************************** ; Float to integer conversion ; Input: 32 bit floating point number in AEXP, AARGB0, AARGB1, AARGB2 ; Use: CALL INT3224 or CALL INT32 ; Output: 24 bit 2's complement integer right justified in AARGB0, AARGB1, AARGB2 ; Result: AARG <-- INT( AARG ) ; Max Timing: 40+6*7+6+16 = 104 clks RND = 0 ; 40+6*7+6+24 = 112 clks RND = 1, SAT = 0 ; 40+6*7+6+26 = 114 clks RND = 1, SAT = 1 ; Min Timing: 4 clks ; PM: 82 DM: 6 ;---------------------------------------------------------------------------------------------- INT3224 INT32 MOVF EXP,W ; test for zero argument BTFSC _Z RETLW 0x00 MOVF AARGB0,W ; save sign in SIGN MOVWF SIGN BSF AARGB0,MSB ; make MSB explicit MOVLW EXPBIAS+D'23' ; remove bias from EXP SUBWF EXP,F BTFSS EXP,MSB GOTO SETIOV3224 COMF EXP,F INCF EXP,F ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& FAST ^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& #IFDEF FAST ;^& MOVLW 8 ; do byte shift if EXP >= 8 SUBWF EXP,W BTFSS _C GOTO TSHIFT3224 MOVWF EXP RLF AARGB2,F ; rotate next bit for rounding MOVF AARGB1,W MOVWF AARGB2 MOVF AARGB0,W MOVWF AARGB1 CLRF AARGB0 MOVLW 8 ; do another byte shift if EXP >= 8 SUBWF EXP,W BTFSS _C GOTO TSHIFT3224 MOVWF EXP RLF AARGB2,F ; rotate next bit for rounding MOVF AARGB1,W MOVWF AARGB2 CLRF AARGB1 MOVLW 8 ; do another byte shift if EXP >= 8 SUBWF EXP,W BTFSS _C GOTO TSHIFT3224 MOVWF EXP RLF AARGB2,F ; rotate next bit for rounding CLRF AARGB2 MOVF EXP,W BTFSS _Z BCF _C GOTO SHIFT3224OK #ENDIF ;^& ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& FAST ^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& TSHIFT3224 MOVF EXP,W ; shift completed if EXP = 0 BTFSC _Z GOTO SHIFT3224OK SHIFT3224 BCF _C RRF AARGB0,F ; right shift by EXP RRF AARGB1,F RRF AARGB2,F DECFSZ EXP,F GOTO SHIFT3224 SHIFT3224OK: #IFDEF FPROUND ;^& BTFSC FPFLAGS,RND BTFSS AARGB2,LSB GOTO INT3224OK BTFSS _C GOTO INT3224OK INCF AARGB2,F BTFSC _Z INCF AARGB1,F BTFSC _Z INCF AARGB0,F BTFSC AARGB0,MSB ; test for overflow GOTO SETIOV3224 #ENDIF ;^& INT3224OK BTFSS SIGN,MSB ; if sign bit set, negate RETLW 0 #ifdef FAST COMF AARGB0,F COMF AARGB1,F COMF AARGB2,F #else call COM_AARG #endif INCF AARGB2,F BTFSC _Z INCF AARGB1,F BTFSC _Z INCF AARGB0,F RETLW 0 CLR_AARG: IRES03224 CLRF AARGB0 ; integer result equals zero CLRF AARGB1 CLRF AARGB2 RETLW 0 SETIOV3224 BSF FPFLAGS,IOV ; set integer overflow flag BTFSS FPFLAGS,SAT ; test for saturation RETLW 0xFF ; return error code in WREG CLRF AARGB0 ; saturate to largest two's BTFSS SIGN,MSB ; complement 24 bit integer #ifdef FAST MOVLW 0xFF MOVWF AARGB0 ; SIGN = 0, 0x 7F FF FF MOVWF AARGB1 ; SIGN = 1, 0x 80 00 00 MOVWF AARGB2 #else call FILL_FF #endif RLF SIGN,F RRF AARGB0,F RETLW 0xFF ; return error code in WREG ;********************************************************************************************** ;********************************************************************************************** ; Float to integer conversion ; Input: 32 bit floating point number in AEXP, AARGB0, AARGB1, AARGB2 ; Use: CALL INT3232 ; Output: 32 bit 2's complement integer right justified in AARGB0, AARGB1, AARGB2, ; AARGB3 ; Result: AARG <-- INT( AARG ) ; Max Timing: 54+6*8+7+21 = 130 clks RND = 0 ; 54+6*8+7+29 = 137 clks RND = 1, SAT = 0 ; 54+6*8+7+29 = 137 clks RND = 1, SAT = 1 ; Min Timing: 5 clks ; PM: 102 DM: 7 ;---------------------------------------------------------------------------------------------- INT3232 CLRF AARGB3 MOVF EXP,W ; test for zero argument BTFSC _Z RETLW 0x00 MOVF AARGB0,W ; save sign in SIGN MOVWF SIGN BSF AARGB0,MSB ; make MSB explicit MOVLW EXPBIAS+D'31' ; remove bias from EXP SUBWF EXP,F BTFSS EXP,MSB GOTO SETIOV32 COMF EXP,F INCF EXP,F ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& FAST ^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& #IFDEF FAST ;^& MOVLW 8 ; do byte shift if EXP >= 8 SUBWF EXP,W BTFSS _C GOTO TSHIFT3232 MOVWF EXP RLF AARGB3,F ; rotate next bit for rounding MOVF AARGB2,W MOVWF AARGB3 MOVF AARGB1,W MOVWF AARGB2 MOVF AARGB0,W MOVWF AARGB1 CLRF AARGB0 MOVLW 8 ; do another byte shift if EXP >= 8 SUBWF EXP,W BTFSS _C GOTO TSHIFT3232 MOVWF EXP RLF AARGB3,F ; rotate next bit for rounding MOVF AARGB2,W MOVWF AARGB3 MOVF AARGB1,W MOVWF AARGB2 CLRF AARGB1 MOVLW 8 ; do another byte shift if EXP >= 8 SUBWF EXP,W BTFSS _C GOTO TSHIFT3232 MOVWF EXP RLF AARGB3,F ; rotate next bit for rounding MOVF AARGB2,W MOVWF AARGB3 CLRF AARGB2 MOVLW 8 ; do another byte shift if EXP >= 8 SUBWF EXP,W BTFSS _C GOTO TSHIFT3232 MOVWF EXP RLF AARGB3,F ; rotate next bit for rounding CLRF AARGB3 MOVF EXP,W BTFSS _Z BCF _C GOTO SHIFT3232OK #ENDIF ;^& ;^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& FAST ^&^&^&^&^&^&^&^&^&^&^&^&^&^&^&^& TSHIFT3232 MOVF EXP,W ; shift completed if EXP = 0 BTFSC _Z GOTO SHIFT3232OK SHIFT3232 BCF _C #ifdef FAST RRF AARGB0,F ; right shift by EXP RRF AARGB1,F RRF AARGB2,F RRF AARGB3,F #else call RR_AARG #endif DECFSZ EXP,F GOTO SHIFT3232 SHIFT3232OK: #IFDEF FPROUND ;^& BTFSC FPFLAGS,RND BTFSS AARGB3,LSB GOTO INT3232OK BTFSS _C GOTO INT3232OK INCF AARGB3,F BTFSC _Z INCF AARGB2,F BTFSC _Z INCF AARGB1,F BTFSC _Z INCF AARGB0,F BTFSC AARGB0,MSB ; test for overflow GOTO SETIOV3224 #ENDIF INT3232OK BTFSS SIGN,MSB ; if sign bit set, negate RETLW 0 #ifdef FAST COMF AARGB0,F COMF AARGB1,F COMF AARGB2,F COMF AARGB3,F #else call COM_AARG_PLUS #endif INCF AARGB3,F BTFSC _Z INCF AARGB2,F BTFSC _Z INCF AARGB1,F BTFSC _Z INCF AARGB0,F RETLW 0 IRES032: #ifdef FAST CLRF AARGB0 ; integer result equals zero CLRF AARGB1 CLRF AARGB2 #else call CLR_AARG #endif CLRF AARGB3 RETLW 0 SETIOV32 BSF FPFLAGS,IOV ; set integer overflow flag BTFSS FPFLAGS,SAT ; test for saturation RETLW 0xFF ; return error code in WREG CLRF AARGB0 ; saturate to largest two's BTFSS SIGN,MSB ; complement 32 bit integer #ifdef FAST MOVLW 0xFF MOVWF AARGB0 ; SIGN = 0, 0x 7F FF FF FF MOVWF AARGB1 ; SIGN = 1, 0x 80 00 00 00 MOVWF AARGB2 MOVWF AARGB3 #else call FILL_FF #endif RLF SIGN,F RRF AARGB0,F RETLW 0xFF ; return error code in WREG ;********************************************************************************************** ;********************************************************************************************** ; Floating Point Multiply ; Input: 32 bit floating point number in AEXP, AARGB0, AARGB1, AARGB2 ; 32 bit floating point number in BEXP, BARGB0, BARGB1, BARGB2 ; Use: CALL FPM32 ; Output: 32 bit floating point product in AEXP, AARGB0, AARGB1, AARGB2 ; Result: AARG <-- AARG * BARG ; Max Timing: 26+23*22+21+21 = 574 clks RND = 0 ; 26+23*22+21+35 = 588 clks RND = 1, SAT = 0 ; 26+23*22+21+38 = 591 clks RND = 1, SAT = 1 ; Min Timing: 6+6 = 12 clks AARG * BARG = 0 ; 24+23*11+21+17 = 315 clks ; PM: 94 DM: 14 ;---------------------------------------------------------------------------------------------- FPM32 MOVF AEXP,W ; test for zero arguments BTFSS _Z MOVF BEXP,W BTFSC _Z GOTO RES032 M32BNE0 MOVF AARGB0,W XORWF BARGB0,W MOVWF SIGN ; save sign in SIGN MOVF BEXP,W ADDWF EXP,F MOVLW EXPBIAS-1 BTFSS _C GOTO MTUN32 SUBWF EXP,F BTFSC _C GOTO SETFOV32 ; set multiply overflow flag GOTO MOK32 MTUN32 SUBWF EXP,F BTFSS _C GOTO SETFUN32 MOK32: #ifdef FAST MOVF AARGB0,W MOVWF AARGB3 MOVF AARGB1,W MOVWF AARGB4 MOVF AARGB2,W MOVWF AARGB5 #else call DUP_A02 #endif BSF AARGB3,MSB ; make argument MSB's explicit BSF BARGB0,MSB BCF _C #ifdef FAST CLRF AARGB0 ; clear initial partial product CLRF AARGB1 CLRF AARGB2 #else call CLR_AARG #endif MOVLW D'24' MOVWF TEMP ; initialize counter MLOOP32 BTFSS AARGB5,LSB ; test next bit GOTO MNOADD32 MADD32 MOVF BARGB2,W ADDWF AARGB2,F MOVF BARGB1,W BTFSC _C INCFSZ BARGB1,W ADDWF AARGB1,F MOVF BARGB0,W BTFSC _C INCFSZ BARGB0,W ADDWF AARGB0,F MNOADD32: #ifdef FAST RRF AARGB0,F ; right shift by EXP RRF AARGB1,F RRF AARGB2,F RRF AARGB3,F #else call RR_AARG #endif RRF AARGB4,F RRF AARGB5,F BCF _C DECFSZ TEMP,F GOTO MLOOP32 BTFSC AARGB0,MSB ; check for postnormalization GOTO MROUND32 #ifdef FAST RLF AARGB3,F ; otherwise, shift left and RLF AARGB2,F ; decrement EXP RLF AARGB1,F RLF AARGB0,F #ELSE call RL_AARG #ENDIF DECF EXP,F MROUND32: #IFDEF FPROUND ;^& BTFSC FPFLAGS,RND BTFSS AARGB2,LSB GOTO MUL32OK BTFSS AARGB3,MSB GOTO MUL32OK INCF AARGB2,F BTFSC _Z INCF AARGB1,F BTFSC _Z INCF AARGB0,F BTFSS _Z ; has rounding caused carryout? GOTO MUL32OK RRF AARGB0,F ; if so, right shift RRF AARGB1,F RRF AARGB2,F INCF EXP,F BTFSC _Z ; check for overflow GOTO SETFOV32 #ENDIF ;^& MUL32OK BTFSS SIGN,MSB BCF AARGB0,MSB ; clear explicit MSB if positive RETLW 0 SETFOV32 BSF FPFLAGS,FOV ; set floating point underflag BTFSS FPFLAGS,SAT ; test for saturation RETLW 0xFF ; return error code in WREG #ifdef FAST MOVLW 0xFF MOVWF AEXP ; saturate to largest floating MOVWF AARGB0 ; point number = 0x FF 7F FF FF MOVWF AARGB1 ; modulo the appropriate sign bit MOVWF AARGB2 #else call FILL_FF #endif RLF SIGN,F RRF AARGB0,F RETLW 0xFF ; return error code in WREG ;********************************************************************************************** ;********************************************************************************************** ; Floating Point Divide ; Input: 32 bit floating point dividend in AEXP, AARGB0, AARGB1, AARGB2 ; 32 bit floating point divisor in BEXP, BARGB0, BARGB1, BARGB2 ; Use: CALL FPD32 ; Output: 32 bit floating point quotient in AEXP, AARGB0, AARGB1, AARGB2 ; Result: AARG <-- AARG / BARG ; Max Timing: 43+12+23*36+35+14 = 932 clks RND = 0 ; 43+12+23*36+35+50 = 968 clks RND = 1, SAT = 0 ; 43+12+23*36+35+53 = 971 clks RND = 1, SAT = 1 ; Min Timing: 7+6 = 13 clks ; PM: 155 DM: 14 ;---------------------------------------------------------------------------------------------- FPD32 MOVF BEXP,W ; test for divide by zero BTFSC _Z GOTO SETFDZ32 MOVF AEXP,W BTFSC _Z GOTO RES032 D32BNE0 MOVF AARGB0,W XORWF BARGB0,W MOVWF SIGN ; save sign in SIGN BSF AARGB0,MSB ; make argument MSB's explicit BSF BARGB0,MSB TALIGN32 CLRF TEMP ; clear align increment #ifdef FAST MOVF AARGB0,W MOVWF AARGB3 ; test for alignment MOVF AARGB1,W MOVWF AARGB4 MOVF AARGB2,W MOVWF AARGB5 #else call DUP_A02 #endif MOVF BARGB2,W SUBWF AARGB5,F MOVF BARGB1,W BTFSS _C INCFSZ BARGB1,W TS1ALIGN32 SUBWF AARGB4,F MOVF BARGB0,W BTFSS _C INCFSZ BARGB0,W TS2ALIGN32 SUBWF AARGB3,F CLRF AARGB3 CLRF AARGB4 CLRF AARGB5 BTFSS _C GOTO DALIGN32OK BCF _C ; align if necessary #ifdef FAST RRF AARGB0,F ; right shift by EXP RRF AARGB1,F RRF AARGB2,F RRF AARGB3,F #else call RR_AARG #endif MOVLW 0x01 MOVWF TEMP ; save align increment DALIGN32OK MOVF BEXP,W ; compare AEXP and BEXP SUBWF EXP,F BTFSS _C GOTO ALTB32 AGEB32 MOVLW EXPBIAS-1 ADDWF TEMP,W ADDWF EXP,F BTFSC _C GOTO SETFOV32 GOTO DARGOK32 ; set overflow flag ALTB32 MOVLW EXPBIAS-1 ADDWF TEMP,W ADDWF EXP,F BTFSS _C GOTO SETFUN32 ; set underflow flag DARGOK32 MOVLW D'24' ; initialize counter MOVWF TEMPB1 DLOOP32 RLF AARGB5,F ; left shift RLF AARGB4,F #ifdef FAST RLF AARGB3,F ; otherwise, shift left and RLF AARGB2,F ; decrement EXP RLF AARGB1,F RLF AARGB0,F #ELSE call RL_AARG #ENDIF RLF TEMP,F MOVF BARGB2,W ; subtract SUBWF AARGB2,F MOVF BARGB1,W BTFSS _C INCFSZ BARGB1,W DS132 SUBWF AARGB1,F MOVF BARGB0,W BTFSS _C INCFSZ BARGB0,W DS232 SUBWF AARGB0,F RLF BARGB0,W IORWF TEMP,F BTFSS TEMP,LSB ; test for restore GOTO DREST32 BSF AARGB5,LSB GOTO DOK32 DREST32 MOVF BARGB2,W ; restore if necessary ADDWF AARGB2,F MOVF BARGB1,W BTFSC _C INCFSZ BARGB1,W DAREST32 ADDWF AARGB1,F MOVF BARGB0,W BTFSC _C INCF BARGB0,W ADDWF AARGB0,F BCF AARGB5,LSB DOK32 DECFSZ TEMPB1,F GOTO DLOOP32 DROUND32: #IFDEF FPROUND ;^& BTFSC FPFLAGS,RND BTFSS AARGB5,LSB GOTO DIV32OK BCF _C RLF AARGB2,F ; compute next significant bit RLF AARGB1,F ; for rounding RLF AARGB0,F RLF TEMP,F MOVF BARGB2,W ; subtract SUBWF AARGB2,F MOVF BARGB1,W BTFSS _C INCFSZ BARGB1,W SUBWF AARGB1,F MOVF BARGB0,W BTFSS _C INCFSZ BARGB0,W SUBWF AARGB0,F RLF BARGB0,W IORWF TEMP,W ANDLW 0x01 ADDWF AARGB5,F BTFSC _C INCF AARGB4,F BTFSC _Z INCF AARGB3,F BTFSS _Z ; test if rounding caused carryout GOTO DIV32OK RRF AARGB3,F RRF AARGB4,F RRF AARGB5,F INCF EXP,F BTFSC _Z ; test for overflow GOTO SETFOV32 #ENDIF ;^& DIV32OK BTFSS SIGN,MSB BCF AARGB3,MSB ; clear explicit MSB if positive MOVF AARGB3,W MOVWF AARGB0 ; move result to AARG MOVF AARGB4,W MOVWF AARGB1 MOVF AARGB5,W MOVWF AARGB2 RETLW 0 SETFUN32 BSF FPFLAGS,FUN ; set floating point underflag BTFSS FPFLAGS,SAT ; test for saturation RETLW 0xFF ; return error code in WREG MOVLW 0x01 ; saturate to smallest floating MOVWF AEXP ; point number = 0x 01 00 00 00 #ifdef FAST CLRF AARGB0 ; modulo the appropriate sign bit CLRF AARGB1 CLRF AARGB2 #else call CLR_AARG #endif RLF SIGN,F RRF AARGB0,F RETLW 0xFF ; return error code in WREG SETFDZ32 BSF FPFLAGS,FDZ ; set divide by zero flag RETLW 0xFF ;********************************************************************************************** ;********************************************************************************************** ; Floating Point Subtract ; Input: 32 bit floating point number in AEXP, AARGB0, AARGB1, AARGB2 ; 32 bit floating point number in BEXP, BARGB0, BARGB1, BARGB2 ; Use: CALL FPS32 ; Output: 32 bit floating point sum in AEXP, AARGB0, AARGB1, AARGB2 ; Result: AARG <-- AARG - BARG ; Max Timing: 2+251 = 253 clks RND = 0 ; 2+265 = 267 clks RND = 1, SAT = 0 ; 2+271 = 273 clks RND = 1, SAT = 1 ; Min Timing: 2+12 = 14 clks ; PM: 2+146 = 148 DM: 14 ;---------------------------------------------------------------------------------------------- FPS32 MOVLW 0x80 XORWF BARGB0,F ;********************************************************************************************** ; Floating Point Add ; Input: 32 bit floating point number in AEXP, AARGB0, AARGB1, AARGB2 ; 32 bit floating point number in BEXP, BARGB0, BARGB1, BARGB2 ; Use: CALL FPA32 ; Output: 32 bit floating point sum in AEXP, AARGB0, AARGB1, AARGB2 ; Result: AARG <-- AARG - BARG ; Max Timing: 31+41+6*7+6+41+90 = 251 clks RND = 0 ; 31+41+6*7+6+55+90 = 265 clks RND = 1, SAT = 0 ; 31+41+6*7+6+55+96 = 271 clks RND = 1, SAT = 1 ; Min Timing: 8+4 = 12 clks ; PM: 146 DM: 14 ;---------------------------------------------------------------------------------------------- FPA32 MOVF AARGB0,W ; exclusive or of signs in TEMP XORWF BARGB0,W MOVWF TEMP CLRF AARGB3 ; clear extended byte CLRF BARGB3 MOVF AEXP,W ; use AARG if AEXP >= BEXP SUBWF BEXP,W BTFSS _C GOTO USEA32 #ifdef FAST ;^& MOVF BEXP,W ; use BARG if AEXP < BEXP MOVWF AARGB5 ; therefore, swap AARG and BARG MOVF AEXP,W MOVWF BEXP MOVF AARGB5,W MOVWF AEXP MOVF BARGB0,W MOVWF AARGB5 MOVF AARGB0,W MOVWF BARGB0 MOVF AARGB5,W MOVWF AARGB0 MOVF BARGB1,W MOVWF AARGB5 MOVF AARGB1,W MOVWF BARGB1 MOVF AARGB5,W MOVWF AARGB1 MOVF BARGB2,W MOVWF AARGB5 MOVF AARGB2,W MOVWF BARGB2 MOVF AARGB5,W MOVWF AARGB2 #ELSE call S_swap #ENDIF USEA32 MOVF BEXP,W ; return AARG if BARG = 0 BTFSC _Z RETLW 0x00 MOVF AARGB0,W MOVWF SIGN ; save sign in SIGN BSF AARGB0,MSB ; make MSB's explicit BSF BARGB0,MSB MOVF BEXP,W ; compute shift count in BEXP SUBWF AEXP,W MOVWF BEXP BTFSC _Z GOTO ALIGNED32 ; AEXP=BEXP, numbers alligned #IFDEF FAST ;^& MOVLW 8 SUBWF BEXP,W BTFSS _C ; if BEXP >= 8, do byte shift GOTO ALIGNB32 MOVWF BEXP MOVF BARGB2,W ; keep for postnormalization MOVWF BARGB3 MOVF BARGB1,W MOVWF BARGB2 MOVF BARGB0,W MOVWF BARGB1 CLRF BARGB0 MOVLW 8 SUBWF BEXP,W BTFSS _C ; if BEXP >= 8, do byte shift GOTO ALIGNB32 MOVWF BEXP MOVF BARGB2,W ; keep for postnormalization MOVWF BARGB3 MOVF BARGB1,W MOVWF BARGB2 CLRF BARGB1 MOVLW 8 SUBWF BEXP,W BTFSS _C ; if BEXP >= 8, BARG = 0 relative to AARG GOTO ALIGNB32 MOVF SIGN,W MOVWF AARGB0 RETLW 0x00 ALIGNB32 MOVF BEXP,W ; already aligned if BEXP = 0 BTFSC _Z GOTO ALIGNED32 #ENDIF ;^& Fast ALOOPB32 BCF _C ; right shift by BEXP RRF BARGB0,F ; right shift by EXP RRF BARGB1,F RRF BARGB2,F RRF BARGB3,F DECFSZ BEXP,F GOTO ALOOPB32 ALIGNED32 BTFSS TEMP,MSB ; negate if signs opposite GOTO AOK32 COMF BARGB3,F COMF BARGB2,F COMF BARGB1,F COMF BARGB0,F INCF BARGB3,F BTFSC _Z INCF BARGB2,F BTFSC _Z INCF BARGB1,F BTFSC _Z INCF BARGB0,F AOK32 MOVF BARGB3,W ADDWF AARGB3,F MOVF BARGB2,W BTFSC _C INCFSZ BARGB2,W ADDWF AARGB2,F MOVF BARGB1,W BTFSC _C INCFSZ BARGB1,W ADDWF AARGB1,F MOVF BARGB0,W BTFSC _C INCFSZ BARGB0,W ADDWF AARGB0,F BTFSC TEMP,MSB GOTO ACOMP32 BTFSS _C GOTO NRMRND4032 #ifdef FAST RRF AARGB0,F ; right shift by EXP RRF AARGB1,F RRF AARGB2,F RRF AARGB3,F #else call RR_AARG #endif INCFSZ AEXP,F GOTO NRMRND4032 GOTO SETFOV32 ACOMP32 BTFSC _C GOTO NRM4032 ; normalize and fix sign #ifdef FAST COMF AARGB3,F COMF AARGB2,F ; negate, toggle sign bit and COMF AARGB1,F ; then normalize COMF AARGB0,F #else call COM_AARG_PLUS #endif INCF AARGB3,F BTFSC _Z INCF AARGB2,F BTFSC _Z INCF AARGB1,F BTFSC _Z INCF AARGB0,F MOVLW 0x80 XORWF SIGN,F #ifndef Very_Fast clrf AARGB3 goto NRM4032 #else GOTO NRM32 #endif #ifndef FAST RL_AARG: RLF AARGB3,F ; otherwise, shift left and RLF AARGB2,F ; decrement EXP RLF AARGB1,F RLF AARGB0,F RETURN RR_AARG: RRF AARGB0,F ; right shift by EXP RRF AARGB1,F RRF AARGB2,F RRF AARGB3,F RETURN FILL_FF: MOVLW 0xFF MOVWF AEXP MOVWF AARGB0 ; SIGN = 0, 0x 7F FF FF FF MOVWF AARGB1 ; SIGN = 1, 0x 80 00 00 00 MOVWF AARGB2 MOVWF AARGB3 RETURN COM_AARG_PLUS: comf AARGB3,f COM_AARG: COMF AARGB2,F ; if < 0, negate and set MSB in SIGN COMF AARGB1,F COMF AARGB0,F RETURN DUP_A02: MOVF AARGB0,W MOVWF AARGB3 MOVF AARGB1,W MOVWF AARGB4 MOVF AARGB2,W MOVWF AARGB5 RETURN #endif END