Test Suite for BCD Arithmetic Routines
The first set of digits per line is the execution time in mS
of the BCD routine being tested.

Number of BCD Digits BCDNumDigits: 24
Number of Decimal Digits per Numeric Var BCDWidth 6
Number of Numeric Vars per BCD Register BCDSize 4

0.00 Main:Load BCDA using FOR Loop with 789123456789654321 BCDA()=000000 789123 456789 654321
12.00 Main:LoadBCD:BCDA() with 123456789123456789654321 BCDA()=123456 789123 456789 654321
0.00 Main:Comp10sBCDA of 123456789=000000 999999 999876 543211
2.00 Main:ClrBCD:BCDA=000000 000000 000000 000000
0.00 Main:Copy BCDA to BCDB using FOR loop:BCDB()=000000 000000 000123 456789
2.00 Main:Copy BCDA to BCDB using CopyBCD:BCDB()=000000 000000 000123 456789
12.00 Main:LoadBCD:BCDA() with 1030792140000000 BCDA()=000000 001030 792140 000000
10.00 Main:LoadBCD:BCDB() with 99999999 BCDB()=000000 000000 000099 999999
2.76 Main:AddAB2C of 1030792140000000+9999=000000 001030 792140 009999
1.92 Main:AddAB2A of 1030792140000000+9999 x 100 =000000 001030 792140 999900
3.06 Main:SubAB2C :1030792140000000-999=000000 001030 792140 998901
2.06 Main:SubAB2A: 1030792140000000-999 x 100 =000000 001030 792140 998901
44.80 Main:MulAB2C:34359738*10000000=000000 000000 000000 000000 000000 000343 597380 000000
310.00 Main:DivAB2C:4294967296\125=000000 000000 000000 000000 000000 000000 000034 359738
0.70 Main:IncBCDA:123456789+100=000000 000000 000123 456889
0.96 Main:DecBCDA:100000001-100=000000 000000 000099 999901
6.00 Main:BCDA2BIN of 343597380=&H14 7A E1 44
5.80 Main:BCDA2Asc$ of 03043597380=3043597380

Test Suite Completed

'Go run the test suite. Remove this line and the TestSuite to include BCDLiB24Digits
'into your own code.
GOTO TestSuite


'*********************************************************** ***************
'BCD Library for MMBasic. BCDLib24DigitsV2.BAS
'
'This Version has been hand OPTIMISED for 24 decimal digits. Do not use with
'other digit lengths.
'
'The algorithms used in this Library typically operate on sextets of digits at a time.
'
'
'(c) Peter Carnegie 2014 with thanks to TassyJim from the BackShed
'who inspired this library with his BigInt Library, and to JohnS also from
'the BackShed who had the insight that one could safely use sextets of digits
'per numeric var hugely improving performance.
'
'This library is NOT Re-entrant, eg should not be used within ISR's
'
'Library uses 3 arrays, BCDA(),BCDB(),BCDC()
'BCDA(),BCDB(),BCDC() will be declared as GLOBAL vars by InitBCDLib()
'These arrays are treated as BCD registers capable
'of holding up to 24 decimal digit numbers.
'
'Numbers are stored in unpacked form, 6 decimal digits per
'array entry, in little endian form.
'eg 123456789 is stored in BCDA() as
'BCDA(0)=456789, BCDA(1)=000123, BCDA(2)=000000
'
'Algorithms processes Sextets of digits at a time reducing
'processing times, eg on a uMite at 48MHz, an 18 digit AddAB2C
'operation takes about 3 mS.
'
'Generally, register BCDC() will contain the results of
'two part operations, eg AddAB2C takes BCDA() + BCDB()
'and returns the result in BCDC().
'
'
'
'The list of functions/subs in the library include
'
' InitBCDLib() MUST be called first. Creates Global BCD Lib Vars, BCDA/B/C(), BCDWidth,BCDNumDigits,BCDSize
' BCDWidth will be set to 6, BCDSize be set to 4, BCDNumDigits will be set to 24
'
' AddAB2C BCDC()=BCDA()+BCDB()
' AddAB2A() BCDA()=BCDA()+BCDB()
' SubAB2C BCDC()=BCDA()-BCDB()
' SubAB2A BCDA()=BCDA()-BCDB()
' IncBCDA(Inc) BCDA()=BCDA()+Inc Note Inc is a SINGLE
' DecBCDA(Dec) BCDA()=BCDA()-Dec Note Dec is a SINGLE
' MulAB2C BCDC()=BCDA()*BCDB()
' DivAB2C BCDC() = BCDA()\BCDB()
'
'Utility Routines******************
'
' ClrBCD(Dest,Width) Dest(0..Width-1)=0, Width defaults to 4 ie 24 dedimal digits
' LoadBCD(Dest,String) Dest() is loaded with contents of string, 6 digits per array element
'
'
' LPad$(A$,ML) Pad a string with leading zeroes to make a string ML chars long
'
' Comp10sBCDA(Digits) 10s Complement BCDA() upto Digits long
'
' BCDA2Bin BCDC() = BCD to Binary conversion of BCDA() in little endian format
' BCDA2Asc$() Returns String representation of BCDA()
'
' PrintBCD(Src,Mode,NumDigits) Print a BCD register to console,Src is first element of BCDregister, eg FREQ(0)
'
' CopyBCD(Src,Dest,NumDigits) Copy a BCD number from source to dest, Src and Dest are first element of BCD register, eg BCDA(0)
'
'*********************************************************** ***************



'=========================================================
'
'Initialise the BCD Library
'MUST be called BEFORE calling any other BCD Lib routines
'Creates Global BCD Lib Vars, BCDA/B/C()
' BCDSize Contains number of Numeric Vars per BCD Register, always 4
' BCDWidth contains the number of decimal digits per Numeric Var, Always 6
' BCDNumDigits contains the number of digits per BCD Register, al;ways 24
'
SUB InitBCDLib()

DIM BCDWidth,BCDSize,BCDNumDigits

'Set precision to 24 decimal digits
BCDNumDigits=24

'Number of Digits per Numeric Var
BCDWidth=6

'Number of Numeric vars per BCD register
'Each Numeric var holds BCDWidth digits
BCDSize=(BCDNumDigits\BCDWidth)

'NB BCDC is TWICE as long as the others to allow for Multiplication
DIM BCDA(BCDSize-1),BCDB(BCDSize-1),BCDC(BCDSize*2)

END SUB

'=========================================================
'BCDC() = BCDA() + BCDB()
'
'BCDA(0..3),BCDB(0..3),BCDC(0..7) Single Arrays
'Each Element stores 6 digits of the overall number
'The numbers are stored in little Endian format
'
'Algorithm works on sextet of digits at a time
'Optimised for 24 digits
'
SUB AddAB2C()
LOCAL Cy,I

'Clear the BCD C Register
BCDC(0)=0:BCDC(1)=0:BCDC(2)=0:BCDC(3)=0
BCDC(4)=0:BCDC(5)=0:BCDC(6)=0:BCDC(7)=0:

I=BCDA(0)+BCDB(0)
Cy=I\&HF4240
BCDC(0)=I MOD &HF4240

I=BCDA(1)+BCDB(1)+Cy
Cy=I\&HF4240
BCDC(1)=I MOD &HF4240

I=BCDA(2)+BCDB(2)+Cy
Cy=I\&HF4240
BCDC(2)=I MOD &HF4240

I=BCDA(3)+BCDB(3)+Cy
Cy=I\&HF4240
BCDC(3)=I MOD &HF4240

BCDC(4)=Cy

END SUB

'=========================================================
'BCDA() = BCDA() + BCDB()
'
'BCDA(0..3),BCDB(0..3) Single Arrays
'Each Element stores 6 digits of the overall number
'The numbers are stored in little Endian format
'
'Algorithm works on sextet of digits at a time
'Optimised for 24 digits
'
SUB AddAB2A()
LOCAL Cy,I

I=BCDA(0)+BCDB(0)
Cy=I\&HF4240
BCDA(0)=I MOD &HF4240

I=BCDA(1)+BCDB(1)+Cy
Cy=I\&HF4240
BCDA(1)=I MOD &HF4240

I=BCDA(2)+BCDB(2)+Cy
Cy=I\&HF4240
BCDA(2)=I MOD &HF4240

I=BCDA(3)+BCDB(3)+Cy
'Cy=I\&HF4240
BCDA(3)=I MOD &HF4240

'Ignore any Overflow
'BCDA(4)=Cy

END SUB


'=========================================================
'
'Subtract BCDB from BCDA
'Result in BCDC
'
'Optimised for 24 digits
'
'
SUB SubAB2C()

LOCAL I,J,Cy

BCDC(0)=BCDA(0):BCDC(1)=BCDA(1):BCDC(2)=BCDA(2):BCDC(3)=BCDA (3):

BCDC(4)=0:BCDC(5)=0:BCDC(6)=0:BCDC(7)=0

J=BCDC(0)+&HF4240-BCDB(0):Cy=1-(J\&HF4240):BCDC(0)=J MOD &HF4240

J=BCDC(1)+&HF4240-BCDB(1)-CY:Cy=1-(J\&HF4240):BCDC(1)=J MOD &HF4240

J=BCDC(2)+&HF4240-BCDB(2)-CY:Cy=1-(J\&HF4240):BCDC(2)=J MOD &HF4240

J=BCDC(3)+&HF4240-BCDB(3)-CY:BCDC(3)=J MOD &HF4240

END SUB

'=========================================================
'
'Subtract BCDB from BCDA
'Result in BCDA
'
'Optimised for 24 digits
'
SUB SubAB2A()

LOCAL Cy,I

I=BCDA(0)+&HF4240-BCDB(0):Cy=1-(I\&HF4240):BCDA(0)=I MOD &HF4240

I=BCDA(1)+&HF4240-BCDB(1)-CY:Cy=1-(I\&HF4240):BCDA(1)=I MOD &HF4240

I=BCDA(2)+&HF4240-BCDB(2)-CY:Cy=1-(I\&HF4240):BCDA(2)=I MOD &HF4240

I=BCDA(3)+&HF4240-BCDB(3)-CY:BCDA(3)=I MOD &HF4240

END SUB

'=========================================================
'
'Increment BCDA() by Inc
'
'NB Inc is a MMBasic single
'
'Optimised for 24 decimal digits
'
SUB IncBCDA(Inc)

LOCAL Cy

BCDA(0)=BCDA(0)+Inc
IF BCDA(0)<&HF4240 THEN
EXIT SUB
ELSE
Cy=BCDA(0)\&HF4240
BCDA(0)=BCDA(0) MOD &HF4240
ENDIF

BCDA(1)=BCDA(1)+Cy
IF BCDA(1)<&HF4240 THEN
EXIT SUB
ELSE
Cy=BCDA(1)\&HF4240
BCDA(1)=BCDA(1) MOD &HF4240
ENDIF

BCDA(2)=BCDA(2)+Cy
IF BCDA(2)<&HF4240 THEN
EXIT SUB
ELSE
Cy=BCDA(2)\&HF4240
BCDA(2)=BCDA(2) MOD &HF4240
ENDIF

BCDA(3)=BCDA(3)+Cy
IF BCDA(3)<&HF4240 THEN
EXIT SUB
ELSE
BCDA(I)=BCDA(I)+Cy
IF BCDA(I)<&HF4240 THEN
EXIT FOR
ELSE
Cy=BCDA(I)\&HF4240
BCDA(I)=BCDA(I) MOD &HF4240
ENDIF
BCDA(3)=BCDA(3) MOD &HF4240
ENDIF

END SUB


'=========================================================
'
'Decrement BCDA() by Dec
'
'NB Dec is an MMBasic Numeric Var
'
' This SUB is optimised for 24 digits only
'
SUB DecBCDA(Dec)

LOCAL I, Bw

Bw=Dec

I=BCDA(0)+&HF4240-Dec
BW=1-(I\&HF4240)
BCDA(0)=I MOD &HF4240
IF Bw=0 THEN EXIT SUB


I=BCDA(1)+&HF4240-BW
BW=1-(I\&HF4240)
BCDA(1)=I MOD &HF4240
IF Bw=0 THEN EXIT SUB

I=BCDA(2)+&HF4240-Bw
BW=1-(I\&HF4240)
BCDA(2)=I MOD &HF4240
IF Bw=0 THEN EXIT SUB

I=BCDA(3)+&HF4240-BW
BCDA(3)=I MOD &HF4240

END SUB

'=========================================================
'BCDC()=BCDA() x BCDB()
'This algorithm works on Sextets of digits
'For optimum speed, make sure the shortest multiplier is in BCDB()
'
'MulAB2C reorganises data and then process in triplets, and then repacks the result
'
SUB MulAB2C

LOCAL Cy,I,J,K,L,M,N,Ele

'These are "shadow" BCD registers used for MUL & Div which are carried out in triplets
LOCAL _BCDA((BCDSize*2)-1),_BCDB((BCDSize*2)-1),_BCDC(BCDSize*4)

'Unpack sextets into _BCDA() and _BCDB
J=0
FOR I=0 TO BCDSize-1
_BCDA(J)=BCDA(I) MOD 1000
_BCDA(J+1)=BCDA(I) \ 1000

_BCDB(J)=BCDB(I) MOD 1000
_BCDB(J+1)=BCDB(I) \ 1000

J=J+2
NEXT I

'Array for the intermediate multiplication
LOCAL C1(BCDSize*4)

Ele=(BCDSize*2)-1

'Set default length
M=Ele
'Find length of BCDA()
FOR I=Ele TO 0 STEP -1
IF _BCDA(I)<>0 THEN
M=I
EXIT FOR
ENDIF
NEXT I

'Set default length
N=Ele
'Find Length of BCDB()
FOR I=Ele 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)>&H3E7 THEN '&H3E7=999
Cy=C1(J)\&H3E8 '&H3E8=1000
C1(J)=C1(J) MOD &H3E8
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 Ele
K=J+L
_BCDC(K)=_BCDC(K)+C1(J)+Cy
IF _BCDC(K)>&H3E7 THEN
Cy=_BCDC(K)\&H3E8
_BCDC(K)=_BCDC(K) MOD &H3E8
ELSE
Cy =0
ENDIF
NEXT J

L=L+1

NEXT I

'Repack the Result from _BCDC() into BCDC()
J=0
FOR I=0 TO (BCDSize*2)-1 STEP 2
BCDC(J)=_BCDC(I) + _BCDC(I+1)*&H3E8
J=J+1
NEXT I

END SUB


'=========================================================
' Dividend in BCDA()
' Divisor in DCDB()
' Result in BCDC()
'
' BCDC() = BCDA() \ BCDB()
'
' Usage :
' LoadBCD BCDA(0),"123456780"
' LoadBCD BCDB(0),"123"
' ClrBCD BCDC(C),1
' DivAB2C
' PrintBCD BCDC(0),0,1
'
' DivAB2C is adapted from TassyJim's BigInt Div Subroutine
' This sub unpacks and re-packs sextet sized BCD registers to and from triplet
' sized registers. The actual work is carried out in Triplets
'
' A DIVIDE operation takes about 400 mS
'
'
SUB DivAB2C()

LOCAL D,I,J,K,M,N
LOCAL Bw,Cy 'Borrow and Carry

LOCAL A3(BCDSize*2),A3L 'Dividend
LOCAL A4(BCDSize*2) 'Divisor 10s Left Shifted
LOCAL A5(BCDSize*2) 'Remainder
LOCAL B3(BCDSize*2) 'Divisor
LOCAL C1(BCDSize*2) 'Try
LOCAL C2(BCDSize*4),C2L 'Captures single digit intermediate results
LOCAL C3(BCDSize*2) 'Used to compare Dividend - Try
LOCAL Diff(BCDSize*2) 'Difference of Dividend - Try

'These are "shadow" BCD registers used for MUL & Div which are carried out in triplets
LOCAL _BCDA((BCDSize*2)-1),_BCDB((BCDSize*2)-1),_BCDC(BCDSize*4)

'Unpack Sextets into _BCDA() and _BCDB
J=0
FOR I=0 TO BCDSize-1
_BCDA(J)=BCDA(I) MOD &H3E8 '&H3E8 =1000
_BCDA(J+1)=BCDA(I)\&H3E8

_BCDB(J)=BCDB(I) MOD &H3E8
_BCDB(J+1)=BCDB(I)\&H3E8

J=J+2
NEXT I

' FOR I=0 TO (BCDSize*4)-1
' _BCDC(I)=0
' NEXT I

Ele=(BCDSize*2)-1

'Find First Non-Zero triplet in BCDA()
M=7
FOR I=Ele TO 0 STEP -1
IF _BCDA(I)<>0 THEN
M=I
EXIT FOR
ENDIF
NEXT I

'Save number of Triplets of BCDA() to process
A3L=M
'Copy BCDA() into working storage
FOR I=M TO 0 STEP -1
A3(I)=_BCDA(I)
NEXT I

'A3(M) contains first non-zero triplet, but which digit
'within A3(M) is non zero
J=0
IF A3(M)>99 THEN
J=3
ELSE
IF A3(M)>9 THEN J=2
IF A3(M)<10 THEN J=1
ENDIF
'Number of significant digits in BCDA()
M=(M*3)+J

'Find out how many triplets in the Divisor
N=ele
FOR I=ele TO 0 STEP -1
IF _BCDB(I)<>0 THEN
N=I
EXIT FOR
ENDIF
NEXT I

'N now contains Number of Triplets in the Divisor
'Copy Divisor into working storage
FOR I=N TO 0 STEP -1
B3(I)=_BCDB(I)
NEXT I

'B3(N) contains first non-zero triplet, but which digit
'within B3(N) is non zero
J=0
IF B3(N)>99 THEN
J=3
ELSE
IF B3(N)>9 THEN J=2
IF B3(N)<10 THEN J=1
ENDIF
'Number of significant digits in BCDA()
N=(N*3)+J

'Do the Long Division
FOR I=M-N TO 0 STEP -1

'Calculate the Subtrahend for this iteration
'Subtrahend=Divisor * 10 ^ I

Cy=0
J=10^I
FOR K=0 TO A3L
A4(K)=(B3(K)*J)+Cy
Cy=INT(A4(K)/&H3E8)
A4(K)=A4(K)-(&H3E8*Cy) 'a Mod n = a - (n * int(a/n)).
NEXT K
A4(K)=Cy

FOR D=1 TO 9

'Multiply the Divisor by D
Cy = 0
FOR K=0 TO A3L
C1(K)=(A4(K)*D)+Cy
Cy=C1(K)\&H3E8
C1(K)=C1(K) MOD &H3E8
NEXT K

IF Cy=0 THEN
J=K-1
ELSE
J=K
C1(K)=Cy
ENDIF

'Subtract new divisor * Try digit from Dividend
Bw=0
FOR K =0 TO J
C3(K)=A3(K)-C1(K)+&H3E8 - Bw
Bw=1 -(C3(K)\&H3E8 )
C3(K)=C3(K) MOD &H3E8
NEXT K

'If No borrow then Dividend is greater than Subtractor
IF Bw=0 THEN
'Save away the result of the subtraction
FOR K=0 TO J 'L
Diff(K)=C1(K)
NEXT K
ELSE
'If Borrow, then Dividend < Subtractor so use the last no-borrow subtraction & exit loop
EXIT FOR
ENDIF

NEXT D

'Update the Result
C2(I)=D- 1
'Update Length of Result
C2L=C2L+ 1

'If the multiplier was NON-Zero then we need to subtract the divisor*D from the dividend
'ie calculate the remainder
IF C2(I)>0 THEN

Bw=0
FOR K=0 TO A3L
A5(K)=A3(K)-Diff(K)+&H3E8-Bw
Bw= 1 -(A5(K)\&H3E8)
A5(K)=A5(K) MOD &H3E8
NEXT K

'Find First non-zero triplet
FOR K=Ele TO 0 STEP -1
IF A5(K)<>0 THEN
A3L=K
EXIT FOR
ENDIF
NEXT K

'Which becomes the new Dividend
FOR K=0 TO A3L
A3(K)=A5(K)
NEXT K

ENDIF
NEXT I

'Transfer the result from C2() to BCDC()
J=0
FOR I=0 TO C2L-1 STEP 3
_BCDC(J)=C2(I)+C2(I+1)*10+C2(I+2)*&H64 '&H64=100
J=J+1
NEXT I

'Repack the Result from _BCDC() into BCDC()
J=0
FOR I=0 TO (BCDSize*2)-1 STEP 2
BCDC(J)=_BCDC(I) + _BCDC(I+1)*&H3E8
J=J+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
'
'The default Width is BCDSize, but can be specified otherwise
'eg when clearing BCDC() which is twice as long as BCDA/B()
'
'This SUB is OPTIMISED for 24 digits
'
SUB ClrBCD(Dest,Width)
LOCAL I

IF Width<1 THEN
POKE VAR Dest,0,0:POKE VAR Dest,1,0:POKE VAR Dest,2,0:POKE VAR Dest,3,0
POKE VAR Dest,4,0:POKE VAR Dest,5,0:POKE VAR Dest,6,0:POKE VAR Dest,7,0
POKE VAR Dest,8,0:POKE VAR Dest,9,0:POKE VAR Dest,10,0:POKE VAR Dest,11,0
POKE VAR Dest,12,0:POKE VAR Dest,13,0:POKE VAR Dest,14,0:POKE VAR Dest,15,0
ELSE
FOR I=0 TO (Width*4)-1
POKE VAR Dest,I,0
NEXT I
ENDIF

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$)
LOCAL I,J,M
LOCAL B(BCDSize),A2$(BCDNumDigits)

'Pad to make sure string is a multiple of 3 digits
A2$(1)=LPad$(A$,BCDWidth)

J = 0
M=LEN(A2$(1))
FOR I = M-BCDWidth+1 TO 1 STEP -BCDWidth
B(J) = VAL(MID$(A2$(1), I, BCDWidth))
J = J + 1
NEXT I

FOR I=0 TO (BCDSize*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
'
'This SUB is OPTIMISED for 24 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



'==========================================
'10s Complement BCDA()
'
'Algorithm operates on BCDWidth of digits at a time
'
SUB Comp10sBCDA(Digits)
LOCAL I,CY,Nines
' PRINT "Comp10sBCDA:BCDA()="; 'DEBUG
Nines=(10^BCDWidth)-1
FOR I=0 TO (Digits \ BCDWidth)
BCDA(I)=(Nines-BCDA(I))
' PRINT BCDA(I);" "; 'DEBUG
NEXT I
' PRINT 'DEBUG
Nines=Nines+1
'Add 1 to BCDA
Cy = 1
FOR I = 0 TO BCDSize-1
BCDA(I) = BCDA(I) + Cy
IF BCDA(I) < Nines THEN
'Cy=0
EXIT FOR
ELSE
Cy = BCDA(I) \ Nines
BCDA(I) = BCDA(I) MOD Nines
ENDIF
NEXT I
'BCDA(I)=Cy

END SUB


'==============================================
'
'Convert BCDA() into an unsigned 32 bit integer
'in BCDC()
'Algorithm process Sextets of decimal digits
'The Number must be less than 2^32, and can be at most 10 digits
'in Length, ie 2 Numeric vars with sextet packing
'The result will at most be 3 Numeric vars
'
SUB BCDA2Bin

LOCAL I,L,Cy

BCDC(0)=0:BCDC(1)=0:BCDC(2)=0:BCDC(3)=0

'Each sextets of digits are worth 0-999999, ie 1,000,000's

L=&HF4240 '1,000,000
FOR I=1 TO 0 STEP -1

'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=1 'L\&HF4240

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)=123456, BCDA(1)=789012,BCDA(2)=345678, then
'BCD2ASC$ will return "345678789012123456"
'
'This SUB is OPTIMISED for 24 Digits
'
FUNCTION BCDA2Asc$()

LOCAL I,J,A$(1) Length 24,B$(1) Length 24

FOR I=3 TO 0 STEP -1
'Find First non Zero Sextet
IF BCDA(I)<>0 THEN
FOR J=I TO 0 STEP -1
'Uncomment the following line for Micromite code - faster
B$(1)=B$(1)+STR$(BCDA(J),BCDWidth,0,"0")
'UnComment out the following 2 lines for Maximite
' A$(1)=STR$(BCDA(J))
' B$(1)=B$(1)+STRING$(BCDWidth-LEN(A$(1)),"0")+A$(1)
NEXT J
'Now Remove any leading Zeroes
FOR J=1 TO 4
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


'=========================================================== ==
'
'If C=1 then Double BCDSize output
'
'
SUB PrintBCD(Src,Mode,C)

LOCAL I,J,K

IF C>0 THEN
J=(BCDSize*2)
ELSE
J=(BCDSize)
ENDIF

LOCAL OutBCD(J)

FOR I=0 TO (J*4)-1

POKE VAR OutBCD(0),I,PEEK(VAR Src,I)

NEXT I

' PRINT "PrintBCD:"; 'DEBUG
FOR I=J-1 TO 0 STEP -1
IF Mode=0 THEN
PRINT STR$(OutBCD(I),BCDWidth,0,"0");" ";
ELSE
PRINT HEX$(OutBCD(I));" ";
ENDIF
NEXT I
PRINT
END SUB


'=========================================================== ==
'
' General purpose way to move BCD data between source and dest
' arrays. NOT as fast as doing a direct copy usin g a FOR loop.
'
' This SUB is OPTIMISED for 24 digits
'
SUB CopyBCD(Src,Dest)

POKE VAR Dest,0,PEEK(VAR Src,0):POKE VAR Dest,1,PEEK(VAR Src,1):POKE VAR Dest,2,PEEK(VAR Src,2):POKE VAR Dest,3,PEEK(VAR Src,3)
POKE VAR Dest,4,PEEK(VAR Src,4):POKE VAR Dest,5,PEEK(VAR Src,5):POKE VAR Dest,6,PEEK(VAR Src,6):POKE VAR Dest,7,PEEK(VAR Src,7)
POKE VAR Dest,8,PEEK(VAR Src,8):POKE VAR Dest,9,PEEK(VAR Src,9):POKE VAR Dest,10,PEEK(VAR Src,10):POKE VAR Dest,11,PEEK(VAR Src,11)
POKE VAR Dest,12,PEEK(VAR Src,12):POKE VAR Dest,13,PEEK(VAR Src,13):POKE VAR Dest,14,PEEK(VAR Src,14):POKE VAR Dest,15,PEEK(VAR Src,15)

END SUB


'<<<<<<<<<<<<<<< ;<<<<<<<<<<Cut from here to end and Discard>>>>>>>>>>>>>& gt;>>>>>>>>>

TestSuite:

PRINT "Test Suite for BCD Arithmetic Routines"
PRINT "The first set of digits per line is the execution time in mS"
PRINT "of the BCD routine being tested."
PRINT
'

IF MM.VER < 4.05 THEN
ERROR "MM Basic V 4.5 or Newer is Required
END
ENDIF

'Declare Global Vars here

'Go RUN the main program
Main

PRINT
PRINT "Test Suite Completed"

END

SUB Main()

CPU 48

LOCAL A$, B$, C$
LOCAL I,J

'Initialise the BCD Library
'Configure for 24 decimal precision
InitBCDLib

PRINT "Number of BCD Digits BCDNumDigits:";BCDNumDigits
PRINT "Number of Decimal Digits per Numeric Var BCDWidth";BCDWidth
PRINT "Number of Numeric Vars per BCD Register BCDSize";BCDSize
PRINT

'Load BCDA using FOR Loop
A$="789123456789654321"
J=0
L=TIMER
FOR I=LEN(A$)-5 TO 1 STEP -6
BCDA(J)=VAL(MID$(A$,I,6))
J=J+1
NEXT I
L=TIMER-L
PRINT STR$(L,3,2);" Main:Load BCDA using FOR Loop with ";A$;" BCDA()=";
PrintBCD BCDA(0),0,0

'Load BCDA using Sub
A$="123456789123456789654321"
L=TIMER
LoadBCD BCDA(0),A$
L=TIMER-L
PRINT STR$(L,3,2);" Main:LoadBCD:BCDA() with ";A$;" BCDA()=";
PrintBCD BCDA(0),0

'10s Complement BCDA
A$="123456789"
LoadBCD BCDA(0),A$
L=TIMER
Comp10sBCDA(15)
L=TIMER-L
PRINT STR$(L,3,2);" Main:Comp10sBCDA of ";A$;"=";
PrintBCD BCDA(0)

'Clear BCDA
L=TIMER
ClrBCD BCDA(0)
L=TIMER-L
PRINT STR$(L,3,2);" Main:ClrBCD:BCDA=";
PrintBCD BCDA(0)

'Copy BCDA to BCDB
A$="123456789"
LoadBCD BCDA(0),A$
L=TIMER
FOR I=0 TO BCDSize-1
BCDB(I)=BCDA(I)
NEXT I
L=TIMER-L
PRINT STR$(L,3,2);" Main:Copy BCDA to BCDB using FOR loop:BCDB()=";
PrintBCD BCDB(0)

'Copy BCDA to BCDB using Sub
ClrBCD BCDB(0)
L=TIMER
CopyBCD BCDA(0),BCDB(0)
L=TIMER-L
PRINT STR$(L,3,2);" Main:Copy BCDA to BCDB using CopyBCD:BCDB()=";
PrintBCD BCDB(0)

'Setup for BCD Add/Sub/Mul/Div tests
A$="1030792140000000"
L=TIMER
LoadBCD BCDA(0),A$
L=TIMER-L
PRINT STR$(L,3,2);" Main:LoadBCD:BCDA() with ";A$;" BCDA()=";
PrintBCD BCDA(0)

B$="99999999"
L=TIMER
LoadBCD BCDB(0),B$
L=TIMER-L
PRINT STR$(L,3,2);" Main:LoadBCD:BCDB() with ";B$;" BCDB()=";
PrintBCD BCDB(0)

'Do BCDC() = BCDA() + BCDB()
B$="9999"
LoadBCD BCDB(0),B$
L=TIMER
FOR I=1 TO 100
AddAB2C
NEXT I
L=TIMER-L
PRINT STR$(L/100,3,2) ;" Main:AddAB2C of ";A$;"+";B$;"=";
PrintBCD BCDC(0),0,0

'Do BCDA() = BCDA() + BCDB()
A$="1030792140000000"
LoadBCD BCDA(0),A$
B$="9999"
LoadBCD BCDB(0),B$
L=TIMER
FOR I=1 TO 100
AddAB2A
NEXT I
L=TIMER-L
PRINT STR$(L/100,3,2) ;" Main:AddAB2A of ";A$;"+";B$;" x 100 =";
PrintBCD BCDA(0),0,0

'Do BCDC() = BCDA() - BCDB()
B$="999"
LoadBCD BCDB(0),B$
L=TIMER
FOR I=1 TO 100
SubAB2C
NEXT I
L=TIMER-L
PRINT STR$(L/100,3,2) ;" Main:SubAB2C :";A$;"-";B$;"=";
PrintBCD BCDC(0),0,0

'Do BCDA() = BCDA() - BCDB()
A$="1030792140000000"
LoadBCD BCDA(0),A$
B$="999"
LoadBCD BCDB(0),B$
L=TIMER
FOR I=1 TO 100
SubAB2A
NEXT I
L=TIMER-L
PRINT STR$(L/100,3,2) ;" Main:SubAB2A: ";A$;"-";B$;" x 100 =";
PrintBCD BCDC(0),0,0

'MulAB2C
A$="34359738"
B$="10000000"
LoadBCD BCDA(0),A$
LoadBCD BCDB(0),B$
L=TIMER
FOR I=1 TO 10
MulAB2C
NEXT I
L=TIMER-L
PRINT STR$(L/10,3,2);" Main:MulAB2C:";A$;"*";B$;"=";
PrintBCD BCDC(0),0,1

'DivAB2C
A$="4294967296" '2^32
B$="125"
LoadBCD BCDA(0),A$
LoadBCD BCDB(0),B$
L=TIMER
DivAB2C
L=TIMER-L
PRINT STR$(L,3,2);" Main:DivAB2C:";A$;"\";B$;"=";
PrintBCD BCDC(0),0,1

'IncBCDA
A$="123456789"
J=1
LoadBCD BCDA(0),(A$)
L=TIMER
FOR I=1 TO 100
IncBCDA J
NEXT I
L=TIMER-L
PRINT STR$(L/100,3,2);" Main:IncBCDA:";A$;"+" STR$(J*100);"=";
PrintBCD BCDA(0)

'DecBCDA
A$="100000001"
J=1
LoadBCD BCDA(0),(A$)
L=TIMER
FOR I=1 TO 100
DecBCDA J
NEXT I
L=TIMER-L
PRINT STR$(L/100,3,2);" Main:DecBCDA:";A$;"-" STR$(J*100);"=";
PrintBCD BCDA(0)

'BCDA2BIN
A$="343597380"
LoadBCD BCDA(0),(A$)
L=TIMER
FOR I=1 TO 10
BCDA2Bin
NEXT I
L=TIMER-L
PRINT STR$(L/10,3,2);;" Main:BCDA2BIN of ";A$;"=&H";
PrintBCD BCDC(0),1,0

'BCDA2ASC
A$="03043597380"
LoadBCD BCDA(0),(A$)
L=TIMER
FOR I=1 TO 10
C$=BCDA2Asc$()
NEXT I
L=TIMER-L
PRINT STR$(L/10,3,2);" Main:BCDA2Asc$ of ";A$;"=";C$

END SUB