1package require Tcl 8.5 2package provide math::decimal 1.0.3 3# 4# Copyright 2011, 2013 Mark Alston. All rights reserved. 5# 6# Redistribution and use in source and binary forms, with or 7# without modification, are permitted provided that the following 8# conditions are met: 9# 10# 1. Redistributions of source code must retain the above copyright 11# notice, this list of conditions and the following disclaimer. 12# 13# 2. Redistributions in binary form must reproduce the above copyright 14# notice, this list of conditions and the following disclaimer in 15# the documentation and/or other materials provided with the distribution. 16# 17# THIS SOFTWARE IS PROVIDED BY Mark Alston ``AS IS'' AND ANY EXPRESS 18# OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 19# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20# ARE DISCLAIMED. IN NO EVENT SHALL Mark Alston OR CONTRIBUTORS 21# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 22# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 23# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; 24# OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 25# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 26# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, 27# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28# 29# 30# decimal.tcl -- 31# 32# Tcl implementation of a General Decimal Arithmetic as defined 33# by the IEEE 754 standard as given on http:://speleotrove.com/decimal 34# 35# Decimal numbers are defined as a list of sign mantissa exponent 36# 37# The following operations are current implemented: 38# 39# fromstr tostr -- for converting to and from decimal numbers. 40# 41# add subtract divide multiply abs compare -- basic operations 42# max min plus minus copynegate copysign is-zero is-signed 43# is-NaN is-infinite is-finite 44# 45# round_half_even round_half_up round_half_down -- rounding methods 46# round_down round_up round_floor round_ceiling 47# round_05up 48# 49# By setting the extended variable to 0 you get the behavior of the decimal 50# subset arithmetic X3.274 as defined on 51# http://speleotrove.com/decimal/dax3274.html#x3274 52# 53# This package passes all tests in test suites: 54# http://speleotrove.com/decimal/dectest.html 55# and http://speleotrove.com/decimal/dectest0.html 56# 57# with the following exceptions: 58# 59# This version fails some tests that require setting the max 60# or min exponent to force truncation or rounding. 61# 62# This version fails some tests which require the sign of zero to be set 63# correctly during rounding 64# 65# This version cannot handle sNaN's (Not sure that they are of any use for 66# tcl programmers anyway. 67# 68# If you find errors in this code please let me know at 69# mark at beernut dot com 70# 71# Decimal -- 72# Namespace for the decimal arithmetic procedures 73# 74namespace eval ::math::decimal { 75 variable precision 20 76 variable maxExponent 999 77 variable minExponent -998 78 variable tinyExponent [expr {$minExponent - ($precision - 1)}] 79 variable rounding half_up 80 variable extended 1 81 82 # Some useful variables to set. 83 variable zero [list 0 0 0] 84 variable one [list 0 1 0] 85 variable ten [list 0 1 1] 86 variable onehundred [list 0 1 2] 87 variable minusone [list 1 1 0] 88 89 namespace export tostr fromstr setVariable getVariable\ 90 add + subtract - divide / multiply * \ 91 divide-int remainder \ 92 fma fused-multiply-add \ 93 plus minus copynegate negate copysign \ 94 abs compare max min \ 95 is-zero is-signed is-NaN is-infinite is-finite \ 96 round_half_even round_half_up round_half_down \ 97 round_down round_up round_floor round_ceiling round_05up 98 99} 100 101# setVariable 102# Set the desired variable 103# 104# Arguments: 105# variable setting 106# 107# Result: 108# None 109# 110proc ::math::decimal::setVariable {variable setting} { 111 variable rounding 112 variable precision 113 variable extended 114 variable maxExponent 115 variable minExponent 116 variable tinyExponent 117 118 switch -nocase -- $variable { 119 rounding {set rounding $setting} 120 precision {set precision $setting} 121 extended {set extended $setting} 122 maxExponent {set maxExponent $setting} 123 minExponent { 124 set minExponent $setting 125 set tinyExponent [expr {$minExponent - ($precision - 1)}] 126 } 127 default {} 128 } 129} 130 131# setVariable 132# Set the desired variable 133# 134# Arguments: 135# variable setting 136# 137# Result: 138# None 139# 140proc ::math::decimal::getVariable {variable} { 141 variable rounding 142 variable precision 143 variable extended 144 variable maxExponent 145 variable minExponent 146 147 switch -- $variable { 148 rounding {return $rounding} 149 precision {return $precision} 150 extended {return $extended} 151 maxExponent {return $maxExponent} 152 minExponent {return $minExponent} 153 default {} 154 } 155} 156 157# add or + 158# Add two numbers 159# 160# Arguments: 161# a First operand 162# b Second operand 163# 164# Result: 165# Sum of both (rescaled) 166# 167proc ::math::decimal::add {a b {rescale 1}} { 168 return [+ $a $b $rescale] 169} 170 171proc ::math::decimal::+ {a b {rescale 1}} { 172 variable extended 173 variable rounding 174 foreach {sa ma ea} $a {break} 175 foreach {sb mb eb} $b {break} 176 177 if {!$extended} { 178 if {$ma == 0 } { 179 return $b 180 } 181 if {$mb == 0 } { 182 return $a 183 } 184 } 185 186 if { $ma eq "NaN" || $mb eq "NaN" } { 187 return [list 0 "NaN" 0] 188 } 189 190 if { $ma eq "Inf" || $mb eq "Inf" } { 191 if { $ma ne "Inf" } { 192 return $b 193 } elseif { $mb ne "Inf" } { 194 return $a 195 } elseif { $sb != $sa } { 196 return [list 0 "NaN" 0] 197 } else { 198 return $a 199 } 200 } 201 202 if { $ea > $eb } { 203 set ma [expr {$ma * 10 ** ($ea-$eb)}] 204 set er $eb 205 } else { 206 set mb [expr {$mb * 10 ** ($eb-$ea)}] 207 set er $ea 208 } 209 if { $sa == $sb } { 210 # Both are either postive or negative 211 # Sign remains the same. 212 set mr [expr {$ma + $mb}] 213 set sr $sa 214 } else { 215 # one is negative and one is positive. 216 # Set sign to the same as the larger number 217 # and subract the smaller from the larger. 218 if { $ma > $mb } { 219 set sr $sa 220 set mr [expr {$ma - $mb}] 221 } elseif { $mb > $ma } { 222 set sr $sb 223 set mr [expr {$mb - $ma}] 224 } else { 225 if { $rounding == "floor" } { 226 set sr 1 227 } else { 228 set sr 0 229 } 230 set mr 0 231 } 232 } 233 if { $rescale } { 234 return [Rescale [list $sr $mr $er]] 235 } else { 236 return [list $sr $mr $er] 237 } 238} 239 240# copynegate -- 241# Takes one operand and returns a copy with the sign inverted. 242# In this implementation it works nearly the same as minus 243# but is probably much faster. The main difference is that no 244# rescaling is done. 245# 246# 247# Arguments: 248# a operand 249# 250# Result: 251# a with sign flipped 252# 253proc ::math::decimal::negate { a } { 254 return [copynegate $a] 255} 256 257proc ::math::decimal::copynegate { a } { 258 lset a 0 [expr {![lindex $a 0]}] 259 return $a 260} 261 262# copysign -- 263# Takes two operands and returns a copy of the first with the 264# sign set to the sign of the second. 265# 266# 267# Arguments: 268# a operand 269# b operand 270# 271# Result: 272# b with a's sign 273# 274proc ::math::decimal::copysign { a b } { 275 lset a 0 [lindex $b 0] 276 return $a 277} 278 279# minus -- 280# subtract 0 $a 281# 282# Note: does not pass all tests on extended mode. 283# 284# Arguments: 285# a operand 286# 287# Result: 288# 0 - $a 289# 290proc ::math::decimal::minus { a } { 291 return [- [list 0 0 0] $a] 292} 293 294# plus -- 295# add 0 $a 296# 297# Note: does not pass all tests on extended mode. 298# 299# Arguments: 300# a operand 301# 302# Result: 303# 0 + $a 304# 305proc ::math::decimal::plus {a} { 306 return [+ [list 0 0 0] $a] 307} 308 309 310 311# subtract or - 312# Subtract two numbers (or unary minus) 313# 314# Arguments: 315# a First operand 316# b Second operand (optional) 317# 318# Result: 319# Sum of both (rescaled) 320# 321proc ::math::decimal::subtract {a {b {}} {rescale 1}} { 322 return [- $a $b] 323} 324 325proc ::math::decimal::- {a {b {}} {rescale 1}} { 326 variable extended 327 328 if {!$extended} { 329 foreach {sa ma ea} $a {break} 330 foreach {sb mb eb} $b {break} 331 if {$ma == 0 } { 332 lset b 0 [expr {![lindex $b 0]}] 333 return $b 334 } 335 if {$mb == 0 } { 336 return $a 337 } 338 } 339 340 if { $b == {} } { 341 lset a 0 [expr {![lindex $a 0]}] 342 return $a 343 } else { 344 lset b 0 [expr {![lindex $b 0]}] 345 return [+ $a $b $rescale] 346 } 347} 348 349 350# compare 351# Compare two numbers. 352# 353# Arguments: 354# a First operand 355# b Second operand 356# 357# Result: 358# 1 if a is larger than b 359# 0 if a is equal to b 360# -1 if a is smaller than b. 361# 362proc ::math::decimal::compare {a b} { 363 foreach {sa ma ea} $a {break} 364 foreach {sb mb eb} $b {break} 365 366 if { $sa != $sb } { 367 if {$ma != 0 } { 368 set ma 1 369 set ea 0 370 } elseif { $mb != 0 } { 371 set mb 1 372 set eb 0 373 } else { 374 return 0 375 } 376 } 377 if { $ma eq "Inf" && $mb eq "Inf" } { 378 if { $sa == $sb } { 379 return 0 380 } elseif { $sa > $sb } { 381 return -1 382 } else { 383 return 1 384 } 385 } 386 387 set comparison [- [list $sa $ma $ea] [list $sb $mb $eb] 0] 388 389 if { [lindex $comparison 0] && [lindex $comparison 1] != 0 } { 390 return -1 391 } elseif { [lindex $comparison 1] == 0 } { 392 return 0 393 } else { 394 return 1 395 } 396} 397 398# min 399# Return the smaller of two numbers 400# 401# Arguments: 402# a First operand 403# b Second operand 404# 405# Result: 406# smaller of a or b 407# 408proc ::math::decimal::min {a b} { 409 foreach {sa ma ea} $a {break} 410 foreach {sb mb eb} $b {break} 411 412 if { $sa != $sb } { 413 if {$ma != 0 } { 414 set ma 1 415 set ea 0 416 } elseif { $mb != 0 } { 417 set mb 1 418 set eb 0 419 } 420 } 421 if { $ma eq "Inf" && $mb eq "Inf" } { 422 if { $sa == $sb } { 423 return [list $sa "Inf" 0] 424 } else { 425 return [list 1 "Inf" 0] 426 } 427 } 428 429 set comparison [compare [list $sa $ma $ea] [list $sb $mb $eb]] 430 431 if { $comparison == 1 } { 432 return [Rescale $b] 433 } elseif { $comparison == -1 } { 434 return [Rescale $a] 435 } elseif { $sb != $sa } { 436 if { $sa } { 437 return [Rescale $a] 438 } else { 439 return [Rescale $b] 440 } 441 } elseif { $sb && $eb > $ea } { 442 # Both are negative and the same numerically. So return the one with the largest exponent. 443 return [Rescale $b] 444 } elseif { $sb } { 445 # Negative with $eb < $ea now. 446 return [Rescale $a] 447 } elseif { $ea > $eb } { 448 # Both are positive so return the one with the smaller 449 return [Rescale $b] 450 } else { 451 return [Rescale $a] 452 } 453} 454 455# max 456# Return the larger of two numbers 457# 458# Arguments: 459# a First operand 460# b Second operand 461# 462# Result: 463# larger of a or b 464# 465proc ::math::decimal::max {a b} { 466 foreach {sa ma ea} $a {break} 467 foreach {sb mb eb} $b {break} 468 469 if { $sa != $sb } { 470 if {$ma != 0 } { 471 set ma 1 472 set ea 0 473 } elseif { $mb != 0 } { 474 set mb 1 475 set eb 0 476 } 477 } 478 if { $ma eq "Inf" && $mb eq "Inf" } { 479 if { $sa == $sb } { 480 return [list $sa "Inf" 0] 481 } else { 482 return [list 0 "Inf" 0] 483 } 484 } 485 486 set comparison [compare [list $sa $ma $ea] [list $sb $mb $eb]] 487 488 if { $comparison == 1 } { 489 return [Rescale $a] 490 } elseif { $comparison == -1 } { 491 return [Rescale $b] 492 } elseif { $sb != $sa } { 493 if { $sa } { 494 return [Rescale $b] 495 } else { 496 return [Rescale $a] 497 } 498 } elseif { $sb && $eb > $ea } { 499 # Both are negative and the same numerically. So return the one with the smallest exponent. 500 return [Rescale $a] 501 } elseif { $sb } { 502 # Negative with $eb < $ea now. 503 return [Rescale $b] 504 } elseif { $ea > $eb } { 505 # Both are positive so return the one with the larger exponent 506 return [Rescale $a] 507 } else { 508 return [Rescale $b] 509 } 510} 511 512# maxmag -- max-magnitude 513# Return the larger of two numbers ignoring their signs. 514# 515# Arguments: 516# a First operand 517# b Second operand 518# 519# Result: 520# larger of a or b ignoring their signs. 521# 522proc ::math::decimal::maxmag {a b} { 523 foreach {sa ma ea} $a {break} 524 foreach {sb mb eb} $b {break} 525 526 527 if { $ma eq "Inf" && $mb eq "Inf" } { 528 if { $sa == 0 || $sb == 0 } { 529 return [list 0 "Inf" 0] 530 } else { 531 return [list 1 "Inf" 0] 532 } 533 } 534 535 set comparison [compare [list 0 $ma $ea] [list 0 $mb $eb]] 536 537 if { $comparison == 1 } { 538 return [Rescale $a] 539 } elseif { $comparison == -1 } { 540 return [Rescale $b] 541 } elseif { $sb != $sa } { 542 if { $sa } { 543 return [Rescale $b] 544 } else { 545 return [Rescale $a] 546 } 547 } elseif { $sb && $eb > $ea } { 548 # Both are negative and the same numerically. So return the one with the smallest exponent. 549 return [Rescale $a] 550 } elseif { $sb } { 551 # Negative with $eb < $ea now. 552 return [Rescale $b] 553 } elseif { $ea > $eb } { 554 # Both are positive so return the one with the larger exponent 555 return [Rescale $a] 556 } else { 557 return [Rescale $b] 558 } 559} 560 561# minmag -- min-magnitude 562# Return the smaller of two numbers ignoring their signs. 563# 564# Arguments: 565# a First operand 566# b Second operand 567# 568# Result: 569# smaller of a or b ignoring their signs. 570# 571proc ::math::decimal::minmag {a b} { 572 foreach {sa ma ea} $a {break} 573 foreach {sb mb eb} $b {break} 574 575 if { $ma eq "Inf" && $mb eq "Inf" } { 576 if { $sa == 1 || $sb == 1 } { 577 return [list 1 "Inf" 0] 578 } else { 579 return [list 0 "Inf" 0] 580 } 581 } 582 583 set comparison [compare [list 0 $ma $ea] [list 0 $mb $eb]] 584 585 if { $comparison == 1 } { 586 return [Rescale $b] 587 } elseif { $comparison == -1 } { 588 return [Rescale $a] 589 } else { 590 # They compared the same so now we use a normal comparison including the signs. This is per the specs. 591 if { $sa > $sb } { 592 return [Rescale $a] 593 } elseif { $sb > $sa } { 594 return [Rescale $b] 595 } elseif { $sb && $eb > $ea } { 596 # Both are negative and the same numerically. So return the one with the largest exponent. 597 return [Rescale $b] 598 } elseif { $sb } { 599 # Negative with $eb < $ea now. 600 return [Rescale $a] 601 } elseif { $ea > $eb } { 602 return [Rescale $b] 603 } else { 604 return [Rescale $a] 605 } 606 } 607} 608 609# fma - fused-multiply-add 610# Takes three operands. Multiplies the first two and then adds the third. 611# Only one rounding (Rescaling) takes place at the end instead of after 612# both the multiplication and again after the addition. 613# 614# Arguments: 615# a First operand 616# b Second operand 617# c Third operand 618# 619# Result: 620# (a*b)+c 621# 622proc ::math::decimal::fused-multiply-add {a b c} { 623 return [fma $a $b $c] 624} 625 626proc ::math::decimal::fma {a b c} { 627 return [+ $c [* $a $b 0]] 628} 629 630# multiply or * 631# Multiply two numbers 632# 633# Arguments: 634# a First operand 635# b Second operand 636# 637# Result: 638# Product of both (rescaled) 639# 640proc ::math::decimal::multiply {a b {rescale 1}} { 641 return [* $a $b $rescale] 642} 643 644proc ::math::decimal::* {a b {rescale 1}} { 645 foreach {sa ma ea} $a {break} 646 foreach {sb mb eb} $b {break} 647 648 if { $ma eq "NaN" || $mb eq "NaN" } { 649 return [list 0 "NaN" 0] 650 } 651 652 set sr [expr {$sa^$sb}] 653 654 if { $ma eq "Inf" || $mb eq "Inf" } { 655 if { $ma == 0 || $mb == 0 } { 656 return [list 0 "NaN" 0] 657 } else { 658 return [list $sr "Inf" 0] 659 } 660 } 661 662 set mr [expr {$ma * $mb}] 663 set er [expr {$ea + $eb}] 664 665 666 if { $rescale } { 667 return [Rescale [list $sr $mr $er]] 668 } else { 669 return [list $sr $mr $er] 670 } 671} 672 673# divide or / 674# Divide two numbers 675# 676# Arguments: 677# a First operand 678# b Second operand 679# 680# Result: 681# Quotient of both (rescaled) 682# 683proc ::math::decimal::divide {a b {rescale 1}} { 684 return [/ $a $b] 685} 686 687proc ::math::decimal::/ {a b {rescale 1}} { 688 variable precision 689 690 foreach {sa ma ea} $a {break} 691 foreach {sb mb eb} $b {break} 692 693 if { $ma eq "NaN" || $mb eq "NaN" } { 694 return [list 0 "NaN" 0] 695 } 696 697 set sr [expr {$sa^$sb}] 698 699 if { $ma eq "Inf" } { 700 if { $mb ne "Inf"} { 701 return [list $sr "Inf" 0] 702 } else { 703 return [list 0 "NaN" 0] 704 } 705 } 706 707 if { $mb eq "Inf" } { 708 if { $ma ne "Inf"} { 709 return [list $sr 0 0] 710 } else { 711 return [list 0 "NaN" 0] 712 } 713 } 714 715 if { $mb == 0 } { 716 if { $ma == 0 } { 717 return [list 0 "NaN" 0] 718 } else { 719 return [list $sr "Inf" 0] 720 } 721 } 722 set adjust 0 723 set mr 0 724 725 726 if { $ma == 0 } { 727 set er [expr {$ea - $eb}] 728 return [list $sr 0 $er] 729 } 730 if { $ma < $mb } { 731 while { $ma < $mb } { 732 set ma [expr {$ma * 10}] 733 incr adjust 734 } 735 } elseif { $ma >= $mb * 10 } { 736 while { $ma >= [expr {$mb * 10}] } { 737 set mb [expr {$mb * 10}] 738 incr adjust -1 739 } 740 } 741 742 while { 1 } { 743 while { $mb <= $ma } { 744 set ma [expr {$ma - $mb}] 745 incr mr 746 } 747 if { ( $ma == 0 && $adjust >= 0 ) || [string length $mr] > $precision + 1 } { 748 break 749 } else { 750 set ma [expr {$ma * 10}] 751 set mr [expr {$mr * 10}] 752 incr adjust 753 } 754 } 755 756 set er [expr {$ea - ($eb + $adjust)}] 757 758 if { $rescale } { 759 return [Rescale [list $sr $mr $er]] 760 } else { 761 return [list $sr $mr $er] 762 } 763} 764 765# divideint -- Divide integer 766# Divide a by b and return the integer part of the division. 767# 768# Basically, if we send a and b to the divideint (which returns i) 769# and remainder function (which returns r) then the following is true: 770# a = i*b + r 771# 772# Arguments: 773# a First operand 774# b Second operand 775# 776# 777proc ::math::decimal::divideint { a b } { 778 foreach {sa ma ea} $a {break} 779 foreach {sb mb eb} $b {break} 780 set sr [expr {$sa^$sb}] 781 782 783 784 if { $sr == 1 } { 785 set sign_string "-" 786 } else { 787 set sign_string "" 788 } 789 790 if { ($ma eq "NaN" || $mb eq "NaN") || ($ma == 0 && $mb == 0 ) } { 791 return "NaN" 792 } 793 794 if { $ma eq "Inf" || $mb eq "Inf" } { 795 if { $ma eq $mb } { 796 return "NaN" 797 } elseif { $mb eq "Inf" } { 798 return "${sign_string}0" 799 } else { 800 return "${sign_string}Inf" 801 } 802 } 803 804 if { $mb == 0 } { 805 return "${sign_string}Inf" 806 } 807 if { $mb == "Inf" } { 808 return "${sign_string}0" 809 } 810 set adjust [expr {abs($ea - $eb)}] 811 if { $ea < $eb } { 812 set a_adjust 0 813 set b_adjust $adjust 814 } elseif { $ea > $eb } { 815 set b_adjust 0 816 set a_adjust $adjust 817 } else { 818 set a_adjust 0 819 set b_adjust 0 820 } 821 822 set integer [expr {($ma*10**$a_adjust)/($mb*10**$b_adjust)}] 823 return $sign_string$integer 824} 825 826# remainder -- Remainder from integer division. 827# Divide a by b and return the remainder part of the division. 828# 829# Basically, if we send a and b to the divideint (which returns i) 830# and remainder function (which returns r) then the following is true: 831# a = i*b + r 832# 833# Arguments: 834# a First operand 835# b Second operand 836# 837# 838proc ::math::decimal::remainder { a b } { 839 foreach {sa ma ea} $a {break} 840 foreach {sb mb eb} $b {break} 841 842 if { $sa == 1 } { 843 set sign_string "-" 844 } else { 845 set sign_string "" 846 } 847 848 if { ($ma eq "NaN" || $mb eq "NaN") || ($ma == 0 && $mb == 0 ) } { 849 if { $mb eq "NaN" && $mb ne $ma } { 850 if { $sb == 1 } { 851 set sign_string "-" 852 } else { 853 set sign_string "" 854 } 855 return "${sign_string}NaN" 856 } elseif { $ma eq "NaN" } { 857 return "${sign_string}NaN" 858 } else { 859 return "NaN" 860 } 861 } elseif { $mb == 0 } { 862 return "NaN" 863 } 864 865 if { $ma eq "Inf" || $mb eq "Inf" } { 866 if { $ma eq $mb } { 867 return "NaN" 868 } elseif { $mb eq "Inf" } { 869 return [tostr $a] 870 } else { 871 return "NaN" 872 } 873 } 874 875 if { $mb == 0 } { 876 return "${sign_string}Inf" 877 } 878 if { $mb == "Inf" } { 879 return "${sign_string}0" 880 } 881 882 lset a 0 0 883 lset b 0 0 884 if { $mb == 0 } { 885 return "${sign_string}Inf" 886 } 887 if { $mb == "Inf" } { 888 return "${sign_string}0" 889 } 890 891 set adjust [expr {abs($ea - $eb)}] 892 if { $ea < $eb } { 893 set a_adjust 0 894 set b_adjust $adjust 895 } elseif { $ea > $eb } { 896 set b_adjust 0 897 set a_adjust $adjust 898 } else { 899 set a_adjust 0 900 set b_adjust 0 901 } 902 903 set integer [expr {($ma*10**$a_adjust)/($mb*10**$b_adjust)}] 904 905 set remainder [tostr [- $a [* [fromstr $integer] $b 0]]] 906 return $sign_string$remainder 907} 908 909 910# abs -- 911# Returns the Absolute Value of a number 912# 913# Arguments: 914# Number in the form of {sign mantisse exponent} 915# 916# Result: 917# Absolute value (as a list) 918# 919 proc ::math::decimal::abs {a} { 920 lset a 0 0 921 return [Rescale $a] 922 } 923 924 925# Rescale -- 926# Rescale the number (using proper rounding) 927# 928# Arguments: 929# a Number in decimal format 930# 931# Result: 932# Rescaled number 933# 934proc ::math::decimal::Rescale { a } { 935 936 937 938 variable precision 939 variable rounding 940 variable maxExponent 941 variable minExponent 942 variable tinyExponent 943 944 foreach {sign mantisse exponent} $a {break} 945 946 set man_length [string length $mantisse] 947 948 set adjusted_exponent [expr {$exponent + ($man_length -1)}] 949 950 if { $adjusted_exponent < $tinyExponent } { 951 set mantisse [lindex [round_$rounding [list $sign $mantisse [expr {abs($tinyExponent) - abs($adjusted_exponent)}]] 0] 1] 952 return [list $sign $mantisse $tinyExponent] 953 } elseif { $adjusted_exponent > $maxExponent } { 954 if { $mantisse == 0 } { 955 return [list $sign 0 $maxExponent] 956 } else { 957 switch -- $rounding { 958 half_even - 959 half_up { return [list $sign "Inf" 0] } 960 down - 961 05up { 962 return [list $sign [string repeat 9 $precision] $maxExponent] 963 } 964 ceiling { 965 if { $sign } { 966 return [list $sign [string repeat 9 $precision] $maxExponent] 967 } else { 968 return [list 0 "Inf" 0] 969 } 970 } 971 floor { 972 if { !$sign } { 973 return [list $sign [string repeat 9 $precision] $maxExponent] 974 } else { 975 return [list 1 "Inf" 0] 976 } 977 } 978 default { } 979 } 980 } 981 } 982 983 if { $man_length <= $precision } { 984 return [list $sign $mantisse $exponent] 985 } 986 987 set mantisse [lindex [round_$rounding [list $sign $mantisse [expr {$precision - $man_length}]] 0] 1] 988 set exponent [expr {$exponent + ($man_length - $precision)}] 989 990 # it is possible now that our rounding gave us a new digit in our mantisse 991 # example rounding 999.9 to 1 digits with precision 3 will give us 992 # 1000 back. 993 # This can only happen by adding a zero on the end of our mantisse however. 994 # So we just chomp it off. 995 996 set man_length_now [string length $mantisse] 997 if { $man_length_now > $precision } { 998 set mantisse [string range $mantisse 0 end-1] 999 incr exponent 1000 # Check again to see if we have overflowed 1001 # we change our test to >= because we have incremented exponent. 1002 if { $adjusted_exponent >= $maxExponent } { 1003 switch -- $rounding { 1004 half_even - 1005 half_up { return [list $sign "Inf" 0] } 1006 down - 1007 05up { 1008 return [list $sign [string repeat 9 $precision] $maxExponent] 1009 } 1010 ceiling { 1011 if { $sign } { 1012 return [list $sign [string repeat 9 $precision] $maxExponent] 1013 } else { 1014 return [list 0 "Inf" 0] 1015 } 1016 } 1017 floor { 1018 if { !$sign } { 1019 return [list $sign [string repeat 9 $precision] $maxExponent] 1020 } else { 1021 return [list 1 "Inf" 0] 1022 } 1023 } 1024 default { } 1025 } 1026 } 1027 } 1028 return [list $sign $mantisse $exponent] 1029} 1030 1031# tostr -- 1032# Convert number to string using appropriate method depending on extended 1033# attribute setting. 1034# 1035# Arguments: 1036# number Number to be converted 1037# 1038# Result: 1039# Number in the form of a string 1040# 1041proc ::math::decimal::tostr { number } { 1042 variable extended 1043 switch -- $extended { 1044 0 { return [tostr_numeric $number] } 1045 1 { return [tostr_scientific $number] } 1046 } 1047} 1048 1049# tostr_scientific -- 1050# Convert number to string using scientific notation as called for in 1051# Decmath specifications. 1052# 1053# Arguments: 1054# number Number to be converted 1055# 1056# Result: 1057# Number in the form of a string 1058# 1059proc ::math::decimal::tostr_scientific {number} { 1060 foreach {sign mantisse exponent} $number {break} 1061 1062 if { $sign } { 1063 set sign_string "-" 1064 } else { 1065 set sign_string "" 1066 } 1067 1068 if { $mantisse eq "NaN" } { 1069 return "NaN" 1070 } 1071 if { $mantisse eq "Inf" } { 1072 return ${sign_string}${mantisse} 1073 } 1074 1075 1076 set digits [string length $mantisse] 1077 set adjusted_exponent [expr {$exponent + $digits - 1}] 1078 1079 # Why -6? Go read the specs on the website mentioned in the header. 1080 # They choose it, I'm using it. They actually list some good reasons though. 1081 if { $exponent <= 0 && $adjusted_exponent >= -6 } { 1082 if { $exponent == 0 } { 1083 set string $mantisse 1084 } else { 1085 set exponent [expr {abs($exponent)}] 1086 if { $digits > $exponent } { 1087 set string [string range $mantisse 0 [expr {$digits-$exponent-1}]].[string range $mantisse [expr {$digits-$exponent}] end] 1088 set exponent [expr {-$exponent}] 1089 } else { 1090 set string 0.[string repeat 0 [expr {$exponent-$digits}]]$mantisse 1091 } 1092 } 1093 } elseif { $exponent <= 0 && $adjusted_exponent < -6 } { 1094 if { $digits > 1 } { 1095 1096 set string [string range $mantisse 0 0].[string range $mantisse 1 end] 1097 1098 set exponent [expr {$exponent + $digits - 1}] 1099 set string "${string}E${exponent}" 1100 } else { 1101 set string "${mantisse}E${exponent}" 1102 } 1103 } else { 1104 if { $adjusted_exponent >= 0 } { 1105 set adjusted_exponent "+$adjusted_exponent" 1106 } 1107 if { $digits > 1 } { 1108 set string "[string range $mantisse 0 0].[string range $mantisse 1 end]E$adjusted_exponent" 1109 } else { 1110 set string "${mantisse}E$adjusted_exponent" 1111 } 1112 } 1113 return $sign_string$string 1114} 1115 1116# tostr_numeric -- 1117# Convert number to string using the simplified number set conversion 1118# from the X3.274 subset of Decimal Arithmetic specifications. 1119# 1120# Arguments: 1121# number Number to be converted 1122# 1123# Result: 1124# Number in the form of a string 1125# 1126proc ::math::decimal::tostr_numeric {number} { 1127 variable precision 1128 foreach {sign mantisse exponent} $number {break} 1129 1130 if { $sign } { 1131 set sign_string "-" 1132 } else { 1133 set sign_string "" 1134 } 1135 1136 if { $mantisse eq "NaN" } { 1137 return "NaN" 1138 } 1139 if { $mantisse eq "Inf" } { 1140 return ${sign_string}${mantisse} 1141 } 1142 1143 set digits [string length $mantisse] 1144 set adjusted_exponent [expr {$exponent + $digits - 1}] 1145 1146 if { $mantisse == 0 } { 1147 set string 0 1148 set sign_string "" 1149 } elseif { $exponent <= 0 && $adjusted_exponent >= -6 } { 1150 if { $exponent == 0 } { 1151 set string $mantisse 1152 } else { 1153 set exponent [expr {abs($exponent)}] 1154 if { $digits > $exponent } { 1155 set string [string range $mantisse 0 [expr {$digits-$exponent-1}]] 1156 set decimal_part [string range $mantisse [expr {$digits-$exponent}] end] 1157 set string ${string}.${decimal_part} 1158 set exponent [expr {-$exponent}] 1159 } else { 1160 set string 0.[string repeat 0 [expr {$exponent-$digits}]]$mantisse 1161 } 1162 } 1163 } elseif { $exponent <= 0 && $adjusted_exponent < -6 } { 1164 if { $digits > 1 } { 1165 set string [string range $mantisse 0 0].[string range $mantisse 1 end] 1166 set exponent [expr {$exponent + $digits - 1}] 1167 set string "${string}E${exponent}" 1168 } else { 1169 set string "${mantisse}E${exponent}" 1170 } 1171 } else { 1172 if { $adjusted_exponent >= 0 } { 1173 set adjusted_exponent "+$adjusted_exponent" 1174 } 1175 if { $digits > 1 && $adjusted_exponent >= $precision } { 1176 set string "[string range $mantisse 0 0].[string range $mantisse 1 end]E$adjusted_exponent" 1177 } elseif { $digits + $exponent <= $precision } { 1178 set string ${mantisse}[string repeat 0 [expr {$exponent}]] 1179 } else { 1180 set string "${mantisse}E$adjusted_exponent" 1181 } 1182 } 1183 return $sign_string$string 1184} 1185 1186# fromstr -- 1187# Convert string to number 1188# 1189# Arguments: 1190# string String to be converted 1191# 1192# Result: 1193# Number in the form of {sign mantisse exponent} 1194# 1195proc ::math::decimal::fromstr {string} { 1196 variable extended 1197 1198 set string [string trim $string "'\""] 1199 1200 if { [string range $string 0 0] == "-" } { 1201 set sign 1 1202 set string [string trimleft $string -] 1203 incr pos -1 1204 } else { 1205 set sign 0 1206 } 1207 1208 if { $string eq "Inf" || $string eq "NaN" } { 1209 if {!$extended} { 1210 # we don't allow these strings in the subset arithmetic. 1211 # throw error. 1212 error "Infinities and NaN's not allowed in simplified decimal arithmetic" 1213 } else { 1214 return [list $sign $string 0] 1215 } 1216 } 1217 1218 set string [string trimleft $string "+-"] 1219 set echeck [string first "E" [string toupper $string]] 1220 set epart 0 1221 if { $echeck >= 0 } { 1222 set epart [string range $string [expr {$echeck+1}] end] 1223 set string [string range $string 0 [expr {$echeck -1}]] 1224 } 1225 1226 set pos [string first . $string] 1227 1228 if { $pos < 0 } { 1229 if { $string == 0 } { 1230 set mantisse 0 1231 if { !$extended } { 1232 set sign 0 1233 } 1234 } else { 1235 set mantisse $string 1236 } 1237 set exponent 0 1238 } else { 1239 if { $string == "" } { 1240 return [list 0 0 0] 1241 } else { 1242 #stripping the leading zeros here is required to avoid some octal issues. 1243 #However, it causes us to fail some tests with numbers like 0.00 and 0.0 1244 #which test differently but we can't deal with now. 1245 set mantisse [string trimleft [string map {. ""} $string] 0] 1246 if { $mantisse == "" } { 1247 set mantisse 0 1248 if {!$extended} { 1249 set sign 0 1250 } 1251 } 1252 set fraction [string range $string [expr {$pos+1}] end] 1253 set exponent [expr {-[string length $fraction]}] 1254 } 1255 } 1256 set exponent [expr {$exponent + $epart}] 1257 1258 if { $extended } { 1259 return [list $sign $mantisse $exponent] 1260 } else { 1261 return [Rescale [list $sign $mantisse $exponent]] 1262 } 1263} 1264 1265# ipart -- 1266# Return the integer part of a Decimal Number 1267# 1268# Arguments: 1269# Number in the form of {sign mantisse exponent} 1270# 1271# 1272# Result: 1273# Integer 1274# 1275proc ::math::decimal::ipart { a } { 1276 1277 foreach {sa ma ea} $a {break} 1278 1279 if { $ea == 0 } { 1280 if { $sa } { 1281 return -$ma 1282 } else { 1283 return $ma 1284 } 1285 } elseif { $ea > 0 } { 1286 if { $sa } { 1287 return [expr {-1 * $ma * 10**$ea}] 1288 } else { 1289 return [expr {$ma * 10**$ea}] 1290 } 1291 } else { 1292 if { [string length $ma] <= abs($ea) } { 1293 return 0 1294 } else { 1295 if { $sa } { 1296 set string_sign "-" 1297 } else { 1298 set string_sign "" 1299 } 1300 set ea [expr {abs($ea)}] 1301 return "${string_sign}[string range $ma 0 end-$ea]" 1302 } 1303 } 1304} 1305 1306# round_05_up -- 1307# Round zero or five away from 0. 1308# The same as round-up, except that rounding up only occurs 1309# if the digit to be rounded up is 0 or 5, and after overflow 1310# the result is the same as for round-down. 1311# 1312# Bias: away from zero 1313# 1314# Arguments: 1315# Number in the form of {sign mantisse exponent} 1316# Number of decimal points to round to. 1317# 1318# Result: 1319# Number in the form of {sign mantisse exponent} 1320# 1321proc ::math::decimal::round_05up {a digits} { 1322 foreach {sa ma ea} $a {break} 1323 1324 if { -$ea== $digits } { 1325 return $a 1326 } elseif { $digits + $ea > 0 } { 1327 set mantissa [expr { $ma * 10**($digits+$ea) }] 1328 set exponent [expr {-1 * $digits}] 1329 } else { 1330 set round_exponent [expr {$digits + $ea}] 1331 if { [string length $ma] <= $round_exponent } { 1332 if { $ma != 0 } { 1333 set mantissa 1 1334 } else { 1335 set mantissa 0 1336 } 1337 set exponent 0 1338 } else { 1339 set integer_part [ipart [list 0 $ma $round_exponent]] 1340 1341 if { [compare [list 0 $ma $round_exponent] [list 0 ${integer_part}0 -1]] == 0 } { 1342 # We are rounding something with fractional part .0 1343 set mantissa $integer_part 1344 } elseif { [string index $integer_part end] eq 0 || [string index $integer_part end] eq 5 } { 1345 set mantissa [expr {$integer_part + 1}] 1346 } else { 1347 set mantissa $integer_part 1348 } 1349 set exponent [expr {-1 * $digits}] 1350 } 1351 } 1352 return [list $sa $mantissa $exponent] 1353} 1354 1355# round_half_up -- 1356# 1357# Round to the nearest. If equidistant, round up. 1358# 1359# 1360# Bias: away from zero 1361# 1362# Arguments: 1363# Number in the form of {sign mantisse exponent} 1364# Number of decimal points to round to. 1365# 1366# Result: 1367# Number in the form of {sign mantisse exponent} 1368# 1369proc ::math::decimal::round_half_up {a digits} { 1370 foreach {sa ma ea} $a {break} 1371 1372 if { $digits + $ea == 0 } { 1373 return $a 1374 } elseif { $digits + $ea > 0 } { 1375 set mantissa [expr {$ma *10 **($digits+$ea)}] 1376 } else { 1377 set round_exponent [expr {$digits + $ea}] 1378 set integer_part [ipart [list 0 $ma $round_exponent]] 1379 1380 switch -- [compare [list 0 $ma $round_exponent] [list 0 ${integer_part}5 -1]] { 1381 0 { 1382 # We are rounding something with fractional part .5 1383 set mantissa [expr {$integer_part + 1}] 1384 } 1385 -1 { 1386 set mantissa $integer_part 1387 } 1388 1 { 1389 set mantissa [expr {$integer_part + 1}] 1390 } 1391 1392 } 1393 } 1394 set exponent [expr {-1 * $digits}] 1395 return [list $sa $mantissa $exponent] 1396} 1397 1398# round_half_even -- 1399# Round to the nearest. If equidistant, round so the final digit is even. 1400# Bias: none 1401# 1402# Arguments: 1403# Number in the form of {sign mantisse exponent} 1404# Number of decimal points to round to. 1405# 1406# Result: 1407# Number in the form of {sign mantisse exponent} 1408# 1409proc ::math::decimal::round_half_even {a digits} { 1410 1411 foreach {sa ma ea} $a {break} 1412 1413 if { $digits + $ea == 0 } { 1414 return $a 1415 } elseif { $digits + $ea > 0 } { 1416 set mantissa [expr {$ma * 10**($digits+$ea)}] 1417 } else { 1418 set round_exponent [expr {$digits + $ea}] 1419 set integer_part [ipart [list 0 $ma $round_exponent]] 1420 1421 switch -- [compare [list 0 $ma $round_exponent] [list 0 ${integer_part}5 -1]] { 1422 0 { 1423 # We are rounding something with fractional part .5 1424 if { $integer_part % 2 } { 1425 # We are odd so round up 1426 set mantissa [expr {$integer_part + 1}] 1427 } else { 1428 # We are even so round down 1429 set mantissa $integer_part 1430 } 1431 } 1432 -1 { 1433 set mantissa $integer_part 1434 } 1435 1 { 1436 set mantissa [expr {$integer_part + 1}] 1437 } 1438 } 1439 } 1440 set exponent [expr {-1 * $digits}] 1441 return [list $sa $mantissa $exponent] 1442} 1443 1444# round_half_down -- 1445# 1446# Round to the nearest. If equidistant, round down. 1447# 1448# Bias: towards zero 1449# 1450# Arguments: 1451# Number in the form of {sign mantisse exponent} 1452# Number of decimal points to round to. 1453# 1454# Result: 1455# Number in the form of {sign mantisse exponent} 1456# 1457proc ::math::decimal::round_half_down {a digits} { 1458 foreach {sa ma ea} $a {break} 1459 1460 if { $digits + $ea == 0 } { 1461 return $a 1462 } elseif { $digits + $ea > 0 } { 1463 set mantissa [expr {$ma * 10**($digits+$ea)}] 1464 } else { 1465 set round_exponent [expr {$digits + $ea}] 1466 set integer_part [ipart [list 0 $ma $round_exponent]] 1467 switch -- [compare [list 0 $ma $round_exponent] [list 0 ${integer_part}5 -1]] { 1468 0 { 1469 # We are rounding something with fractional part .5 1470 # The rule is to round half down. 1471 set mantissa $integer_part 1472 } 1473 -1 { 1474 set mantissa $integer_part 1475 } 1476 1 { 1477 set mantissa [expr {$integer_part + 1}] 1478 } 1479 } 1480 } 1481 set exponent [expr {-1 * $digits}] 1482 return [list $sa $mantissa $exponent] 1483} 1484 1485# round_down -- 1486# 1487# Round toward 0. (Truncate) 1488# 1489# Bias: towards zero 1490# 1491# Arguments: 1492# Number in the form of {sign mantisse exponent} 1493# Number of decimal points to round to. 1494# 1495# Result: 1496# Number in the form of {sign mantisse exponent} 1497# 1498proc ::math::decimal::round_down {a digits} { 1499 foreach {sa ma ea} $a {break} 1500 1501 1502 if { -$ea== $digits } { 1503 return $a 1504 } elseif { $digits + $ea > 0 } { 1505 set mantissa [expr { $ma * 10**($digits+$ea) }] 1506 } else { 1507 set round_exponent [expr {$digits + $ea}] 1508 set mantissa [ipart [list 0 $ma $round_exponent]] 1509 } 1510 1511 set exponent [expr {-1 * $digits}] 1512 return [list $sa $mantissa $exponent] 1513} 1514 1515# round_floor -- 1516# 1517# Round toward -Infinity. 1518# 1519# Bias: down toward -Inf. 1520# 1521# Arguments: 1522# Number in the form of {sign mantisse exponent} 1523# Number of decimal points to round to. 1524# 1525# Result: 1526# Number in the form of {sign mantisse exponent} 1527# 1528proc ::math::decimal::round_floor {a digits} { 1529 foreach {sa ma ea} $a {break} 1530 1531 if { -$ea== $digits } { 1532 return $a 1533 } elseif { $digits + $ea > 0 } { 1534 set mantissa [expr { $ma * 10**($digits+$ea) }] 1535 } else { 1536 set round_exponent [expr {$digits + $ea}] 1537 if { $ma == 0 } { 1538 set mantissa 0 1539 } elseif { !$sa } { 1540 set mantissa [ipart [list 0 $ma $round_exponent]] 1541 } else { 1542 set mantissa [expr {[ipart [list 0 $ma $round_exponent]] + 1}] 1543 } 1544 } 1545 set exponent [expr {-1 * $digits}] 1546 return [list $sa $mantissa $exponent] 1547} 1548 1549# round_up -- 1550# 1551# Round away from 0 1552# 1553# Bias: away from 0 1554# 1555# Arguments: 1556# Number in the form of {sign mantisse exponent} 1557# Number of decimal points to round to. 1558# 1559# Result: 1560# Number in the form of {sign mantisse exponent} 1561# 1562proc ::math::decimal::round_up {a digits} { 1563 foreach {sa ma ea} $a {break} 1564 1565 1566 if { -$ea== $digits } { 1567 return $a 1568 } elseif { $digits + $ea > 0 } { 1569 set mantissa [expr { $ma * 10**($digits+$ea) }] 1570 set exponent [expr {-1 * $digits}] 1571 } else { 1572 set round_exponent [expr {$digits + $ea}] 1573 if { [string length $ma] <= $round_exponent } { 1574 if { $ma != 0 } { 1575 set mantissa 1 1576 } else { 1577 set mantissa 0 1578 } 1579 set exponent 0 1580 } else { 1581 set integer_part [ipart [list 0 $ma $round_exponent]] 1582 switch -- [compare [list 0 $ma $round_exponent] [list 0 ${integer_part}0 -1]] { 1583 0 { 1584 # We are rounding something with fractional part .0 1585 set mantissa $integer_part 1586 } 1587 default { 1588 set mantissa [expr {$integer_part + 1}] 1589 } 1590 } 1591 set exponent [expr {-1 * $digits}] 1592 } 1593 } 1594 return [list $sa $mantissa $exponent] 1595} 1596 1597# round_ceiling -- 1598# 1599# Round toward Infinity 1600# 1601# Bias: up toward Inf. 1602# 1603# Arguments: 1604# Number in the form of {sign mantisse exponent} 1605# Number of decimal points to round to. 1606# 1607# Result: 1608# Number in the form of {sign mantisse exponent} 1609# 1610proc ::math::decimal::round_ceiling {a digits} { 1611 foreach {sa ma ea} $a {break} 1612 if { -$ea== $digits } { 1613 return $a 1614 } elseif { $digits + $ea > 0 } { 1615 set mantissa [expr { $ma * 10**($digits+$ea) }] 1616 set exponent [expr {-1 * $digits}] 1617 } else { 1618 set round_exponent [expr {$digits + $ea}] 1619 if { [string length $ma] <= $round_exponent } { 1620 if { $ma != 0 } { 1621 set mantissa 1 1622 } else { 1623 set mantissa 0 1624 } 1625 set exponent 0 1626 } else { 1627 set integer_part [ipart [list 0 $ma $round_exponent]] 1628 switch -- [compare [list 0 $ma $round_exponent] [list 0 ${integer_part}0 -1]] { 1629 0 { 1630 # We are rounding something with fractional part .0 1631 set mantissa $integer_part 1632 } 1633 default { 1634 if { $sa } { 1635 set mantissa [expr {$integer_part}] 1636 } else { 1637 set mantissa [expr {$integer_part + 1}] 1638 } 1639 } 1640 } 1641 set exponent [expr {-1 * $digits}] 1642 } 1643 } 1644 1645 return [list $sa $mantissa $exponent] 1646} 1647 1648# is-finite 1649# 1650# Takes one operand and returns: 1 if neither Inf or Nan otherwise 0. 1651# 1652# 1653# Arguments: 1654# a - decimal number 1655# 1656# Returns: 1657# 1658proc ::math::decimal::is-finite { a } { 1659 set mantissa [lindex $a 1] 1660 if { $mantissa == "Inf" || $mantissa == "NaN" } { 1661 return 0 1662 } else { 1663 return 1 1664 } 1665} 1666 1667# is-infinite 1668# 1669# Takes one operand and returns: 1 if Inf otherwise 0. 1670# 1671# 1672# Arguments: 1673# a - decimal number 1674# 1675# Returns: 1676# 1677proc ::math::decimal::is-infinite { a } { 1678 set mantissa [lindex $a 1] 1679 if { $mantissa == "Inf" } { 1680 return 1 1681 } else { 1682 return 0 1683 } 1684} 1685 1686# is-NaN 1687# 1688# Takes one operand and returns: 1 if NaN otherwise 0. 1689# 1690# 1691# Arguments: 1692# a - decimal number 1693# 1694# Returns: 1695# 1696proc ::math::decimal::is-NaN { a } { 1697 set mantissa [lindex $a 1] 1698 if { $mantissa == "NaN" } { 1699 return 1 1700 } else { 1701 return 0 1702 } 1703} 1704 1705# is-signed 1706# 1707# Takes one operand and returns: 1 if sign is 1 (negative). 1708# 1709# 1710# Arguments: 1711# a - decimal number 1712# 1713# Returns: 1714# 1715proc ::math::decimal::is-signed { a } { 1716 set sign [lindex $a 0] 1717 if { $sign } { 1718 return 1 1719 } else { 1720 return 0 1721 } 1722} 1723 1724# is-zero 1725# 1726# Takes one operand and returns: 1 if operand is zero otherwise 0. 1727# 1728# 1729# Arguments: 1730# a - decimal number 1731# 1732# Returns: 1733# 1734proc ::math::decimal::is-zero { a } { 1735 set mantisse [lindex $a 1] 1736 if { $mantisse == 0 } { 1737 return 1 1738 } else { 1739 return 0 1740 } 1741} 1742