Binary coded decimal: Difference between revisions
m
→{{header|Wren}}: Changed to Wren S/H
Puppydrum64 (talk | contribs) No edit summary |
m (→{{header|Wren}}: Changed to Wren S/H) |
||
| (35 intermediate revisions by 13 users not shown) | |||
Line 18:
The 6502 is a bit different in that it has a special operating mode where all addition and subtraction is handled as binary-coded decimal. Like the 68000, this must be invoked ahead of time, rather than using the Intel method of doing the math normally and then correcting it after the fact. (This special operating mode won't work on the aforementioned Ricoh 2A03, which performs math in "normal" mode even if the decimal flag is set.)
<
lda #$19
clc
Line 46:
jsr PrintHex
jsr NewLine
rts ;return to basic</
{{out}}
<pre>20
Line 53:
=={{header|68000 Assembly}}==
The 68000 has special mathematics commands for binary-coded decimal. However, they only work at byte length, and cannot use immediate operands. Even adding by 1 this way requires you to load 1 into a register first.
<
MOVEQ #1,D1
MOVEQ #0,D2
Line 77:
JSR PrintHex
jmp *</
{{out}}
<pre>20
29
0100</pre>
=={{header|ALGOL 68}}==
Algol 68 does not have BCD as standard. This sample implements 2-digit unsigned packed decimal numbers, similar to the [[#PL/M|PL/M]] sample. The 2-digit numbers are then used to provide addition/subtraction of larger numbers.
<syntaxhighlight lang="algol68">BEGIN # implements packed BCD arithmetic #
INT x99 = ( 9 * 16 ) + 9; # maximum unsigned 2-digit BCD value #
# structure to hold BCD values #
MODE BCD = STRUCT( INT value # BCD value - signed -x99 to x99 #
, BOOL carry # TRUE if the value overflowed, #
); # FALSE otherwise #
# constructs a BCD value from a, assuming it is in the correct format #
# if the value has overflowed, it is truncated to a valid value and #
# carry is set #
OP ASBCD = ( INT a )BCD:
BEGIN
INT v := ABS a;
BOOL carry = v > x99;
IF carry THEN
v := ( ( ( v OVER 16 ) MOD 10 ) * 16 ) + ( v MOD 16 )
FI;
BCD( v * SIGN a, carry )
END # ASBCD # ;
# returns a converted to BCD format, truncating and setting carry #
# if necessary #
OP TOBCD = ( INT a )BCD:
IF a < 0
THEN - TOBCD ABS a
ELSE BCD( ( ( ( a OVER 10 ) MOD 10 ) * 16 ) + ( a MOD 10 ), a > x99 )
FI # TOBCD # ;
BCD bcd 99 = TOBCD 99;
BCD bcd 1 = TOBCD 1;
BCD bcd 0 = TOBCD 0;
# returns a two-digit string representation of the BCD value a #
OP TOSTRING = ( BCD a )STRING: IF value OF a < 0 THEN "-" ELSE "" FI
+ whole( ABS value OF a OVER 16, 0 )
+ whole( ABS value OF a MOD 16, 0 )
;
# returns a string representation of the row of BCD values in a #
# assumes the most significant digits are in a[ LWB a ] #
OP TOSTRING = ( []BCD a )STRING:
BEGIN
STRING result := "";
FOR b pos FROM LWB a TO UPB a DO result +:= TOSTRING a[ b pos ] OD;
result
END # TOSTRING # ;
# returns the sum of a and b, a and b can be positive or negative #
# the result is always positive, if it would be negative, it is #
# tens complemented #
OP + = ( BCD a, b )BCD:
BEGIN
INT av = ABS value OF a, bv = ABS value OF b;
BOOL ap = value OF a >= 0, bp = value OF b >= 0;
INT a2 = av MOD 16, b2 = bv MOD 16;
INT bcd value =
IF ap = bp
THEN # both positive or both negative #
INT result := av + bv;
IF a2 + b2 > 9 THEN result +:= 6 FI;
IF ap THEN result ELSE - result FI
ELIF av >= bv
THEN # different signs, magnitude of a at least that of b #
INT result := av - bv;
IF a2 < b2 THEN result -:= 6 FI;
IF ap THEN result ELSE - result FI
ELSE # different signs, magnitude of a less than that of b #
INT result := bv - av;
IF b2 < a2 THEN result -:= 6 FI;
IF ap THEN - result ELSE - result FI
FI;
IF bcd value >= 0 THEN # result is positive #
ASBCD bcd value
ELSE # result is negative - tens complement #
BCD result := ( bcd 99 + ASBCD bcd value ) + bcd 1;
carry OF result := TRUE;
result
FI
END # + # ;
# returns the value of b negated, carry is preserved #
OP - = ( BCD a )BCD: BCD( - value OF a, carry OF a );
# returns the difference of a and b, a and b can be positive or negative #
OP - = ( BCD a, b )BCD: a + - b;
# adds b to a and resurns a #
OP +:= = ( REF BCD a, BCD b )REF BCD: a := a + b;
# subtracts b from a and resurns a #
OP -:= = ( REF BCD a, BCD b )REF BCD: a := a - b;
# task test cases #
print( ( TOSTRING ( TOBCD 19 + bcd 1 ), newline ) );
print( ( TOSTRING ( TOBCD 30 - bcd 1 ), newline ) );
BCD r = TOBCD 99 + bcd 1;
print( ( IF carry OF r THEN "1" ELSE "" FI, TOSTRING r, newline ) );
print( ( newline ) );
# use the 2-digit BCD to add/subtract larger numbers #
[ 1 : 6 ]BCD d12 :=
( TOBCD 1, TOBCD 23, TOBCD 45, TOBCD 67, TOBCD 89, TOBCD 01 );
[]BCD a12 =
( TOBCD 1, TOBCD 11, TOBCD 11, TOBCD 11, TOBCD 11, TOBCD 11 );
TO 10 DO # repeatedly add s12 to d12 #
print( ( TOSTRING d12, " + ", TOSTRING a12, " = " ) );
BOOL carry := FALSE;
FOR b pos FROM UPB d12 BY -1 TO LWB d12 DO
d12[ b pos ] +:= a12[ b pos ];
BOOL need carry = carry OF d12[ b pos ];
IF carry THEN d12[ b pos ] +:= bcd 1 FI;
carry := need carry OR carry OF d12[ b pos ]
OD;
print( ( TOSTRING d12, newline ) )
OD;
TO 10 DO # repeatedly subtract a12 from d12 #
print( ( TOSTRING d12, " - ", TOSTRING a12, " = " ) );
BOOL carry := FALSE;
FOR b pos FROM UPB d12 BY -1 TO LWB d12 DO
d12[ b pos ] -:= a12[ b pos ];
BOOL need carry = carry OF d12[ b pos ];
IF carry THEN d12[ b pos ] -:= bcd 1 FI;
carry := need carry OR carry OF d12[ b pos ]
OD;
print( ( TOSTRING d12, newline ) )
OD
END</syntaxhighlight>
{{out}}
<pre>
20
29
100
012345678901 + 011111111111 = 023456790012
023456790012 + 011111111111 = 034567901123
034567901123 + 011111111111 = 045679012234
045679012234 + 011111111111 = 056790123345
056790123345 + 011111111111 = 067901234456
067901234456 + 011111111111 = 079012345567
079012345567 + 011111111111 = 090123456678
090123456678 + 011111111111 = 101234567789
101234567789 + 011111111111 = 112345678900
112345678900 + 011111111111 = 123456790011
123456790011 - 011111111111 = 112345678900
112345678900 - 011111111111 = 101234567789
101234567789 - 011111111111 = 090123456678
090123456678 - 011111111111 = 079012345567
079012345567 - 011111111111 = 067901234456
067901234456 - 011111111111 = 056790123345
056790123345 - 011111111111 = 045679012234
045679012234 - 011111111111 = 034567901123
034567901123 - 011111111111 = 023456790012
023456790012 - 011111111111 = 012345678901
</pre>
=={{header|ALGOL W}}==
{{Trans|ALGOL 68}}
<syntaxhighlight lang="pascal">begin % implements packed BCD arithmetic %
integer X99; % maximum unsigned 2-digit BCD value %
% structure to hold BCD values %
record BCD ( integer dValue % signed BCD value: -x99 to x99 %
; logical dCarry % TRUE if the value overflowed, %
); % FALSE otherwise %
reference(BCD) bcd99, bcd1, bcd0;
% constructs a BCD value from a, assuming it is in the correct format %
% if the value has overflowed, it is truncated to a valid value and %
% carry is set %
reference(BCD) procedure asBcd ( integer value a ) ;
begin
integer v;
logical carry;
v := abs a;
carry := v > X99;
if carry then v := ( ( ( v div 16 ) rem 10 ) * 16 ) + ( v rem 16 );
BCD( if a < 0 then - v else v, carry )
end asBcd ;
% returns a converted to BCD format, truncating and setting carry %
% if necessary %
reference(BCD) procedure toBcd ( integer value a ) ;
if a < 0
then negateBcd( toBcd( abs a ) )
else BCD( ( ( ( a div 10 ) rem 10 ) * 16 ) + ( a rem 10 ), a > X99 )
;
% returns the value of b negated, carry is preserved %
reference(BCD) procedure negateBcd ( reference(BCD) value a ) ; BCD( - dValue(a), dCarry(a) );
% writes a two-digit string representation of the BCD value a %
procedure writeOnBcd ( reference(BCD) value a ) ;
begin
if dValue(a) < 0 then writeon( s_w := 0, "-" );
writeon( i_w := 1, s_w := 0
, abs dValue(a) div 16
, abs dValue(a) rem 16
)
end writeOnBcd;
% writes a BCD value with a preceeding newline %
procedure writeBcd ( reference(BCD) value a ) ; begin write(); writeOnBcd( a ) end;
% writes an array of BCD values - the bounds should be 1 :: ub %
procedure showBcd ( reference(BCD) array a ( * ); integer value ub ) ;
for i := 1 until ub do writeOnBcd( a( i ) );
% returns the sum of a and b, a and b can be positive or negative %
reference(BCD) procedure addBcd ( reference(BCD) value a, b ) ;
begin
integer av, bv, a2, b2, bcdResult;
logical ap, bp;
av := abs dValue(a); bv := abs dValue(b);
ap := dValue(a) >= 0; bp := dValue(b) >= 0;
a2 := av rem 16; b2 := bv rem 16;
if ap = bp then begin
bcdResult := av + bv;
if a2 + b2 > 9 then bcdResult := bcdResult + 6;
if not ap then bcdResult := - bcdResult
end
else if av >= bv then begin
bcdResult := av - bv;
if a2 < b2 then bcdResult := bcdResult - 6;
if not ap then bcdResult := - bcdResult
end
else begin
bcdResult := bv - av;
if b2 < a2 then bcdResult := bcdResult - 6;
if ap then bcdResult := - bcdResult
end if_ap_eq_bp__av_ge_bv__;
if bcdResult >= 0 then begin % result is positive %
asBcd( bcdResult )
end
else begin % negative result - tens complement %
reference(BCD) sum;
sum := addBcd( addBcd( bcd99, asBcd( bcdResult ) ), bcd1 );
dCarry(sum) := true;
sum
end if_bcdResult_ge_0__
end addBcd;
% returns the difference of a and b, a and b can be positive or negative %
reference(BCD) procedure subtractBcd ( reference(BCD) value a, b ) ; addBcd( a, negateBcd( b ) );
X99 := ( 9 * 16 ) + 9;
bcd99 := toBcd( 99 );
bcd1 := toBcd( 1 );
bcd0 := toBcd( 0 );
begin % task test cases %
reference(BCD) r;
writeBcd( addBcd( toBcd( 19 ), toBcd( 1 ) ) );
writeBcd( subtractBcd( toBcd( 30 ), toBcd( 1 ) ) );
r := addBcd( toBcd( 99 ), toBcd( 1 ) );
if dCarry(r) then write( s_w := 0, "1" );
writeOnBcd( r );
end;
begin % use the 2-digit BCD to add/subtract larger numbers %
reference(BCD) array d12, a12 ( 1 :: 6 );
integer dPos;
write();
dPos := 0;
for v := 1, 23, 45, 67, 89, 01 do begin
dPos := dPos + 1;
d12( dPos ) := toBcd( v )
end for_v ;
dPos := 0;
for v := 1, 11, 11, 11, 11, 11 do begin
dPos := dPos + 1;
a12( dPos ) := toBcd( v )
end for_v ;
for i := 1 until 10 do begin % repeatedly add a12 to d12 %
logical carry;
write();showBcd( d12, 6 );writeon( " + " );showBcd( a12, 6 );writeon( " = " );
carry := false;
for bPos := 6 step -1 until 1 do begin
logical needCarry;
d12( bPos ) := addBcd( d12( bPos ), a12( bPos ) );
needCarry := dCarry(d12( bPos ));
if carry then d12( bPos ) := addBcd( d12( bPOs ), bcd1 );
carry := needCarry or dCarry(d12( bPos ))
end for_bPos ;
showBcd( d12, 6 )
end for_i;
for i := 1 until 10 do begin % repeatedly subtract a12 from d12 %
logical carry;
write();showBcd( d12, 6 );writeon( " - " );showBcd( a12, 6 );writeon( " = " );
carry := false;
for bPos := 6 step -1 until 1 do begin
logical needCarry;
d12( bPos ) := subtractBcd( d12( bPos ), a12( bPos ) );
needCarry := dCarry(d12( bPos ));
if carry then d12( bPos ) := subtractBcd( d12( bPOs ), bcd1 );
carry := needCarry or dCarry(d12( bPos ))
end for_bPos ;
showBcd( d12, 6 )
end for_i;
end
end.</syntaxhighlight>
{{out}}
<pre>
20
29
100
012345678901 + 011111111111 = 023456790012
023456790012 + 011111111111 = 034567901123
034567901123 + 011111111111 = 045679012234
045679012234 + 011111111111 = 056790123345
056790123345 + 011111111111 = 067901234456
067901234456 + 011111111111 = 079012345567
079012345567 + 011111111111 = 090123456678
090123456678 + 011111111111 = 101234567789
101234567789 + 011111111111 = 112345678900
112345678900 + 011111111111 = 123456790011
123456790011 - 011111111111 = 112345678900
112345678900 - 011111111111 = 101234567789
101234567789 - 011111111111 = 090123456678
090123456678 - 011111111111 = 079012345567
079012345567 - 011111111111 = 067901234456
067901234456 - 011111111111 = 056790123345
056790123345 - 011111111111 = 045679012234
045679012234 - 011111111111 = 034567901123
034567901123 - 011111111111 = 023456790012
023456790012 - 011111111111 = 012345678901
</pre>
=={{header|C++}}==
{{trans|Rust}}
<syntaxhighlight lang="cpp">#include <cassert>
#include <cstdint>
#include <iostream>
class bcd64 {
public:
constexpr explicit bcd64(uint64_t bits = 0) : bits_(bits) {}
constexpr bcd64& operator+=(bcd64 other) {
uint64_t t1 = bits_ + 0x0666666666666666;
uint64_t t2 = t1 + other.bits_;
uint64_t t3 = t1 ^ other.bits_;
uint64_t t4 = ~(t2 ^ t3) & 0x1111111111111110;
uint64_t t5 = (t4 >> 2) | (t4 >> 3);
bits_ = t2 - t5;
return *this;
}
constexpr bcd64 operator-() const {
uint64_t t1 = static_cast<uint64_t>(-static_cast<int64_t>(bits_));
uint64_t t2 = t1 + 0xFFFFFFFFFFFFFFFF;
uint64_t t3 = t2 ^ 1;
uint64_t t4 = ~(t2 ^ t3) & 0x1111111111111110;
uint64_t t5 = (t4 >> 2) | (t4 >> 3);
return bcd64(t1 - t5);
}
friend constexpr bool operator==(bcd64 a, bcd64 b);
friend std::ostream& operator<<(std::ostream& os, bcd64 a);
private:
uint64_t bits_;
};
constexpr bool operator==(bcd64 a, bcd64 b) { return a.bits_ == b.bits_; }
constexpr bool operator!=(bcd64 a, bcd64 b) { return !(a == b); }
constexpr bcd64 operator+(bcd64 a, bcd64 b) {
bcd64 sum(a);
sum += b;
return sum;
}
constexpr bcd64 operator-(bcd64 a, bcd64 b) { return a + -b; }
std::ostream& operator<<(std::ostream& os, bcd64 a) {
auto f = os.flags();
os << std::showbase << std::hex << a.bits_;
os.flags(f);
return os;
}
int main() {
constexpr bcd64 one(0x01);
assert(bcd64(0x19) + one == bcd64(0x20));
std::cout << bcd64(0x19) + one << '\n';
assert(bcd64(0x30) - one == bcd64(0x29));
std::cout << bcd64(0x30) - one << '\n';
assert(bcd64(0x99) + one == bcd64(0x100));
std::cout << bcd64(0x99) + one << '\n';
}</syntaxhighlight>
{{out}}
<pre>
0x20
0x29
0x100
</pre>
=={{header|Forth}}==
This code implements direct BCD arithmetic using notes from Douglas Jones from the University of Iowa: https://homepage.cs.uiowa.edu/~jones/bcd/bcd.html#packed
<syntaxhighlight lang="forth">
\ add two 15 digit bcd numbers
\
: bcd+ ( n1 n2 -- n3 )
0x0666666666666666 + \ offset the digits in n2
2dup xor \ add, discounting carry
-rot + swap \ add with carry (only carries have correct digit)
over xor \ bitmask of where carries occurred.
invert 0x1111111111111110 and \ invert then change digit to 6
dup 2 rshift swap 3 rshift or \ in each non-carry position
- 0x0FFFFFFFFFFFFFFF and ; \ subtract bitmask from result, discard MSD
: bcdneg ( n -- n ) \ reduction of 9999...9999 swap - 1 bcd+
negate 0x0FFFFFFFFFFFFFFF and dup 1-
1 xor over xor invert 0x1111111111111110 and
dup 2 rshift swap 3 rshift or - ;
: bcd- bcdneg bcd+ ;
</syntaxhighlight>
{{Out}}
<pre>
Gforth 0.7.3, Copyright (C) 1995-2008 Free Software Foundation, Inc.
Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'
Type `bye' to exit
hex ok
19 1 bcd+ . 20 ok
30 1 bcd- . 29 ok
99 1 bcd+ . 100 ok
</pre>
=={{header|FreeBASIC}}==
<syntaxhighlight lang="vb">#Define setBCD(v) (CUByte((v) \ 10 Shl 4 + (v) Mod 10)) ' base 16 to base 10
Dim n As Ubyte = setBCD(19)
Print "0x" & 19; " + 1 = "; "0x" & 19+1; " or, in packed BCD, ";
Print Using "########"; CUInt(Bin(n, 8));
Print Using " + 1 = ########"; CUInt(Bin(n + setBCD(7), 8))
n = setBCD(30)
Print "0x" & 30; " - 1 = "; "0x" & 30-1; " or, in packed BCD, ";
Print Using "########"; CUInt(Bin(n, 8));
Print Using " - 1 = ########"; CUInt(Bin(n + setBCD(7), 8))
n = setBCD(99)
Print "0x" & 99; " + 1 = "; "0x" & 99+1; " or, in packed BCD, ";
Print Using "########"; CUInt(Bin(n, 8));
Print Using " + 1 = ########"; CUInt(Bin(n + setBCD(7), 8))
Sleep</syntaxhighlight>
{{out}}
<pre>0x19 + 1 = 0x20 or, in packed BCD, 11001 + 1 = 100000
0x30 - 1 = 0x29 or, in packed BCD, 110000 - 1 = 110111
0x99 + 1 = 0x100 or, in packed BCD, 10011001 + 1 = 10100000</pre>
=={{header|J}}==
Here, we represent hexadecimal numbers using J's constant notation, and to demonstrate bcd we generate results in that representation:
<syntaxhighlight lang="j"> bcd=: &.((10 #. 16 #.inv ". ::]) :. ('16b',16 hfd@#. 10 #.inv ]))
16b19 +bcd 1
16b20
16b30 -bcd 1
16b29
16b99 +bcd 1
16b100
(16b99 +bcd 1) -bcd 1
16b99</syntaxhighlight>
Note that we're actually using a hex representation as an intermediate result here. Technically, though, sticking with built in arithmetic and formatting as decimal, but gluing the '16b' prefix onto the formatted result would have been more efficient. And that says a lot about bcd representation. (The value of bcd is not efficiency, but how it handles edge cases. Consider the [https://en.wikipedia.org/wiki/IEEE_754#Decimal decimal IEEE 754] format as an example where this might be considered significant. There are other ways to achieve those edge cases -- bcd happens to be relevant when building the mechanisms into hardware.)
For reference, here are decimal and binary representations of the above numbers:
<syntaxhighlight lang="j"> (":,_16{.' '-.~'2b',":@#:) 16b19
25 2b11001
(":,_16{.' '-.~'2b',":@#:) 16b20
32 2b100000
(":,_16{.' '-.~'2b',":@#:) 16b29
41 2b101001
(":,_16{.' '-.~'2b',":@#:) 16b30
48 2b110000
(":,_16{.' '-.~'2b',":@#:) 16b99
153 2b10011001
(":,_16{.' '-.~'2b',":@#:) 16b100
256 2b100000000
2b11001
25
NB. ...</syntaxhighlight>
=={{header|Julia}}==
Handles negative and floating point numbers (but avoid BigFloats due to very long decimal places from binary to decimal conversion).
<syntaxhighlight lang="julia">const nibs = [0b0, 0b1, 0b10, 0b11, 0b100, 0b101, 0b110, 0b111, 0b1000, 0b1001]
"""
function bcd_decode(data::Vector{codeunit}, sgn, decimalplaces; table = nibs)
Decode BCD number
bcd: packed BCD data as vector of bytes
sgn: sign(positive 1, negative -1, zero 0)
decimalplaces: decimal places from end for placing decimal point (-1 if none)
table: translation table, defaults to same as nibble (nibs table)
"""
function bcd_decode(bcd::Vector{UInt8}, sgn, decimalplaces = 0; table = nibs)
decoded = 0
for (i, byt) in enumerate(bcd)
decoded = decoded * 10 + table[byt >> 4 + 1]
decoded = decoded * 10 + table[byt & 0b1111 + 1]
end
return decimalplaces == 0 ? sgn * decoded : sgn * decoded / 10^decimalplaces
end
"""
function bcd_encode(number::Real; table::Vector{UInt8} = nibs)
Encode real number as BCD.
`number`` is in native binary formats
`table`` is the table used for encoding the nibbles of the decimal digits, default `nibs`
Returns: BCD encoding vector of UInt8, number's sign (1, 0 -1), and position of decimal point
"""
function bcd_encode(number::Real; table::Vector{UInt8} = nibs)
if (sgn = sign(number)) < 0
number = -number
end
s = string(number)
if (exponentfound = findlast(ch -> ch in ['e', 'E'], s)) != nothing
expplace = parse(Int, s[exponentfound+1:end])
s = s[begin:exponentfound-1]
else
expplace = 0
end
if (decimalplaces = findfirst(==('.'), s)) != nothing
s = s[begin:decimalplaces-1] * s[decimalplaces+1:end]
decimalplaces = length(s) - decimalplaces + 1
decimalplaces -= expplace
else
decimalplaces = -expplace
end
len = length(s)
if isodd(len)
s = "0" * s
len += 1
end
return [table[s[i+1]-'0'+1] | (table[s[i]-'0'+1] << 4) for i in 1:2:len-1], sgn, decimalplaces
end
"""
function bcd_encode(number::Integer; table::Vector{UInt8} = nibs)
Encode integer as BCD.
`number`` is in native binary formats
`table`` is the table used for encoding the nibbles of the decimal digits, default `nibs`
Returns: Tuple containg two values: a BCD encoded vector of UInt8 and the number's sign (1, 0 -1)
"""
function bcd_encode(number::Integer; table::Vector{UInt8} = nibs)
if (sgn = sign(number)) < 0
number = -number
end
s = string(number)
len = length(s)
if isodd(len)
s = "0" * s
len += 1
end
return [table[s[i+1]-'0'+1] | (table[s[i]-'0'+1] << 4) for i in 1:2:len-1], sgn
end
for test in [1, 2, 3, -9876, 10, 12342436]
enc = bcd_encode(test, table = nibs)
dec = bcd_decode(enc..., table = nibs)
println("$test encoded is $enc, decoded is $dec")
end
for test in [-987654.321, -10.0, 9.9999, 123424367.0089]
enc = bcd_encode(test, table = nibs)
dec = bcd_decode(enc..., table = nibs)
println("$test encoded is $enc, decoded is $dec")
end
println("BCD 19 ($(bcd_encode(19)[1])) + BCD 1 ($(bcd_encode(1))[1]) = BCD 20 " *
"($(bcd_encode(bcd_decode(bcd_encode(19)...) + bcd_decode(bcd_encode(1)...))))")
println("BCD 30 ($(bcd_encode(30)[1])) - BCD 1 ($(bcd_encode(1))[1]) = BCD 29 " *
"($(bcd_encode(bcd_decode(bcd_encode(30)...) - bcd_decode(bcd_encode(1)...))))")
println("BCD 99 ($(bcd_encode(99)[1])) + BCD 1 ($(bcd_encode(1))[1]) = BCD 100 " *
"($(bcd_encode(bcd_decode(bcd_encode(99)...) + bcd_decode(bcd_encode(1)...))))")
</syntaxhighlight>{{out}}
<pre>
1 encoded is (UInt8[0x01], 1), decoded is 1
2 encoded is (UInt8[0x02], 1), decoded is 2
3 encoded is (UInt8[0x03], 1), decoded is 3
-9876 encoded is (UInt8[0x98, 0x76], -1), decoded is -9876
10 encoded is (UInt8[0x10], 1), decoded is 10
12342436 encoded is (UInt8[0x12, 0x34, 0x24, 0x36], 1), decoded is 12342436
-987654.321 encoded is (UInt8[0x09, 0x87, 0x65, 0x43, 0x21], -1.0, 3), decoded is -987654.321
-10.0 encoded is (UInt8[0x01, 0x00], -1.0, 1), decoded is -10.0
9.9999 encoded is (UInt8[0x09, 0x99, 0x99], 1.0, 4), decoded is 9.9999
1.234243670089e8 encoded is (UInt8[0x01, 0x23, 0x42, 0x43, 0x67, 0x00, 0x89], 1.0, 4), decoded is 1.234243670089e8
BCD 19 (UInt8[0x19]) + BCD 1 ((UInt8[0x01], 1)[1]) = BCD 20 ((UInt8[0x20], 1))
BCD 30 (UInt8[0x30]) - BCD 1 ((UInt8[0x01], 1)[1]) = BCD 29 ((UInt8[0x29], 1))
BCD 99 (UInt8[0x99]) + BCD 1 ((UInt8[0x01], 1)[1]) = BCD 100 ((UInt8[0x01, 0x00], 1))
</pre>
=={{header|Nim}}==
{{trans|Rust}}
We define a type <code>Bcd64</code> as derived but distinct of <code>uint64</code> and operators and functions working on this type.
<syntaxhighlight lang="Nim">import std/strutils
type Bcd64 = distinct uint64
func `+`(a, b: Bcd64): Bcd64 =
let t1 = a.uint64 + 0x0666_6666_6666_6666u64
let t2 = t1 + b.uint64
let t3 = t1 xor b.uint64
let t4 = not(t2 xor t3) and 0x1111_1111_1111_1110u64
let t5 = (t4 shr 2) or (t4 shr 3)
result = Bcd64(t2 - t5)
func `-`(a: Bcd64): Bcd64 =
## Return 10's complement.
let t1 = cast[uint64](-cast[int64](a))
let t2 = t1 + 0xFFFF_FFFF_FFFF_FFFFu64
let t3 = t2 xor 1
let t4 = not(t2 xor t3) and 0x1111_1111_1111_1110u64
let t5 = (t4 shr 2) or (t4 shr 3)
result = Bcd64(t1 - t5)
func `-`(a, b: Bcd64): Bcd64 =
a + (-b)
func `$`(n: Bcd64): string =
var s = n.uint64.toHex
var i = 0
while i < s.len - 1 and s[i] == '0':
inc i
result = "0x" & s[i..^1]
const One = Bcd64(0x01u64)
echo "$1 + $2 = $3".format(Bcd64(0x19), One, Bcd64(0x19) + One)
echo "$1 - $2 = $3".format(Bcd64(0x30), One, Bcd64(0x30) - One)
echo "$1 + $2 = $3".format(Bcd64(0x99), One, Bcd64(0x99) + One)
</syntaxhighlight>
{{out}}
<pre>0x19 + 0x1 = 0x20
0x30 - 0x1 = 0x29
0x99 + 0x1 = 0x100
</pre>
=={{header|Pascal}}==
==={{header|Free Pascal}}===
There exist a special unit for BCD, even with fractions.Obvious for Delphi compatibility.
<syntaxhighlight lang="pascal">program CheckBCD;
// See https://wiki.freepascal.org/BcdUnit
{$IFDEF FPC} {$MODE objFPC}{$ELSE} {$APPTYPE CONSOLE} {$ENDIF}
uses
sysutils,fmtBCD {$IFDEF WINDOWS},Windows{$ENDIF} ;
{type
TBcd = packed record
Precision: Byte;
SignSpecialPlaces: Byte;
Fraction: packed array [0..31] of Byte;
end;}
var
Bcd0,Bcd1,BcdOut : tBCD;
Begin
Bcd1 := IntegerToBcd(1);
// 0x19 + 1 = 0x20
Bcd0 := IntegerToBcd(19);
BcdAdd(Bcd0,Bcd1,BcdOut);
writeln(BcdToStr(Bcd0),'+',BcdToStr(Bcd1),' =',BcdToStr(BcdOut));
// 0x30 - 1 = 0x29
Bcd0 := IntegerToBcd(29);
BcdAdd(Bcd0,Bcd1,BcdOut);
writeln(BcdToStr(Bcd0),'+',BcdToStr(Bcd1),' =',BcdToStr(BcdOut));
// 0x99 + 1 = 0x100
Bcd0 := IntegerToBcd(99);
BcdAdd(Bcd0,Bcd1,BcdOut);
writeln(BcdToStr(Bcd0),'+',BcdToStr(Bcd1),' =',BcdToStr(BcdOut));
BcdMultiply(Bcd0,Bcd0,BcdOut);
writeln(BcdToStr(Bcd0),'*',BcdToStr(Bcd0),' =',BcdToStr(BcdOut));
end.</syntaxhighlight>
{{out}}
<pre>19+1 =20
29+1 =30
99+1 =100
99*99 =9801
</pre>
=={{header|Phix}}==
=== using fbld and fbstp ===
The FPU maths is all as normal (decimal), it is only the load and store that convert from/to BCD.<br>
While I supply everything in decimal, you could easily return and pass around the likes of acc and res.
<!--<syntaxhighlight lang="phix">-->
<span style="color: #008080;">without</span> <span style="color: #008080;">javascript_semantics</span> <span style="color: #000080;font-style:italic;">-- (not a chance!)</span>
<span style="color: #7060A8;">requires</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"1.0.2"</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- #ilASM{fbld, fbstp} added</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">h</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- convert the 10 bytes BCD, as held in
-- a binary string, to a decimal string.</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">s</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">to</span> <span style="color: #000000;">1</span> <span style="color: #008080;">by</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]!=</span><span style="color: #008000;">'\0'</span> <span style="color: #008080;">or</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%x"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">i</span><span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">1</span> <span style="color: #008080;">by</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">&=</span> <span style="color: #7060A8;">sprintf</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"%02x"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">s</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span>
<span style="color: #000080;font-style:italic;">-- Some (binary) strings to hold 10 byte BCDs:</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">acc</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">'\0'</span><span style="color: #0000FF;">,</span><span style="color: #000000;">10</span><span style="color: #0000FF;">),</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">'\0'</span><span style="color: #0000FF;">,</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)</span>
#ilASM{
mov eax,[a]
mov edx,[b]
mov esi,[acc]
mov edi,[res]
push eax
fild dword[esp]
fbstp tbyte[ebx+esi*4] -- save as 10 byte BCD
fbld tbyte[ebx+esi*4] -- reload proves we can
mov [esp],edx
fild dword[esp]
faddp
fbstp tbyte[ebx+edi*4]
pop eax -- (discard temp workspace)
}
<span style="color: #004080;">integer</span> <span style="color: #000000;">pm</span> <span style="color: #0000FF;">=</span> <span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">?</span><span style="color: #008000;">'+'</span><span style="color: #0000FF;">:</span><span style="color: #008000;">'-'</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%s %c %d = %s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">h</span><span style="color: #0000FF;">(</span><span style="color: #000000;">acc</span><span style="color: #0000FF;">),</span><span style="color: #000000;">pm</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">abs</span><span style="color: #0000FF;">(</span><span style="color: #000000;">b</span><span style="color: #0000FF;">),</span><span style="color: #000000;">h</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #000000;">19</span><span style="color: #0000FF;">,+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #000000;">30</span><span style="color: #0000FF;">,-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">test</span><span style="color: #0000FF;">(</span><span style="color: #000000;">99</span><span style="color: #0000FF;">,+</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
19 + 1 = 20
30 - 1 = 29
99 + 1 = 100
</pre>
=== using daa and das ===
This time we'll supply the arguments in hex/BCD.
Note the result is limited to 16 bits plus one carry bit here.<br>
The aaa, aas, aam, and aad instructions are also available.
Same output as above, of course
<!--<syntaxhighlight lang="phix">-->
<span style="color: #008080;">without</span> <span style="color: #008080;">javascript_semantics</span> <span style="color: #000080;font-style:italic;">-- (not a chance!)</span>
<span style="color: #7060A8;">requires</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"1.0.2"</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- #ilASM{aaa, etc} added</span>
<span style="color: #7060A8;">requires</span><span style="color: #0000FF;">(</span><span style="color: #000000;">32</span><span style="color: #0000FF;">)</span> <span style="color: #000080;font-style:italic;">-- aaa etc not valid on 64 bit</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">test2</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">bcd</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">res</span>
#ilASM{
mov eax,[bcd]
mov ecx, 1
cmp [op],'+'
jne :sub1
add al,cl
daa
adc ah,0
jmp @f
::sub1
sub al,cl
das
@@:
mov[res],eax
}
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%x %c 1 = %x\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">bcd</span><span style="color: #0000FF;">,</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">res</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">test2</span><span style="color: #0000FF;">(</span><span style="color: #000000;">#19</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'+'</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">test2</span><span style="color: #0000FF;">(</span><span style="color: #000000;">#30</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'-'</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">test2</span><span style="color: #0000FF;">(</span><span style="color: #000000;">#99</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'+'</span><span style="color: #0000FF;">)</span>
<!--</syntaxhighlight>-->
=== hll bit fiddling ===
With routines to convert between decimal and bcd, same output as above, of course.
No attempt has been made to support fractions or negative numbers...
<!--<syntaxhighlight lang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span> <span style="color: #000080;font-style:italic;">-- (no requires() needed here)</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">bcd_decode</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">bcd</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">assert</span><span style="color: #0000FF;">(</span><span style="color: #000000;">bcd</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">dec</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">bcd</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">+=</span> <span style="color: #7060A8;">and_bits</span><span style="color: #0000FF;">(</span><span style="color: #000000;">bcd</span><span style="color: #0000FF;">,</span><span style="color: #000000;">#F</span><span style="color: #0000FF;">)*</span><span style="color: #000000;">dec</span>
<span style="color: #000000;">bcd</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">bcd</span> <span style="color: #0000FF;">>></span> <span style="color: #000000;">4</span>
<span style="color: #000000;">dec</span> <span style="color: #0000FF;">*=</span> <span style="color: #000000;">10</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">bcd_encode</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">dec</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">assert</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dec</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">shift</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">dec</span> <span style="color: #008080;">do</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">+=</span> <span style="color: #7060A8;">remainder</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dec</span><span style="color: #0000FF;">,</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)</span> <span style="color: #0000FF;"><<</span> <span style="color: #000000;">shift</span>
<span style="color: #000000;">dec</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">trunc</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dec</span><span style="color: #0000FF;">/</span><span style="color: #000000;">10</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">shift</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">4</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">test3</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">dec</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">bcd</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">bcd_encode</span><span style="color: #0000FF;">(</span><span style="color: #000000;">dec</span><span style="color: #0000FF;">),</span>
<span style="color: #000000;">work</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">bcd</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">shift</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span>
<span style="color: #000000;">carry</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">work</span> <span style="color: #008080;">or</span> <span style="color: #000000;">carry</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">digit</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">(</span><span style="color: #000000;">work</span> <span style="color: #0000FF;">&&</span> <span style="color: #000000;">#F</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">op</span><span style="color: #0000FF;">=</span><span style="color: #008000;">'+'</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">digit</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">carry</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">digit</span><span style="color: #0000FF;">></span><span style="color: #000000;">9</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">digit</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">10</span>
<span style="color: #000000;">carry</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">carry</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">digit</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">carry</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">digit</span><span style="color: #0000FF;"><</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">digit</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">10</span>
<span style="color: #000000;">carry</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">carry</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">res</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">digit</span><span style="color: #0000FF;"><<</span><span style="color: #000000;">shift</span>
<span style="color: #000000;">work</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">work</span><span style="color: #0000FF;">>></span><span style="color: #000000;">4</span>
<span style="color: #000000;">shift</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">4</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%d %c 1 = %d\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">bcd_decode</span><span style="color: #0000FF;">(</span><span style="color: #000000;">bcd</span><span style="color: #0000FF;">),</span><span style="color: #000000;">op</span><span style="color: #0000FF;">,</span><span style="color: #000000;">bcd_decode</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">)})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000000;">test3</span><span style="color: #0000FF;">(</span><span style="color: #000000;">19</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'+'</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">test3</span><span style="color: #0000FF;">(</span><span style="color: #000000;">30</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'-'</span><span style="color: #0000FF;">)</span>
<span style="color: #000000;">test3</span><span style="color: #0000FF;">(</span><span style="color: #000000;">99</span><span style="color: #0000FF;">,</span><span style="color: #008000;">'+'</span><span style="color: #0000FF;">)</span>
<!--</syntaxhighlight>-->
=={{header|PL/M}}==
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
The 8080 PL/M compiler supports packed BCD by wrapping the 8080/Z80 DAA instruction with the DEC built in function, demonstrated here. Unfortunately, I couldn't get the first use of DEC to yeild the correct result without first doing a shift operation. Not sure if this is a bug in the program, the compiler or the 8080 emulator or that I'm misunderstanding something...
This is basically {{Trans|Z80 Assembly}}
<syntaxhighlight lang="pli">100H: /* DEMONSTRATE PL/M'S BCD HANDLING */
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
DECLARE FN BYTE, ARG ADDRESS;
GOTO 5;
END BDOS;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
PR$BCD: PROCEDURE( V ); /* PRINT A 2-DIGIT BCD NUMBER */
DECLARE V BYTE;
DECLARE D BYTE;
D = SHR( V AND 0F0H, 4 );
CALL PR$CHAR( D + '0' );
D = V AND 0FH;
CALL PR$CHAR( D + '0' );
END PR$BCD ;
DECLARE ( A, B, I ) BYTE;
A = SHL( 1, 4 ); /* WORKS AROUND A POSSIBLE BUG IN THE 8080 EMULATOR */
/* OR MY UNDERSTANDING OF THE DEC() FUNCTION... */
A = 19H;
CALL PR$BCD( DEC( A + 1 ) ); CALL PR$NL;
A = 30H;
CALL PR$BCD( DEC( A - 1 ) ); CALL PR$NL;
B = 00H;
A = 99H;
A = DEC( A + 1 ); /* ADD 1 TO 99 - THIS WILL SET CARRY */
B = DEC( B PLUS 0 ); /* ADD THE CARRY TO GET THE LEADING DIGITS */
CALL PR$BCD( B ); CALL PR$BCD( A ); CALL PR$NL;
EOF</syntaxhighlight>
{{out}}
<pre>
20
29
0100
</pre>
A more complex example, showing how the DEC function can be used to perform unsigned BCD addition and subtraction on arbitrary length BCD numbers.
<syntaxhighlight lang="pli">100H: /* DEMONSTRATE PL/M'S BCD HANDLING */
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
DECLARE FN BYTE, ARG ADDRESS;
GOTO 5;
END BDOS;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
PR$BCD: PROCEDURE( V ); /* PRINT A 2-DIGIT BCD NUMBER */
DECLARE V BYTE;
DECLARE D BYTE;
D = SHR( V AND 0F0H, 4 );
CALL PR$CHAR( D + '0' );
D = V AND 0FH;
CALL PR$CHAR( D + '0' );
END PR$BCD ;
DECLARE ( A, B, C, D, E, F, I ) BYTE;
F = 1H; /* CONSTRUCT 12345678901 AS A 12 DIGIT BCD NUMBER */
E = 23H; /* IN F, E, D, C, B. A */
D = 45H;
C = 67H;
B = 89H;
A = 01H;
DO I = 1 TO 10; /* REPEATEDLY ADD 11111111111 TO THE NUMBER */
CALL PR$BCD( F );
CALL PR$BCD( E );
CALL PR$BCD( D );
CALL PR$BCD( C );
CALL PR$BCD( B );
CALL PR$BCD( A );
CALL PR$STRING( .' + 011111111111 = $' );
A = DEC( A + 11H ); /* THE PARAMETER TO THE DEC BUILTIN FUNCTION */
B = DEC( B PLUS 11H ); /* MUST BE A CONSTANT OR UNSCRIPTED VARIABLE */
C = DEC( C PLUS 11H ); /* +/-/PLUS/MINUS ANOTHER CONSTANT OR */
D = DEC( D PLUS 11H ); /* UNSUBSCRIPTED VARIABLE */
E = DEC( E PLUS 11H ); /* ( WHICH MUST CONTAIN 2-DIGIT BCD VALUES ).*/
F = DEC( F PLUS 1 ); /* PLUS/MINUS PERFORM ADDITION/SUBTRACTION */
CALL PR$BCD( F ); /* INCLUDING THE CARRY FROM THE PREVIOUS */
CALL PR$BCD( E ); /* OPERATION, +/- IGNORE THE CARRY. */
CALL PR$BCD( D ); /* THE RESULT IS ADJUSTED TO BE A 2-DIGIT */
CALL PR$BCD( C ); /* BCD VALUE AND THE CARRY FLAG IS SET */
CALL PR$BCD( B ); /* ACCORDINGLY */
CALL PR$BCD( A );
CALL PR$NL;
END;
DO I = 1 TO 10; /* REPEATEDLY SUBTRACT 11111111111 FROM THE NUMBER */
CALL PR$BCD( F );
CALL PR$BCD( E );
CALL PR$BCD( D );
CALL PR$BCD( C );
CALL PR$BCD( B );
CALL PR$BCD( A );
CALL PR$STRING( .' - 011111111111 = $' );
A = DEC( A - 11H );
B = DEC( B MINUS 11H );
C = DEC( C MINUS 11H );
D = DEC( D MINUS 11H );
E = DEC( E MINUS 11H );
F = DEC( F MINUS 1 );
CALL PR$BCD( F );
CALL PR$BCD( E );
CALL PR$BCD( D );
CALL PR$BCD( C );
CALL PR$BCD( B );
CALL PR$BCD( A );
CALL PR$NL;
END;
EOF
</syntaxhighlight>
{{out}}
<pre>
012345678901 + 011111111111 = 023456790012
023456790012 + 011111111111 = 034567901123
034567901123 + 011111111111 = 045679012234
045679012234 + 011111111111 = 056790123345
056790123345 + 011111111111 = 067901234456
067901234456 + 011111111111 = 079012345567
079012345567 + 011111111111 = 090123456678
090123456678 + 011111111111 = 101234567789
101234567789 + 011111111111 = 112345678900
112345678900 + 011111111111 = 123456790011
123456790011 - 011111111111 = 112345678900
112345678900 - 011111111111 = 101234567789
101234567789 - 011111111111 = 090123456678
090123456678 - 011111111111 = 079012345567
079012345567 - 011111111111 = 067901234456
067901234456 - 011111111111 = 056790123345
056790123345 - 011111111111 = 045679012234
045679012234 - 011111111111 = 034567901123
034567901123 - 011111111111 = 023456790012
023456790012 - 011111111111 = 012345678901
</pre>
=={{header|Raku}}==
{{trans|Rust}}
<syntaxhighlight lang="raku" line># 20220930 Raku programming solution
class Bcd64 { has uint64 $.bits }
multi infix:<⊞> (Bcd64 \p, Bcd64 \q) {
my $t1 = p.bits + 0x0666_6666_6666_6666;
my $t2 = ( $t1 + q.bits ) % uint64.Range.max ;
my $t3 = $t1 +^ q.bits;
my $t4 = +^($t2 +^ $t3) +& 0x1111_1111_1111_1110;
my $t5 = ($t4 +> 2) +| ($t4 +> 3);
Bcd64.new: bits => ($t2 - $t5)
}
multi prefix:<⊟> (Bcd64 \p) {
my $t1 = uint64.Range.max + 1 - p.bits ;
my $t2 = ( $t1 + 0xFFFF_FFFF_FFFF_FFFF ) % uint64.Range.max;
my $t3 = $t2 +^ 1;
my $t4 = +^($t2 +^ $t3) +& 0x1111_1111_1111_1110;
my $t5 = ($t4 +> 2) +| ($t4 +> 3);
Bcd64.new: bits => ($t1 - $t5)
}
multi infix:<⊟> (Bcd64 \p, Bcd64 \q) { p ⊞ ( ⊟q ) }
my ($one,$n19,$n30,$n99) = (0x01,0x19,0x30,0x99).map: { Bcd64.new: bits=>$_ };
{ .bits.base(16).say } for ($n19 ⊞ $one,$n30 ⊟ $one,$n99 ⊞ $one);
</syntaxhighlight>
{{out}}
<pre>
20
29
100
</pre>
=={{header|RPL}}==
{{trans|Forth}}
{{works with|Halcyon Calc|4.2.7}}
≪ #666666666666666h + DUP2 XOR ROT ROT + SWAP OVER XOR
NOT #1111111111111110h AND
DUP SR SR SWAP SR SR SR OR -
#FFFFFFFFFFFFFFFh AND
≫ 'ADBCD' STO
≪ NOT 1 + #FFFFFFFFFFFFFFFh AND DUP 1 - 1 XOR OVER XOR
NOT #1111111111111110h AND
DUP SR SR SWAP SR SR SR OR -
≫ 'NGBCD' STO
≪ NGBCD ADBCD ≫
'SUBCD' STO
64 STWS HEX
#19 #1 ADBCD
#99 #1 ADBCD
#30 #1 SUBCD
{{out}}
<pre>
3: #20h
2: #100h
1: #29h
</pre>
=={{header|Rust}}==
Based on the Forth implementation re: how to implement BCD arithmetic in software. Uses operator overloading for new BCD type.
<syntaxhighlight lang="rust">
#[derive(Copy, Clone)]
pub struct Bcd64 {
bits: u64
}
use std::ops::*;
impl Add for Bcd64 {
type Output = Self;
fn add(self, other: Self) -> Self {
let t1 = self.bits + 0x0666_6666_6666_6666;
let t2 = t1.wrapping_add(other.bits);
let t3 = t1 ^ other.bits;
let t4 = !(t2 ^ t3) & 0x1111_1111_1111_1110;
let t5 = (t4 >> 2) | (t4 >> 3);
return Bcd64{ bits: t2 - t5 };
}
}
impl Neg for Bcd64 {
type Output = Self;
fn neg(self) -> Self { // return 10's complement
let t1 = -(self.bits as i64) as u64;
let t2 = t1.wrapping_add(0xFFFF_FFFF_FFFF_FFFF);
let t3 = t2 ^ 1;
let t4 = !(t2 ^ t3) & 0x1111_1111_1111_1110;
let t5 = (t4 >> 2) | (t4 >> 3);
return Bcd64{ bits: t1 - t5 };
}
}
impl Sub for Bcd64 {
type Output = Self;
fn sub(self, other: Self) -> Self {
return self + -other;
}
}
#[test]
fn addition_test() {
let one = Bcd64{ bits: 0x01 };
assert_eq!((Bcd64{ bits: 0x19 } + one).bits, 0x20);
assert_eq!((Bcd64{ bits: 0x30 } - one).bits, 0x29);
assert_eq!((Bcd64{ bits: 0x99 } + one).bits, 0x100);
}
</syntaxhighlight>
{{Out}}
For the output, use "cargo test" to run the unit test for this module.
<pre>
running 1 test
test bcd::addition_test ... ok
test result: ok. 1 passed; 0 failed; 0 ignored; 0 measured; 0 filtered out; finished in 0.00s
</pre>
=={{header|Wren}}==
{{libheader|Wren-check}}
{{libheader|Wren-math}}
{{libheader|Wren-str}}
{{libheader|Wren-fmt}}
In Wren all numbers are represented by 64 bit floats and the language has no real concept of bytes, nibbles or even integers.
The following is therefore a simulation of BCD arithmetic using packed binary strings to represent decimal digits. It only works for non-negative integral numbers.
We can change to 'unpacked' notation simply by prepending '0000' to each 'digit' of the 'packed' notation.
In what follows, the hex prefix '0x' is simply a way of representing BCD literals and has nothing to do with hexadecimal as such.
<syntaxhighlight lang="wren">import "./check" for Check
import "./math" for Int
import "./str" for Str
import "./fmt" for Fmt
class BCD {
static init_() {
__bcd = [
"0000", "0001", "0010", "0011", "0100",
"0101", "0110", "0111", "1000", "1001"
]
__dec = {
"0000": "0", "0001": "1", "0010": "2", "0011": "3", "0100": "4",
"0101": "5", "0110": "6", "0111": "7", "1000": "8", "1001": "9"
}
}
construct new(n) {
if (n is String) {
if (n.startsWith("0x")) n = n[2..-1]
n = Num.fromString(n)
}
Check.nonNegInt("n", n)
if (!__bcd) BCD.init_()
_b = ""
for (digit in Int.digits(n)) _b = _b + __bcd[digit]
}
toInt {
var ns = ""
for (nibble in Str.chunks(_b, 4)) ns = ns + __dec[nibble]
return Num.fromString(ns)
}
+(other) {
if (!(other is BCD)) other = BCD.new(other)
return BCD.new(this.toInt + other.toInt)
}
-(other) {
if (!(other is BCD)) other = BCD.new(other)
return BCD.new(this.toInt - other.toInt)
}
toString {
var ret = _b.trimStart("0")
if (ret == "") ret = "0"
return ret
}
toUnpacked {
var ret = ""
for (nibble in Str.chunks(_b, 4)) ret = ret + "0000" + nibble
ret = ret.trimStart("0")
if (ret == "") ret = "0"
return ret
}
toHex { "0x" + this.toInt.toString }
}
var hexs = ["0x19", "0x30", "0x99"]
var ops = ["+", "-", "+"]
for (packed in [true, false]) {
for (i in 0...hexs.count) {
var op = ops[i]
var bcd = BCD.new(hexs[i])
var bcd2 = (op == "+") ? bcd + 1 : bcd - 1
var str = packed ? bcd.toString : bcd.toUnpacked
var str2 = packed ? bcd2.toString : bcd2.toUnpacked
var hex = bcd.toHex
var hex2 = bcd2.toHex
var un = packed ? "" : "un"
var w = packed ? 8 : 12
var args = [hex, op, hex2, un, w, str, op, str2]
Fmt.lprint("$s $s 1 = $-5s or, in $0spacked BCD, $*s $s 1 = $s", args)
}
if (packed) System.print()
}</syntaxhighlight>
{{out}}
<pre>
0x19 + 1 = 0x20 or, in packed BCD, 11001 + 1 = 100000
0x30 - 1 = 0x29 or, in packed BCD, 110000 - 1 = 101001
0x99 + 1 = 0x100 or, in packed BCD, 10011001 + 1 = 100000000
0x19 + 1 = 0x20 or, in unpacked BCD, 100001001 + 1 = 1000000000
0x30 - 1 = 0x29 or, in unpacked BCD, 1100000000 - 1 = 1000001001
0x99 + 1 = 0x100 or, in unpacked BCD, 100100001001 + 1 = 10000000000000000
</pre>
=={{header|Z80 Assembly}}==
The <code>DAA</code> function will convert an 8-bit hexadecimal value to BCD after an addition or subtraction is performed. The algorithm used is actually quite complex, but the Z80's dedicated hardware for it makes it all happen in 4 clock cycles, tied with the fastest instructions the CPU can perform.
<
PrintChar equ &BB5A ;Amstrad CPC kernel's print routine
org &1000
Line 135 ⟶ 1,326:
add a,&F0
adc a,&40
jp PrintChar</
{{out}}
<pre>20
| |||