Binary coded decimal: Difference between revisions

From Rosetta Code
Content added Content deleted
(Rust implementation)
(→‎{{header|ALGOL 68}}: Use unsigned BCD, show addition/subtraction of larger numbers.)
Line 83: Line 83:
0100</pre>
0100</pre>
=={{header|ALGOL 68}}==
=={{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 packed decimal numbers, similar to the [[#PL/M|PL/M]] sample though the numbers here are signed.
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.
<lang algol68>BEGIN # implements BCD arithmetic for 2-digit signed packed BCD #
<lang algol68>BEGIN # implements packed BCD arithmetic #
INT x99 = ( 9 * 16 ) + 9; # maximum unsigned BCD value #
INT x99 = ( 9 * 16 ) + 9; # maximum unsigned 2-digit BCD value #
# structure to hold BCD values #
# structure to hold BCD values #
MODE BCD = STRUCT( INT value # BCD value - signed -x99 to x99 #
MODE BCD = STRUCT( INT value # BCD value - signed -x99 to x99 #
, BOOL carry # TRUE if the value overflowed, #
, BOOL carry # TRUE if the value overflowed, #
); # FALSE otherwise #
); # FALSE otherwise #

# constructs a BCD value from a, assuming it is in the correct format #
# 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 #
# if the value has overflowed, it is truncated to a valid value and #
Line 109: Line 110:
ELSE BCD( ( ( ( a OVER 10 ) MOD 10 ) * 16 ) + ( a MOD 10 ), a > x99 )
ELSE BCD( ( ( ( a OVER 10 ) MOD 10 ) * 16 ) + ( a MOD 10 ), a > x99 )
FI # TOBCD # ;
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 #
# returns a two-digit string representation of the BCD value a #
OP TOSTRING = ( BCD a )STRING: IF value OF a < 0 THEN "-" ELSE "" FI
OP TOSTRING = ( BCD a )STRING: IF value OF a < 0 THEN "-" ELSE "" FI
Line 114: Line 120:
+ whole( ABS value OF a MOD 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 #
# 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:
OP + = ( BCD a, b )BCD:
BEGIN
ASBCD IF INT av = ABS value OF a, bv = ABS value OF b;
BOOL ap = value OF a >= 0, bp = value OF b >= 0;
INT av = ABS value OF a, bv = ABS value OF b;
INT a2 = av MOD 16, b2 = bv MOD 16;
BOOL ap = value OF a >= 0, bp = value OF b >= 0;
ap = bp
INT a2 = av MOD 16, b2 = bv MOD 16;
THEN
INT bcd value =
INT result := av + bv;
IF ap = bp
IF a2 + b2 > 9 THEN result +:= 6 FI;
THEN # both positive or both negative #
IF ap THEN result ELSE - result FI
INT result := av + bv;
ELIF av >= bv
IF a2 + b2 > 9 THEN result +:= 6 FI;
THEN
IF ap THEN result ELSE - result FI
INT result := av - bv;
ELIF av >= bv
IF a2 < b2 THEN result -:= 6 FI;
THEN # different signs, magnitude of a at least that of b #
IF ap THEN result ELSE - result FI
INT result := av - bv;
ELSE
IF a2 < b2 THEN result -:= 6 FI;
INT result := bv - av;
IF ap THEN result ELSE - result FI
IF b2 < a2 THEN result -:= 6 FI;
ELSE # different signs, magnitude of a less than that of b #
IF ap THEN - result ELSE result FI
INT result := bv - av;
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 #
# returns the value of b negated, carry is preserved #
OP - = ( BCD a )BCD: BCD( - value OF a, carry OF a );
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 #
# returns the difference of a and b, a and b can be positive or negative #
OP - = ( BCD a, b )BCD: a + - b;
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 #
# task test cases #
⚫
print( ( TOSTRING ( TOBCD 19 + bcd 1 ), newline ) );
⚫
BCD r;
r := TOBCD( 19 ) + TOBCD( 1 );
print( ( TOSTRING ( TOBCD 30 - bcd 1 ), newline ) );
print( ( TOSTRING r, newline ) );
BCD r = TOBCD 99 + 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( ( IF carry OF r THEN "1" ELSE "" FI, TOSTRING r, newline ) );
print( ( newline ) );
print( ( newline ) );

⚫
# additional test cases #
# use the 2-digit BCD to add/subtract larger numbers #
PROC test add = ( INT v )VOID:
BEGIN
[ 1 : 6 ]BCD d12 :=
FOR i FROM 0 TO 20 DO
( TOBCD 1, TOBCD 23, TOBCD 45, TOBCD 67, TOBCD 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 ) )
END # test add # ;
print( ( TOSTRING d12, " + ", TOSTRING a12, " = " ) );
PROC test sub = ( INT v )VOID:
BOOL carry := FALSE;
FOR b pos FROM UPB d12 BY -1 TO LWB d12 DO
⚫
BEGIN
FOR i FROM 0 TO 20 DO
d12[ b pos ] +:= a12[ b pos ];
print( ( TOSTRING ( TOBCD( v ) - TOBCD( i ) ), " " ) )
BOOL need carry = carry OF d12[ b pos ];
OD;
IF carry THEN d12[ b pos ] +:= bcd 1 FI;
print( ( newline ) )
carry := need carry 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 ];
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</lang>
END</lang>
{{out}}
{{out}}
Line 176: Line 211:
100
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>
</pre>


Revision as of 14:51, 1 August 2022

Binary coded decimal is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

Binary-Coded Decimal (or BCD for short) is a method of representing decimal numbers by storing what appears to be a decimal number but is actually stored as hexadecimal. Many CISC CPUs (e.g. X86 Assembly have special hardware routines for displaying these kinds of numbers.) On low-level hardware, such as 7-segment displays, binary-coded decimal is very important for outputting data in a format the end user can understand.

Task

Use your language's built-in BCD functions, OR create your own conversion function, that converts an addition of hexadecimal numbers to binary-coded decimal. You should get the following results with these test cases:

  •   0x19 + 1 = 0x20
  •   0x30 - 1 = 0x29
  •   0x99 + 1 = 0x100
Bonus Points

Demonstrate the above test cases in both "packed BCD" (two digits per byte) and "unpacked BCD" (one digit per byte).



6502 Assembly

Doesn't work with: Ricoh 2A03

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.)

<lang 6502asm>sed ;set decimal flag; now all math is BCD lda #$19 clc adc #1 cld ;chances are, PrintHex won't work properly when in decimal mode. JSR PrintHex ;unimplemented print routine JSR NewLine

sed lda #$30 sec sbc #1 cld jsr PrintHex JSR NewLine

sed lda #$99 clc adc #1 pha lda #0 adc #0 ;adds the carry cld jsr PrintHex pla jsr PrintHex jsr NewLine rts ;return to basic</lang>

Output:
20
29
0100

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. <lang 68000devpac> MOVEQ #$19,D0 MOVEQ #1,D1 MOVEQ #0,D2

ABCD D1,D0 JSR PrintHex JSR NewLine

MOVEQ #$30,D0 SBCD D1,D0 JSR PrintHex JSR NewLine

MOVE.B #$99,D0 ABCD D1,D0 ;D0 has rolled over to 00 and set both the extend and carry flags. ADDX D2,D2 ;add the extend flag which was set by the above operation ;this can't use immediate operands either so we're using D2 which we set to zero at the start.

MOVE.L D0,D3 ;back up the output since PrintHex takes D0 as its argument. MOVE.L D2,D0 ;print the 01 JSR PrintHex MOVE.L D3,D0 ;then the 00 JSR PrintHex 

       jmp *</lang>
Output:
20
29
0100

ALGOL 68

Algol 68 does not have BCD as standard. This sample implements 2-digit unsigned packed decimal numbers, similar to the PL/M sample. The 2-digit numbers are then used to provide addition/subtraction of larger numbers. <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</lang>

Output:
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

ALGOL W

Translation of: ALGOL 68

<lang algolw>begin % implements BCD arithmetic for 2-digit signed packed BCD  % 

   integer X99;                                % maximum unsigned 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                %
   % 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;

   % 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__;
       asBcd( bcdResult )
   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;

   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

end.</lang>

Output:
20
29
100

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 <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+ ;

</lang>

Output:
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

J

Here, we represent hexadecimal numbers using J's constant notation, and to demonstrate bcd we generate results in that representation:

<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</lang>

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 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:

<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. ...</lang>

Julia

Handles negative and floating point numbers (but avoid BigFloats due to very long decimal places from binary to decimal conversion). <lang ruby>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)...))))")

</lang>

Output:
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))

Pascal

Free Pascal

There exist a special unit for BCD, even with fractions.Obvious for Delphi compatibility. <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.</lang>

Output:
19+1 =20
29+1 =30
99+1 =100
99*99 =9801

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.
While I supply everything in decimal, you could easily return and pass around the likes of acc and res. 

without javascript_semantics -- (not a chance!)
requires("1.0.2")   -- #ilASM{fbld, fbstp} added

function h(string s)
    -- convert the 10 bytes BCD, as held in 
    -- a binary string, to a decimal string.
    for i=length(s) to 1 by -1 do
        if s[i]!='\0' or i=1 then
            string res = sprintf("%x",s[i])
            for j=i-1 to 1 by -1 do
                res &= sprintf("%02x",s[j])
            end for
            return res
        end if
    end for
end function

procedure test(integer a, b)
    -- Some (binary) strings to hold 10 byte BCDs:
    string acc = repeat('\0',10),
           res = repeat('\0',10)
    #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)
          }
    integer pm = iff(b>=0?'+':'-')
    printf(1,"%s %c %d = %s\n",{h(acc),pm,abs(b),h(res)})
end procedure
test(19,+1)
test(30,-1)
test(99,+1)
Output:
19 + 1 = 20
30 - 1 = 29
99 + 1 = 100

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.
The aaa, aas, aam, and aad instructions are also available. Same output as above, of course 

without javascript_semantics -- (not a chance!)
requires("1.0.2")   -- #ilASM{aaa, etc} added
requires(32)        -- aaa etc not valid on 64 bit

procedure test2(integer bcd, op)
    integer res
    #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
          }
    printf(1,"%x %c 1 = %x\n",{bcd,op,res})
end procedure
test2(#19,'+')
test2(#30,'-')
test2(#99,'+')

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... 

with javascript_semantics -- (no requires() needed here)
function bcd_decode(integer bcd)
    assert(bcd>=0)
    integer res = 0, dec = 1
    while bcd do
        res += and_bits(bcd,#F)*dec
        bcd = bcd >> 4
        dec *= 10
    end while
    return res
end function

function bcd_encode(integer dec)
    assert(dec>=0)
    integer res = 0, shift = 0
    while dec do
        res += remainder(dec,10) << shift
        dec = trunc(dec/10)
        shift += 4
    end while
    return res
end function

procedure test3(integer dec, op)
    integer bcd = bcd_encode(dec),
            work = bcd, res = 0, shift = 0, 
            carry = 1
    while work or carry do
        integer digit = (work && #F)
        if op='+' then
            digit += carry
            if digit>9 then
                digit -= 10
                carry = 1
            else
                carry = 0
            end if
        else
            digit -= carry
            if digit<0 then
                digit += 10
                carry = 1
            else
                carry = 0
            end if
        end if
        res += digit<<shift
        work = work>>4
        shift += 4
    end while
    printf(1,"%d %c 1 = %d\n",{bcd_decode(bcd),op,bcd_decode(res)})
end procedure
test3(19,'+')
test3(30,'-')
test3(99,'+')

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

Translation of: Z80 Assembly

<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</lang>

Output:
20
29
0100

A more complex example, showing how the DEC function can be used to perform unsigned BCD addition and subtraction on arbitrary length BCD numbers. <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 123456789 TO THE NUMBER AND DISPLAY IT */
     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( .' + 123456789 = $' );
     A = DEC( A  +   89H );    /* THE PARAMETER TO THE DEC BUILTIN FUNCTION */
     B = DEC( B PLUS 67H );    /* MUST BE A CONSTANT OR UNSCRIPTED VARIABLE */
     C = DEC( C PLUS 45H );    /* +/-/PLUS/MINUS ANOTHER CONSTANT OR        */
     D = DEC( D PLUS 23H );    /* UNSUBSCRIPTED VARIABLE                    */
     E = DEC( E PLUS  1H );    /* ( WHICH MUST CONTAIN 2-DIGIT BCD VALUES ).*/
     F = DEC( F PLUS  0  );    /* 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;

  A, B, C, D, E, F = 099H;   /* SET THE 12 DIGIT BCD NUMBER TO 999999999999 */

  DO I = 1 TO 10;   /* REPEATEDLY SUBTRACT 987654321 AND DISPLAY THE RESULT */
     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( .' - 987654321 = $' );
     A = DEC( A   -   21H );
     B = DEC( B MINUS 43H );
     C = DEC( C MINUS 65H );
     D = DEC( D MINUS 87H );
     E = DEC( E MINUS  9H );
     F = DEC( F MINUS  0  );
     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</lang>

Output:
012345678901 + 123456789 = 012469135690
012469135690 + 123456789 = 012592592479
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

Rust

Based on the Forth implementation re: how to implement BCD arithmetic in software. Uses operator overloading for new BCD type. <lang Rust>

  1. [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;
   }

}

  1. [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);

} </lang>

Output:

For the output, use "cargo test" to run the unit test for this module. 

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

Wren

Library: Wren-check
Library: Wren-math
Library: Wren-str
Library: 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. <lang ecmascript>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()

}</lang>

Output:
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

Z80 Assembly

The DAA 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.

<lang z80> PrintChar equ &BB5A ;Amstrad CPC kernel's print routine org &1000

ld a,&19 add 1 daa call ShowHex call NewLine

ld a,&30 sub 1 daa call ShowHex call NewLine

ld a,&99 add 1 daa

this rolls over to 00 since DAA only works with the accumulator.
But the carry is set by this operation, so we can work accordingly.

jr nc,continue ;this branch is never taken, it exists to demonstrate the concept of how DAA affects the carry flag. push af ld a,1 call ShowHex pop af continue: call ShowHex call NewLine ret ;return to basic

ShowHex: push af and %11110000 rrca rrca rrca rrca call PrintHexChar pop af and %00001111 ;call PrintHexChar ;execution flows into it naturally. PrintHexChar: ;this little trick converts hexadecimal or BCD to ASCII. or a ;Clear Carry Flag daa add a,&F0 adc a,&40 jp PrintChar</lang>

Output:
20
29
0100
Retrieved from "https://rosettacode.org/wiki/Binary_coded_decimal?oldid=321777"