G8JCF
 Guru
 Joined: 15/05/2014 Location: United KingdomPosts: 676 |
Posted: 10:09am 15 Jul 2014 |
Copy link to clipboard |
 Print this post |
|
Hi
Thanks to feedback from @boss, and comments from several people, I've amended the AD9850Controller source code so that it runs more quickly than previous versions.
Version 11 changes from Version 9
- Include tuning step sizes 10,000, 100,000, 1,000,000 Hz
- Implement Native SINGLE precision for step-sizes of 100Hz or greater
else use use BCD library
- Optimised DDS write SUBS
- Changed ISR's to SUB/END SUB
- Added Sub StepChange to respond to Push Switch
- Updates to LCD are now done only every 100mS, see SETTICK 100, DispFreq,1
Known Problems
- If the Step size is set greater than the current frequency and the encoder is
rotated ANT-Clockwise, "strange" operating frequency results, but rotating
Clockwise so that the operating frequency is GT than step-size returns the
op freq to correct values.
TTD
- Update the BCD arith routines to process quintets of digits at a time
- Fix the Step size vs Op Frequency problem
Please let me know how this release works for you.
73
Peter
'AD9850 VFO Controller V11 - Tues 15 Jul 2014
'
'Peter Carnegie - GM8JCF - 2014
'eBay AD9850 Modules use 125,000,000 Hz Clocks
'AD9850 Fout= (Δ Phase × CLKIN)/2^32 where Fout=32 bit tuning word
'TuningWord= Fout * 2^32 / CLKIN = Fout * (2^32/125,000,000)
'2^32/125,000,000 = 34.359738368 - VB6 Double Precision
'Using Integer only arithmetic, multiply by 1,000,000
'DivConst= 34359738
'We then divide the result of TuningWord=DivConst * Fout by 1,000,000
'
'
'
'V11 - Include tuning steps sizes 10,000, 100,000, 1,000,000 Hz
' - Implement Native SINGLE precision for step-sizes of 100Hz or greater
' else use BCD library
' - Optimised DDS write SUBS
' - Changed ISR's to SUB/END SUB
' - Added Sub StepChange to respond to Push Switch
' - Updates to LCD are now done only every 100mS, see SETTICK 100, DispFreq,1
'
'Known Problems
' - If the Step size is set greater than the current frequency and the encoder is
' rotated ANT-Clockwise, "strange" operating frequency results, but rotating
' Clockwise so that the operating frequency is GT than step-size returns the
' op freq to correct values.
'
'TTD
' - Update the BCD arith routines to process quintets of digits at a time
' - Fix the Step size vs Op Frequency.
'High Speed for Initialisation
CPU 48
'Initialise the BCD Library
InitBCDLib
DIM DivConst(7)
'Load it up in BCD
LoadBCD DivConst(0),"34359738"
'2^32/125,000,000 as a SINGLE
'MMBasic will truncate it to 6 digits of precision
DIM DivConstSingle
DivConstSingle=34.359738368
'Cur Freq in BCD
DIM CurFreq(7)
'Load it up in BCD
LoadBCD CurFreq(0),"1000000"
'Current Frequency as a SINGLE
DIM CurrentFrequency
CurrentFrequency=1000000
'Define DDS Control pins
FQUD=18
SData=17
WCLK=16
'Initialise the LCD Display
DispLen=16
'26=D7, 25=D6, 24=d5, 23=d4
'22=RS, 21=EN
LCD INIT 26,25,24,23,22,21
'When Set to 1 will trigger a display of frequency
DIM DispRqst
'Rotary Encoder Input pins - see page 22 uMite User Manual
DIM RA,RB
RA=2
RB=3
'TuneStep change switch on Rotary Encoder
DIM SW
SW=4
'Setup the I/O pins for the Rotary Encoder
SETPIN RB, DIN
SETPIN RA, INTH, ISRREInt
SETPIN SW, INTL, ISRStepChange
'Variable incremented/decremented by the ISRREInt
'ISR for the Rotary Encoder
DIM Value,LastValue
'Var set ON to request StepChange, by ISRStepChange
DIM StepChangeRqst
'Raw Tuning Word, ie scaled by 1E6
DIM RawTWord(7)
'Tuning Word scaled back to real world units, ie divide by 1E6
DIM TWord(7)
'Index of which Step size is in force
DIM CurStepIndex
'Startup with 10Hz tuning steps
CurStepIndex=1
'Current Step in TWord units
DIM CurStepTW(7)
'Array of Possible Step Sizes in Hz
DIM StepHz(6)
StepHz(0)=1
StepHz(1)=10
StepHz(2)=100
StepHz(3)=1000
StepHz(4)=10000
StepHZ(5)=100000
StepHZ(6)=1000000
'What to Add/Subtract from the Scaled tuning Word
'for each Encoder Up/Down
DIM StepTWord$(6) Length 24
'These TuningWord sizes were calculated using Double precision arithmetic
'in VB6, using 2^32/125.0
'
StepTWord$(0)="34359738" '1Hz 34359738.368
StepTWord$(1)="343597384" '10Hz 343597383.68
StepTWord$(2)="3435973837" '100Hz 3435973836.8
StepTWord$(3)="34359738368" '1000Hz 34359738368.
StepTWord$(4)="343597383680" '10000Hz 343597383680
StepTWord$(5)="3435973836800" '100000Hz 3435973836800
StepTWord$(6)="34359738368000" '1000000Hz 34359738368000
'Load the CurStepTW with the startup Step in TW
LoadBCD CurStepTW(0),StepTWord$(CurStepIndex)
'The Current Step in TW units in a SINGLE
DIM CurStepTWSingle
CurStepTWSingle=VAL(StepTWord$(CurStepIndex))/1E6
'Calculate Starting TuningWord
CopyBCD DivConst(0),BCDA(0)
CopyBCD CurFreq(0),BCDB(0)
'Calculate the Tuning Word, this one is * 1E6
MulAB2C
'Save the RawTWord
CopyBCD BCDC(0), RawTWord(0)
'SINGLE version of the TWord
DIM TWordSingle
'Calculate the Tuning Word as a SINGLE
TWordSingle=CurrentFrequency * DivConstSingle
'Start with clean BCD Registers
ClrBCD(BCDA(0))
ClrBCD(BCDB(0))
ClrBCD(BCDC(0),15)
'Go do Main Loop
Main
END
'====================================================
'
'Loop for ever
'
SUB Main
'General purpose String used in Main Loop
LOCAL D$(1) length 24
LOCAL I,L,Cy
'Flag set=1 when rotary encoder has moved.
'Do it this way to improve responsiveness
LOCAL Change
D$(1)="GM8JCF"
LCD 2, C16, D$(1)
'Initialise the I/O & DDS chip
InitDDS
'Trigger a display of Frequency
DispRqst=1
SETTICK 100,DispFreq,1
'Display the Step Size
LCD 2,1,STRING$(20," ")
LCD 2,1,"Step="+STR$(StepHz(CurStepIndex))+" Hz"
PRINT "Tune Step="+STR$(StepHz(CurStepIndex)) 'DEBUG
'Save Power, slow down the CPU
CPU 5
'Do for ever !
DO
Change=Value-LastValue
Value=LastValue
'Any movement ?
IF Change<>0 THEN
' Print "Main:Change:";Change 'DEBUG
'We need all the speed we can get for the calculations
CPU 48
L=TIMER 'DEBUG
'If the Tune Step is 100Hz or greater then we can use the Native SINGLE
'arithmetic of MMBasic otherwise we must use ths much slower BCD arithmetic
'
IF StepHZ(CurStepIndex) >= 100 THEN
L=TIMER 'DEBUG
IF Change<0 THEN
CurrentFrequency=CurrentFrequency-StepHz(CurStepIndex)
' TWordSingle=TWordSingle-CurStepTWSingle
ELSE
CurrentFrequency=CurrentFrequency+StepHz(CurStepIndex)
' TWordSingle=TWordSingle+CurStepTWSingle
ENDIF
'Calculate Tuning Word
TWordSingle=CurrentFrequency * DivConstSingle
' PRINT "Calc Time: ";TIMER-L 'DEBUG
L=TIMER
'Now we have to get it into the DDS Chip
SendDDSDataSingle TWordSingle
' PRINT "DDS Comms: ";TIMER-L 'DEBUG
ELSE
'
'The Tune Step is less than 100Hz so we have to use extended precision arithmetic
'which is slower
'
'If encoder is turning ANTI-clockwise, Decrement
'If encoder is turning CLOCKwise, Increment
IF Change<0 THEN
DecCurFreq(StepHz(CurStepIndex))
ELSE
IncCurFreq(StepHz(CurStepIndex))
ENDIF
'If ANTI-clockwise then decrement TuningWORD
'If CLOCKwise then incrementg TuningWORD
IF Change<0 THEN
'Decrement
Cy=0
FOR I=0 TO 4
RawTword(I)=RawTword(I)+1000 - CurStepTW(I) - Cy
Cy=1 - (RawTword(I) \ 1000)
RawTword(I)=RawTword(I) MOD 1000
NEXT I
ELSE
'Increment
Cy=0
FOR I=0 TO 4
RawTword(I)=RawTword(I) + CurStepTW(I) + Cy
IF RawTword(I)>999 THEN
Cy=RawTword(I)\1000
RawTword(I)=RawTword(I) MOD 1000
ELSE
Cy=0
ENDIF
NEXT I
ENDIF
'Save the New Tuning Word for next time
FOR I=0 TO 7
BCDC(I)=RawTword(I)
NEXT I
'Round to the nearest 1,000,000
'ie Add 500,000, then chop off the last 6 digits
Cy=500
FOR I=1 TO 3
BCDC(I)=BCDC(I)+Cy
IF BCDC(I)<1000 THEN
EXIT FOR
ELSE
Cy=BCDC(I)\1000
BCDC(I)=BCDC(I) MOD 1000
ENDIF
NEXT I
'And make the Actual DDS Tuning Word, ie scale down by 1E6
'For BCD that just means removing the last 6 digits
FOR I=2 TO 7
BCDA(I-2)=BCDC(I)
NEXT I
BCDA(6)=0:BCDA(7)=0
'Convert BCD to UINT32
BCDA2Bin
'Send the Tuning Word to the DDS
SendDDSData
ENDIF
'Request a display of Frequency
DispRqst=1
'Reset change flag for next iteration
Change=0
PRINT "Loop Time=";TIMER-L 'DEBUG
'Slowdown the CPU to save power
CPU 5
ENDIF
'Is there a request to change the Tune Step ?
IF StepChangeRqst THEN
StepChange
StepChangeRqst=0
ENDIF
'Go check again
LOOP
END SUB
END
'=========================================================
'
'Interrupt Service Routines
'
'Here when the Rotary encoder moves
SUB ISRREInt
IF PIN(RB)=1 THEN
'Clockwise rotation
Value=Value+1
ELSE
'Anti-Clockwise rotation
Value=Value-1
ENDIF
END SUB
'=========================================================
'
'Here on Step Switch click
'
SUB ISRStepChange
'Set Step Change Requested
StepChangeRqst=1
' PRINT "ISRStepChange" 'DEBUG
END SUB
'=========================================================
'
'Change the Tuning Step
'
SUB StepChange
LOCAL CurrentStepHz
LOCAL CurrentStepIndex
LOCAL Freq$(1) Length 12
LOCAL D$(1) Length 20
'Capture the current step Index
CurrentStepIndex=CurStepIndex
'Bump the index
CurStepIndex=CurStepIndex+1
'Roll round CurStepIndex if greater than 6
CurStepIndex=CurStepIndex MOD 7
'Did we roll over to step 0 ?
'If Yes then we are going to use extended precision arithmetic
'so we have to load up the BCD variables
IF CurStepIndex=0 THEN
'Get the Current Frequency
' PRINT "StepChange:";STR$(CurrentFrequency) 'DEBUG
Freq$(1)=STR$(CurrentFrequency)
L=LEN(Freq$(1))
IF L>6 THEN
IF MID$(Freq$(1),L,1)="6" THEN
Freq$(1)=STR$(CurrentFrequency/1e1)+"0"
ELSE
Freq$(1)=STR$(CurrentFrequency/1e2)+"00"
ENDIF
ENDIF
LoadBCD CurFreq(0),Freq$(1)
'Calculate the Tuning Word - this is the x 1E6 one
CopyBCD DivConst(0),BCDA(0)
CopyBCD CurFreq(0),BCDB(0)
'Calculate the Tuning Word, this one is * 1E6
MulAB2C
'Save the RawTWord
CopyBCD BCDC(0), RawTWord(0)
ENDIF
'Was the last StepHz less than 100Hz and the new one greater than 99 Hz
IF (StepHz(CurrentStepIndex) < 100) AND (StepHz(CurStepIndex>99)) THEN
'Convert CurFreq() into CurrentFrequency
Freq$(1)=CurFreq2Asc$()
' PRINT "Conversion of Freq$(1):";Freq$(1) 'DEBUG
CurrentFrequency=VAL(Freq$(1))
' PRINT "Val Freq$(1):";CurrentFrequency 'DEBUG
TWordSingle=CurrentFrequency * DivConstSingle
CurStepTWSingle=VAL(StepTWord$(CurStepIndex))/1E6
ENDIF
'Display the Step size
LCD 2,1,STRING$(20," ")
D$(1)=STR$(StepHz(CurStepIndex))
IF MID$(D$(1),LEN(D$(1),1))="5" THEN
D$(1)=STR$(StepHz(CurStepIndex)/1e1)+"0"
ENDIF
LCD 2,1,"Step="+D$(1)+" Hz"
PRINT "Tune Step="+STR$(StepHz(CurStepIndex)) 'DEBUG
END SUB
'=========================================================
'
'Increment CurFreq() by Inc
'
SUB IncCurFreq(Inc)
LOCAL I,Cy
Cy=Inc
FOR I=0 TO 2 '7
CurFreq(I)=CurFreq(I) + Cy
IF CurFreq(I)<1000 THEN
EXIT FOR
ELSE
Cy=CurFreq(I)\1000
CurFreq(I)=CurFreq(I) MOD 1000
ENDIF
NEXT I
END SUB
'=========================================================
'
'Decrement CurFreq() by Dec
'
SUB DecCurFreq(Dec)
LOCAL I,Bw
Bw=Dec
FOR I=0 TO 7
CurFreq(I)=CurFreq(I)+1000 - BW
BW=1 - (CurFreq(I) \ 1000)
CurFreq(I)=CurFreq(I) MOD 1000
IF BW=0 THEN EXIT FOR
NEXT I
END SUB
'=========================================================
'Returns a string representing the BCD Digits from CurFreq()
'eg if CurFreq(0)=123, CurFreq(1)=456,CurFreq(2)=789, then
'CurFreq2ASC$ will return "789456123"
'
FUNCTION CurFreq2Asc$()
LOCAL I,J,A$(1) Length BCDSize*3,B$(1) Length BCDSize*3
'Frequency is 8 digits long , eg 30,000,000
FOR I=2 TO 0 STEP -1
'Find First non Zero Triplet
IF CurFreq(I)<>0 THEN
FOR J=I TO 0 STEP -1
B$(1)=B$(1)+STR$(CurFreq(J),3,0,"0")
NEXT J
'Now Remove any leading Zeroes
FOR J=1 TO 3
IF PEEK(VAR B$(1),J)<>&H30 THEN
B$(1)=MID$(B$(1),J)
EXIT FOR
ENDIF
NEXT J
EXIT FOR
ENDIF
NEXT I
CurFreq2Asc$=B$(1)
END FUNCTION
'=========================================================
'
'Imitialise the DDS
'
SUB InitDDS
SETPIN FQUD, DOUT : PIN(FQUD)=0
SETPIN SData, DOUT : PIN(SData)=0
SETPIN WCLK, DOUT : PIN(WCLK)=0
SetFreq
END SUB
'----------------------------------------------------------- ---
'Fundamental equation for DDS
'Tuningword = FrequencyDesired * (AccumulatorBits / ClockIn)
'For an AD9850, TuningWord = F * ( (2^32) / ClkIn )
'
SUB SetFreq
LOCAL I,J,TWord(7)
FOR I=0 TO 7
BCDA(I)=CurFreq(I)
NEXT I
FOR I=0 TO 7
BCDB(I)=DivConst(I)
NEXT I
'Calc the Tuning Word
MulAB2C
'Save this Long Tuning Word
FOR I=0 TO 7
RawTWord(I)=BCDC(I)
NEXT I
'Div by 1E6
J=0
ClrBCD(BCDA(0))
FOR I=2 TO 7
BCDA(J)=BCDC(I)
J=J+1
NEXT I
' PRINT BCDA2Asc$() 'DEBUG
'Convert BCDA() to 8 hex digits, ie 32 bits
BCDA2Bin
'Tuning Word is now in BCDC()
'Send it to out
SendDDSData
END SUB
'=========================================================
'
'Tuning Word to be sent to the DDS must be in BCDC()
'Called by BCD based routines
'
SUB SendDDSData
' LOCAL I
' Print "SendDDSData:BCDC():&H"; 'DEBUG
' For I=3 to 0 step -1 'DEBUG
' Print Hex$(BCDC(I)); 'DEBUG
' Next I 'DEBUG
' Print 'DEBUG
' BCDC(4)=0
PIN(FQUD)=0 'Make sure FQUD is Low
PIN(WCLK)=0 'Clock pin Low
PIN(Sdata)=0 'Data Pin Low
'Send the Tuning Word and COntrol bytes to the AD9850
'Inline for speed
Send8Bits BCDC(0)
Send8Bits BCDC(1)
Send8Bits BCDC(2)
Send8Bits BCDC(3)
Send8Bits 0
PULSE FQUD,0.05 'Latch the data into the DDS chip
END SUB
'=========================================================
'
'Send Tuning Word as SINGLE TWord to DDS
'
SUB SendDDSDataSingle(TWord)
LOCAL B
PIN(FQUD)=&H0 'Make sure FQUD is Low
PIN(WCLK)=&H0 'Clock pin Low
PIN(Sdata)=&H0 'Data Pin Low
'Make a copy because we're going to change the Arg
B=TWord
'Inline the 5 byte send for maximum speed
Send8Bits B AND &HFF:B=B\&H100
Send8Bits B AND &HFF:B=B\&H100
Send8Bits B AND &HFF:B=B\&H100
Send8Bits B
Send8Bits 0
PULSE FQUD,0.05 'Latch the data into the DDS chip
END SUB
'=========================================================
'
'Send Byte in B to DDS chip
'
SUB Send8Bits(B)
'Inline the 8 bit send for max speed
PIN(SData)=B AND &H1:PULSE WCLK,0.05
PIN(SData)=B AND &H2:PULSE WCLK,0.05
PIN(SData)=B AND &H4:PULSE WCLK,0.05
PIN(SData)=B AND &H8:PULSE WCLK,0.05
PIN(SData)=B AND &H10:PULSE WCLK,0.05
PIN(SData)=B AND &H20:PULSE WCLK,0.05
PIN(SData)=B AND &H40:PULSE WCLK,0.05
PIN(SData)=B AND &H80:PULSE WCLK,0.05
END SUB
'=========================================================
'
'Display Operating Frequency on LCD and Console
'
SUB DispFreq
LOCAL CurFreq$(1) Length 12
LOCAL L
'If No Request to Display then nothing to do
IF DispRqst=0 THEN EXIT SUB
'Reset the Display Request flag
DispRqst=0
'Using Single precision arithmetic ?
IF StepHZ(CurStepIndex) < 100 THEN
CurFreq$(1)=CurFreq2Asc$()
ELSE
CurFreq$(1)=STR$(CurrentFrequency)
L=LEN(CurFreq$(1))
'Is Sciemtific Notation in force
IF L>6 THEN
IF MID$(CurFreq$(1),L,1)="6" THEN
CurFreq$(1)=STR$(CurrentFrequency/1e1)+"0"
ELSE
CurFreq$(1)=STR$(CurrentFrequency/1e2)+"00"
ENDIF
ENDIF
ENDIF
'Display Frequency on the console
PRINT "CurFreq$:";CurFreq$(1) 'DEBUG
'Display Frequency on the LCD on Line 1
LCD 1, C16, CurFreq$(1)
END SUB
'=========================================================
'
'Initialise the BCD Library
'MUST be called BEFORE calling any other BCD Lib routines
'Creates Global BCD Lib Vars, BCDA/B/C() and BCDSize
'NumDigits is Number of BCD digits, eg 24,
'BCDSize will return number of elements used to represent NumDigits, ie NumDigits\3
'
SUB InitBCDLib(NumDigits)
IF NumDigits=0 THEN NumDigits=24
DIM BCDSize
'Number of elements per BCD register
'Each Element holds 3 digits
BCDSize=(NumDigits\3)
'The next version of the BCDLib will use BCDSize
'instead of hard-coded values of 7, 15, 24 etc
'to allow arbitrary precision arithmetic
DIM BCDA(BCDSize-1),BCDB(BCDSize-1),BCDC(BCDSize*3)
END SUB
'=========================================================
'BCDC()=BCDA() x BCDB()
'This algorithm works on Triplets of digits
'For optimum speed, make sure the shortest multiplier is in BCDB()
'
SUB MulAB2C
LOCAL Cy, I, J, K, L, M, N
'Array for the intermediate multiplication
LOCAL C1(16)
FOR I=0 TO 15
BCDC(I)=0
NEXT I
'Set default length
M=7
'Find length of BCDA()
FOR I = 7 TO 0 STEP -1
IF BCDA(I) <> 0 THEN
M=I
EXIT FOR
ENDIF
NEXT I
'Set default length
N=7
'Find Length of BCDB()
FOR I = 7 TO 0 STEP -1
IF BCDB(I) <> 0 THEN
N=I
EXIT FOR
ENDIF
NEXT I
'Now Do the Long Multiplication of the two numbers
L = 0
K = 0
FOR I = 0 TO M+1
Cy = 0
FOR J = 0 TO N+1
C1(J)=(BCDA(I)*BCDB(J))+Cy
IF C1(J) > 999 THEN
Cy = C1(J) \ 1000
C1(J) = C1(J) MOD 1000
ELSE
Cy = 0
ENDIF
NEXT J
'Add the partial result to the overall total
'Add each element of C() to D() result into D()
Cy = 0
FOR J = 0 TO 7 '23 \ 3
K = J + L
BCDC(K)=BCDC(K)+C1(J)+Cy
IF BCDC(K) > 999 THEN
Cy=BCDC(K)\1000
BCDC(K)=BCDC(K) MOD 1000
ELSE
Cy = 0
ENDIF
NEXT J
L=L+1
NEXT I
END SUB
'=========================================================
'
'Clear BCD Register
'Dest is Element 0 of a BCD register, eg FREQ(0)
'NumDigits is Number of digits in the BCD register, is Optional
'
SUB ClrBCD(Dest,NumDigits)
LOCAL I
IF NumDigits=0 THEN NumDigits=7
FOR I=0 TO (NumDigits*4)-1
POKE VAR Dest,I,0
NEXT I
END SUB
'=========================================================
'
'Copy a BCD string into a BCD Register/Destination
'Dest is the first element of a BCD register, eg BCDA(0), CurFreq(0)
'A$ is a string of BCD digits, eg "1234567890"
'
SUB LoadBCD(Dest,A$,NumDigits)
LOCAL I,J,M
LOCAL B(15),A2$(28)
IF NumDigits=0 THEN NumDigits=7
'Pad to make sure string is a multiple of 3 digits
A2$(1)=LPad$(A$,3)
J = 0
M=LEN(A2$(1))
FOR I = M - 2 TO 1 STEP -3
B(J) = VAL(MID$(A2$(1), I, 3))
J = J + 1
NEXT I
FOR I=0 TO (NumDigits*4)-1
POKE VAR Dest,I,PEEK(VAR B(0),I)
NEXT I
END SUB
'=========================================================
'
'Prepend leading 0 to make sure
'string is a multiple of ML digits
'
FUNCTION LPad$(A$,ML)
LOCAL I,J,M
M=LEN(A$)
IF M MOD ML <> 0 THEN
FOR I=ML TO 24 STEP ML
IF M<I THEN
' Print "LPad$:A$";A$ 'DEBUG
LPad$=STRING$(I-M,"0")+A$
EXIT FOR
ENDIF
NEXT I
ELSE
LPad$=A$
ENDIF
END FUNCTION
'==============================================
'
'Convert BCDA() into an unsigned 32 bit integer
'in BCDC()
'Algorithm process triplets of decimal digits
'
SUB BCDA2Bin
LOCAL I,T,L,Cy
FOR I=0 TO 15
BCDC(I)=0
NEXT I
T=7
' print "BCDA(I) "; 'DEBUG
FOR I=7 TO 0 STEP -1
' Print BCDA(I);" "; 'DEBUG
IF BCDA(I)<>0 THEN
T=I
EXIT FOR
ENDIF
NEXT I
'Each triplet of digits are worth 0-999, ie 1000's
L=1000 ^ (T)
FOR I=T TO 0 STEP -1 '0 To 11
'Add Next Decimal Digit into the Binary Long word
BCDC(0)=BCDC(0)+(BCDA(I)*L)
'Has this caused an overflow
IF BCDC(0)>&HFF THEN
'Yes
'Now ripple the overflow across the other bytes
Cy=BCDC(0) AND &H7FFFFF00 '2147483392 '&H7FFFFF00
BCDC(0)=BCDC(0)AND &HFF '255 '&HFF
BCDC(1)=BCDC(1)+(Cy\&H100) '256)
'Has this caused an overflow
IF (BCDC(1)>&HFF) THEN
'Yes
'Now ripple the overflow across the other bytes
Cy=BCDC(1) AND &H7FFFFF00 '2147483392 '&H7FFFFF00
BCDC(1)=BCDC(1) AND &HFF '255 '&HFF
BCDC(2)=BCDC(2)+(Cy\&H100) '256)
'Has this caused an overflow
IF (BCDC(2)>&HFF) THEN
'Yes
'Now ripple the overflow across the other bytes
Cy=BCDC(2) AND &H7FFFFF00 '2147483392 '&H7FFFFF00
BCDC(2)=BCDC(2) AND &HFF '255 '&HFF
BCDC(3)=BCDC(3)+(Cy\&H100) '256)
ENDIF
ENDIF
ENDIF
L=L\1000
NEXT I
'Was there an overflow
IF (BCDC(3)>&HFF) THEN
ERROR "OverFlow"
ENDIF
END SUB
'=========================================================
'
'Returns a string representing the BCD Digits from BCDA()
'eg if BCDA(0)=123, BCDA(1)=456,BCDA(2)=789, then
'BCD2ASC$ will return "789456123"
'
FUNCTION BCDA2Asc$()
LOCAL I,J,A$(1) Length BCDSize*3,B$(1) Length BCDSize*3
FOR I=7 TO 0 STEP -1
'Find First non Zero Triplet
IF BCDA(I)<>0 THEN
FOR J=I TO 0 STEP -1
'Uncomment the following line for Micromite only code - faster
B$(1)=B$(1)+STR$(BCDA(J),3,0,"0")
'Comment out the following 2 lines for Micromite only code - faster
' A$(1)=STR$(BCDA(J))
' B$(1)=B$(1)+STRING$(3-LEN(A$(1)),"0")+A$(1)
NEXT J
'Now Remove any leading Zeroes
FOR J=1 TO 3
' IF MID$(B$(1),J,1)<>"0" THEN
IF PEEK(VAR B$(1),J)<>&H30 THEN
B$(1)=MID$(B$(1),J)
EXIT FOR
ENDIF
NEXT J
EXIT FOR
ENDIF
NEXT I
BCDA2Asc$=B$(1)
END FUNCTION
'=========================================================
'
' General purpose way to move BCD data between source and dest
' arrays. NOT as fast as doing a direct copy using a FOR loop.
'
SUB CopyBCD(Src,Dest,NumDigits)
LOCAL I
IF NumDigits=0 THEN NumDigits=7
FOR I=0 TO (NumDigits * 4)-1
POKE VAR Dest,I,PEEK(VAR Src,I)
NEXT I
END SUB
The only Konstant is Change |