Rosetta Code

Binary coded decimal: Difference between revisions

Page Discussion

Binary coded decimal (view source)

Revision as of 17:14, 7 November 2023

11,745 bytes added ,  6 months ago
m
→‎{{header|Wren}}: Changed to Wren S/H
(Rust implementation)
m (→‎{{header|Wren}}: Changed to Wren S/H)
 
(13 intermediate revisions by 8 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.)
 
<langsyntaxhighlight lang="6502asm">sed ;set decimal flag; now all math is BCD
lda #$19
clc
Line 46:
jsr PrintHex
jsr NewLine
rts ;return to basic</langsyntaxhighlight>
{{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.
<langsyntaxhighlight lang="68000devpac"> MOVEQ #$19,D0
MOVEQ #1,D1
MOVEQ #0,D2
Line 77:
JSR PrintHex
 
jmp *</langsyntaxhighlight>
{{out}}
<pre>20
Line 83:
0100</pre>
=={{header|ALGOL 68}}==
Although ALGOL 68G probably used BCD internally for LONG LONG INT values, 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. thoughThe the2-digit numbers here are signedthen used to provide addition/subtraction of larger numbers.
<langsyntaxhighlight lang="algol68">BEGIN # implements packed BCD arithmetic for 2-digit signed packed BCD #
INT x99 = ( 9 * 16 ) + 9; # maximum unsigned 2-digit BCD value #
# structure to hold BCD values #
MODE BCD = STRUCT( INT value 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 #
Line 109 ⟶ 110:
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
Line 114 ⟶ 120:
+ 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
ASBCD IF INT av = ABS value OF a, bv = ABS value OF b;
INT BOOL apav = ABS value OF a, >= 0, bp = bv = ABS value OF b >= 0;
BOOL ap = INT a2value =OF ava MOD>= 160, bp = value OF b b2 >= bv MOD 160;
INT a2 = av apMOD 16, b2 = bpbv MOD 16;
INT bcd value = THEN
IF INT result :ap = av + bv;bp
THEN # both positive or both negative IF a2 + b2 > 9 THEN result +:= 6 FI;#
IF ap THEN INT result ELSE:= -av result+ FIbv;
ELIF av IF a2 + b2 > 9 THEN result +:= bv6 FI;
IF ap THEN result ELSE - result FI
ELIF INTav result :>= av - bv;
THEN IF# a2different <signs, b2magnitude THENof a at least that of b result -:= 6 FI;#
IF ap THEN INT result ELSE:= -av result- FIbv;
ELSE IF a2 < b2 THEN result -:= 6 FI;
INT result := bvIF ap THEN result ELSE - av;result FI
ELSE IF# b2different <signs, a2magnitude THENof resulta -:=less 6than FI;that of b #
IF ap THEN -INT result ELSE:= resultbv - FIav;
FI # + # 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 ) );
BCD r;
rprint( :=( TOSTRING TOBCD( 19TOBCD )30 +- TOBCD(bcd 1 ), newline ) );
print(BCD (r TOSTRING= r,TOBCD 99 newline+ )bcd )1;
r := TOBCD( 30 ) - TOBCD( 1 );
print( ( TOSTRING r, newline ) );
r := TOBCD( 99 ) + TOBCD( 1 );
print( ( IF carry OF r THEN "1" ELSE "" FI, TOSTRING r, newline ) );
print( ( newline ) );
 
# additional test cases #
# use the 2-digit BCD to add/subtract larger numbers #
PROC test add = ( INT v )VOID:
[ 1 : 6 ]BCD BEGINd12 :=
( TOBCD 1, FORTOBCD i23, FROMTOBCD 045, TOTOBCD 2067, DOTOBCD 89, TOBCD 01 );
[]BCD a12 =
print( ( TOSTRING ( TOBCD( v ) + TOBCD( i ) ), " " ) )
( TOBCD 1, TOBCD 11, TOBCD 11, TOBCD 11, TOBCD 11, TOBCD 11 );
OD;
TO 10 DO # repeatedly add s12 to d12 #
print( ( newline ) )
print( END( #TOSTRING testd12, add" #+ ", TOSTRING a12, " = " ) );
PROC test sub = (BOOL INTcarry v )VOID:= FALSE;
FOR b pos FROM UPB d12 BY -1 TO LWB d12 DO
BEGIN
d12[ FORb ipos FROM] 0+:= TOa12[ 20b DOpos ];
BOOL need carry = print(carry (OF TOSTRINGd12[ (b TOBCD(pos v ) - TOBCD( i ) ), " " ) )];
IF ODcarry THEN d12[ b pos ] +:= bcd 1 FI;
carry print(:= (need newlinecarry )OR )carry OF d12[ b pos ]
END # test sub # OD;
print( ( TOSTRING d12, newline ) )
test add( 19 );
test add( 40 )OD;
TO 10 DO # repeatedly subtract a12 from d12 #
test add( 82 );
print( ( TOSTRING d12, " - ", TOSTRING a12, " = " ) );
test add( -9 );
test sub( 99 ) BOOL carry := FALSE;
FOR b pos FROM UPB d12 BY -1 TO LWB d12 DO
test sub( 33 );
d12[ b pos ] -:= a12[ b pos ];
test sub( 12 )
BOOL need carry = carry OF d12[ b pos ];
END</lang>
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>
Line 176 ⟶ 211:
100
 
012345678901 + 011111111111 = 023456790012
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
023456790012 + 011111111111 = 034567901123
40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
034567901123 + 011111111111 = 045679012234
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 00 01 02
045679012234 + 011111111111 = 056790123345
-09 -08 -07 -06 -05 -04 -03 -02 -01 00 01 02 03 04 05 06 07 08 09 10 11
056790123345 + 011111111111 = 067901234456
99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79
067901234456 + 011111111111 = 079012345567
33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13
079012345567 + 011111111111 = 090123456678
12 11 10 09 08 07 06 05 04 03 02 01 00 -01 -02 -03 -04 -05 -06 -07 -08
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}}
<langsyntaxhighlight algolwlang="pascal">begin % implements packed BCD arithmetic for 2-digit signed packed BCD %
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 %
Line 225 ⟶ 273:
% 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 %
Line 249 ⟶ 300:
if ap then bcdResult := - bcdResult
end if_ap_eq_bp__av_ge_bv__;
asBcd(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 %
Line 263 ⟶ 325:
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.</lang>
end.</syntaxhighlight>
{{out}}
<pre>
Line 270 ⟶ 375:
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">
<lang Forth>
\ add two 15 digit bcd numbers
\
Line 292 ⟶ 487:
 
: bcd- bcdneg bcd+ ;
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 304 ⟶ 499:
</pre>
 
=={{header|JFreeBASIC}}==
<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:
 
<langsyntaxhighlight Jlang="j"> bcd=: &.((10 #. 16 #.inv ". ::]) :. ('16b',16 hfd@#. 10 #.inv ]))
16b19 +bcd 1
16b20
Line 316 ⟶ 535:
16b100
(16b99 +bcd 1) -bcd 1
16b99</langsyntaxhighlight>
 
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.)
Line 322 ⟶ 541:
For reference, here are decimal and binary representations of the above numbers:
 
<langsyntaxhighlight Jlang="j"> (":,_16{.' '-.~'2b',":@#:) 16b19
25 2b11001
(":,_16{.' '-.~'2b',":@#:) 16b20
Line 336 ⟶ 555:
2b11001
25
NB. ...</langsyntaxhighlight>
 
=={{header|Julia}}==
Handles negative and floating point numbers (but avoid BigFloats due to very long decimal places from binary to decimal conversion).
<langsyntaxhighlight rubylang="julia">const nibs = [0b0, 0b1, 0b10, 0b11, 0b100, 0b101, 0b110, 0b111, 0b1000, 0b1001]
 
"""
Line 434 ⟶ 652:
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)...))))")
</langsyntaxhighlight>{{out}}
<pre>
1 encoded is (UInt8[0x01], 1), decoded is 1
Line 449 ⟶ 667:
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>
 
Line 454 ⟶ 718:
==={{header|Free Pascal}}===
There exist a special unit for BCD, even with fractions.Obvious for Delphi compatibility.
<langsyntaxhighlight lang="pascal">program CheckBCD;
// See https://wiki.freepascal.org/BcdUnit
{$IFDEF FPC} {$MODE objFPC}{$ELSE} {$APPTYPE CONSOLE} {$ENDIF}
Line 484 ⟶ 748:
BcdMultiply(Bcd0,Bcd0,BcdOut);
writeln(BcdToStr(Bcd0),'*',BcdToStr(Bcd0),' =',BcdToStr(BcdOut));
end.</langsyntaxhighlight>
{{out}}
<pre>19+1 =20
Line 491 ⟶ 755:
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.
<!--<langsyntaxhighlight Phixlang="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>
Line 539 ⟶ 802:
<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>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 551 ⟶ 814:
The aaa, aas, aam, and aad instructions are also available.
Same output as above, of course
<!--<langsyntaxhighlight Phixlang="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>
Line 578 ⟶ 841:
<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>
<!--</langsyntaxhighlight>-->
 
=== 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...
<!--<langsyntaxhighlight Phixlang="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>
Line 639 ⟶ 902:
<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>
<!--</langsyntaxhighlight>-->
 
=={{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}}
<langsyntaxhighlight lang="pli">100H: /* DEMONSTRATE PL/M'S BCD HANDLING */
 
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
Line 677 ⟶ 939:
CALL PR$BCD( B ); CALL PR$BCD( A ); CALL PR$NL;
 
EOF</langsyntaxhighlight>
{{out}}
<pre>
Line 686 ⟶ 948:
 
A more complex example, showing how the DEC function can be used to perform unsigned BCD addition and subtraction on arbitrary length BCD numbers.
<langsyntaxhighlight lang="pli">100H: /* DEMONSTRATE PL/M'S BCD HANDLING */
 
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
Line 714 ⟶ 976:
A = 01H;
 
DO I = 1 TO 10; /* REPEATEDLY ADD 12345678911111111111 TO THE NUMBER AND DISPLAY IT */
CALL PR$BCD( F );
CALL PR$BCD( E );
Line 721 ⟶ 983:
CALL PR$BCD( B );
CALL PR$BCD( A );
CALL PR$STRING( .' + 123456789011111111111 = $' );
A = DEC( A + 89H11H ); /* THE PARAMETER TO THE DEC BUILTIN FUNCTION */
B = DEC( B PLUS 67H11H ); /* MUST BE A CONSTANT OR UNSCRIPTED VARIABLE */
C = DEC( C PLUS 45H11H ); /* +/-/PLUS/MINUS ANOTHER CONSTANT OR */
D = DEC( D PLUS 23H11H ); /* UNSUBSCRIPTED VARIABLE */
E = DEC( E PLUS 1H11H ); /* ( WHICH MUST CONTAIN 2-DIGIT BCD VALUES ).*/
F = DEC( F PLUS 01 ); /* PLUS/MINUS PERFORM ADDITION/SUBTRACTION */
CALL PR$BCD( F ); /* INCLUDING THE CARRY FROM THE PREVIOUS */
CALL PR$BCD( E ); /* OPERATION, +/- IGNORE THE CARRY. */
Line 737 ⟶ 999:
END;
 
A,DO B,I C,= 1 TO 10; D, E, F = 099H; /* SETREPEATEDLY THESUBTRACT 1211111111111 DIGITFROM BCDTHE NUMBER TO 999999999999 */
 
DO I = 1 TO 10; /* REPEATEDLY SUBTRACT 987654321 AND DISPLAY THE RESULT */
CALL PR$BCD( F );
CALL PR$BCD( E );
Line 746 ⟶ 1,006:
CALL PR$BCD( B );
CALL PR$BCD( A );
CALL PR$STRING( .' - 987654321011111111111 = $' );
A = DEC( A - 21H11H );
B = DEC( B MINUS 43H11H );
C = DEC( C MINUS 65H11H );
D = DEC( D MINUS 87H11H );
E = DEC( E MINUS 9H11H );
F = DEC( F MINUS 01 );
CALL PR$BCD( F );
CALL PR$BCD( E );
Line 762 ⟶ 1,022:
END;
 
EOF</lang>
</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
012345678901 + 123456789 = 012469135690
2: #100h
012469135690 + 123456789 = 012592592479
1: #29h
012592592479 + 123456789 = 012716049268
012716049268 + 123456789 = 012839506057
012839506057 + 123456789 = 012962962846
012962962846 + 123456789 = 013086419635
013086419635 + 123456789 = 013209876424
013209876424 + 123456789 = 013333333213
013333333213 + 123456789 = 013456790002
013456790002 + 123456789 = 013580246791
999999999999 - 987654321 = 999012345678
999012345678 - 987654321 = 998024691357
998024691357 - 987654321 = 997037037036
997037037036 - 987654321 = 996049382715
996049382715 - 987654321 = 995061728394
995061728394 - 987654321 = 994074074073
994074074073 - 987654321 = 993086419752
993086419752 - 987654321 = 992098765431
992098765431 - 987654321 = 991111111110
991111111110 - 987654321 = 990123456789
</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">
<lang Rust>
#[derive(Copy, Clone)]
pub struct Bcd64 {
Line 835 ⟶ 1,160:
assert_eq!((Bcd64{ bits: 0x99 } + one).bits, 0x100);
}
</syntaxhighlight>
</lang>
{{Out}}
For the output, use "cargo test" to run the unit test for this module.
Line 857 ⟶ 1,182:
 
In what follows, the hex prefix '0x' is simply a way of representing BCD literals and has nothing to do with hexadecimal as such.
<langsyntaxhighlight ecmascriptlang="wren">import "./check" for Check
import "./math" for Int
import "./str" for Str
Line 935 ⟶ 1,260:
}
if (packed) System.print()
}</langsyntaxhighlight>
 
{{out}}
Line 951 ⟶ 1,276:
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.
 
<langsyntaxhighlight lang="z80">
PrintChar equ &BB5A ;Amstrad CPC kernel's print routine
org &1000
Line 1,001 ⟶ 1,326:
add a,&F0
adc a,&40
jp PrintChar</langsyntaxhighlight>
{{out}}
<pre>20
PureFox
9,476

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/321776...355662"