Binary coded decimal: Difference between revisions

</pre>

=={{header|ALGOL W}}==

{{Trans|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>

{{out}}

<pre>

20

29

100