Binary coded decimal: Difference between revisions

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>


Retrieved from "https://rosettacode.org/wiki/Binary_coded_decimal"