Binary coded decimal: Difference between revisions
Added Algol 68
(→{{header|PL/M}}: Added simple example that is as per the task.) |
(Added Algol 68) |
||
Line 82:
29
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 packed decimal numbers, similar to the [[#PL/M|PL/M]] sample though the numbers here are signed.
<lang algol68>BEGIN # implements BCD arithmetic for 2-digit signed packed BCD #
INT x99 = ( 9 * 16 ) + 9; # maximum unsigned 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 # ;
# 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 the sum of a and b, a and b can be positive or negative #
OP + = ( BCD a, b )BCD:
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 a2 = av MOD 16, b2 = bv MOD 16;
ap = bp
THEN
INT result := av + bv;
IF a2 + b2 > 9 THEN result +:= 6 FI;
IF ap THEN result ELSE - result FI
ELIF av >= bv
THEN
INT result := av - bv;
IF a2 < b2 THEN result -:= 6 FI;
IF ap THEN result ELSE - result FI
ELSE
INT result := bv - av;
IF b2 < a2 THEN result -:= 6 FI;
IF ap THEN - result ELSE result FI
FI # + # ;
# 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;
# task test cases #
BCD r;
r := TOBCD( 19 ) + TOBCD( 1 );
print( ( TOSTRING r, newline ) );
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 #
PROC test add = ( INT v )VOID:
BEGIN
FOR i FROM 0 TO 20 DO
print( ( TOSTRING ( TOBCD( v ) + TOBCD( i ) ), " " ) )
OD;
print( ( newline ) )
END # test add # ;
PROC test sub = ( INT v )VOID:
BEGIN
FOR i FROM 0 TO 20 DO
print( ( TOSTRING ( TOBCD( v ) - TOBCD( i ) ), " " ) )
OD;
print( ( newline ) )
END # test sub # ;
test add( 19 );
test add( 40 );
test add( 82 );
test add( -9 );
test sub( 99 );
test sub( 33 );
test sub( 12 )
END</lang>
{{out}}
<pre>
20
29
100
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 00 01 02
-09 -08 -07 -06 -05 -04 -03 -02 -01 00 01 02 03 04 05 06 07 08 09 10 11
99 98 97 96 95 94 93 92 91 90 89 88 87 86 85 84 83 82 81 80 79
33 32 31 30 29 28 27 26 25 24 23 22 21 20 19 18 17 16 15 14 13
12 11 10 09 08 07 06 05 04 03 02 01 00 -01 -02 -03 -04 -05 -06 -07 -08
</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
| |||