Tcl based Packed Decimal Arithmetic

During February 2002, Gerald Lester posted version 0.1 of the following code, designed to be a script level package for performing precise math against decimal numbers.

For more precision from a C based extension, check out mpexpr.

A similar Tcl-based implementation is at Arbitrary precision math procedures.


   package provide packedDecimal 0.1
   
   namespace eval packedDecimal {
       namespace export add subtract multiply divide setDecimals
   
       variable decimals 2
       variable formatString {%d.%2.2d}
       variable carry 100
   }
   
   proc packedDecimal::add {a b} {
       variable decimals
       variable formatString
   
       scan $a %d.%d a1 a2
       scan $b %d.%d b1 b2
       incr a2 $b2
       if {[string length $a2] > $decimals} then {
           incr a1 1
           set a2 [string range $a2 1 end]
       }
       incr a1 $b1
       return [format $formatString $a1 $a2]
   }
   
   proc packedDecimal::subtract {a b} {
       variable decimals
       variable formatString
       variable carry
   
       scan $a %d.%d a1 a2
       scan $b %d.%d b1 b2
       incr a2 -$b2
       if {$a2 < 0} then {
           incr b1 1
           set a2 [expr {$carry + $a2}]
       }
       incr a1 -$b1
       return [format $formatString $a1 $a2]
   }
   
   # This is not really right yet!
   proc packedDecimal::roundingRule {a b} {
       variable carry
   
       while {$b >= $carry/2} {
           incr a 1
           incr b -$carry
       }
       return [list $a $b]
   }
   
   # Does not handle negative values - DKF
   proc packedDecimal::multiply {a b} {
       variable decimals
       variable formatString
       variable carry
   
       scan $a %u.%u a1 a2
       scan $b %u.%u b1 b2
   
       set c1 [expr {$a1*$b1}]
       set c2 [expr {$a1*$b2 + $b1*$a2}]
       set c3 [expr {$a2*$b2}]
       foreach {c2 c3} [roundingRule $c2 $c3] {break}
       foreach {c1 c2} [roundingRule $c1 $c2] {break}
       if {$c2 < 0} {
           incr c1 -1
           incr c2 $carry
       }
       return [format $formatString $c1 $c2]
   }
   
   proc packedDecimal::divide {a b} {
       variable decimals
       variable formatString
   
       return -code error {Sorry, Divide is not yet implemented!}
   }
   
   proc packedDecimal::setDecimals {a} {
       variable decimals
       variable formatString
       variable carry 100
   
       set formatString [format {%%d.%%%d.%dd} $a $a]
       set decimals $a
       set carry [format "1%${a}.${a}d" 0]
       return;
   }
   
   proc packedDecimal::getDecimals {} {
       variable decimals
   
       return $decimals
   }

AM A FAQ that deals with decimal arithmetic can be found at [L1 ]. There is also a formal specification available (and an implementation in C, with a "renewable" licence) [L2 ].


beernutmark I have worked up a Decimal Arithmetic Package for tcl 8.5


Sarnold I have been doing some Decimal arithmetic with bignums.


Gerald Lester