Binary coded decimal: Difference between revisions

m
→‎{{header|Wren}}: Changed to Wren S/H
(→‎{{header|PL/M}}: Show the same 12-digit arithmetic as the Algol 68 and Algol W samples)
m (→‎{{header|Wren}}: Changed to Wren S/H)
 
(10 intermediate revisions by 7 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 84:
=={{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.
<langsyntaxhighlight lang="algol68">BEGIN # implements packed BCD arithmetic #
INT x99 = ( 9 * 16 ) + 9; # maximum unsigned 2-digit BCD value #
# structure to hold BCD values #
Line 204:
OD
 
END</langsyntaxhighlight>
{{out}}
<pre>
Line 232:
023456790012 - 011111111111 = 012345678901
</pre>
 
=={{header|ALGOL W}}==
{{Trans|ALGOL 68}}
<langsyntaxhighlight lang="pascal">begin % implements packed BCD arithmetic %
integer X99; % maximum unsigned 2-digit BCD value %
% structure to hold BCD values %
Line 370 ⟶ 369:
end
 
end.</langsyntaxhighlight>
{{out}}
<pre>
Line 397 ⟶ 396:
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 419 ⟶ 487:
 
: bcd- bcdneg bcd+ ;
</syntaxhighlight>
</lang>
{{Out}}
<pre>
Line 431 ⟶ 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 443 ⟶ 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 449 ⟶ 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 463 ⟶ 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 561 ⟶ 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 576 ⟶ 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 581 ⟶ 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 611 ⟶ 748:
BcdMultiply(Bcd0,Bcd0,BcdOut);
writeln(BcdToStr(Bcd0),'*',BcdToStr(Bcd0),' =',BcdToStr(BcdOut));
end.</langsyntaxhighlight>
{{out}}
<pre>19+1 =20
Line 618 ⟶ 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 666 ⟶ 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 678 ⟶ 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 705 ⟶ 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 766 ⟶ 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 804 ⟶ 939:
CALL PR$BCD( B ); CALL PR$BCD( A ); CALL PR$NL;
 
EOF</langsyntaxhighlight>
{{out}}
<pre>
Line 813 ⟶ 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 888 ⟶ 1,023:
 
EOF
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 911 ⟶ 1,046:
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">
<lang Rust>
#[derive(Copy, Clone)]
pub struct Bcd64 {
Line 961 ⟶ 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 983 ⟶ 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 1,061 ⟶ 1,260:
}
if (packed) System.print()
}</langsyntaxhighlight>
 
{{out}}
Line 1,077 ⟶ 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,127 ⟶ 1,326:
add a,&F0
adc a,&40
jp PrintChar</langsyntaxhighlight>
{{out}}
<pre>20
9,476

edits