Ruby  1.9.3p286(2012-10-12revision37165)
ext/bigdecimal/bigdecimal.c
Go to the documentation of this file.
00001 /*
00002  *
00003  * Ruby BigDecimal(Variable decimal precision) extension library.
00004  *
00005  * Copyright(C) 2002 by Shigeo Kobayashi(shigeo@tinyforest.gr.jp)
00006  *
00007  * You may distribute under the terms of either the GNU General Public
00008  * License or the Artistic License, as specified in the README file
00009  * of this BigDecimal distribution.
00010  *
00011  *  NOTE: Change log in this source removed to reduce source code size.
00012  *        See rev. 1.25 if needed.
00013  *
00014  */
00015 
00016 /* #define BIGDECIMAL_DEBUG 1 */
00017 #ifdef BIGDECIMAL_DEBUG
00018 # define BIGDECIMAL_ENABLE_VPRINT 1
00019 #endif
00020 #include "bigdecimal.h"
00021 
00022 #ifndef BIGDECIMAL_DEBUG
00023 # define NDEBUG
00024 #endif
00025 #include <assert.h>
00026 
00027 #include <ctype.h>
00028 #include <stdio.h>
00029 #include <stdlib.h>
00030 #include <string.h>
00031 #include <errno.h>
00032 #include <math.h>
00033 #include "math.h"
00034 
00035 #ifdef HAVE_IEEEFP_H
00036 #include <ieeefp.h>
00037 #endif
00038 
00039 /* #define ENABLE_NUMERIC_STRING */
00040 
00041 VALUE rb_cBigDecimal;
00042 VALUE rb_mBigMath;
00043 
00044 static ID id_BigDecimal_exception_mode;
00045 static ID id_BigDecimal_rounding_mode;
00046 static ID id_BigDecimal_precision_limit;
00047 
00048 static ID id_up;
00049 static ID id_down;
00050 static ID id_truncate;
00051 static ID id_half_up;
00052 static ID id_default;
00053 static ID id_half_down;
00054 static ID id_half_even;
00055 static ID id_banker;
00056 static ID id_ceiling;
00057 static ID id_ceil;
00058 static ID id_floor;
00059 static ID id_to_r;
00060 static ID id_eq;
00061 
00062 /* MACRO's to guard objects from GC by keeping them in stack */
00063 #define ENTER(n) volatile VALUE vStack[n];int iStack=0
00064 #define PUSH(x)  vStack[iStack++] = (VALUE)(x);
00065 #define SAVE(p)  PUSH(p->obj);
00066 #define GUARD_OBJ(p,y) {p=y;SAVE(p);}
00067 
00068 #define BASE_FIG  RMPD_COMPONENT_FIGURES
00069 #define BASE      RMPD_BASE
00070 
00071 #define HALF_BASE (BASE/2)
00072 #define BASE1 (BASE/10)
00073 
00074 #ifndef DBLE_FIG
00075 #define DBLE_FIG (DBL_DIG+1)    /* figure of double */
00076 #endif
00077 
00078 #ifndef RBIGNUM_ZERO_P
00079 # define RBIGNUM_ZERO_P(x) (RBIGNUM_LEN(x) == 0 || \
00080                             (RBIGNUM_DIGITS(x)[0] == 0 && \
00081                              (RBIGNUM_LEN(x) == 1 || bigzero_p(x))))
00082 #endif
00083 
00084 static inline int
00085 bigzero_p(VALUE x)
00086 {
00087     long i;
00088     BDIGIT *ds = RBIGNUM_DIGITS(x);
00089 
00090     for (i = RBIGNUM_LEN(x) - 1; 0 <= i; i--) {
00091         if (ds[i]) return 0;
00092     }
00093     return 1;
00094 }
00095 
00096 #ifndef RRATIONAL_ZERO_P
00097 # define RRATIONAL_ZERO_P(x) (FIXNUM_P(RRATIONAL(x)->num) && \
00098                               FIX2LONG(RRATIONAL(x)->num) == 0)
00099 #endif
00100 
00101 #ifndef RRATIONAL_NEGATIVE_P
00102 # define RRATIONAL_NEGATIVE_P(x) RTEST(rb_funcall((x), '<', 1, INT2FIX(0)))
00103 #endif
00104 
00105 /*
00106  * ================== Ruby Interface part ==========================
00107  */
00108 #define DoSomeOne(x,y,f) rb_num_coerce_bin(x,y,f)
00109 
00110 /*
00111  * Returns the BigDecimal version number.
00112  *
00113  * Ruby 1.8.0 returns 1.0.0.
00114  * Ruby 1.8.1 thru 1.8.3 return 1.0.1.
00115  */
00116 static VALUE
00117 BigDecimal_version(VALUE self)
00118 {
00119     /*
00120      * 1.0.0: Ruby 1.8.0
00121      * 1.0.1: Ruby 1.8.1
00122      * 1.1.0: Ruby 1.9.3
00123     */
00124     return rb_str_new2("1.1.0");
00125 }
00126 
00127 /*
00128  *   VP routines used in BigDecimal part
00129  */
00130 static unsigned short VpGetException(void);
00131 static void  VpSetException(unsigned short f);
00132 static void  VpInternalRound(Real *c, size_t ixDigit, BDIGIT vPrev, BDIGIT v);
00133 static int   VpLimitRound(Real *c, size_t ixDigit);
00134 static Real *VpDup(Real const* const x);
00135 
00136 /*
00137  *  **** BigDecimal part ****
00138  */
00139 
00140 static void
00141 BigDecimal_delete(void *pv)
00142 {
00143     VpFree(pv);
00144 }
00145 
00146 static size_t
00147 BigDecimal_memsize(const void *ptr)
00148 {
00149     const Real *pv = ptr;
00150     return pv ? (sizeof(*pv) + pv->MaxPrec * sizeof(BDIGIT)) : 0;
00151 }
00152 
00153 static const rb_data_type_t BigDecimal_data_type = {
00154     "BigDecimal",
00155     {0, BigDecimal_delete, BigDecimal_memsize,},
00156 };
00157 
00158 static inline int
00159 is_kind_of_BigDecimal(VALUE const v)
00160 {
00161     return rb_typeddata_is_kind_of(v, &BigDecimal_data_type);
00162 }
00163 
00164 static VALUE
00165 ToValue(Real *p)
00166 {
00167     if(VpIsNaN(p)) {
00168         VpException(VP_EXCEPTION_NaN,"Computation results to 'NaN'(Not a Number)",0);
00169     } else if(VpIsPosInf(p)) {
00170         VpException(VP_EXCEPTION_INFINITY,"Computation results to 'Infinity'",0);
00171     } else if(VpIsNegInf(p)) {
00172         VpException(VP_EXCEPTION_INFINITY,"Computation results to '-Infinity'",0);
00173     }
00174     return p->obj;
00175 }
00176 
00177 NORETURN(static void cannot_be_coerced_into_BigDecimal(VALUE, VALUE));
00178 
00179 static void
00180 cannot_be_coerced_into_BigDecimal(VALUE exc_class, VALUE v)
00181 {
00182     VALUE str;
00183 
00184     if (rb_special_const_p(v)) {
00185         str = rb_str_cat2(rb_str_dup(rb_inspect(v)),
00186                           " can't be coerced into BigDecimal");
00187     }
00188     else {
00189         str = rb_str_cat2(rb_str_dup(rb_class_name(rb_obj_class(v))),
00190                           " can't be coerced into BigDecimal");
00191     }
00192 
00193     rb_exc_raise(rb_exc_new3(exc_class, str));
00194 }
00195 
00196 static VALUE BigDecimal_div2(int, VALUE*, VALUE);
00197 
00198 static Real*
00199 GetVpValueWithPrec(VALUE v, long prec, int must)
00200 {
00201     Real *pv;
00202     VALUE num, bg, args[2];
00203     char szD[128];
00204     VALUE orig = Qundef;
00205 
00206 again:
00207     switch(TYPE(v))
00208     {
00209       case T_FLOAT:
00210         if (prec < 0) goto unable_to_coerce_without_prec;
00211         if (prec > DBL_DIG+1)goto SomeOneMayDoIt;
00212         v = rb_funcall(v, id_to_r, 0);
00213         goto again;
00214       case T_RATIONAL:
00215         if (prec < 0) goto unable_to_coerce_without_prec;
00216 
00217         if (orig == Qundef ? (orig = v, 1) : orig != v) {
00218             num = RRATIONAL(v)->num;
00219             pv = GetVpValueWithPrec(num, -1, must);
00220             if (pv == NULL) goto SomeOneMayDoIt;
00221 
00222             args[0] = RRATIONAL(v)->den;
00223             args[1] = LONG2NUM(prec);
00224             v = BigDecimal_div2(2, args, ToValue(pv));
00225             goto again;
00226         }
00227 
00228         v = orig;
00229         goto SomeOneMayDoIt;
00230 
00231       case T_DATA:
00232         if (is_kind_of_BigDecimal(v)) {
00233             pv = DATA_PTR(v);
00234             return pv;
00235         }
00236         else {
00237             goto SomeOneMayDoIt;
00238         }
00239         break;
00240 
00241       case T_FIXNUM:
00242         sprintf(szD, "%ld", FIX2LONG(v));
00243         return VpCreateRbObject(VpBaseFig() * 2 + 1, szD);
00244 
00245 #ifdef ENABLE_NUMERIC_STRING
00246       case T_STRING:
00247         SafeStringValue(v);
00248         return VpCreateRbObject(strlen(RSTRING_PTR(v)) + VpBaseFig() + 1,
00249                                 RSTRING_PTR(v));
00250 #endif /* ENABLE_NUMERIC_STRING */
00251 
00252       case T_BIGNUM:
00253         bg = rb_big2str(v, 10);
00254         return VpCreateRbObject(strlen(RSTRING_PTR(bg)) + VpBaseFig() + 1,
00255                                 RSTRING_PTR(bg));
00256       default:
00257         goto SomeOneMayDoIt;
00258     }
00259 
00260 SomeOneMayDoIt:
00261     if (must) {
00262         cannot_be_coerced_into_BigDecimal(rb_eTypeError, v);
00263     }
00264     return NULL; /* NULL means to coerce */
00265 
00266 unable_to_coerce_without_prec:
00267     if (must) {
00268         rb_raise(rb_eArgError,
00269                  "%s can't be coerced into BigDecimal without a precision",
00270                  rb_obj_classname(v));
00271     }
00272     return NULL;
00273 }
00274 
00275 static Real*
00276 GetVpValue(VALUE v, int must)
00277 {
00278     return GetVpValueWithPrec(v, -1, must);
00279 }
00280 
00281 /* call-seq:
00282  * BigDecimal.double_fig
00283  *
00284  * The BigDecimal.double_fig class method returns the number of digits a
00285  * Float number is allowed to have. The result depends upon the CPU and OS
00286  * in use.
00287  */
00288 static VALUE
00289 BigDecimal_double_fig(VALUE self)
00290 {
00291     return INT2FIX(VpDblFig());
00292 }
00293 
00294 /* call-seq:
00295  * precs
00296  *
00297  * Returns an Array of two Integer values.
00298  *
00299  * The first value is the current number of significant digits in the
00300  * BigDecimal. The second value is the maximum number of significant digits
00301  * for the BigDecimal.
00302  */
00303 static VALUE
00304 BigDecimal_prec(VALUE self)
00305 {
00306     ENTER(1);
00307     Real *p;
00308     VALUE obj;
00309 
00310     GUARD_OBJ(p,GetVpValue(self,1));
00311     obj = rb_assoc_new(INT2NUM(p->Prec*VpBaseFig()),
00312                        INT2NUM(p->MaxPrec*VpBaseFig()));
00313     return obj;
00314 }
00315 
00316 static VALUE
00317 BigDecimal_hash(VALUE self)
00318 {
00319     ENTER(1);
00320     Real *p;
00321     st_index_t hash;
00322 
00323     GUARD_OBJ(p,GetVpValue(self,1));
00324     hash = (st_index_t)p->sign;
00325     /* hash!=2: the case for 0(1),NaN(0) or +-Infinity(3) is sign itself */
00326     if(hash == 2 || hash == (st_index_t)-2) {
00327         hash ^= rb_memhash(p->frac, sizeof(BDIGIT)*p->Prec);
00328         hash += p->exponent;
00329     }
00330     return INT2FIX(hash);
00331 }
00332 
00333 static VALUE
00334 BigDecimal_dump(int argc, VALUE *argv, VALUE self)
00335 {
00336     ENTER(5);
00337     Real *vp;
00338     char *psz;
00339     VALUE dummy;
00340     volatile VALUE dump;
00341 
00342     rb_scan_args(argc, argv, "01", &dummy);
00343     GUARD_OBJ(vp,GetVpValue(self,1));
00344     dump = rb_str_new(0,VpNumOfChars(vp,"E")+50);
00345     psz = RSTRING_PTR(dump);
00346     sprintf(psz, "%"PRIuSIZE":", VpMaxPrec(vp)*VpBaseFig());
00347     VpToString(vp, psz+strlen(psz), 0, 0);
00348     rb_str_resize(dump, strlen(psz));
00349     return dump;
00350 }
00351 
00352 /*
00353  * Internal method used to provide marshalling support. See the Marshal module.
00354  */
00355 static VALUE
00356 BigDecimal_load(VALUE self, VALUE str)
00357 {
00358     ENTER(2);
00359     Real *pv;
00360     unsigned char *pch;
00361     unsigned char ch;
00362     unsigned long m=0;
00363 
00364     SafeStringValue(str);
00365     pch = (unsigned char *)RSTRING_PTR(str);
00366     /* First get max prec */
00367     while((*pch)!=(unsigned char)'\0' && (ch=*pch++)!=(unsigned char)':') {
00368         if(!ISDIGIT(ch)) {
00369             rb_raise(rb_eTypeError, "load failed: invalid character in the marshaled string");
00370         }
00371         m = m*10 + (unsigned long)(ch-'0');
00372     }
00373     if(m>VpBaseFig()) m -= VpBaseFig();
00374     GUARD_OBJ(pv,VpNewRbClass(m,(char *)pch,self));
00375     m /= VpBaseFig();
00376     if(m && pv->MaxPrec>m) pv->MaxPrec = m+1;
00377     return ToValue(pv);
00378 }
00379 
00380 static unsigned short
00381 check_rounding_mode(VALUE const v)
00382 {
00383     unsigned short sw;
00384     ID id;
00385     switch (TYPE(v)) {
00386       case T_SYMBOL:
00387         id = SYM2ID(v);
00388         if (id == id_up)
00389             return VP_ROUND_UP;
00390         if (id == id_down || id == id_truncate)
00391             return VP_ROUND_DOWN;
00392         if (id == id_half_up || id == id_default)
00393             return VP_ROUND_HALF_UP;
00394         if (id == id_half_down)
00395             return VP_ROUND_HALF_DOWN;
00396         if (id == id_half_even || id == id_banker)
00397             return VP_ROUND_HALF_EVEN;
00398         if (id == id_ceiling || id == id_ceil)
00399             return VP_ROUND_CEIL;
00400         if (id == id_floor)
00401             return VP_ROUND_FLOOR;
00402         rb_raise(rb_eArgError, "invalid rounding mode");
00403 
00404       default:
00405         break;
00406     }
00407 
00408     Check_Type(v, T_FIXNUM);
00409     sw = (unsigned short)FIX2UINT(v);
00410     if (!VpIsRoundMode(sw)) {
00411         rb_raise(rb_eArgError, "invalid rounding mode");
00412     }
00413     return sw;
00414 }
00415 
00416 /* call-seq:
00417  * BigDecimal.mode(mode, value)
00418  *
00419  * Controls handling of arithmetic exceptions and rounding. If no value
00420  * is supplied, the current value is returned.
00421  *
00422  * Six values of the mode parameter control the handling of arithmetic
00423  * exceptions:
00424  *
00425  * BigDecimal::EXCEPTION_NaN
00426  * BigDecimal::EXCEPTION_INFINITY
00427  * BigDecimal::EXCEPTION_UNDERFLOW
00428  * BigDecimal::EXCEPTION_OVERFLOW
00429  * BigDecimal::EXCEPTION_ZERODIVIDE
00430  * BigDecimal::EXCEPTION_ALL
00431  *
00432  * For each mode parameter above, if the value set is false, computation
00433  * continues after an arithmetic exception of the appropriate type.
00434  * When computation continues, results are as follows:
00435  *
00436  * EXCEPTION_NaN:: NaN
00437  * EXCEPTION_INFINITY:: +infinity or -infinity
00438  * EXCEPTION_UNDERFLOW:: 0
00439  * EXCEPTION_OVERFLOW:: +infinity or -infinity
00440  * EXCEPTION_ZERODIVIDE:: +infinity or -infinity
00441  *
00442  * One value of the mode parameter controls the rounding of numeric values:
00443  * BigDecimal::ROUND_MODE. The values it can take are:
00444  *
00445  * ROUND_UP, :up:: round away from zero
00446  * ROUND_DOWN, :down, :truncate:: round towards zero (truncate)
00447  * ROUND_HALF_UP, :half_up, :default:: round towards the nearest neighbor, unless both neighbors are equidistant, in which case round away from zero. (default)
00448  * ROUND_HALF_DOWN, :half_down:: round towards the nearest neighbor, unless both neighbors are equidistant, in which case round towards zero.
00449  * ROUND_HALF_EVEN, :half_even, :banker:: round towards the nearest neighbor, unless both neighbors are equidistant, in which case round towards the even neighbor (Banker's rounding)
00450  * ROUND_CEILING, :ceiling, :ceil:: round towards positive infinity (ceil)
00451  * ROUND_FLOOR, :floor:: round towards negative infinity (floor)
00452  *
00453  */
00454 static VALUE
00455 BigDecimal_mode(int argc, VALUE *argv, VALUE self)
00456 {
00457     VALUE which;
00458     VALUE val;
00459     unsigned long f,fo;
00460 
00461     if(rb_scan_args(argc,argv,"11",&which,&val)==1) val = Qnil;
00462 
00463     Check_Type(which, T_FIXNUM);
00464     f = (unsigned long)FIX2INT(which);
00465 
00466     if(f&VP_EXCEPTION_ALL) {
00467         /* Exception mode setting */
00468         fo = VpGetException();
00469         if(val==Qnil) return INT2FIX(fo);
00470         if(val!=Qfalse && val!=Qtrue) {
00471             rb_raise(rb_eArgError, "second argument must be true or false");
00472             return Qnil; /* Not reached */
00473         }
00474         if(f&VP_EXCEPTION_INFINITY) {
00475             VpSetException((unsigned short)((val==Qtrue)?(fo|VP_EXCEPTION_INFINITY):
00476                            (fo&(~VP_EXCEPTION_INFINITY))));
00477         }
00478         fo = VpGetException();
00479         if(f&VP_EXCEPTION_NaN) {
00480             VpSetException((unsigned short)((val==Qtrue)?(fo|VP_EXCEPTION_NaN):
00481                            (fo&(~VP_EXCEPTION_NaN))));
00482         }
00483         fo = VpGetException();
00484         if(f&VP_EXCEPTION_UNDERFLOW) {
00485             VpSetException((unsigned short)((val==Qtrue)?(fo|VP_EXCEPTION_UNDERFLOW):
00486                            (fo&(~VP_EXCEPTION_UNDERFLOW))));
00487         }
00488         fo = VpGetException();
00489         if(f&VP_EXCEPTION_ZERODIVIDE) {
00490             VpSetException((unsigned short)((val==Qtrue)?(fo|VP_EXCEPTION_ZERODIVIDE):
00491                            (fo&(~VP_EXCEPTION_ZERODIVIDE))));
00492         }
00493         fo = VpGetException();
00494         return INT2FIX(fo);
00495     }
00496     if (VP_ROUND_MODE == f) {
00497         /* Rounding mode setting */
00498         unsigned short sw;
00499         fo = VpGetRoundMode();
00500         if (NIL_P(val)) return INT2FIX(fo);
00501         sw = check_rounding_mode(val);
00502         fo = VpSetRoundMode(sw);
00503         return INT2FIX(fo);
00504     }
00505     rb_raise(rb_eTypeError, "first argument for BigDecimal#mode invalid");
00506     return Qnil;
00507 }
00508 
00509 static size_t
00510 GetAddSubPrec(Real *a, Real *b)
00511 {
00512     size_t mxs;
00513     size_t mx = a->Prec;
00514     SIGNED_VALUE d;
00515 
00516     if(!VpIsDef(a) || !VpIsDef(b)) return (size_t)-1L;
00517     if(mx < b->Prec) mx = b->Prec;
00518     if(a->exponent!=b->exponent) {
00519         mxs = mx;
00520         d = a->exponent - b->exponent;
00521         if (d < 0) d = -d;
00522         mx = mx + (size_t)d;
00523         if (mx<mxs) {
00524             return VpException(VP_EXCEPTION_INFINITY,"Exponent overflow",0);
00525         }
00526     }
00527     return mx;
00528 }
00529 
00530 static SIGNED_VALUE
00531 GetPositiveInt(VALUE v)
00532 {
00533     SIGNED_VALUE n;
00534     Check_Type(v, T_FIXNUM);
00535     n = FIX2INT(v);
00536     if (n < 0) {
00537         rb_raise(rb_eArgError, "argument must be positive");
00538     }
00539     return n;
00540 }
00541 
00542 VP_EXPORT Real *
00543 VpNewRbClass(size_t mx, const char *str, VALUE klass)
00544 {
00545     Real *pv = VpAlloc(mx,str);
00546     pv->obj = TypedData_Wrap_Struct(klass, &BigDecimal_data_type, pv);
00547     return pv;
00548 }
00549 
00550 VP_EXPORT Real *
00551 VpCreateRbObject(size_t mx, const char *str)
00552 {
00553     Real *pv = VpAlloc(mx,str);
00554     pv->obj = TypedData_Wrap_Struct(rb_cBigDecimal, &BigDecimal_data_type, pv);
00555     return pv;
00556 }
00557 
00558 static Real *
00559 VpDup(Real const* const x)
00560 {
00561     Real *pv;
00562 
00563     assert(x != NULL);
00564 
00565     pv = VpMemAlloc(sizeof(Real) + x->MaxPrec * sizeof(BDIGIT));
00566     pv->MaxPrec = x->MaxPrec;
00567     pv->Prec = x->Prec;
00568     pv->exponent = x->exponent;
00569     pv->sign = x->sign;
00570     pv->flag = x->flag;
00571     MEMCPY(pv->frac, x->frac, BDIGIT, pv->MaxPrec);
00572 
00573     pv->obj = TypedData_Wrap_Struct(
00574         rb_obj_class(x->obj), &BigDecimal_data_type, pv);
00575 
00576     return pv;
00577 }
00578 
00579 /* Returns True if the value is Not a Number */
00580 static VALUE
00581 BigDecimal_IsNaN(VALUE self)
00582 {
00583     Real *p = GetVpValue(self,1);
00584     if(VpIsNaN(p))  return Qtrue;
00585     return Qfalse;
00586 }
00587 
00588 /* Returns nil, -1, or +1 depending on whether the value is finite,
00589  * -infinity, or +infinity.
00590  */
00591 static VALUE
00592 BigDecimal_IsInfinite(VALUE self)
00593 {
00594     Real *p = GetVpValue(self,1);
00595     if(VpIsPosInf(p)) return INT2FIX(1);
00596     if(VpIsNegInf(p)) return INT2FIX(-1);
00597     return Qnil;
00598 }
00599 
00600 /* Returns True if the value is finite (not NaN or infinite) */
00601 static VALUE
00602 BigDecimal_IsFinite(VALUE self)
00603 {
00604     Real *p = GetVpValue(self,1);
00605     if(VpIsNaN(p)) return Qfalse;
00606     if(VpIsInf(p)) return Qfalse;
00607     return Qtrue;
00608 }
00609 
00610 static void
00611 BigDecimal_check_num(Real *p)
00612 {
00613     if(VpIsNaN(p)) {
00614        VpException(VP_EXCEPTION_NaN,"Computation results to 'NaN'(Not a Number)",1);
00615     } else if(VpIsPosInf(p)) {
00616        VpException(VP_EXCEPTION_INFINITY,"Computation results to 'Infinity'",1);
00617     } else if(VpIsNegInf(p)) {
00618        VpException(VP_EXCEPTION_INFINITY,"Computation results to '-Infinity'",1);
00619     }
00620 }
00621 
00622 static VALUE BigDecimal_split(VALUE self);
00623 
00624 /* Returns the value as an integer (Fixnum or Bignum).
00625  *
00626  * If the BigNumber is infinity or NaN, raises FloatDomainError.
00627  */
00628 static VALUE
00629 BigDecimal_to_i(VALUE self)
00630 {
00631     ENTER(5);
00632     ssize_t e, nf;
00633     Real *p;
00634 
00635     GUARD_OBJ(p,GetVpValue(self,1));
00636     BigDecimal_check_num(p);
00637 
00638     e = VpExponent10(p);
00639     if(e<=0) return INT2FIX(0);
00640     nf = VpBaseFig();
00641     if(e<=nf) {
00642         return LONG2NUM((long)(VpGetSign(p)*(BDIGIT_DBL_SIGNED)p->frac[0]));
00643     }
00644     else {
00645         VALUE a = BigDecimal_split(self);
00646         VALUE digits = RARRAY_PTR(a)[1];
00647         VALUE numerator = rb_funcall(digits, rb_intern("to_i"), 0);
00648         VALUE ret;
00649         ssize_t dpower = e - (ssize_t)RSTRING_LEN(digits);
00650 
00651         if (VpGetSign(p) < 0) {
00652             numerator = rb_funcall(numerator, '*', 1, INT2FIX(-1));
00653         }
00654         if (dpower < 0) {
00655             ret = rb_funcall(numerator, rb_intern("div"), 1,
00656                               rb_funcall(INT2FIX(10), rb_intern("**"), 1,
00657                                          INT2FIX(-dpower)));
00658         }
00659         else
00660             ret = rb_funcall(numerator, '*', 1,
00661                              rb_funcall(INT2FIX(10), rb_intern("**"), 1,
00662                                         INT2FIX(dpower)));
00663         if (TYPE(ret) == T_FLOAT)
00664             rb_raise(rb_eFloatDomainError, "Infinity");
00665         return ret;
00666     }
00667 }
00668 
00669 /* Returns a new Float object having approximately the same value as the
00670  * BigDecimal number. Normal accuracy limits and built-in errors of binary
00671  * Float arithmetic apply.
00672  */
00673 static VALUE
00674 BigDecimal_to_f(VALUE self)
00675 {
00676     ENTER(1);
00677     Real *p;
00678     double d;
00679     SIGNED_VALUE e;
00680     char *buf;
00681     volatile VALUE str;
00682 
00683     GUARD_OBJ(p, GetVpValue(self, 1));
00684     if (VpVtoD(&d, &e, p) != 1)
00685         return rb_float_new(d);
00686     if (e > (SIGNED_VALUE)(DBL_MAX_10_EXP+BASE_FIG))
00687         goto overflow;
00688     if (e < (SIGNED_VALUE)(DBL_MIN_10_EXP-BASE_FIG))
00689         goto underflow;
00690 
00691     str = rb_str_new(0, VpNumOfChars(p,"E"));
00692     buf = RSTRING_PTR(str);
00693     VpToString(p, buf, 0, 0);
00694     errno = 0;
00695     d = strtod(buf, 0);
00696     if (errno == ERANGE)
00697         goto overflow;
00698     return rb_float_new(d);
00699 
00700 overflow:
00701     VpException(VP_EXCEPTION_OVERFLOW, "BigDecimal to Float conversion", 0);
00702     if (d > 0.0)
00703         return rb_float_new(VpGetDoublePosInf());
00704     else
00705         return rb_float_new(VpGetDoubleNegInf());
00706 
00707 underflow:
00708     VpException(VP_EXCEPTION_UNDERFLOW, "BigDecimal to Float conversion", 0);
00709     if (d > 0.0)
00710         return rb_float_new(0.0);
00711     else
00712         return rb_float_new(-0.0);
00713 }
00714 
00715 
00716 /* Converts a BigDecimal to a Rational.
00717  */
00718 static VALUE
00719 BigDecimal_to_r(VALUE self)
00720 {
00721     Real *p;
00722     ssize_t sign, power, denomi_power;
00723     VALUE a, digits, numerator;
00724 
00725     p = GetVpValue(self,1);
00726     BigDecimal_check_num(p);
00727 
00728     sign = VpGetSign(p);
00729     power = VpExponent10(p);
00730     a = BigDecimal_split(self);
00731     digits = RARRAY_PTR(a)[1];
00732     denomi_power = power - RSTRING_LEN(digits);
00733     numerator = rb_funcall(digits, rb_intern("to_i"), 0);
00734 
00735     if (sign < 0) {
00736         numerator = rb_funcall(numerator, '*', 1, INT2FIX(-1));
00737     }
00738     if (denomi_power < 0) {
00739         return rb_Rational(numerator,
00740                            rb_funcall(INT2FIX(10), rb_intern("**"), 1,
00741                                       INT2FIX(-denomi_power)));
00742     }
00743     else {
00744         return rb_Rational1(rb_funcall(numerator, '*', 1,
00745                                        rb_funcall(INT2FIX(10), rb_intern("**"), 1,
00746                                                   INT2FIX(denomi_power))));
00747     }
00748 }
00749 
00750 /* The coerce method provides support for Ruby type coercion. It is not
00751  * enabled by default.
00752  *
00753  * This means that binary operations like + * / or - can often be performed
00754  * on a BigDecimal and an object of another type, if the other object can
00755  * be coerced into a BigDecimal value.
00756  *
00757  * e.g.
00758  * a = BigDecimal.new("1.0")
00759  * b = a / 2.0  -> 0.5
00760  *
00761  * Note that coercing a String to a BigDecimal is not supported by default;
00762  * it requires a special compile-time option when building Ruby.
00763  */
00764 static VALUE
00765 BigDecimal_coerce(VALUE self, VALUE other)
00766 {
00767     ENTER(2);
00768     VALUE obj;
00769     Real *b;
00770 
00771     if (TYPE(other) == T_FLOAT) {
00772         obj = rb_assoc_new(other, BigDecimal_to_f(self));
00773     }
00774     else {
00775         if (TYPE(other) == T_RATIONAL) {
00776             Real* pv = DATA_PTR(self);
00777             GUARD_OBJ(b, GetVpValueWithPrec(other, pv->Prec*VpBaseFig(), 1));
00778         }
00779         else {
00780             GUARD_OBJ(b, GetVpValue(other, 1));
00781         }
00782         obj = rb_assoc_new(b->obj, self);
00783     }
00784 
00785     return obj;
00786 }
00787 
00788 static VALUE
00789 BigDecimal_uplus(VALUE self)
00790 {
00791     return self;
00792 }
00793 
00794  /* call-seq:
00795   * add(value, digits)
00796   *
00797   * Add the specified value.
00798   *
00799   * e.g.
00800   *   c = a.add(b,n)
00801   *   c = a + b
00802   *
00803   * digits:: If specified and less than the number of significant digits of the result, the result is rounded to that number of digits, according to BigDecimal.mode.
00804   */
00805 static VALUE
00806 BigDecimal_add(VALUE self, VALUE r)
00807 {
00808     ENTER(5);
00809     Real *c, *a, *b;
00810     size_t mx;
00811     GUARD_OBJ(a,GetVpValue(self,1));
00812     b = GetVpValue(r,0);
00813     if(!b) return DoSomeOne(self,r,'+');
00814     SAVE(b);
00815     if(VpIsNaN(b)) return b->obj;
00816     if(VpIsNaN(a)) return a->obj;
00817     mx = GetAddSubPrec(a,b);
00818     if (mx == (size_t)-1L) {
00819         GUARD_OBJ(c,VpCreateRbObject(VpBaseFig() + 1, "0"));
00820         VpAddSub(c, a, b, 1);
00821     } else {
00822         GUARD_OBJ(c,VpCreateRbObject(mx *(VpBaseFig() + 1), "0"));
00823         if(!mx) {
00824             VpSetInf(c,VpGetSign(a));
00825         } else {
00826             VpAddSub(c, a, b, 1);
00827         }
00828     }
00829     return ToValue(c);
00830 }
00831 
00832  /* call-seq:
00833   * sub(value, digits)
00834   *
00835   * Subtract the specified value.
00836   *
00837   * e.g.
00838   *   c = a.sub(b,n)
00839   *   c = a - b
00840   *
00841   * digits:: If specified and less than the number of significant digits of the result, the result is rounded to that number of digits, according to BigDecimal.mode.
00842   */
00843 static VALUE
00844 BigDecimal_sub(VALUE self, VALUE r)
00845 {
00846     ENTER(5);
00847     Real *c, *a, *b;
00848     size_t mx;
00849 
00850     GUARD_OBJ(a,GetVpValue(self,1));
00851     b = GetVpValue(r,0);
00852     if(!b) return DoSomeOne(self,r,'-');
00853     SAVE(b);
00854 
00855     if(VpIsNaN(b)) return b->obj;
00856     if(VpIsNaN(a)) return a->obj;
00857 
00858     mx = GetAddSubPrec(a,b);
00859     if (mx == (size_t)-1L) {
00860         GUARD_OBJ(c,VpCreateRbObject(VpBaseFig() + 1, "0"));
00861         VpAddSub(c, a, b, -1);
00862     } else {
00863         GUARD_OBJ(c,VpCreateRbObject(mx *(VpBaseFig() + 1), "0"));
00864         if(!mx) {
00865             VpSetInf(c,VpGetSign(a));
00866         } else {
00867             VpAddSub(c, a, b, -1);
00868         }
00869     }
00870     return ToValue(c);
00871 }
00872 
00873 static VALUE
00874 BigDecimalCmp(VALUE self, VALUE r,char op)
00875 {
00876     ENTER(5);
00877     SIGNED_VALUE e;
00878     Real *a, *b=0;
00879     GUARD_OBJ(a,GetVpValue(self,1));
00880     switch (TYPE(r)) {
00881     case T_DATA:
00882         if (!is_kind_of_BigDecimal(r)) break;
00883         /* fall through */
00884     case T_FIXNUM:
00885         /* fall through */
00886     case T_BIGNUM:
00887         GUARD_OBJ(b, GetVpValue(r,0));
00888         break;
00889 
00890     case T_FLOAT:
00891         GUARD_OBJ(b, GetVpValueWithPrec(r, DBL_DIG+1, 0));
00892         break;
00893 
00894     case T_RATIONAL:
00895         GUARD_OBJ(b, GetVpValueWithPrec(r, a->Prec*VpBaseFig(), 0));
00896         break;
00897 
00898     default:
00899         break;
00900     }
00901     if (b == NULL) {
00902         ID f = 0;
00903 
00904         switch (op) {
00905         case '*':
00906             return rb_num_coerce_cmp(self, r, rb_intern("<=>"));
00907 
00908         case '=':
00909             return RTEST(rb_num_coerce_cmp(self, r, rb_intern("=="))) ? Qtrue : Qfalse;
00910 
00911         case 'G':
00912             f = rb_intern(">=");
00913             break;
00914 
00915         case 'L':
00916             f = rb_intern("<=");
00917             break;
00918 
00919         case '>':
00920             /* fall through */
00921         case '<':
00922             f = (ID)op;
00923             break;
00924 
00925         default:
00926             break;
00927         }
00928         return rb_num_coerce_relop(self, r, f);
00929     }
00930     SAVE(b);
00931     e = VpComp(a, b);
00932     if (e == 999)
00933         return (op == '*') ? Qnil : Qfalse;
00934     switch (op) {
00935     case '*':
00936         return   INT2FIX(e); /* any op */
00937 
00938     case '=':
00939         if(e==0) return Qtrue;
00940         return Qfalse;
00941 
00942     case 'G':
00943         if(e>=0) return Qtrue;
00944         return Qfalse;
00945 
00946     case '>':
00947         if(e> 0) return Qtrue;
00948         return Qfalse;
00949 
00950     case 'L':
00951         if(e<=0) return Qtrue;
00952         return Qfalse;
00953 
00954     case '<':
00955         if(e< 0) return Qtrue;
00956         return Qfalse;
00957 
00958     default:
00959         break;
00960     }
00961 
00962     rb_bug("Undefined operation in BigDecimalCmp()");
00963 }
00964 
00965 /* Returns True if the value is zero. */
00966 static VALUE
00967 BigDecimal_zero(VALUE self)
00968 {
00969     Real *a = GetVpValue(self,1);
00970     return VpIsZero(a) ? Qtrue : Qfalse;
00971 }
00972 
00973 /* Returns self if the value is non-zero, nil otherwise. */
00974 static VALUE
00975 BigDecimal_nonzero(VALUE self)
00976 {
00977     Real *a = GetVpValue(self,1);
00978     return VpIsZero(a) ? Qnil : self;
00979 }
00980 
00981 /* The comparison operator.
00982  * a <=> b is 0 if a == b, 1 if a > b, -1 if a < b.
00983  */
00984 static VALUE
00985 BigDecimal_comp(VALUE self, VALUE r)
00986 {
00987     return BigDecimalCmp(self, r, '*');
00988 }
00989 
00990 /*
00991  * Tests for value equality; returns true if the values are equal.
00992  *
00993  * The == and === operators and the eql? method have the same implementation
00994  * for BigDecimal.
00995  *
00996  * Values may be coerced to perform the comparison:
00997  *
00998  * BigDecimal.new('1.0') == 1.0  -> true
00999  */
01000 static VALUE
01001 BigDecimal_eq(VALUE self, VALUE r)
01002 {
01003     return BigDecimalCmp(self, r, '=');
01004 }
01005 
01006 /* call-seq:
01007  * a < b
01008  *
01009  * Returns true if a is less than b. Values may be coerced to perform the
01010  * comparison (see ==, coerce).
01011  */
01012 static VALUE
01013 BigDecimal_lt(VALUE self, VALUE r)
01014 {
01015     return BigDecimalCmp(self, r, '<');
01016 }
01017 
01018 /* call-seq:
01019  * a <= b
01020  *
01021  * Returns true if a is less than or equal to b. Values may be coerced to
01022  * perform the comparison (see ==, coerce).
01023  */
01024 static VALUE
01025 BigDecimal_le(VALUE self, VALUE r)
01026 {
01027     return BigDecimalCmp(self, r, 'L');
01028 }
01029 
01030 /* call-seq:
01031  * a > b
01032  *
01033  * Returns true if a is greater than b.  Values may be coerced to
01034  * perform the comparison (see ==, coerce).
01035  */
01036 static VALUE
01037 BigDecimal_gt(VALUE self, VALUE r)
01038 {
01039     return BigDecimalCmp(self, r, '>');
01040 }
01041 
01042 /* call-seq:
01043  * a >= b
01044  *
01045  * Returns true if a is greater than or equal to b. Values may be coerced to
01046  * perform the comparison (see ==, coerce)
01047  */
01048 static VALUE
01049 BigDecimal_ge(VALUE self, VALUE r)
01050 {
01051     return BigDecimalCmp(self, r, 'G');
01052 }
01053 
01054 static VALUE
01055 BigDecimal_neg(VALUE self)
01056 {
01057     ENTER(5);
01058     Real *c, *a;
01059     GUARD_OBJ(a,GetVpValue(self,1));
01060     GUARD_OBJ(c,VpCreateRbObject(a->Prec *(VpBaseFig() + 1), "0"));
01061     VpAsgn(c, a, -1);
01062     return ToValue(c);
01063 }
01064 
01065  /* call-seq:
01066   * mult(value, digits)
01067   *
01068   * Multiply by the specified value.
01069   *
01070   * e.g.
01071   *   c = a.mult(b,n)
01072   *   c = a * b
01073   *
01074   * digits:: If specified and less than the number of significant digits of the result, the result is rounded to that number of digits, according to BigDecimal.mode.
01075   */
01076 static VALUE
01077 BigDecimal_mult(VALUE self, VALUE r)
01078 {
01079     ENTER(5);
01080     Real *c, *a, *b;
01081     size_t mx;
01082 
01083     GUARD_OBJ(a,GetVpValue(self,1));
01084     b = GetVpValue(r,0);
01085     if(!b) return DoSomeOne(self,r,'*');
01086     SAVE(b);
01087 
01088     mx = a->Prec + b->Prec;
01089     GUARD_OBJ(c,VpCreateRbObject(mx *(VpBaseFig() + 1), "0"));
01090     VpMult(c, a, b);
01091     return ToValue(c);
01092 }
01093 
01094 static VALUE
01095 BigDecimal_divide(Real **c, Real **res, Real **div, VALUE self, VALUE r)
01096 /* For c = self.div(r): with round operation */
01097 {
01098     ENTER(5);
01099     Real *a, *b;
01100     size_t mx;
01101 
01102     GUARD_OBJ(a,GetVpValue(self,1));
01103     b = GetVpValue(r,0);
01104     if(!b) return DoSomeOne(self,r,'/');
01105     SAVE(b);
01106     *div = b;
01107     mx = a->Prec + vabs(a->exponent);
01108     if(mx<b->Prec + vabs(b->exponent)) mx = b->Prec + vabs(b->exponent);
01109     mx =(mx + 1) * VpBaseFig();
01110     GUARD_OBJ((*c),VpCreateRbObject(mx, "#0"));
01111     GUARD_OBJ((*res),VpCreateRbObject((mx+1) * 2 +(VpBaseFig() + 1), "#0"));
01112     VpDivd(*c, *res, a, b);
01113     return (VALUE)0;
01114 }
01115 
01116  /* call-seq:
01117   * div(value, digits)
01118   * quo(value)
01119   *
01120   * Divide by the specified value.
01121   *
01122   * e.g.
01123   *   c = a.div(b,n)
01124   *
01125   * digits:: If specified and less than the number of significant digits of the result, the result is rounded to that number of digits, according to BigDecimal.mode.
01126   *
01127   * If digits is 0, the result is the same as the / operator. If not, the
01128   * result is an integer BigDecimal, by analogy with Float#div.
01129   *
01130   * The alias quo is provided since div(value, 0) is the same as computing
01131   * the quotient; see divmod.
01132   */
01133 static VALUE
01134 BigDecimal_div(VALUE self, VALUE r)
01135 /* For c = self/r: with round operation */
01136 {
01137     ENTER(5);
01138     Real *c=NULL, *res=NULL, *div = NULL;
01139     r = BigDecimal_divide(&c, &res, &div, self, r);
01140     if(r!=(VALUE)0) return r; /* coerced by other */
01141     SAVE(c);SAVE(res);SAVE(div);
01142     /* a/b = c + r/b */
01143     /* c xxxxx
01144        r 00000yyyyy  ==> (y/b)*BASE >= HALF_BASE
01145      */
01146     /* Round */
01147     if(VpHasVal(div)) { /* frac[0] must be zero for NaN,INF,Zero */
01148         VpInternalRound(c, 0, c->frac[c->Prec-1], (BDIGIT)(VpBaseVal()*(BDIGIT_DBL)res->frac[0]/div->frac[0]));
01149     }
01150     return ToValue(c);
01151 }
01152 
01153 /*
01154  * %: mod = a%b = a - (a.to_f/b).floor * b
01155  * div = (a.to_f/b).floor
01156  */
01157 static VALUE
01158 BigDecimal_DoDivmod(VALUE self, VALUE r, Real **div, Real **mod)
01159 {
01160     ENTER(8);
01161     Real *c=NULL, *d=NULL, *res=NULL;
01162     Real *a, *b;
01163     size_t mx;
01164 
01165     GUARD_OBJ(a,GetVpValue(self,1));
01166     b = GetVpValue(r,0);
01167     if(!b) return Qfalse;
01168     SAVE(b);
01169 
01170     if(VpIsNaN(a) || VpIsNaN(b)) goto NaN;
01171     if(VpIsInf(a) && VpIsInf(b)) goto NaN;
01172     if(VpIsZero(b)) {
01173         rb_raise(rb_eZeroDivError, "divided by 0");
01174     }
01175     if(VpIsInf(a)) {
01176        GUARD_OBJ(d,VpCreateRbObject(1, "0"));
01177        VpSetInf(d, (SIGNED_VALUE)(VpGetSign(a) == VpGetSign(b) ? 1 : -1));
01178        GUARD_OBJ(c,VpCreateRbObject(1, "NaN"));
01179        *div = d;
01180        *mod = c;
01181        return Qtrue;
01182     }
01183     if(VpIsInf(b)) {
01184        GUARD_OBJ(d,VpCreateRbObject(1, "0"));
01185        *div = d;
01186        *mod = a;
01187        return Qtrue;
01188     }
01189     if(VpIsZero(a)) {
01190        GUARD_OBJ(c,VpCreateRbObject(1, "0"));
01191        GUARD_OBJ(d,VpCreateRbObject(1, "0"));
01192        *div = d;
01193        *mod = c;
01194        return Qtrue;
01195     }
01196 
01197     mx = a->Prec + vabs(a->exponent);
01198     if(mx<b->Prec + vabs(b->exponent)) mx = b->Prec + vabs(b->exponent);
01199     mx =(mx + 1) * VpBaseFig();
01200     GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
01201     GUARD_OBJ(res,VpCreateRbObject((mx+1) * 2 +(VpBaseFig() + 1), "#0"));
01202     VpDivd(c, res, a, b);
01203     mx = c->Prec *(VpBaseFig() + 1);
01204     GUARD_OBJ(d,VpCreateRbObject(mx, "0"));
01205     VpActiveRound(d,c,VP_ROUND_DOWN,0);
01206     VpMult(res,d,b);
01207     VpAddSub(c,a,res,-1);
01208     if(!VpIsZero(c) && (VpGetSign(a)*VpGetSign(b)<0)) {
01209         VpAddSub(res,d,VpOne(),-1);
01210         GUARD_OBJ(d,VpCreateRbObject(GetAddSubPrec(c, b)*(VpBaseFig() + 1), "0"));
01211         VpAddSub(d  ,c,b,       1);
01212         *div = res;
01213         *mod = d;
01214     } else {
01215         *div = d;
01216         *mod = c;
01217     }
01218     return Qtrue;
01219 
01220 NaN:
01221     GUARD_OBJ(c,VpCreateRbObject(1, "NaN"));
01222     GUARD_OBJ(d,VpCreateRbObject(1, "NaN"));
01223     *div = d;
01224     *mod = c;
01225     return Qtrue;
01226 }
01227 
01228 /* call-seq:
01229  * a % b
01230  * a.modulo(b)
01231  *
01232  * Returns the modulus from dividing by b. See divmod.
01233  */
01234 static VALUE
01235 BigDecimal_mod(VALUE self, VALUE r) /* %: a%b = a - (a.to_f/b).floor * b */
01236 {
01237     ENTER(3);
01238     Real *div=NULL, *mod=NULL;
01239 
01240     if(BigDecimal_DoDivmod(self,r,&div,&mod)) {
01241         SAVE(div); SAVE(mod);
01242         return ToValue(mod);
01243     }
01244     return DoSomeOne(self,r,'%');
01245 }
01246 
01247 static VALUE
01248 BigDecimal_divremain(VALUE self, VALUE r, Real **dv, Real **rv)
01249 {
01250     ENTER(10);
01251     size_t mx;
01252     Real *a=NULL, *b=NULL, *c=NULL, *res=NULL, *d=NULL, *rr=NULL, *ff=NULL;
01253     Real *f=NULL;
01254 
01255     GUARD_OBJ(a,GetVpValue(self,1));
01256     b = GetVpValue(r,0);
01257     if(!b) return DoSomeOne(self,r,rb_intern("remainder"));
01258     SAVE(b);
01259 
01260     mx  =(a->MaxPrec + b->MaxPrec) *VpBaseFig();
01261     GUARD_OBJ(c  ,VpCreateRbObject(mx, "0"));
01262     GUARD_OBJ(res,VpCreateRbObject((mx+1) * 2 +(VpBaseFig() + 1), "#0"));
01263     GUARD_OBJ(rr ,VpCreateRbObject((mx+1) * 2 +(VpBaseFig() + 1), "#0"));
01264     GUARD_OBJ(ff ,VpCreateRbObject((mx+1) * 2 +(VpBaseFig() + 1), "#0"));
01265 
01266     VpDivd(c, res, a, b);
01267 
01268     mx = c->Prec *(VpBaseFig() + 1);
01269 
01270     GUARD_OBJ(d,VpCreateRbObject(mx, "0"));
01271     GUARD_OBJ(f,VpCreateRbObject(mx, "0"));
01272 
01273     VpActiveRound(d,c,VP_ROUND_DOWN,0); /* 0: round off */
01274 
01275     VpFrac(f, c);
01276     VpMult(rr,f,b);
01277     VpAddSub(ff,res,rr,1);
01278 
01279     *dv = d;
01280     *rv = ff;
01281     return (VALUE)0;
01282 }
01283 
01284 /* Returns the remainder from dividing by the value.
01285  *
01286  * x.remainder(y) means x-y*(x/y).truncate
01287  */
01288 static VALUE
01289 BigDecimal_remainder(VALUE self, VALUE r) /* remainder */
01290 {
01291     VALUE  f;
01292     Real  *d,*rv=0;
01293     f = BigDecimal_divremain(self,r,&d,&rv);
01294     if(f!=(VALUE)0) return f;
01295     return ToValue(rv);
01296 }
01297 
01298 /* Divides by the specified value, and returns the quotient and modulus
01299  * as BigDecimal numbers. The quotient is rounded towards negative infinity.
01300  *
01301  * For example:
01302  *
01303  * require 'bigdecimal'
01304  *
01305  * a = BigDecimal.new("42")
01306  * b = BigDecimal.new("9")
01307  *
01308  * q,m = a.divmod(b)
01309  *
01310  * c = q * b + m
01311  *
01312  * a == c  -> true
01313  *
01314  * The quotient q is (a/b).floor, and the modulus is the amount that must be
01315  * added to q * b to get a.
01316  */
01317 static VALUE
01318 BigDecimal_divmod(VALUE self, VALUE r)
01319 {
01320     ENTER(5);
01321     Real *div=NULL, *mod=NULL;
01322 
01323     if(BigDecimal_DoDivmod(self,r,&div,&mod)) {
01324         SAVE(div); SAVE(mod);
01325         return rb_assoc_new(ToValue(div), ToValue(mod));
01326     }
01327     return DoSomeOne(self,r,rb_intern("divmod"));
01328 }
01329 
01330 static VALUE
01331 BigDecimal_div2(int argc, VALUE *argv, VALUE self)
01332 {
01333     ENTER(5);
01334     VALUE b,n;
01335     int na = rb_scan_args(argc,argv,"11",&b,&n);
01336     if(na==1) { /* div in Float sense */
01337        Real *div=NULL;
01338        Real *mod;
01339        if(BigDecimal_DoDivmod(self,b,&div,&mod)) {
01340           return BigDecimal_to_i(ToValue(div));
01341        }
01342        return DoSomeOne(self,b,rb_intern("div"));
01343     } else {    /* div in BigDecimal sense */
01344        SIGNED_VALUE ix = GetPositiveInt(n);
01345        if (ix == 0) return BigDecimal_div(self, b);
01346        else {
01347           Real *res=NULL;
01348           Real *av=NULL, *bv=NULL, *cv=NULL;
01349           size_t mx = (ix+VpBaseFig()*2);
01350           size_t pl = VpSetPrecLimit(0);
01351 
01352           GUARD_OBJ(cv,VpCreateRbObject(mx,"0"));
01353           GUARD_OBJ(av,GetVpValue(self,1));
01354           GUARD_OBJ(bv,GetVpValue(b,1));
01355           mx = av->Prec + bv->Prec + 2;
01356           if(mx <= cv->MaxPrec) mx = cv->MaxPrec+1;
01357           GUARD_OBJ(res,VpCreateRbObject((mx * 2  + 2)*VpBaseFig(), "#0"));
01358           VpDivd(cv,res,av,bv);
01359           VpSetPrecLimit(pl);
01360           VpLeftRound(cv,VpGetRoundMode(),ix);
01361           return ToValue(cv);
01362        }
01363     }
01364 }
01365 
01366 static VALUE
01367 BigDecimal_add2(VALUE self, VALUE b, VALUE n)
01368 {
01369     ENTER(2);
01370     Real   *cv;
01371     SIGNED_VALUE mx = GetPositiveInt(n);
01372     if (mx == 0) return BigDecimal_add(self, b);
01373     else {
01374        size_t pl = VpSetPrecLimit(0);
01375        VALUE   c = BigDecimal_add(self,b);
01376        VpSetPrecLimit(pl);
01377        GUARD_OBJ(cv,GetVpValue(c,1));
01378        VpLeftRound(cv,VpGetRoundMode(),mx);
01379        return ToValue(cv);
01380     }
01381 }
01382 
01383 static VALUE
01384 BigDecimal_sub2(VALUE self, VALUE b, VALUE n)
01385 {
01386     ENTER(2);
01387     Real *cv;
01388     SIGNED_VALUE mx = GetPositiveInt(n);
01389     if (mx == 0) return BigDecimal_sub(self, b);
01390     else {
01391        size_t pl = VpSetPrecLimit(0);
01392        VALUE   c = BigDecimal_sub(self,b);
01393        VpSetPrecLimit(pl);
01394        GUARD_OBJ(cv,GetVpValue(c,1));
01395        VpLeftRound(cv,VpGetRoundMode(),mx);
01396        return ToValue(cv);
01397     }
01398 }
01399 
01400 static VALUE
01401 BigDecimal_mult2(VALUE self, VALUE b, VALUE n)
01402 {
01403     ENTER(2);
01404     Real *cv;
01405     SIGNED_VALUE mx = GetPositiveInt(n);
01406     if (mx == 0) return BigDecimal_mult(self, b);
01407     else {
01408        size_t pl = VpSetPrecLimit(0);
01409        VALUE   c = BigDecimal_mult(self,b);
01410        VpSetPrecLimit(pl);
01411        GUARD_OBJ(cv,GetVpValue(c,1));
01412        VpLeftRound(cv,VpGetRoundMode(),mx);
01413        return ToValue(cv);
01414     }
01415 }
01416 
01417 /* Returns the absolute value.
01418  *
01419  * BigDecimal('5').abs -> 5
01420  *
01421  * BigDecimal('-3').abs -> 3
01422  */
01423 static VALUE
01424 BigDecimal_abs(VALUE self)
01425 {
01426     ENTER(5);
01427     Real *c, *a;
01428     size_t mx;
01429 
01430     GUARD_OBJ(a,GetVpValue(self,1));
01431     mx = a->Prec *(VpBaseFig() + 1);
01432     GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
01433     VpAsgn(c, a, 1);
01434     VpChangeSign(c, 1);
01435     return ToValue(c);
01436 }
01437 
01438 /* call-seq:
01439  * sqrt(n)
01440  *
01441  * Returns the square root of the value.
01442  *
01443  * If n is specified, returns at least that many significant digits.
01444  */
01445 static VALUE
01446 BigDecimal_sqrt(VALUE self, VALUE nFig)
01447 {
01448     ENTER(5);
01449     Real *c, *a;
01450     size_t mx, n;
01451 
01452     GUARD_OBJ(a,GetVpValue(self,1));
01453     mx = a->Prec *(VpBaseFig() + 1);
01454 
01455     n = GetPositiveInt(nFig) + VpDblFig() + 1;
01456     if(mx <= n) mx = n;
01457     GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
01458     VpSqrt(c, a);
01459     return ToValue(c);
01460 }
01461 
01462 /* Return the integer part of the number.
01463  */
01464 static VALUE
01465 BigDecimal_fix(VALUE self)
01466 {
01467     ENTER(5);
01468     Real *c, *a;
01469     size_t mx;
01470 
01471     GUARD_OBJ(a,GetVpValue(self,1));
01472     mx = a->Prec *(VpBaseFig() + 1);
01473     GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
01474     VpActiveRound(c,a,VP_ROUND_DOWN,0); /* 0: round off */
01475     return ToValue(c);
01476 }
01477 
01478 /* call-seq:
01479  * round(n, mode)
01480  *
01481  * Round to the nearest 1 (by default), returning the result as a BigDecimal.
01482  *
01483  * BigDecimal('3.14159').round -> 3
01484  *
01485  * BigDecimal('8.7').round -> 9
01486  *
01487  * If n is specified and positive, the fractional part of the result has no
01488  * more than that many digits.
01489  *
01490  * If n is specified and negative, at least that many digits to the left of the
01491  * decimal point will be 0 in the result.
01492  *
01493  * BigDecimal('3.14159').round(3) -> 3.142
01494  *
01495  * BigDecimal('13345.234').round(-2) -> 13300.0
01496  *
01497  * The value of the optional mode argument can be used to determine how
01498  * rounding is performed; see BigDecimal.mode.
01499  */
01500 static VALUE
01501 BigDecimal_round(int argc, VALUE *argv, VALUE self)
01502 {
01503     ENTER(5);
01504     Real   *c, *a;
01505     int    iLoc = 0;
01506     VALUE  vLoc;
01507     VALUE  vRound;
01508     size_t mx, pl;
01509 
01510     unsigned short sw = VpGetRoundMode();
01511 
01512     switch (rb_scan_args(argc, argv, "02", &vLoc, &vRound)) {
01513     case 0:
01514         iLoc = 0;
01515         break;
01516     case 1:
01517         Check_Type(vLoc, T_FIXNUM);
01518         iLoc = FIX2INT(vLoc);
01519         break;
01520     case 2:
01521         Check_Type(vLoc, T_FIXNUM);
01522         iLoc = FIX2INT(vLoc);
01523         sw = check_rounding_mode(vRound);
01524         break;
01525     }
01526 
01527     pl = VpSetPrecLimit(0);
01528     GUARD_OBJ(a,GetVpValue(self,1));
01529     mx = a->Prec *(VpBaseFig() + 1);
01530     GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
01531     VpSetPrecLimit(pl);
01532     VpActiveRound(c,a,sw,iLoc);
01533     if (argc == 0) {
01534         return BigDecimal_to_i(ToValue(c));
01535     }
01536     return ToValue(c);
01537 }
01538 
01539 /* call-seq:
01540  * truncate(n)
01541  *
01542  * Truncate to the nearest 1, returning the result as a BigDecimal.
01543  *
01544  * BigDecimal('3.14159').truncate -> 3
01545  *
01546  * BigDecimal('8.7').truncate -> 8
01547  *
01548  * If n is specified and positive, the fractional part of the result has no
01549  * more than that many digits.
01550  *
01551  * If n is specified and negative, at least that many digits to the left of the
01552  * decimal point will be 0 in the result.
01553  *
01554  * BigDecimal('3.14159').truncate(3) -> 3.141
01555  *
01556  * BigDecimal('13345.234').truncate(-2) -> 13300.0
01557  */
01558 static VALUE
01559 BigDecimal_truncate(int argc, VALUE *argv, VALUE self)
01560 {
01561     ENTER(5);
01562     Real *c, *a;
01563     int iLoc;
01564     VALUE vLoc;
01565     size_t mx, pl = VpSetPrecLimit(0);
01566 
01567     if(rb_scan_args(argc,argv,"01",&vLoc)==0) {
01568         iLoc = 0;
01569     } else {
01570         Check_Type(vLoc, T_FIXNUM);
01571         iLoc = FIX2INT(vLoc);
01572     }
01573 
01574     GUARD_OBJ(a,GetVpValue(self,1));
01575     mx = a->Prec *(VpBaseFig() + 1);
01576     GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
01577     VpSetPrecLimit(pl);
01578     VpActiveRound(c,a,VP_ROUND_DOWN,iLoc); /* 0: truncate */
01579     if (argc == 0) {
01580         return BigDecimal_to_i(ToValue(c));
01581     }
01582     return ToValue(c);
01583 }
01584 
01585 /* Return the fractional part of the number.
01586  */
01587 static VALUE
01588 BigDecimal_frac(VALUE self)
01589 {
01590     ENTER(5);
01591     Real *c, *a;
01592     size_t mx;
01593 
01594     GUARD_OBJ(a,GetVpValue(self,1));
01595     mx = a->Prec *(VpBaseFig() + 1);
01596     GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
01597     VpFrac(c, a);
01598     return ToValue(c);
01599 }
01600 
01601 /* call-seq:
01602  * floor(n)
01603  *
01604  * Return the largest integer less than or equal to the value, as a BigDecimal.
01605  *
01606  * BigDecimal('3.14159').floor -> 3
01607  *
01608  * BigDecimal('-9.1').floor -> -10
01609  *
01610  * If n is specified and positive, the fractional part of the result has no
01611  * more than that many digits.
01612  *
01613  * If n is specified and negative, at least that
01614  * many digits to the left of the decimal point will be 0 in the result.
01615  *
01616  * BigDecimal('3.14159').floor(3) -> 3.141
01617  *
01618  * BigDecimal('13345.234').floor(-2) -> 13300.0
01619  */
01620 static VALUE
01621 BigDecimal_floor(int argc, VALUE *argv, VALUE self)
01622 {
01623     ENTER(5);
01624     Real *c, *a;
01625     int iLoc;
01626     VALUE vLoc;
01627     size_t mx, pl = VpSetPrecLimit(0);
01628 
01629     if(rb_scan_args(argc,argv,"01",&vLoc)==0) {
01630         iLoc = 0;
01631     } else {
01632         Check_Type(vLoc, T_FIXNUM);
01633         iLoc = FIX2INT(vLoc);
01634     }
01635 
01636     GUARD_OBJ(a,GetVpValue(self,1));
01637     mx = a->Prec *(VpBaseFig() + 1);
01638     GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
01639     VpSetPrecLimit(pl);
01640     VpActiveRound(c,a,VP_ROUND_FLOOR,iLoc);
01641 #ifdef BIGDECIMAL_DEBUG
01642     VPrint(stderr, "floor: c=%\n", c);
01643 #endif
01644     if (argc == 0) {
01645         return BigDecimal_to_i(ToValue(c));
01646     }
01647     return ToValue(c);
01648 }
01649 
01650 /* call-seq:
01651  * ceil(n)
01652  *
01653  * Return the smallest integer greater than or equal to the value, as a BigDecimal.
01654  *
01655  * BigDecimal('3.14159').ceil -> 4
01656  *
01657  * BigDecimal('-9.1').ceil -> -9
01658  *
01659  * If n is specified and positive, the fractional part of the result has no
01660  * more than that many digits.
01661  *
01662  * If n is specified and negative, at least that
01663  * many digits to the left of the decimal point will be 0 in the result.
01664  *
01665  * BigDecimal('3.14159').ceil(3) -> 3.142
01666  *
01667  * BigDecimal('13345.234').ceil(-2) -> 13400.0
01668  */
01669 static VALUE
01670 BigDecimal_ceil(int argc, VALUE *argv, VALUE self)
01671 {
01672     ENTER(5);
01673     Real *c, *a;
01674     int iLoc;
01675     VALUE vLoc;
01676     size_t mx, pl = VpSetPrecLimit(0);
01677 
01678     if(rb_scan_args(argc,argv,"01",&vLoc)==0) {
01679         iLoc = 0;
01680     } else {
01681         Check_Type(vLoc, T_FIXNUM);
01682         iLoc = FIX2INT(vLoc);
01683     }
01684 
01685     GUARD_OBJ(a,GetVpValue(self,1));
01686     mx = a->Prec *(VpBaseFig() + 1);
01687     GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
01688     VpSetPrecLimit(pl);
01689     VpActiveRound(c,a,VP_ROUND_CEIL,iLoc);
01690     if (argc == 0) {
01691         return BigDecimal_to_i(ToValue(c));
01692     }
01693     return ToValue(c);
01694 }
01695 
01696 /* call-seq:
01697  * to_s(s)
01698  *
01699  * Converts the value to a string.
01700  *
01701  * The default format looks like  0.xxxxEnn.
01702  *
01703  * The optional parameter s consists of either an integer; or an optional '+'
01704  * or ' ', followed by an optional number, followed by an optional 'E' or 'F'.
01705  *
01706  * If there is a '+' at the start of s, positive values are returned with
01707  * a leading '+'.
01708  *
01709  * A space at the start of s returns positive values with a leading space.
01710  *
01711  * If s contains a number, a space is inserted after each group of that many
01712  * fractional digits.
01713  *
01714  * If s ends with an 'E', engineering notation (0.xxxxEnn) is used.
01715  *
01716  * If s ends with an 'F', conventional floating point notation is used.
01717  *
01718  * Examples:
01719  *
01720  * BigDecimal.new('-123.45678901234567890').to_s('5F') -> '-123.45678 90123 45678 9'
01721  *
01722  * BigDecimal.new('123.45678901234567890').to_s('+8F') -> '+123.45678901 23456789'
01723  *
01724  * BigDecimal.new('123.45678901234567890').to_s(' F') -> ' 123.4567890123456789'
01725  */
01726 static VALUE
01727 BigDecimal_to_s(int argc, VALUE *argv, VALUE self)
01728 {
01729     ENTER(5);
01730     int   fmt=0;   /* 0:E format */
01731     int   fPlus=0; /* =0:default,=1: set ' ' before digits ,set '+' before digits. */
01732     Real  *vp;
01733     volatile VALUE str;
01734     char  *psz;
01735     char   ch;
01736     size_t nc, mc = 0;
01737     VALUE  f;
01738 
01739     GUARD_OBJ(vp,GetVpValue(self,1));
01740 
01741     if(rb_scan_args(argc,argv,"01",&f)==1) {
01742         if(TYPE(f)==T_STRING) {
01743             SafeStringValue(f);
01744             psz = RSTRING_PTR(f);
01745             if(*psz==' ') {
01746                 fPlus = 1; psz++;
01747             } else if(*psz=='+') {
01748                 fPlus = 2; psz++;
01749             }
01750             while((ch=*psz++)!=0) {
01751                 if(ISSPACE(ch)) continue;
01752                 if(!ISDIGIT(ch)) {
01753                     if(ch=='F' || ch=='f') fmt = 1; /* F format */
01754                     break;
01755                 }
01756                 mc = mc * 10 + ch - '0';
01757             }
01758         }
01759         else {
01760             mc = (size_t)GetPositiveInt(f);
01761         }
01762     }
01763     if(fmt) {
01764         nc = VpNumOfChars(vp,"F");
01765     } else {
01766         nc = VpNumOfChars(vp,"E");
01767     }
01768     if(mc>0) nc += (nc + mc - 1) / mc + 1;
01769 
01770     str = rb_str_new(0, nc);
01771     psz = RSTRING_PTR(str);
01772 
01773     if(fmt) {
01774         VpToFString(vp, psz, mc, fPlus);
01775     } else {
01776         VpToString (vp, psz, mc, fPlus);
01777     }
01778     rb_str_resize(str, strlen(psz));
01779     return str;
01780 }
01781 
01782 /* Splits a BigDecimal number into four parts, returned as an array of values.
01783  *
01784  * The first value represents the sign of the BigDecimal, and is -1 or 1, or 0
01785  * if the BigDecimal is Not a Number.
01786  *
01787  * The second value is a string representing the significant digits of the
01788  * BigDecimal, with no leading zeros.
01789  *
01790  * The third value is the base used for arithmetic (currently always 10) as an
01791  * Integer.
01792  *
01793  * The fourth value is an Integer exponent.
01794  *
01795  * If the BigDecimal can be represented as 0.xxxxxx*10**n, then xxxxxx is the
01796  * string of significant digits with no leading zeros, and n is the exponent.
01797  *
01798  * From these values, you can translate a BigDecimal to a float as follows:
01799  *
01800  *   sign, significant_digits, base, exponent = a.split
01801  *   f = sign * "0.#{significant_digits}".to_f * (base ** exponent)
01802  *
01803  * (Note that the to_f method is provided as a more convenient way to translate
01804  * a BigDecimal to a Float.)
01805  */
01806 static VALUE
01807 BigDecimal_split(VALUE self)
01808 {
01809     ENTER(5);
01810     Real *vp;
01811     VALUE obj,str;
01812     ssize_t e, s;
01813     char *psz1;
01814 
01815     GUARD_OBJ(vp,GetVpValue(self,1));
01816     str = rb_str_new(0, VpNumOfChars(vp,"E"));
01817     psz1 = RSTRING_PTR(str);
01818     VpSzMantissa(vp,psz1);
01819     s = 1;
01820     if(psz1[0]=='-') {
01821         size_t len = strlen(psz1+1);
01822 
01823         memmove(psz1, psz1+1, len);
01824         psz1[len] = '\0';
01825         s = -1;
01826     }
01827     if(psz1[0]=='N') s=0; /* NaN */
01828     e = VpExponent10(vp);
01829     obj  = rb_ary_new2(4);
01830     rb_ary_push(obj, INT2FIX(s));
01831     rb_ary_push(obj, str);
01832     rb_str_resize(str, strlen(psz1));
01833     rb_ary_push(obj, INT2FIX(10));
01834     rb_ary_push(obj, INT2NUM(e));
01835     return obj;
01836 }
01837 
01838 /* Returns the exponent of the BigDecimal number, as an Integer.
01839  *
01840  * If the number can be represented as 0.xxxxxx*10**n where xxxxxx is a string
01841  * of digits with no leading zeros, then n is the exponent.
01842  */
01843 static VALUE
01844 BigDecimal_exponent(VALUE self)
01845 {
01846     ssize_t e = VpExponent10(GetVpValue(self, 1));
01847     return INT2NUM(e);
01848 }
01849 
01850 /* Returns debugging information about the value as a string of comma-separated
01851  * values in angle brackets with a leading #:
01852  *
01853  * BigDecimal.new("1234.5678").inspect ->
01854  * "#<BigDecimal:b7ea1130,'0.12345678E4',8(12)>"
01855  *
01856  * The first part is the address, the second is the value as a string, and
01857  * the final part ss(mm) is the current number of significant digits and the
01858  * maximum number of significant digits, respectively.
01859  */
01860 static VALUE
01861 BigDecimal_inspect(VALUE self)
01862 {
01863     ENTER(5);
01864     Real *vp;
01865     volatile VALUE obj;
01866     size_t nc;
01867     char *psz, *tmp;
01868 
01869     GUARD_OBJ(vp,GetVpValue(self,1));
01870     nc = VpNumOfChars(vp,"E");
01871     nc +=(nc + 9) / 10;
01872 
01873     obj = rb_str_new(0, nc+256);
01874     psz = RSTRING_PTR(obj);
01875     sprintf(psz,"#<BigDecimal:%"PRIxVALUE",'",self);
01876     tmp = psz + strlen(psz);
01877     VpToString(vp, tmp, 10, 0);
01878     tmp += strlen(tmp);
01879     sprintf(tmp, "',%"PRIuSIZE"(%"PRIuSIZE")>", VpPrec(vp)*VpBaseFig(), VpMaxPrec(vp)*VpBaseFig());
01880     rb_str_resize(obj, strlen(psz));
01881     return obj;
01882 }
01883 
01884 static VALUE BigMath_s_exp(VALUE, VALUE, VALUE);
01885 static VALUE BigMath_s_log(VALUE, VALUE, VALUE);
01886 
01887 #define BigMath_exp(x, n) BigMath_s_exp(rb_mBigMath, (x), (n))
01888 #define BigMath_log(x, n) BigMath_s_log(rb_mBigMath, (x), (n))
01889 
01890 inline static int
01891 is_integer(VALUE x)
01892 {
01893     return (TYPE(x) == T_FIXNUM || TYPE(x) == T_BIGNUM);
01894 }
01895 
01896 inline static int
01897 is_negative(VALUE x)
01898 {
01899     if (FIXNUM_P(x)) {
01900         return FIX2LONG(x) < 0;
01901     }
01902     else if (TYPE(x) == T_BIGNUM) {
01903         return RBIGNUM_NEGATIVE_P(x);
01904     }
01905     else if (TYPE(x) == T_FLOAT) {
01906         return RFLOAT_VALUE(x) < 0.0;
01907     }
01908     return RTEST(rb_funcall(x, '<', 1, INT2FIX(0)));
01909 }
01910 
01911 #define is_positive(x) (!is_negative(x))
01912 
01913 inline static int
01914 is_zero(VALUE x)
01915 {
01916     VALUE num;
01917 
01918     switch (TYPE(x)) {
01919       case T_FIXNUM:
01920         return FIX2LONG(x) == 0;
01921 
01922       case T_BIGNUM:
01923         return Qfalse;
01924 
01925       case T_RATIONAL:
01926         num = RRATIONAL(x)->num;
01927         return FIXNUM_P(num) && FIX2LONG(num) == 0;
01928 
01929       default:
01930         break;
01931     }
01932 
01933     return RTEST(rb_funcall(x, id_eq, 1, INT2FIX(0)));
01934 }
01935 
01936 inline static int
01937 is_one(VALUE x)
01938 {
01939     VALUE num, den;
01940 
01941     switch (TYPE(x)) {
01942       case T_FIXNUM:
01943         return FIX2LONG(x) == 1;
01944 
01945       case T_BIGNUM:
01946         return Qfalse;
01947 
01948       case T_RATIONAL:
01949         num = RRATIONAL(x)->num;
01950         den = RRATIONAL(x)->den;
01951         return FIXNUM_P(den) && FIX2LONG(den) == 1 &&
01952                FIXNUM_P(num) && FIX2LONG(num) == 1;
01953 
01954       default:
01955         break;
01956     }
01957 
01958     return RTEST(rb_funcall(x, id_eq, 1, INT2FIX(1)));
01959 }
01960 
01961 inline static int
01962 is_even(VALUE x)
01963 {
01964     switch (TYPE(x)) {
01965       case T_FIXNUM:
01966         return (FIX2LONG(x) % 2) == 0;
01967 
01968       case T_BIGNUM:
01969         return (RBIGNUM_DIGITS(x)[0] % 2) == 0;
01970 
01971       default:
01972         break;
01973     }
01974 
01975     return 0;
01976 }
01977 
01978 static VALUE
01979 rmpd_power_by_big_decimal(Real const* x, Real const* exp, ssize_t const n)
01980 {
01981     VALUE log_x, multiplied, y;
01982 
01983     if (VpIsZero(exp)) {
01984         return ToValue(VpCreateRbObject(n, "1"));
01985     }
01986 
01987     log_x = BigMath_log(x->obj, SSIZET2NUM(n+1));
01988     multiplied = BigDecimal_mult2(exp->obj, log_x, SSIZET2NUM(n+1));
01989     y = BigMath_exp(multiplied, SSIZET2NUM(n));
01990 
01991     return y;
01992 }
01993 
01994 /* call-seq:
01995  * power(n)
01996  * power(n, prec)
01997  *
01998  * Returns the value raised to the power of n. Note that n must be an Integer.
01999  *
02000  * Also available as the operator **
02001  */
02002 static VALUE
02003 BigDecimal_power(int argc, VALUE*argv, VALUE self)
02004 {
02005     ENTER(5);
02006     VALUE vexp, prec;
02007     Real* exp = NULL;
02008     Real *x, *y;
02009     ssize_t mp, ma, n;
02010     SIGNED_VALUE int_exp;
02011     double d;
02012 
02013     rb_scan_args(argc, argv, "11", &vexp, &prec);
02014 
02015     GUARD_OBJ(x, GetVpValue(self, 1));
02016     n = NIL_P(prec) ? (ssize_t)(x->Prec*VpBaseFig()) : NUM2SSIZET(prec);
02017 
02018     if (VpIsNaN(x)) {
02019         y = VpCreateRbObject(n, "0#");
02020         RB_GC_GUARD(y->obj);
02021         VpSetNaN(y);
02022         return ToValue(y);
02023     }
02024 
02025 retry:
02026     switch (TYPE(vexp)) {
02027       case T_FIXNUM:
02028         break;
02029 
02030       case T_BIGNUM:
02031         break;
02032 
02033       case T_FLOAT:
02034         d = RFLOAT_VALUE(vexp);
02035         if (d == round(d)) {
02036             vexp = LL2NUM((LONG_LONG)round(d));
02037             goto retry;
02038         }
02039         exp = GetVpValueWithPrec(vexp, DBL_DIG+1, 1);
02040         break;
02041 
02042       case T_RATIONAL:
02043         if (is_zero(RRATIONAL(vexp)->num)) {
02044             if (is_positive(vexp)) {
02045                 vexp = INT2FIX(0);
02046                 goto retry;
02047             }
02048         }
02049         else if (is_one(RRATIONAL(vexp)->den)) {
02050             vexp = RRATIONAL(vexp)->num;
02051             goto retry;
02052         }
02053         exp = GetVpValueWithPrec(vexp, n, 1);
02054         break;
02055 
02056       case T_DATA:
02057         if (is_kind_of_BigDecimal(vexp)) {
02058             VALUE zero = INT2FIX(0);
02059             VALUE rounded = BigDecimal_round(1, &zero, vexp);
02060             if (RTEST(BigDecimal_eq(vexp, rounded))) {
02061                 vexp = BigDecimal_to_i(vexp);
02062                 goto retry;
02063             }
02064             exp = DATA_PTR(vexp);
02065             break;
02066         }
02067         /* fall through */
02068       default:
02069         rb_raise(rb_eTypeError,
02070                  "wrong argument type %s (expected scalar Numeric)",
02071                  rb_obj_classname(vexp));
02072     }
02073 
02074     if (VpIsZero(x)) {
02075         if (is_negative(vexp)) {
02076             y = VpCreateRbObject(n, "#0");
02077             RB_GC_GUARD(y->obj);
02078             if (VpGetSign(x) < 0) {
02079                 if (is_integer(vexp)) {
02080                     if (is_even(vexp)) {
02081                         /* (-0) ** (-even_integer)  -> Infinity */
02082                         VpSetPosInf(y);
02083                     }
02084                     else {
02085                         /* (-0) ** (-odd_integer)  -> -Infinity */
02086                         VpSetNegInf(y);
02087                     }
02088                 }
02089                 else {
02090                     /* (-0) ** (-non_integer)  -> Infinity */
02091                     VpSetPosInf(y);
02092                 }
02093             }
02094             else {
02095                 /* (+0) ** (-num)  -> Infinity */
02096                 VpSetPosInf(y);
02097             }
02098             return ToValue(y);
02099         }
02100         else if (is_zero(vexp)) {
02101             return ToValue(VpCreateRbObject(n, "1"));
02102         }
02103         else {
02104             return ToValue(VpCreateRbObject(n, "0"));
02105         }
02106     }
02107 
02108     if (is_zero(vexp)) {
02109         return ToValue(VpCreateRbObject(n, "1"));
02110     }
02111     else if (is_one(vexp)) {
02112         return self;
02113     }
02114 
02115     if (VpIsInf(x)) {
02116         if (is_negative(vexp)) {
02117             if (VpGetSign(x) < 0) {
02118                 if (is_integer(vexp)) {
02119                     if (is_even(vexp)) {
02120                         /* (-Infinity) ** (-even_integer) -> +0 */
02121                         return ToValue(VpCreateRbObject(n, "0"));
02122                     }
02123                     else {
02124                         /* (-Infinity) ** (-odd_integer) -> -0 */
02125                         return ToValue(VpCreateRbObject(n, "-0"));
02126                     }
02127                 }
02128                 else {
02129                     /* (-Infinity) ** (-non_integer) -> -0 */
02130                     return ToValue(VpCreateRbObject(n, "-0"));
02131                 }
02132             }
02133             else {
02134                 return ToValue(VpCreateRbObject(n, "0"));
02135             }
02136         }
02137         else {
02138             y = VpCreateRbObject(n, "0#");
02139             if (VpGetSign(x) < 0) {
02140                 if (is_integer(vexp)) {
02141                     if (is_even(vexp)) {
02142                         VpSetPosInf(y);
02143                     }
02144                     else {
02145                         VpSetNegInf(y);
02146                     }
02147                 }
02148                 else {
02149                     /* TODO: support complex */
02150                     rb_raise(rb_eMathDomainError,
02151                              "a non-integral exponent for a negative base");
02152                 }
02153             }
02154             else {
02155                 VpSetPosInf(y);
02156             }
02157             return ToValue(y);
02158         }
02159     }
02160 
02161     if (exp != NULL) {
02162         return rmpd_power_by_big_decimal(x, exp, n);
02163     }
02164     else if (TYPE(vexp) == T_BIGNUM) {
02165         VALUE abs_value = BigDecimal_abs(self);
02166         if (is_one(abs_value)) {
02167             return ToValue(VpCreateRbObject(n, "1"));
02168         }
02169         else if (RTEST(rb_funcall(abs_value, '<', 1, INT2FIX(1)))) {
02170             if (is_negative(vexp)) {
02171                 y = VpCreateRbObject(n, "0#");
02172                 if (is_even(vexp)) {
02173                     VpSetInf(y, VpGetSign(x));
02174                 }
02175                 else {
02176                     VpSetInf(y, -VpGetSign(x));
02177                 }
02178                 return ToValue(y);
02179             }
02180             else if (VpGetSign(x) < 0 && is_even(vexp)) {
02181                 return ToValue(VpCreateRbObject(n, "-0"));
02182             }
02183             else {
02184                 return ToValue(VpCreateRbObject(n, "0"));
02185             }
02186         }
02187         else {
02188             if (is_positive(vexp)) {
02189                 y = VpCreateRbObject(n, "0#");
02190                 if (is_even(vexp)) {
02191                     VpSetInf(y, VpGetSign(x));
02192                 }
02193                 else {
02194                     VpSetInf(y, -VpGetSign(x));
02195                 }
02196                 return ToValue(y);
02197             }
02198             else if (VpGetSign(x) < 0 && is_even(vexp)) {
02199                 return ToValue(VpCreateRbObject(n, "-0"));
02200             }
02201             else {
02202                 return ToValue(VpCreateRbObject(n, "0"));
02203             }
02204         }
02205     }
02206 
02207     int_exp = FIX2INT(vexp);
02208     ma = int_exp;
02209     if (ma < 0)  ma = -ma;
02210     if (ma == 0) ma = 1;
02211 
02212     if (VpIsDef(x)) {
02213         mp = x->Prec * (VpBaseFig() + 1);
02214         GUARD_OBJ(y, VpCreateRbObject(mp * (ma + 1), "0"));
02215     }
02216     else {
02217         GUARD_OBJ(y, VpCreateRbObject(1, "0"));
02218     }
02219     VpPower(y, x, int_exp);
02220     return ToValue(y);
02221 }
02222 
02223 /* call-seq:
02224  *   big_decimal ** exp  -> big_decimal
02225  *
02226  * It is a synonym of big_decimal.power(exp).
02227  */
02228 static VALUE
02229 BigDecimal_power_op(VALUE self, VALUE exp)
02230 {
02231     return BigDecimal_power(1, &exp, self);
02232 }
02233 
02234 /* call-seq:
02235  *   new(initial, digits)
02236  *
02237  * Create a new BigDecimal object.
02238  *
02239  * initial:: The initial value, as an Integer, a Float, a Rational,
02240  *           a BigDecimal, or a String.
02241  *           If it is a String, spaces are ignored and unrecognized characters
02242  *           terminate the value.
02243  *
02244  * digits:: The number of significant digits, as a Fixnum. If omitted or 0,
02245  *          the number of significant digits is determined from the initial
02246  *          value.
02247  *
02248  * The actual number of significant digits used in computation is usually
02249  * larger than the specified number.
02250  */
02251 static VALUE
02252 BigDecimal_new(int argc, VALUE *argv, VALUE self)
02253 {
02254     ENTER(5);
02255     Real *pv;
02256     size_t mf;
02257     VALUE  nFig;
02258     VALUE  iniValue;
02259 
02260     if (rb_scan_args(argc, argv, "11", &iniValue, &nFig) == 1) {
02261         mf = 0;
02262     }
02263     else {
02264         mf = GetPositiveInt(nFig);
02265     }
02266 
02267     switch (TYPE(iniValue)) {
02268       case T_DATA:
02269         if (is_kind_of_BigDecimal(iniValue)) {
02270             pv = VpDup(DATA_PTR(iniValue));
02271             return ToValue(pv);
02272         }
02273         break;
02274 
02275       case T_FIXNUM:
02276         /* fall through */
02277       case T_BIGNUM:
02278         return ToValue(GetVpValue(iniValue, 1));
02279 
02280       case T_FLOAT:
02281         if (mf > DBL_DIG+1) {
02282             rb_raise(rb_eArgError, "precision too large.");
02283         }
02284         /* fall through */
02285       case T_RATIONAL:
02286         if (NIL_P(nFig)) {
02287             rb_raise(rb_eArgError, "can't omit precision for a Rational.");
02288         }
02289         return ToValue(GetVpValueWithPrec(iniValue, mf, 1));
02290 
02291       case T_STRING:
02292         /* fall through */
02293       default:
02294         break;
02295     }
02296     SafeStringValue(iniValue);
02297     GUARD_OBJ(pv, VpNewRbClass(mf, RSTRING_PTR(iniValue),self));
02298 
02299     return ToValue(pv);
02300 }
02301 
02302 static VALUE
02303 BigDecimal_global_new(int argc, VALUE *argv, VALUE self)
02304 {
02305     return BigDecimal_new(argc, argv, rb_cBigDecimal);
02306 }
02307 
02308  /* call-seq:
02309   * BigDecimal.limit(digits)
02310   *
02311   * Limit the number of significant digits in newly created BigDecimal
02312   * numbers to the specified value. Rounding is performed as necessary,
02313   * as specified by BigDecimal.mode.
02314   *
02315   * A limit of 0, the default, means no upper limit.
02316   *
02317   * The limit specified by this method takes less priority over any limit
02318   * specified to instance methods such as ceil, floor, truncate, or round.
02319   */
02320 static VALUE
02321 BigDecimal_limit(int argc, VALUE *argv, VALUE self)
02322 {
02323     VALUE  nFig;
02324     VALUE  nCur = INT2NUM(VpGetPrecLimit());
02325 
02326     if(rb_scan_args(argc,argv,"01",&nFig)==1) {
02327         int nf;
02328         if(nFig==Qnil) return nCur;
02329         Check_Type(nFig, T_FIXNUM);
02330         nf = FIX2INT(nFig);
02331         if(nf<0) {
02332             rb_raise(rb_eArgError, "argument must be positive");
02333         }
02334         VpSetPrecLimit(nf);
02335     }
02336     return nCur;
02337 }
02338 
02339 /* Returns the sign of the value.
02340  *
02341  * Returns a positive value if > 0, a negative value if < 0, and a
02342  * zero if == 0.
02343  *
02344  * The specific value returned indicates the type and sign of the BigDecimal,
02345  * as follows:
02346  *
02347  * BigDecimal::SIGN_NaN:: value is Not a Number
02348  * BigDecimal::SIGN_POSITIVE_ZERO:: value is +0
02349  * BigDecimal::SIGN_NEGATIVE_ZERO:: value is -0
02350  * BigDecimal::SIGN_POSITIVE_INFINITE:: value is +infinity
02351  * BigDecimal::SIGN_NEGATIVE_INFINITE:: value is -infinity
02352  * BigDecimal::SIGN_POSITIVE_FINITE:: value is positive
02353  * BigDecimal::SIGN_NEGATIVE_FINITE:: value is negative
02354  */
02355 static VALUE
02356 BigDecimal_sign(VALUE self)
02357 { /* sign */
02358     int s = GetVpValue(self,1)->sign;
02359     return INT2FIX(s);
02360 }
02361 
02362 /* call-seq:
02363  * BigDecimal.save_exception_mode { ... }
02364  */
02365 static VALUE
02366 BigDecimal_save_exception_mode(VALUE self)
02367 {
02368     unsigned short const exception_mode = VpGetException();
02369     int state;
02370     VALUE ret = rb_protect(rb_yield, Qnil, &state);
02371     VpSetException(exception_mode);
02372     if (state) rb_jump_tag(state);
02373     return ret;
02374 }
02375 
02376 /* call-seq:
02377  * BigDecimal.save_rounding_mode { ... }
02378  */
02379 static VALUE
02380 BigDecimal_save_rounding_mode(VALUE self)
02381 {
02382     unsigned short const round_mode = VpGetRoundMode();
02383     int state;
02384     VALUE ret = rb_protect(rb_yield, Qnil, &state);
02385     VpSetRoundMode(round_mode);
02386     if (state) rb_jump_tag(state);
02387     return ret;
02388 }
02389 
02390 /* call-seq:
02391  * BigDecimal.save_limit { ... }
02392  */
02393 static VALUE
02394 BigDecimal_save_limit(VALUE self)
02395 {
02396     size_t const limit = VpGetPrecLimit();
02397     int state;
02398     VALUE ret = rb_protect(rb_yield, Qnil, &state);
02399     VpSetPrecLimit(limit);
02400     if (state) rb_jump_tag(state);
02401     return ret;
02402 }
02403 
02404 /* call-seq:
02405  * BigMath.exp(x, prec)
02406  *
02407  * Computes the value of e (the base of natural logarithms) raised to the
02408  * power of x, to the specified number of digits of precision.
02409  *
02410  * If x is infinite, returns Infinity.
02411  *
02412  * If x is NaN, returns NaN.
02413  */
02414 static VALUE
02415 BigMath_s_exp(VALUE klass, VALUE x, VALUE vprec)
02416 {
02417     ssize_t prec, n, i;
02418     Real* vx = NULL;
02419     VALUE one, d, x1, y, z;
02420     int negative = 0;
02421     int infinite = 0;
02422     int nan = 0;
02423     double flo;
02424 
02425     prec = NUM2SSIZET(vprec);
02426     if (prec <= 0) {
02427         rb_raise(rb_eArgError, "Zero or negative precision for exp");
02428     }
02429 
02430     /* TODO: the following switch statement is almostly the same as one in the
02431      *       BigDecimalCmp function. */
02432     switch (TYPE(x)) {
02433       case T_DATA:
02434           if (!is_kind_of_BigDecimal(x)) break;
02435           vx = DATA_PTR(x);
02436           negative = VpGetSign(vx) < 0;
02437           infinite = VpIsPosInf(vx) || VpIsNegInf(vx);
02438           nan = VpIsNaN(vx);
02439           break;
02440 
02441       case T_FIXNUM:
02442           /* fall through */
02443       case T_BIGNUM:
02444           vx = GetVpValue(x, 0);
02445           break;
02446 
02447       case T_FLOAT:
02448         flo = RFLOAT_VALUE(x);
02449         negative = flo < 0;
02450         infinite = isinf(flo);
02451         nan = isnan(flo);
02452         if (!infinite && !nan) {
02453             vx = GetVpValueWithPrec(x, DBL_DIG+1, 0);
02454         }
02455         break;
02456 
02457       case T_RATIONAL:
02458         vx = GetVpValueWithPrec(x, prec, 0);
02459         break;
02460 
02461       default:
02462         break;
02463     }
02464     if (infinite) {
02465         if (negative) {
02466             return ToValue(GetVpValueWithPrec(INT2NUM(0), prec, 1));
02467         }
02468         else {
02469             Real* vy;
02470             vy = VpCreateRbObject(prec, "#0");
02471             RB_GC_GUARD(vy->obj);
02472             VpSetInf(vy, VP_SIGN_POSITIVE_INFINITE);
02473             return ToValue(vy);
02474         }
02475     }
02476     else if (nan) {
02477         Real* vy;
02478         vy = VpCreateRbObject(prec, "#0");
02479         RB_GC_GUARD(vy->obj);
02480         VpSetNaN(vy);
02481         return ToValue(vy);
02482     }
02483     else if (vx == NULL) {
02484         cannot_be_coerced_into_BigDecimal(rb_eArgError, x);
02485     }
02486     RB_GC_GUARD(vx->obj);
02487 
02488     n = prec + rmpd_double_figures();
02489     negative = VpGetSign(vx) < 0;
02490     if (negative) {
02491         VpSetSign(vx, 1);
02492     }
02493 
02494     RB_GC_GUARD(one) = ToValue(VpCreateRbObject(1, "1"));
02495     RB_GC_GUARD(x1) = one;
02496     RB_GC_GUARD(y)  = one;
02497     RB_GC_GUARD(d)  = y;
02498     RB_GC_GUARD(z)  = one;
02499     i  = 0;
02500 
02501     while (!VpIsZero((Real*)DATA_PTR(d))) {
02502         VALUE argv[2];
02503         SIGNED_VALUE const ey = VpExponent10(DATA_PTR(y));
02504         SIGNED_VALUE const ed = VpExponent10(DATA_PTR(d));
02505         ssize_t m = n - vabs(ey - ed);
02506         if (m <= 0) {
02507             break;
02508         }
02509         else if ((size_t)m < rmpd_double_figures()) {
02510             m = rmpd_double_figures();
02511         }
02512 
02513         x1 = BigDecimal_mult2(x1, x, SSIZET2NUM(n));
02514         ++i;
02515         z = BigDecimal_mult(z, SSIZET2NUM(i));
02516         argv[0] = z;
02517         argv[1] = SSIZET2NUM(m);
02518         d = BigDecimal_div2(2, argv, x1);
02519         y = BigDecimal_add(y, d);
02520     }
02521 
02522     if (negative) {
02523         VALUE argv[2];
02524         argv[0] = y;
02525         argv[1] = vprec;
02526         return BigDecimal_div2(2, argv, one);
02527     }
02528     else {
02529         vprec = SSIZET2NUM(prec - VpExponent10(DATA_PTR(y)));
02530         return BigDecimal_round(1, &vprec, y);
02531     }
02532 }
02533 
02534 /* call-seq:
02535  * BigMath.log(x, prec)
02536  *
02537  * Computes the natural logarithm of x to the specified number of digits of
02538  * precision.
02539  *
02540  * If x is zero or negative, raises Math::DomainError.
02541  *
02542  * If x is positive infinite, returns Infinity.
02543  *
02544  * If x is NaN, returns NaN.
02545  */
02546 static VALUE
02547 BigMath_s_log(VALUE klass, VALUE x, VALUE vprec)
02548 {
02549     ssize_t prec, n, i;
02550     SIGNED_VALUE expo;
02551     Real* vx = NULL;
02552     VALUE argv[2], vn, one, two, w, x2, y, d;
02553     int zero = 0;
02554     int negative = 0;
02555     int infinite = 0;
02556     int nan = 0;
02557     double flo;
02558     long fix;
02559 
02560     if (TYPE(vprec) != T_FIXNUM && TYPE(vprec) != T_BIGNUM) {
02561         rb_raise(rb_eArgError, "precision must be an Integer");
02562     }
02563 
02564     prec = NUM2SSIZET(vprec);
02565     if (prec <= 0) {
02566         rb_raise(rb_eArgError, "Zero or negative precision for exp");
02567     }
02568 
02569     /* TODO: the following switch statement is almostly the same as one in the
02570      *       BigDecimalCmp function. */
02571     switch (TYPE(x)) {
02572       case T_DATA:
02573           if (!is_kind_of_BigDecimal(x)) break;
02574           vx = DATA_PTR(x);
02575           zero = VpIsZero(vx);
02576           negative = VpGetSign(vx) < 0;
02577           infinite = VpIsPosInf(vx) || VpIsNegInf(vx);
02578           nan = VpIsNaN(vx);
02579           break;
02580 
02581       case T_FIXNUM:
02582         fix = FIX2LONG(x);
02583         zero = fix == 0;
02584         negative = fix < 0;
02585         goto get_vp_value;
02586 
02587       case T_BIGNUM:
02588         zero = RBIGNUM_ZERO_P(x);
02589         negative = RBIGNUM_NEGATIVE_P(x);
02590 get_vp_value:
02591         if (zero || negative) break;
02592         vx = GetVpValue(x, 0);
02593         break;
02594 
02595       case T_FLOAT:
02596         flo = RFLOAT_VALUE(x);
02597         zero = flo == 0;
02598         negative = flo < 0;
02599         infinite = isinf(flo);
02600         nan = isnan(flo);
02601         if (!zero && !negative && !infinite && !nan) {
02602             vx = GetVpValueWithPrec(x, DBL_DIG+1, 1);
02603         }
02604         break;
02605 
02606       case T_RATIONAL:
02607         zero = RRATIONAL_ZERO_P(x);
02608         negative = RRATIONAL_NEGATIVE_P(x);
02609         if (zero || negative) break;
02610         vx = GetVpValueWithPrec(x, prec, 1);
02611         break;
02612 
02613       case T_COMPLEX:
02614         rb_raise(rb_eMathDomainError,
02615                  "Complex argument for BigMath.log");
02616 
02617       default:
02618         break;
02619     }
02620     if (infinite && !negative) {
02621         Real* vy;
02622         vy = VpCreateRbObject(prec, "#0");
02623         RB_GC_GUARD(vy->obj);
02624         VpSetInf(vy, VP_SIGN_POSITIVE_INFINITE);
02625         return ToValue(vy);
02626     }
02627     else if (nan) {
02628         Real* vy;
02629         vy = VpCreateRbObject(prec, "#0");
02630         RB_GC_GUARD(vy->obj);
02631         VpSetNaN(vy);
02632         return ToValue(vy);
02633     }
02634     else if (zero || negative) {
02635         rb_raise(rb_eMathDomainError,
02636                  "Zero or negative argument for log");
02637     }
02638     else if (vx == NULL) {
02639         cannot_be_coerced_into_BigDecimal(rb_eArgError, x);
02640     }
02641     x = ToValue(vx);
02642 
02643     RB_GC_GUARD(one) = ToValue(VpCreateRbObject(1, "1"));
02644     RB_GC_GUARD(two) = ToValue(VpCreateRbObject(1, "2"));
02645 
02646     n = prec + rmpd_double_figures();
02647     RB_GC_GUARD(vn) = SSIZET2NUM(n);
02648     expo = VpExponent10(vx);
02649     if (expo < 0 || expo >= 3) {
02650         char buf[16];
02651         snprintf(buf, 16, "1E%ld", -expo);
02652         x = BigDecimal_mult2(x, ToValue(VpCreateRbObject(1, buf)), vn);
02653     }
02654     else {
02655         expo = 0;
02656     }
02657     w = BigDecimal_sub(x, one);
02658     argv[0] = BigDecimal_add(x, one);
02659     argv[1] = vn;
02660     x = BigDecimal_div2(2, argv, w);
02661     RB_GC_GUARD(x2) = BigDecimal_mult2(x, x, vn);
02662     RB_GC_GUARD(y)  = x;
02663     RB_GC_GUARD(d)  = y;
02664     i = 1;
02665     while (!VpIsZero((Real*)DATA_PTR(d))) {
02666         SIGNED_VALUE const ey = VpExponent10(DATA_PTR(y));
02667         SIGNED_VALUE const ed = VpExponent10(DATA_PTR(d));
02668         ssize_t m = n - vabs(ey - ed);
02669         if (m <= 0) {
02670             break;
02671         }
02672         else if ((size_t)m < rmpd_double_figures()) {
02673             m = rmpd_double_figures();
02674         }
02675 
02676         x = BigDecimal_mult2(x2, x, vn);
02677         i += 2;
02678         argv[0] = SSIZET2NUM(i);
02679         argv[1] = SSIZET2NUM(m);
02680         d = BigDecimal_div2(2, argv, x);
02681         y = BigDecimal_add(y, d);
02682     }
02683 
02684     y = BigDecimal_mult(y, two);
02685     if (expo != 0) {
02686         VALUE log10, vexpo, dy;
02687         log10 = BigMath_s_log(klass, INT2FIX(10), vprec);
02688         vexpo = ToValue(GetVpValue(SSIZET2NUM(expo), 1));
02689         dy = BigDecimal_mult(log10, vexpo);
02690         y = BigDecimal_add(y, dy);
02691     }
02692 
02693     return y;
02694 }
02695 
02696 /* Document-class: BigDecimal
02697  * BigDecimal provides arbitrary-precision floating point decimal arithmetic.
02698  *
02699  * Copyright (C) 2002 by Shigeo Kobayashi <shigeo@tinyforest.gr.jp>.
02700  * You may distribute under the terms of either the GNU General Public
02701  * License or the Artistic License, as specified in the README file
02702  * of the BigDecimal distribution.
02703  *
02704  * Documented by mathew <meta@pobox.com>.
02705  *
02706  * = Introduction
02707  *
02708  * Ruby provides built-in support for arbitrary precision integer arithmetic.
02709  * For example:
02710  *
02711  * 42**13   ->   1265437718438866624512
02712  *
02713  * BigDecimal provides similar support for very large or very accurate floating
02714  * point numbers.
02715  *
02716  * Decimal arithmetic is also useful for general calculation, because it
02717  * provides the correct answers people expect--whereas normal binary floating
02718  * point arithmetic often introduces subtle errors because of the conversion
02719  * between base 10 and base 2. For example, try:
02720  *
02721  *   sum = 0
02722  *   for i in (1..10000)
02723  *     sum = sum + 0.0001
02724  *   end
02725  *   print sum
02726  *
02727  * and contrast with the output from:
02728  *
02729  *   require 'bigdecimal'
02730  *
02731  *   sum = BigDecimal.new("0")
02732  *   for i in (1..10000)
02733  *     sum = sum + BigDecimal.new("0.0001")
02734  *   end
02735  *   print sum
02736  *
02737  * Similarly:
02738  *
02739  * (BigDecimal.new("1.2") - BigDecimal("1.0")) == BigDecimal("0.2") -> true
02740  *
02741  * (1.2 - 1.0) == 0.2 -> false
02742  *
02743  * = Special features of accurate decimal arithmetic
02744  *
02745  * Because BigDecimal is more accurate than normal binary floating point
02746  * arithmetic, it requires some special values.
02747  *
02748  * == Infinity
02749  *
02750  * BigDecimal sometimes needs to return infinity, for example if you divide
02751  * a value by zero.
02752  *
02753  * BigDecimal.new("1.0") / BigDecimal.new("0.0")  -> infinity
02754  *
02755  * BigDecimal.new("-1.0") / BigDecimal.new("0.0")  -> -infinity
02756  *
02757  * You can represent infinite numbers to BigDecimal using the strings
02758  * 'Infinity', '+Infinity' and '-Infinity' (case-sensitive)
02759  *
02760  * == Not a Number
02761  *
02762  * When a computation results in an undefined value, the special value NaN
02763  * (for 'not a number') is returned.
02764  *
02765  * Example:
02766  *
02767  * BigDecimal.new("0.0") / BigDecimal.new("0.0") -> NaN
02768  *
02769  * You can also create undefined values.  NaN is never considered to be the
02770  * same as any other value, even NaN itself:
02771  *
02772  * n = BigDecimal.new('NaN')
02773  *
02774  * n == 0.0 -> nil
02775  *
02776  * n == n -> nil
02777  *
02778  * == Positive and negative zero
02779  *
02780  * If a computation results in a value which is too small to be represented as
02781  * a BigDecimal within the currently specified limits of precision, zero must
02782  * be returned.
02783  *
02784  * If the value which is too small to be represented is negative, a BigDecimal
02785  * value of negative zero is returned. If the value is positive, a value of
02786  * positive zero is returned.
02787  *
02788  * BigDecimal.new("1.0") / BigDecimal.new("-Infinity") -> -0.0
02789  *
02790  * BigDecimal.new("1.0") / BigDecimal.new("Infinity") -> 0.0
02791  *
02792  * (See BigDecimal.mode for how to specify limits of precision.)
02793  *
02794  * Note that -0.0 and 0.0 are considered to be the same for the purposes of
02795  * comparison.
02796  *
02797  * Note also that in mathematics, there is no particular concept of negative
02798  * or positive zero; true mathematical zero has no sign.
02799  */
02800 void
02801 Init_bigdecimal(void)
02802 {
02803     VALUE arg;
02804 
02805     id_BigDecimal_exception_mode = rb_intern_const("BigDecimal.exception_mode");
02806     id_BigDecimal_rounding_mode = rb_intern_const("BigDecimal.rounding_mode");
02807     id_BigDecimal_precision_limit = rb_intern_const("BigDecimal.precision_limit");
02808 
02809     /* Initialize VP routines */
02810     VpInit(0UL);
02811 
02812     /* Class and method registration */
02813     rb_cBigDecimal = rb_define_class("BigDecimal",rb_cNumeric);
02814 
02815     /* Global function */
02816     rb_define_global_function("BigDecimal", BigDecimal_global_new, -1);
02817 
02818     /* Class methods */
02819     rb_define_singleton_method(rb_cBigDecimal, "new", BigDecimal_new, -1);
02820     rb_define_singleton_method(rb_cBigDecimal, "mode", BigDecimal_mode, -1);
02821     rb_define_singleton_method(rb_cBigDecimal, "limit", BigDecimal_limit, -1);
02822     rb_define_singleton_method(rb_cBigDecimal, "double_fig", BigDecimal_double_fig, 0);
02823     rb_define_singleton_method(rb_cBigDecimal, "_load", BigDecimal_load, 1);
02824     rb_define_singleton_method(rb_cBigDecimal, "ver", BigDecimal_version, 0);
02825 
02826     rb_define_singleton_method(rb_cBigDecimal, "save_exception_mode", BigDecimal_save_exception_mode, 0);
02827     rb_define_singleton_method(rb_cBigDecimal, "save_rounding_mode", BigDecimal_save_rounding_mode, 0);
02828     rb_define_singleton_method(rb_cBigDecimal, "save_limit", BigDecimal_save_limit, 0);
02829 
02830     /* Constants definition */
02831 
02832     /*
02833      * Base value used in internal calculations.  On a 32 bit system, BASE
02834      * is 10000, indicating that calculation is done in groups of 4 digits.
02835      * (If it were larger, BASE**2 wouldn't fit in 32 bits, so you couldn't
02836      * guarantee that two groups could always be multiplied together without
02837      * overflow.)
02838      */
02839     rb_define_const(rb_cBigDecimal, "BASE", INT2FIX((SIGNED_VALUE)VpBaseVal()));
02840 
02841     /* Exceptions */
02842 
02843     /*
02844      * 0xff: Determines whether overflow, underflow or zero divide result in
02845      * an exception being thrown. See BigDecimal.mode.
02846      */
02847     rb_define_const(rb_cBigDecimal, "EXCEPTION_ALL",INT2FIX(VP_EXCEPTION_ALL));
02848 
02849     /*
02850      * 0x02: Determines what happens when the result of a computation is not a
02851      * number (NaN). See BigDecimal.mode.
02852      */
02853     rb_define_const(rb_cBigDecimal, "EXCEPTION_NaN",INT2FIX(VP_EXCEPTION_NaN));
02854 
02855     /*
02856      * 0x01: Determines what happens when the result of a computation is
02857      * infinity.  See BigDecimal.mode.
02858      */
02859     rb_define_const(rb_cBigDecimal, "EXCEPTION_INFINITY",INT2FIX(VP_EXCEPTION_INFINITY));
02860 
02861     /*
02862      * 0x04: Determines what happens when the result of a computation is an
02863      * underflow (a result too small to be represented). See BigDecimal.mode.
02864      */
02865     rb_define_const(rb_cBigDecimal, "EXCEPTION_UNDERFLOW",INT2FIX(VP_EXCEPTION_UNDERFLOW));
02866 
02867     /*
02868      * 0x01: Determines what happens when the result of a computation is an
02869      * overflow (a result too large to be represented). See BigDecimal.mode.
02870      */
02871     rb_define_const(rb_cBigDecimal, "EXCEPTION_OVERFLOW",INT2FIX(VP_EXCEPTION_OVERFLOW));
02872 
02873     /*
02874      * 0x01: Determines what happens when a division by zero is performed.
02875      * See BigDecimal.mode.
02876      */
02877     rb_define_const(rb_cBigDecimal, "EXCEPTION_ZERODIVIDE",INT2FIX(VP_EXCEPTION_ZERODIVIDE));
02878 
02879     /*
02880      * 0x100: Determines what happens when a result must be rounded in order to
02881      * fit in the appropriate number of significant digits. See
02882      * BigDecimal.mode.
02883      */
02884     rb_define_const(rb_cBigDecimal, "ROUND_MODE",INT2FIX(VP_ROUND_MODE));
02885 
02886     /* 1: Indicates that values should be rounded away from zero. See
02887      * BigDecimal.mode.
02888      */
02889     rb_define_const(rb_cBigDecimal, "ROUND_UP",INT2FIX(VP_ROUND_UP));
02890 
02891     /* 2: Indicates that values should be rounded towards zero. See
02892      * BigDecimal.mode.
02893      */
02894     rb_define_const(rb_cBigDecimal, "ROUND_DOWN",INT2FIX(VP_ROUND_DOWN));
02895 
02896     /* 3: Indicates that digits >= 5 should be rounded up, others rounded down.
02897      * See BigDecimal.mode. */
02898     rb_define_const(rb_cBigDecimal, "ROUND_HALF_UP",INT2FIX(VP_ROUND_HALF_UP));
02899 
02900     /* 4: Indicates that digits >= 6 should be rounded up, others rounded down.
02901      * See BigDecimal.mode.
02902      */
02903     rb_define_const(rb_cBigDecimal, "ROUND_HALF_DOWN",INT2FIX(VP_ROUND_HALF_DOWN));
02904     /* 5: Round towards +infinity. See BigDecimal.mode. */
02905     rb_define_const(rb_cBigDecimal, "ROUND_CEILING",INT2FIX(VP_ROUND_CEIL));
02906 
02907     /* 6: Round towards -infinity. See BigDecimal.mode. */
02908     rb_define_const(rb_cBigDecimal, "ROUND_FLOOR",INT2FIX(VP_ROUND_FLOOR));
02909 
02910     /* 7: Round towards the even neighbor. See BigDecimal.mode. */
02911     rb_define_const(rb_cBigDecimal, "ROUND_HALF_EVEN",INT2FIX(VP_ROUND_HALF_EVEN));
02912 
02913     /* 0: Indicates that a value is not a number. See BigDecimal.sign. */
02914     rb_define_const(rb_cBigDecimal, "SIGN_NaN",INT2FIX(VP_SIGN_NaN));
02915 
02916     /* 1: Indicates that a value is +0. See BigDecimal.sign. */
02917     rb_define_const(rb_cBigDecimal, "SIGN_POSITIVE_ZERO",INT2FIX(VP_SIGN_POSITIVE_ZERO));
02918 
02919     /* -1: Indicates that a value is -0. See BigDecimal.sign. */
02920     rb_define_const(rb_cBigDecimal, "SIGN_NEGATIVE_ZERO",INT2FIX(VP_SIGN_NEGATIVE_ZERO));
02921 
02922     /* 2: Indicates that a value is positive and finite. See BigDecimal.sign. */
02923     rb_define_const(rb_cBigDecimal, "SIGN_POSITIVE_FINITE",INT2FIX(VP_SIGN_POSITIVE_FINITE));
02924 
02925     /* -2: Indicates that a value is negative and finite. See BigDecimal.sign. */
02926     rb_define_const(rb_cBigDecimal, "SIGN_NEGATIVE_FINITE",INT2FIX(VP_SIGN_NEGATIVE_FINITE));
02927 
02928     /* 3: Indicates that a value is positive and infinite. See BigDecimal.sign. */
02929     rb_define_const(rb_cBigDecimal, "SIGN_POSITIVE_INFINITE",INT2FIX(VP_SIGN_POSITIVE_INFINITE));
02930 
02931     /* -3: Indicates that a value is negative and infinite. See BigDecimal.sign. */
02932     rb_define_const(rb_cBigDecimal, "SIGN_NEGATIVE_INFINITE",INT2FIX(VP_SIGN_NEGATIVE_INFINITE));
02933 
02934     arg = rb_str_new2("+Infinity");
02935     rb_define_const(rb_cBigDecimal, "INFINITY", BigDecimal_global_new(1, &arg, rb_cBigDecimal));
02936     arg = rb_str_new2("NaN");
02937     rb_define_const(rb_cBigDecimal, "NAN", BigDecimal_global_new(1, &arg, rb_cBigDecimal));
02938 
02939 
02940     /* instance methods */
02941     rb_define_method(rb_cBigDecimal, "precs", BigDecimal_prec, 0);
02942 
02943     rb_define_method(rb_cBigDecimal, "add", BigDecimal_add2, 2);
02944     rb_define_method(rb_cBigDecimal, "sub", BigDecimal_sub2, 2);
02945     rb_define_method(rb_cBigDecimal, "mult", BigDecimal_mult2, 2);
02946     rb_define_method(rb_cBigDecimal, "div", BigDecimal_div2, -1);
02947     rb_define_method(rb_cBigDecimal, "hash", BigDecimal_hash, 0);
02948     rb_define_method(rb_cBigDecimal, "to_s", BigDecimal_to_s, -1);
02949     rb_define_method(rb_cBigDecimal, "to_i", BigDecimal_to_i, 0);
02950     rb_define_method(rb_cBigDecimal, "to_int", BigDecimal_to_i, 0);
02951     rb_define_method(rb_cBigDecimal, "to_r", BigDecimal_to_r, 0);
02952     rb_define_method(rb_cBigDecimal, "split", BigDecimal_split, 0);
02953     rb_define_method(rb_cBigDecimal, "+", BigDecimal_add, 1);
02954     rb_define_method(rb_cBigDecimal, "-", BigDecimal_sub, 1);
02955     rb_define_method(rb_cBigDecimal, "+@", BigDecimal_uplus, 0);
02956     rb_define_method(rb_cBigDecimal, "-@", BigDecimal_neg, 0);
02957     rb_define_method(rb_cBigDecimal, "*", BigDecimal_mult, 1);
02958     rb_define_method(rb_cBigDecimal, "/", BigDecimal_div, 1);
02959     rb_define_method(rb_cBigDecimal, "quo", BigDecimal_div, 1);
02960     rb_define_method(rb_cBigDecimal, "%", BigDecimal_mod, 1);
02961     rb_define_method(rb_cBigDecimal, "modulo", BigDecimal_mod, 1);
02962     rb_define_method(rb_cBigDecimal, "remainder", BigDecimal_remainder, 1);
02963     rb_define_method(rb_cBigDecimal, "divmod", BigDecimal_divmod, 1);
02964     /* rb_define_method(rb_cBigDecimal, "dup", BigDecimal_dup, 0); */
02965     rb_define_method(rb_cBigDecimal, "to_f", BigDecimal_to_f, 0);
02966     rb_define_method(rb_cBigDecimal, "abs", BigDecimal_abs, 0);
02967     rb_define_method(rb_cBigDecimal, "sqrt", BigDecimal_sqrt, 1);
02968     rb_define_method(rb_cBigDecimal, "fix", BigDecimal_fix, 0);
02969     rb_define_method(rb_cBigDecimal, "round", BigDecimal_round, -1);
02970     rb_define_method(rb_cBigDecimal, "frac", BigDecimal_frac, 0);
02971     rb_define_method(rb_cBigDecimal, "floor", BigDecimal_floor, -1);
02972     rb_define_method(rb_cBigDecimal, "ceil", BigDecimal_ceil, -1);
02973     rb_define_method(rb_cBigDecimal, "power", BigDecimal_power, -1);
02974     rb_define_method(rb_cBigDecimal, "**", BigDecimal_power_op, 1);
02975     rb_define_method(rb_cBigDecimal, "<=>", BigDecimal_comp, 1);
02976     rb_define_method(rb_cBigDecimal, "==", BigDecimal_eq, 1);
02977     rb_define_method(rb_cBigDecimal, "===", BigDecimal_eq, 1);
02978     rb_define_method(rb_cBigDecimal, "eql?", BigDecimal_eq, 1);
02979     rb_define_method(rb_cBigDecimal, "<", BigDecimal_lt, 1);
02980     rb_define_method(rb_cBigDecimal, "<=", BigDecimal_le, 1);
02981     rb_define_method(rb_cBigDecimal, ">", BigDecimal_gt, 1);
02982     rb_define_method(rb_cBigDecimal, ">=", BigDecimal_ge, 1);
02983     rb_define_method(rb_cBigDecimal, "zero?", BigDecimal_zero, 0);
02984     rb_define_method(rb_cBigDecimal, "nonzero?", BigDecimal_nonzero, 0);
02985     rb_define_method(rb_cBigDecimal, "coerce", BigDecimal_coerce, 1);
02986     rb_define_method(rb_cBigDecimal, "inspect", BigDecimal_inspect, 0);
02987     rb_define_method(rb_cBigDecimal, "exponent", BigDecimal_exponent, 0);
02988     rb_define_method(rb_cBigDecimal, "sign", BigDecimal_sign, 0);
02989     rb_define_method(rb_cBigDecimal, "nan?",      BigDecimal_IsNaN, 0);
02990     rb_define_method(rb_cBigDecimal, "infinite?", BigDecimal_IsInfinite, 0);
02991     rb_define_method(rb_cBigDecimal, "finite?",   BigDecimal_IsFinite, 0);
02992     rb_define_method(rb_cBigDecimal, "truncate",  BigDecimal_truncate, -1);
02993     rb_define_method(rb_cBigDecimal, "_dump", BigDecimal_dump, -1);
02994 
02995     /* mathematical functions */
02996     rb_mBigMath = rb_define_module("BigMath");
02997     rb_define_singleton_method(rb_mBigMath, "exp", BigMath_s_exp, 2);
02998     rb_define_singleton_method(rb_mBigMath, "log", BigMath_s_log, 2);
02999 
03000     id_up = rb_intern_const("up");
03001     id_down = rb_intern_const("down");
03002     id_truncate = rb_intern_const("truncate");
03003     id_half_up = rb_intern_const("half_up");
03004     id_default = rb_intern_const("default");
03005     id_half_down = rb_intern_const("half_down");
03006     id_half_even = rb_intern_const("half_even");
03007     id_banker = rb_intern_const("banker");
03008     id_ceiling = rb_intern_const("ceiling");
03009     id_ceil = rb_intern_const("ceil");
03010     id_floor = rb_intern_const("floor");
03011     id_to_r = rb_intern_const("to_r");
03012     id_eq = rb_intern_const("==");
03013 }
03014 
03015 /*
03016  *
03017  *  ============================================================================
03018  *
03019  *  vp_ routines begin from here.
03020  *
03021  *  ============================================================================
03022  *
03023  */
03024 #ifdef BIGDECIMAL_DEBUG
03025 static int gfDebug = 1;         /* Debug switch */
03026 #if 0
03027 static int gfCheckVal = 1;      /* Value checking flag in VpNmlz()  */
03028 #endif
03029 #endif /* BIGDECIMAL_DEBUG */
03030 
03031 static Real *VpConstOne;    /* constant 1.0 */
03032 static Real *VpPt5;        /* constant 0.5 */
03033 #define maxnr 100UL    /* Maximum iterations for calcurating sqrt. */
03034                 /* used in VpSqrt() */
03035 
03036 /* ETC */
03037 #define MemCmp(x,y,z) memcmp(x,y,z)
03038 #define StrCmp(x,y)   strcmp(x,y)
03039 
03040 static int VpIsDefOP(Real *c,Real *a,Real *b,int sw);
03041 static int AddExponent(Real *a, SIGNED_VALUE n);
03042 static BDIGIT VpAddAbs(Real *a,Real *b,Real *c);
03043 static BDIGIT VpSubAbs(Real *a,Real *b,Real *c);
03044 static size_t VpSetPTR(Real *a, Real *b, Real *c, size_t *a_pos, size_t *b_pos, size_t *c_pos, BDIGIT *av, BDIGIT *bv);
03045 static int VpNmlz(Real *a);
03046 static void VpFormatSt(char *psz, size_t fFmt);
03047 static int VpRdup(Real *m, size_t ind_m);
03048 
03049 #ifdef BIGDECIMAL_DEBUG
03050 static int gnAlloc=0; /* Memory allocation counter */
03051 #endif /* BIGDECIMAL_DEBUG */
03052 
03053 VP_EXPORT void *
03054 VpMemAlloc(size_t mb)
03055 {
03056     void *p = xmalloc(mb);
03057     if (!p) {
03058         VpException(VP_EXCEPTION_MEMORY, "failed to allocate memory", 1);
03059     }
03060     memset(p, 0, mb);
03061 #ifdef BIGDECIMAL_DEBUG
03062     gnAlloc++; /* Count allocation call */
03063 #endif /* BIGDECIMAL_DEBUG */
03064     return p;
03065 }
03066 
03067 VP_EXPORT void
03068 VpFree(Real *pv)
03069 {
03070     if(pv != NULL) {
03071         xfree(pv);
03072 #ifdef BIGDECIMAL_DEBUG
03073         gnAlloc--; /* Decrement allocation count */
03074         if(gnAlloc==0) {
03075             printf(" *************** All memories allocated freed ****************");
03076             getchar();
03077         }
03078         if(gnAlloc<0) {
03079             printf(" ??????????? Too many memory free calls(%d) ?????????????\n",gnAlloc);
03080             getchar();
03081         }
03082 #endif /* BIGDECIMAL_DEBUG */
03083     }
03084 }
03085 
03086 /*
03087  * EXCEPTION Handling.
03088  */
03089 
03090 #define rmpd_set_thread_local_exception_mode(mode) \
03091     rb_thread_local_aset( \
03092         rb_thread_current(), \
03093         id_BigDecimal_exception_mode, \
03094         INT2FIX((int)(mode)) \
03095     )
03096 
03097 static unsigned short
03098 VpGetException (void)
03099 {
03100     VALUE const vmode = rb_thread_local_aref(
03101         rb_thread_current(),
03102         id_BigDecimal_exception_mode
03103     );
03104 
03105     if (NIL_P(vmode)) {
03106         rmpd_set_thread_local_exception_mode(RMPD_EXCEPTION_MODE_DEFAULT);
03107         return RMPD_EXCEPTION_MODE_DEFAULT;
03108     }
03109 
03110     return (unsigned short)FIX2UINT(vmode);
03111 }
03112 
03113 static void
03114 VpSetException(unsigned short f)
03115 {
03116     rmpd_set_thread_local_exception_mode(f);
03117 }
03118 
03119 /*
03120  * Precision limit.
03121  */
03122 
03123 #define rmpd_set_thread_local_precision_limit(limit) \
03124     rb_thread_local_aset( \
03125         rb_thread_current(), \
03126         id_BigDecimal_precision_limit, \
03127         SIZET2NUM(limit) \
03128     )
03129 #define RMPD_PRECISION_LIMIT_DEFAULT ((size_t)0)
03130 
03131 /* These 2 functions added at v1.1.7 */
03132 VP_EXPORT size_t
03133 VpGetPrecLimit(void)
03134 {
03135     VALUE const vlimit = rb_thread_local_aref(
03136         rb_thread_current(),
03137         id_BigDecimal_precision_limit
03138     );
03139 
03140     if (NIL_P(vlimit)) {
03141         rmpd_set_thread_local_precision_limit(RMPD_PRECISION_LIMIT_DEFAULT);
03142         return RMPD_PRECISION_LIMIT_DEFAULT;
03143     }
03144 
03145     return NUM2SIZET(vlimit);
03146 }
03147 
03148 VP_EXPORT size_t
03149 VpSetPrecLimit(size_t n)
03150 {
03151     size_t const s = VpGetPrecLimit();
03152     rmpd_set_thread_local_precision_limit(n);
03153     return s;
03154 }
03155 
03156 /*
03157  * Rounding mode.
03158  */
03159 
03160 #define rmpd_set_thread_local_rounding_mode(mode) \
03161     rb_thread_local_aset( \
03162         rb_thread_current(), \
03163         id_BigDecimal_rounding_mode, \
03164         INT2FIX((int)(mode)) \
03165     )
03166 
03167 VP_EXPORT unsigned short
03168 VpGetRoundMode(void)
03169 {
03170     VALUE const vmode = rb_thread_local_aref(
03171         rb_thread_current(),
03172         id_BigDecimal_rounding_mode
03173     );
03174 
03175     if (NIL_P(vmode)) {
03176         rmpd_set_thread_local_rounding_mode(RMPD_ROUNDING_MODE_DEFAULT);
03177         return RMPD_ROUNDING_MODE_DEFAULT;
03178     }
03179 
03180     return (unsigned short)FIX2INT(vmode);
03181 }
03182 
03183 VP_EXPORT int
03184 VpIsRoundMode(unsigned short n)
03185 {
03186     switch (n) {
03187       case VP_ROUND_UP:
03188       case VP_ROUND_DOWN:
03189       case VP_ROUND_HALF_UP:
03190       case VP_ROUND_HALF_DOWN:
03191       case VP_ROUND_CEIL:
03192       case VP_ROUND_FLOOR:
03193       case VP_ROUND_HALF_EVEN:
03194         return 1;
03195 
03196       default:
03197         return 0;
03198     }
03199 }
03200 
03201 VP_EXPORT unsigned short
03202 VpSetRoundMode(unsigned short n)
03203 {
03204     if (VpIsRoundMode(n)) {
03205         rmpd_set_thread_local_rounding_mode(n);
03206         return n;
03207     }
03208 
03209     return VpGetRoundMode();
03210 }
03211 
03212 /*
03213  *  0.0 & 1.0 generator
03214  *    These gZero_..... and gOne_..... can be any name
03215  *    referenced from nowhere except Zero() and One().
03216  *    gZero_..... and gOne_..... must have global scope
03217  *    (to let the compiler know they may be changed in outside
03218  *    (... but not actually..)).
03219  */
03220 volatile const double gZero_ABCED9B1_CE73__00400511F31D = 0.0;
03221 volatile const double gOne_ABCED9B4_CE73__00400511F31D  = 1.0;
03222 static double
03223 Zero(void)
03224 {
03225     return gZero_ABCED9B1_CE73__00400511F31D;
03226 }
03227 
03228 static double
03229 One(void)
03230 {
03231     return gOne_ABCED9B4_CE73__00400511F31D;
03232 }
03233 
03234 /*
03235   ----------------------------------------------------------------
03236   Value of sign in Real structure is reserved for future use.
03237   short sign;
03238                     ==0 : NaN
03239                       1 : Positive zero
03240                      -1 : Negative zero
03241                       2 : Positive number
03242                      -2 : Negative number
03243                       3 : Positive infinite number
03244                      -3 : Negative infinite number
03245   ----------------------------------------------------------------
03246 */
03247 
03248 VP_EXPORT double
03249 VpGetDoubleNaN(void) /* Returns the value of NaN */
03250 {
03251     static double fNaN = 0.0;
03252     if(fNaN==0.0) fNaN = Zero()/Zero();
03253     return fNaN;
03254 }
03255 
03256 VP_EXPORT double
03257 VpGetDoublePosInf(void) /* Returns the value of +Infinity */
03258 {
03259     static double fInf = 0.0;
03260     if(fInf==0.0) fInf = One()/Zero();
03261     return fInf;
03262 }
03263 
03264 VP_EXPORT double
03265 VpGetDoubleNegInf(void) /* Returns the value of -Infinity */
03266 {
03267     static double fInf = 0.0;
03268     if(fInf==0.0) fInf = -(One()/Zero());
03269     return fInf;
03270 }
03271 
03272 VP_EXPORT double
03273 VpGetDoubleNegZero(void) /* Returns the value of -0 */
03274 {
03275     static double nzero = 1000.0;
03276     if(nzero!=0.0) nzero = (One()/VpGetDoubleNegInf());
03277     return nzero;
03278 }
03279 
03280 #if 0  /* unused */
03281 VP_EXPORT int
03282 VpIsNegDoubleZero(double v)
03283 {
03284     double z = VpGetDoubleNegZero();
03285     return MemCmp(&v,&z,sizeof(v))==0;
03286 }
03287 #endif
03288 
03289 VP_EXPORT int
03290 VpException(unsigned short f, const char *str,int always)
03291 {
03292     VALUE exc;
03293     int   fatal=0;
03294     unsigned short const exception_mode = VpGetException();
03295 
03296     if(f==VP_EXCEPTION_OP || f==VP_EXCEPTION_MEMORY) always = 1;
03297 
03298     if (always || (exception_mode & f)) {
03299         switch(f)
03300         {
03301         /*
03302         case VP_EXCEPTION_OVERFLOW:
03303         */
03304         case VP_EXCEPTION_ZERODIVIDE:
03305         case VP_EXCEPTION_INFINITY:
03306         case VP_EXCEPTION_NaN:
03307         case VP_EXCEPTION_UNDERFLOW:
03308         case VP_EXCEPTION_OP:
03309              exc = rb_eFloatDomainError;
03310              goto raise;
03311         case VP_EXCEPTION_MEMORY:
03312              fatal = 1;
03313              goto raise;
03314         default:
03315              fatal = 1;
03316              goto raise;
03317         }
03318     }
03319     return 0; /* 0 Means VpException() raised no exception */
03320 
03321 raise:
03322     if(fatal) rb_fatal("%s", str);
03323     else   rb_raise(exc, "%s", str);
03324     return 0;
03325 }
03326 
03327 /* Throw exception or returns 0,when resulting c is Inf or NaN */
03328 /*  sw=1:+ 2:- 3:* 4:/ */
03329 static int
03330 VpIsDefOP(Real *c,Real *a,Real *b,int sw)
03331 {
03332     if(VpIsNaN(a) || VpIsNaN(b)) {
03333         /* at least a or b is NaN */
03334         VpSetNaN(c);
03335         goto NaN;
03336     }
03337 
03338     if(VpIsInf(a)) {
03339         if(VpIsInf(b)) {
03340             switch(sw)
03341             {
03342             case 1: /* + */
03343                 if(VpGetSign(a)==VpGetSign(b)) {
03344                     VpSetInf(c,VpGetSign(a));
03345                     goto Inf;
03346                 } else {
03347                     VpSetNaN(c);
03348                     goto NaN;
03349                 }
03350             case 2: /* - */
03351                 if(VpGetSign(a)!=VpGetSign(b)) {
03352                     VpSetInf(c,VpGetSign(a));
03353                     goto Inf;
03354                 } else {
03355                     VpSetNaN(c);
03356                     goto NaN;
03357                 }
03358                 break;
03359             case 3: /* * */
03360                 VpSetInf(c,VpGetSign(a)*VpGetSign(b));
03361                 goto Inf;
03362                 break;
03363             case 4: /* / */
03364                 VpSetNaN(c);
03365                 goto NaN;
03366             }
03367             VpSetNaN(c);
03368             goto NaN;
03369         }
03370         /* Inf op Finite */
03371         switch(sw)
03372         {
03373         case 1: /* + */
03374         case 2: /* - */
03375                 VpSetInf(c,VpGetSign(a));
03376                 break;
03377         case 3: /* * */
03378                 if(VpIsZero(b)) {
03379                     VpSetNaN(c);
03380                     goto NaN;
03381                 }
03382                 VpSetInf(c,VpGetSign(a)*VpGetSign(b));
03383                 break;
03384         case 4: /* / */
03385                 VpSetInf(c,VpGetSign(a)*VpGetSign(b));
03386         }
03387         goto Inf;
03388     }
03389 
03390     if(VpIsInf(b)) {
03391         switch(sw)
03392         {
03393         case 1: /* + */
03394                 VpSetInf(c,VpGetSign(b));
03395                 break;
03396         case 2: /* - */
03397                 VpSetInf(c,-VpGetSign(b));
03398                 break;
03399         case 3: /* * */
03400                 if(VpIsZero(a)) {
03401                     VpSetNaN(c);
03402                     goto NaN;
03403                 }
03404                 VpSetInf(c,VpGetSign(a)*VpGetSign(b));
03405                 break;
03406         case 4: /* / */
03407                 VpSetZero(c,VpGetSign(a)*VpGetSign(b));
03408         }
03409         goto Inf;
03410     }
03411     return 1; /* Results OK */
03412 
03413 Inf:
03414     return VpException(VP_EXCEPTION_INFINITY,"Computation results to 'Infinity'",0);
03415 NaN:
03416     return VpException(VP_EXCEPTION_NaN,"Computation results to 'NaN'",0);
03417 }
03418 
03419 /*
03420   ----------------------------------------------------------------
03421 */
03422 
03423 /*
03424  *    returns number of chars needed to represent vp in specified format.
03425  */
03426 VP_EXPORT size_t
03427 VpNumOfChars(Real *vp,const char *pszFmt)
03428 {
03429     SIGNED_VALUE  ex;
03430     size_t nc;
03431 
03432     if(vp == NULL)   return BASE_FIG*2+6;
03433     if(!VpIsDef(vp)) return 32; /* not sure,may be OK */
03434 
03435     switch(*pszFmt)
03436     {
03437     case 'F':
03438          nc = BASE_FIG*(vp->Prec + 1)+2;
03439          ex = vp->exponent;
03440          if(ex < 0) {
03441              nc += BASE_FIG*(size_t)(-ex);
03442          }
03443          else {
03444              if((size_t)ex > vp->Prec) {
03445                  nc += BASE_FIG*((size_t)ex - vp->Prec);
03446              }
03447          }
03448          break;
03449     case 'E':
03450     default:
03451          nc = BASE_FIG*(vp->Prec + 2)+6; /* 3: sign + exponent chars */
03452     }
03453     return nc;
03454 }
03455 
03456 /*
03457  * Initializer for Vp routines and constants used.
03458  * [Input]
03459  *   BaseVal: Base value(assigned to BASE) for Vp calculation.
03460  *   It must be the form BaseVal=10**n.(n=1,2,3,...)
03461  *   If Base <= 0L,then the BASE will be calcurated so
03462  *   that BASE is as large as possible satisfying the
03463  *   relation MaxVal <= BASE*(BASE+1). Where the value
03464  *   MaxVal is the largest value which can be represented
03465  *   by one BDIGIT word in the computer used.
03466  *
03467  * [Returns]
03468  * 1+DBL_DIG   ... OK
03469  */
03470 VP_EXPORT size_t
03471 VpInit(BDIGIT BaseVal)
03472 {
03473     /* Setup +/- Inf  NaN -0 */
03474     VpGetDoubleNaN();
03475     VpGetDoublePosInf();
03476     VpGetDoubleNegInf();
03477     VpGetDoubleNegZero();
03478 
03479     /* Allocates Vp constants. */
03480     VpConstOne = VpAlloc(1UL, "1");
03481     VpPt5 = VpAlloc(1UL, ".5");
03482 
03483 #ifdef BIGDECIMAL_DEBUG
03484     gnAlloc = 0;
03485 #endif /* BIGDECIMAL_DEBUG */
03486 
03487 #ifdef BIGDECIMAL_DEBUG
03488     if(gfDebug) {
03489         printf("VpInit: BaseVal   = %lu\n", BaseVal);
03490         printf("  BASE   = %lu\n", BASE);
03491         printf("  HALF_BASE = %lu\n", HALF_BASE);
03492         printf("  BASE1  = %lu\n", BASE1);
03493         printf("  BASE_FIG  = %u\n", BASE_FIG);
03494         printf("  DBLE_FIG  = %d\n", DBLE_FIG);
03495     }
03496 #endif /* BIGDECIMAL_DEBUG */
03497 
03498     return rmpd_double_figures();
03499 }
03500 
03501 VP_EXPORT Real *
03502 VpOne(void)
03503 {
03504     return VpConstOne;
03505 }
03506 
03507 /* If exponent overflows,then raise exception or returns 0 */
03508 static int
03509 AddExponent(Real *a, SIGNED_VALUE n)
03510 {
03511     SIGNED_VALUE e = a->exponent;
03512     SIGNED_VALUE m = e+n;
03513     SIGNED_VALUE eb, mb;
03514     if(e>0) {
03515         if(n>0) {
03516             mb = m*(SIGNED_VALUE)BASE_FIG;
03517             eb = e*(SIGNED_VALUE)BASE_FIG;
03518             if(mb<eb) goto overflow;
03519         }
03520     } else if(n<0) {
03521         mb = m*(SIGNED_VALUE)BASE_FIG;
03522         eb = e*(SIGNED_VALUE)BASE_FIG;
03523         if(mb>eb) goto underflow;
03524     }
03525     a->exponent = m;
03526     return 1;
03527 
03528 /* Overflow/Underflow ==> Raise exception or returns 0 */
03529 underflow:
03530     VpSetZero(a,VpGetSign(a));
03531     return VpException(VP_EXCEPTION_UNDERFLOW,"Exponent underflow",0);
03532 
03533 overflow:
03534     VpSetInf(a,VpGetSign(a));
03535     return VpException(VP_EXCEPTION_OVERFLOW,"Exponent overflow",0);
03536 }
03537 
03538 /*
03539  * Allocates variable.
03540  * [Input]
03541  *   mx ... allocation unit, if zero then mx is determined by szVal.
03542  *    The mx is the number of effective digits can to be stored.
03543  *   szVal ... value assigned(char). If szVal==NULL,then zero is assumed.
03544  *            If szVal[0]=='#' then Max. Prec. will not be considered(1.1.7),
03545  *            full precision specified by szVal is allocated.
03546  *
03547  * [Returns]
03548  *   Pointer to the newly allocated variable, or
03549  *   NULL be returned if memory allocation is failed,or any error.
03550  */
03551 VP_EXPORT Real *
03552 VpAlloc(size_t mx, const char *szVal)
03553 {
03554     size_t i, ni, ipn, ipf, nf, ipe, ne, nalloc;
03555     char v,*psz;
03556     int  sign=1;
03557     Real *vp = NULL;
03558     size_t mf = VpGetPrecLimit();
03559     VALUE buf;
03560 
03561     mx = (mx + BASE_FIG - 1) / BASE_FIG + 1;    /* Determine allocation unit. */
03562     if (szVal) {
03563         while (ISSPACE(*szVal)) szVal++;
03564         if (*szVal != '#') {
03565              if (mf) {
03566                 mf = (mf + BASE_FIG - 1) / BASE_FIG + 2; /* Needs 1 more for div */
03567                 if (mx > mf) {
03568                     mx = mf;
03569                 }
03570             }
03571         }
03572         else {
03573             ++szVal;
03574         }
03575     }
03576     else {
03577        /* necessary to be able to store */
03578        /* at least mx digits. */
03579        /* szVal==NULL ==> allocate zero value. */
03580        vp = (Real *) VpMemAlloc(sizeof(Real) + mx * sizeof(BDIGIT));
03581        /* xmalloc() alway returns(or throw interruption) */
03582        vp->MaxPrec = mx;    /* set max precision */
03583        VpSetZero(vp,1);    /* initialize vp to zero. */
03584        return vp;
03585     }
03586 
03587     /* Skip all '_' after digit: 2006-6-30 */
03588     ni = 0;
03589     buf = rb_str_tmp_new(strlen(szVal)+1);
03590     psz = RSTRING_PTR(buf);
03591     i   = 0;
03592     ipn = 0;
03593     while ((psz[i]=szVal[ipn]) != 0) {
03594         if (ISDIGIT(psz[i])) ++ni;
03595         if (psz[i] == '_') {
03596             if (ni > 0) { ipn++; continue; }
03597             psz[i] = 0;
03598             break;
03599         }
03600         ++i;
03601         ++ipn;
03602     }
03603     /* Skip trailing spaces */
03604     while (--i > 0) {
03605         if (ISSPACE(psz[i])) psz[i] = 0;
03606         else break;
03607     }
03608     szVal = psz;
03609 
03610     /* Check on Inf & NaN */
03611     if (StrCmp(szVal, SZ_PINF) == 0 ||
03612         StrCmp(szVal, SZ_INF)  == 0 ) {
03613         vp = (Real *) VpMemAlloc(sizeof(Real) + sizeof(BDIGIT));
03614         vp->MaxPrec = 1;    /* set max precision */
03615         VpSetPosInf(vp);
03616         return vp;
03617     }
03618     if (StrCmp(szVal, SZ_NINF) == 0) {
03619         vp = (Real *) VpMemAlloc(sizeof(Real) + sizeof(BDIGIT));
03620         vp->MaxPrec = 1;    /* set max precision */
03621         VpSetNegInf(vp);
03622         return vp;
03623     }
03624     if (StrCmp(szVal, SZ_NaN) == 0) {
03625         vp = (Real *) VpMemAlloc(sizeof(Real) + sizeof(BDIGIT));
03626         vp->MaxPrec = 1;    /* set max precision */
03627         VpSetNaN(vp);
03628         return vp;
03629     }
03630 
03631     /* check on number szVal[] */
03632     ipn = i = 0;
03633     if      (szVal[i] == '-') { sign=-1; ++i; }
03634     else if (szVal[i] == '+')            ++i;
03635     /* Skip digits */
03636     ni = 0;            /* digits in mantissa */
03637     while ((v = szVal[i]) != 0) {
03638         if (!ISDIGIT(v)) break;
03639         ++i;
03640         ++ni;
03641     }
03642     nf  = 0;
03643     ipf = 0;
03644     ipe = 0;
03645     ne  = 0;
03646     if (v) {
03647         /* other than digit nor \0 */
03648         if (szVal[i] == '.') {    /* xxx. */
03649             ++i;
03650             ipf = i;
03651             while ((v = szVal[i]) != 0) {    /* get fraction part. */
03652                 if (!ISDIGIT(v)) break;
03653                 ++i;
03654                 ++nf;
03655             }
03656         }
03657         ipe = 0;        /* Exponent */
03658 
03659         switch (szVal[i]) {
03660         case '\0':
03661             break;
03662         case 'e': case 'E':
03663         case 'd': case 'D':
03664             ++i;
03665             ipe = i;
03666             v = szVal[i];
03667             if ((v == '-') || (v == '+')) ++i;
03668             while ((v=szVal[i]) != 0) {
03669                 if (!ISDIGIT(v)) break;
03670                 ++i;
03671                 ++ne;
03672             }
03673             break;
03674         default:
03675             break;
03676         }
03677     }
03678     nalloc = (ni + nf + BASE_FIG - 1) / BASE_FIG + 1;    /* set effective allocation  */
03679     /* units for szVal[]  */
03680     if (mx <= 0) mx = 1;
03681     nalloc = Max(nalloc, mx);
03682     mx = nalloc;
03683     vp = (Real *) VpMemAlloc(sizeof(Real) + mx * sizeof(BDIGIT));
03684     /* xmalloc() alway returns(or throw interruption) */
03685     vp->MaxPrec = mx;        /* set max precision */
03686     VpSetZero(vp, sign);
03687     VpCtoV(vp, &szVal[ipn], ni, &szVal[ipf], nf, &szVal[ipe], ne);
03688     rb_str_resize(buf, 0);
03689     return vp;
03690 }
03691 
03692 /*
03693  * Assignment(c=a).
03694  * [Input]
03695  *   a   ... RHSV
03696  *   isw ... switch for assignment.
03697  *    c = a  when isw > 0
03698  *    c = -a when isw < 0
03699  *    if c->MaxPrec < a->Prec,then round operation
03700  *    will be performed.
03701  * [Output]
03702  *  c  ... LHSV
03703  */
03704 VP_EXPORT size_t
03705 VpAsgn(Real *c, Real *a, int isw)
03706 {
03707     size_t n;
03708     if(VpIsNaN(a)) {
03709         VpSetNaN(c);
03710         return 0;
03711     }
03712     if(VpIsInf(a)) {
03713         VpSetInf(c,isw*VpGetSign(a));
03714         return 0;
03715     }
03716 
03717     /* check if the RHS is zero */
03718     if(!VpIsZero(a)) {
03719         c->exponent = a->exponent;    /* store  exponent */
03720         VpSetSign(c,(isw*VpGetSign(a)));    /* set sign */
03721         n =(a->Prec < c->MaxPrec) ?(a->Prec) :(c->MaxPrec);
03722         c->Prec = n;
03723         memcpy(c->frac, a->frac, n * sizeof(BDIGIT));
03724         /* Needs round ? */
03725         if(isw!=10) {
03726             /* Not in ActiveRound */
03727             if(c->Prec < a->Prec) {
03728                 VpInternalRound(c,n,(n>0)?a->frac[n-1]:0,a->frac[n]);
03729             } else {
03730                 VpLimitRound(c,0);
03731             }
03732         }
03733     } else {
03734         /* The value of 'a' is zero.  */
03735         VpSetZero(c,isw*VpGetSign(a));
03736         return 1;
03737     }
03738     return c->Prec*BASE_FIG;
03739 }
03740 
03741 /*
03742  *   c = a + b  when operation =  1 or 2
03743  *  = a - b  when operation = -1 or -2.
03744  *   Returns number of significant digits of c
03745  */
03746 VP_EXPORT size_t
03747 VpAddSub(Real *c, Real *a, Real *b, int operation)
03748 {
03749     short sw, isw;
03750     Real *a_ptr, *b_ptr;
03751     size_t n, na, nb, i;
03752     BDIGIT mrv;
03753 
03754 #ifdef BIGDECIMAL_DEBUG
03755     if(gfDebug) {
03756         VPrint(stdout, "VpAddSub(enter) a=% \n", a);
03757         VPrint(stdout, "     b=% \n", b);
03758         printf(" operation=%d\n", operation);
03759     }
03760 #endif /* BIGDECIMAL_DEBUG */
03761 
03762     if(!VpIsDefOP(c,a,b,(operation>0)?1:2)) return 0; /* No significant digits */
03763 
03764     /* check if a or b is zero  */
03765     if(VpIsZero(a)) {
03766         /* a is zero,then assign b to c */
03767         if(!VpIsZero(b)) {
03768             VpAsgn(c, b, operation);
03769         } else {
03770             /* Both a and b are zero. */
03771             if(VpGetSign(a)<0 && operation*VpGetSign(b)<0) {
03772                 /* -0 -0 */
03773                 VpSetZero(c,-1);
03774             } else {
03775                 VpSetZero(c,1);
03776             }
03777             return 1; /* 0: 1 significant digits */
03778         }
03779         return c->Prec*BASE_FIG;
03780     }
03781     if(VpIsZero(b)) {
03782         /* b is zero,then assign a to c. */
03783         VpAsgn(c, a, 1);
03784         return c->Prec*BASE_FIG;
03785     }
03786 
03787     if(operation < 0) sw = -1;
03788     else              sw =  1;
03789 
03790     /* compare absolute value. As a result,|a_ptr|>=|b_ptr| */
03791     if(a->exponent > b->exponent) {
03792         a_ptr = a;
03793         b_ptr = b;
03794     }         /* |a|>|b| */
03795     else if(a->exponent < b->exponent) {
03796         a_ptr = b;
03797         b_ptr = a;
03798     }                /* |a|<|b| */
03799     else {
03800         /* Exponent part of a and b is the same,then compare fraction */
03801         /* part */
03802         na = a->Prec;
03803         nb = b->Prec;
03804         n = Min(na, nb);
03805         for(i=0;i < n; ++i) {
03806             if(a->frac[i] > b->frac[i]) {
03807                 a_ptr = a;
03808                 b_ptr = b;
03809                 goto end_if;
03810             } else if(a->frac[i] < b->frac[i]) {
03811                 a_ptr = b;
03812                 b_ptr = a;
03813                 goto end_if;
03814             }
03815         }
03816         if(na > nb) {
03817          a_ptr = a;
03818             b_ptr = b;
03819             goto end_if;
03820         } else if(na < nb) {
03821             a_ptr = b;
03822             b_ptr = a;
03823             goto end_if;
03824         }
03825         /* |a| == |b| */
03826         if(VpGetSign(a) + sw *VpGetSign(b) == 0) {
03827             VpSetZero(c,1);        /* abs(a)=abs(b) and operation = '-'  */
03828             return c->Prec*BASE_FIG;
03829         }
03830         a_ptr = a;
03831         b_ptr = b;
03832     }
03833 
03834 end_if:
03835     isw = VpGetSign(a) + sw *VpGetSign(b);
03836     /*
03837      *  isw = 0 ...( 1)+(-1),( 1)-( 1),(-1)+(1),(-1)-(-1)
03838      *      = 2 ...( 1)+( 1),( 1)-(-1)
03839      *      =-2 ...(-1)+(-1),(-1)-( 1)
03840      *   If isw==0, then c =(Sign a_ptr)(|a_ptr|-|b_ptr|)
03841      *              else c =(Sign ofisw)(|a_ptr|+|b_ptr|)
03842     */
03843     if(isw) {            /* addition */
03844         VpSetSign(c, 1);
03845         mrv = VpAddAbs(a_ptr, b_ptr, c);
03846         VpSetSign(c, isw / 2);
03847     } else {            /* subtraction */
03848         VpSetSign(c, 1);
03849         mrv = VpSubAbs(a_ptr, b_ptr, c);
03850         if(a_ptr == a) {
03851             VpSetSign(c,VpGetSign(a));
03852         } else    {
03853             VpSetSign(c,VpGetSign(a_ptr) * sw);
03854         }
03855     }
03856     VpInternalRound(c,0,(c->Prec>0)?c->frac[c->Prec-1]:0,mrv);
03857 
03858 #ifdef BIGDECIMAL_DEBUG
03859     if(gfDebug) {
03860         VPrint(stdout, "VpAddSub(result) c=% \n", c);
03861         VPrint(stdout, "     a=% \n", a);
03862         VPrint(stdout, "     b=% \n", b);
03863         printf(" operation=%d\n", operation);
03864     }
03865 #endif /* BIGDECIMAL_DEBUG */
03866     return c->Prec*BASE_FIG;
03867 }
03868 
03869 /*
03870  * Addition of two variable precisional variables
03871  * a and b assuming abs(a)>abs(b).
03872  *   c = abs(a) + abs(b) ; where |a|>=|b|
03873  */
03874 static BDIGIT
03875 VpAddAbs(Real *a, Real *b, Real *c)
03876 {
03877     size_t word_shift;
03878     size_t ap;
03879     size_t bp;
03880     size_t cp;
03881     size_t a_pos;
03882     size_t b_pos, b_pos_with_word_shift;
03883     size_t c_pos;
03884     BDIGIT av, bv, carry, mrv;
03885 
03886 #ifdef BIGDECIMAL_DEBUG
03887     if(gfDebug) {
03888         VPrint(stdout, "VpAddAbs called: a = %\n", a);
03889         VPrint(stdout, "     b = %\n", b);
03890     }
03891 #endif /* BIGDECIMAL_DEBUG */
03892 
03893     word_shift = VpSetPTR(a, b, c, &ap, &bp, &cp, &av, &bv);
03894     a_pos = ap;
03895     b_pos = bp;
03896     c_pos = cp;
03897     if(word_shift==(size_t)-1L) return 0; /* Overflow */
03898     if(b_pos == (size_t)-1L) goto Assign_a;
03899 
03900     mrv = av + bv; /* Most right val. Used for round. */
03901 
03902     /* Just assign the last few digits of b to c because a has no  */
03903     /* corresponding digits to be added. */
03904     while(b_pos + word_shift > a_pos) {
03905         --c_pos;
03906         if(b_pos > 0) {
03907             c->frac[c_pos] = b->frac[--b_pos];
03908         } else {
03909             --word_shift;
03910             c->frac[c_pos] = 0;
03911         }
03912     }
03913 
03914     /* Just assign the last few digits of a to c because b has no */
03915     /* corresponding digits to be added. */
03916     b_pos_with_word_shift = b_pos + word_shift;
03917     while(a_pos > b_pos_with_word_shift) {
03918         c->frac[--c_pos] = a->frac[--a_pos];
03919     }
03920     carry = 0;    /* set first carry be zero */
03921 
03922     /* Now perform addition until every digits of b will be */
03923     /* exhausted. */
03924     while(b_pos > 0) {
03925         c->frac[--c_pos] = a->frac[--a_pos] + b->frac[--b_pos] + carry;
03926         if(c->frac[c_pos] >= BASE) {
03927             c->frac[c_pos] -= BASE;
03928             carry = 1;
03929         } else {
03930             carry = 0;
03931         }
03932     }
03933 
03934     /* Just assign the first few digits of a with considering */
03935     /* the carry obtained so far because b has been exhausted. */
03936     while(a_pos > 0) {
03937         c->frac[--c_pos] = a->frac[--a_pos] + carry;
03938         if(c->frac[c_pos] >= BASE) {
03939             c->frac[c_pos] -= BASE;
03940             carry = 1;
03941         } else {
03942             carry = 0;
03943         }
03944     }
03945     if(c_pos) c->frac[c_pos - 1] += carry;
03946     goto Exit;
03947 
03948 Assign_a:
03949     VpAsgn(c, a, 1);
03950     mrv = 0;
03951 
03952 Exit:
03953 
03954 #ifdef BIGDECIMAL_DEBUG
03955     if(gfDebug) {
03956         VPrint(stdout, "VpAddAbs exit: c=% \n", c);
03957     }
03958 #endif /* BIGDECIMAL_DEBUG */
03959     return mrv;
03960 }
03961 
03962 /*
03963  * c = abs(a) - abs(b)
03964  */
03965 static BDIGIT
03966 VpSubAbs(Real *a, Real *b, Real *c)
03967 {
03968     size_t word_shift;
03969     size_t ap;
03970     size_t bp;
03971     size_t cp;
03972     size_t a_pos;
03973     size_t b_pos, b_pos_with_word_shift;
03974     size_t c_pos;
03975     BDIGIT av, bv, borrow, mrv;
03976 
03977 #ifdef BIGDECIMAL_DEBUG
03978     if(gfDebug) {
03979         VPrint(stdout, "VpSubAbs called: a = %\n", a);
03980         VPrint(stdout, "     b = %\n", b);
03981     }
03982 #endif /* BIGDECIMAL_DEBUG */
03983 
03984     word_shift = VpSetPTR(a, b, c, &ap, &bp, &cp, &av, &bv);
03985     a_pos = ap;
03986     b_pos = bp;
03987     c_pos = cp;
03988     if(word_shift==(size_t)-1L) return 0; /* Overflow */
03989     if(b_pos == (size_t)-1L) goto Assign_a;
03990 
03991     if(av >= bv) {
03992         mrv = av - bv;
03993         borrow = 0;
03994     } else {
03995         mrv    = 0;
03996         borrow = 1;
03997     }
03998 
03999     /* Just assign the values which are the BASE subtracted by   */
04000     /* each of the last few digits of the b because the a has no */
04001     /* corresponding digits to be subtracted. */
04002     if(b_pos + word_shift > a_pos) {
04003         while(b_pos + word_shift > a_pos) {
04004             --c_pos;
04005             if(b_pos > 0) {
04006                 c->frac[c_pos] = BASE - b->frac[--b_pos] - borrow;
04007             } else {
04008                 --word_shift;
04009                 c->frac[c_pos] = BASE - borrow;
04010             }
04011             borrow = 1;
04012         }
04013     }
04014     /* Just assign the last few digits of a to c because b has no */
04015     /* corresponding digits to subtract. */
04016 
04017     b_pos_with_word_shift = b_pos + word_shift;
04018     while(a_pos > b_pos_with_word_shift) {
04019         c->frac[--c_pos] = a->frac[--a_pos];
04020     }
04021 
04022     /* Now perform subtraction until every digits of b will be */
04023     /* exhausted. */
04024     while(b_pos > 0) {
04025         --c_pos;
04026         if(a->frac[--a_pos] < b->frac[--b_pos] + borrow) {
04027             c->frac[c_pos] = BASE + a->frac[a_pos] - b->frac[b_pos] - borrow;
04028             borrow = 1;
04029         } else {
04030             c->frac[c_pos] = a->frac[a_pos] - b->frac[b_pos] - borrow;
04031             borrow = 0;
04032         }
04033     }
04034 
04035     /* Just assign the first few digits of a with considering */
04036     /* the borrow obtained so far because b has been exhausted. */
04037     while(a_pos > 0) {
04038         --c_pos;
04039         if(a->frac[--a_pos] < borrow) {
04040             c->frac[c_pos] = BASE + a->frac[a_pos] - borrow;
04041             borrow = 1;
04042         } else {
04043             c->frac[c_pos] = a->frac[a_pos] - borrow;
04044             borrow = 0;
04045         }
04046     }
04047     if(c_pos) c->frac[c_pos - 1] -= borrow;
04048     goto Exit;
04049 
04050 Assign_a:
04051     VpAsgn(c, a, 1);
04052     mrv = 0;
04053 
04054 Exit:
04055 #ifdef BIGDECIMAL_DEBUG
04056     if(gfDebug) {
04057         VPrint(stdout, "VpSubAbs exit: c=% \n", c);
04058     }
04059 #endif /* BIGDECIMAL_DEBUG */
04060     return mrv;
04061 }
04062 
04063 /*
04064  * Note: If(av+bv)>= HALF_BASE,then 1 will be added to the least significant
04065  *    digit of c(In case of addition).
04066  * ------------------------- figure of output -----------------------------------
04067  *      a =  xxxxxxxxxxx
04068  *      b =    xxxxxxxxxx
04069  *      c =xxxxxxxxxxxxxxx
04070  *      word_shift =  |   |
04071  *      right_word =  |    | (Total digits in RHSV)
04072  *      left_word  = |   |   (Total digits in LHSV)
04073  *      a_pos      =    |
04074  *      b_pos      =     |
04075  *      c_pos      =      |
04076  */
04077 static size_t
04078 VpSetPTR(Real *a, Real *b, Real *c, size_t *a_pos, size_t *b_pos, size_t *c_pos, BDIGIT *av, BDIGIT *bv)
04079 {
04080     size_t left_word, right_word, word_shift;
04081     c->frac[0] = 0;
04082     *av = *bv = 0;
04083     word_shift =((a->exponent) -(b->exponent));
04084     left_word = b->Prec + word_shift;
04085     right_word = Max((a->Prec),left_word);
04086     left_word =(c->MaxPrec) - 1;    /* -1 ... prepare for round up */
04087     /*
04088      * check if 'round' is needed.
04089      */
04090     if(right_word > left_word) {    /* round ? */
04091         /*---------------------------------
04092          *  Actual size of a = xxxxxxAxx
04093          *  Actual size of b = xxxBxxxxx
04094          *  Max. size of   c = xxxxxx
04095          *  Round off        =   |-----|
04096          *  c_pos            =   |
04097          *  right_word       =   |
04098          *  a_pos            =    |
04099          */
04100         *c_pos = right_word = left_word + 1;    /* Set resulting precision */
04101         /* be equal to that of c */
04102         if((a->Prec) >=(c->MaxPrec)) {
04103             /*
04104              *   a =  xxxxxxAxxx
04105              *   c =  xxxxxx
04106              *   a_pos =    |
04107              */
04108             *a_pos = left_word;
04109             *av = a->frac[*a_pos];    /* av is 'A' shown in above. */
04110         } else {
04111             /*
04112              *   a = xxxxxxx
04113              *   c = xxxxxxxxxx
04114              *  a_pos =     |
04115              */
04116             *a_pos = a->Prec;
04117         }
04118         if((b->Prec + word_shift) >= c->MaxPrec) {
04119             /*
04120              *   a = xxxxxxxxx
04121              *   b =  xxxxxxxBxxx
04122              *   c = xxxxxxxxxxx
04123              *  b_pos =   |
04124              */
04125             if(c->MaxPrec >=(word_shift + 1)) {
04126                 *b_pos = c->MaxPrec - word_shift - 1;
04127                 *bv = b->frac[*b_pos];
04128             } else {
04129                 *b_pos = -1L;
04130             }
04131         } else {
04132             /*
04133              *   a = xxxxxxxxxxxxxxxx
04134              *   b =  xxxxxx
04135              *   c = xxxxxxxxxxxxx
04136              *  b_pos =     |
04137              */
04138             *b_pos = b->Prec;
04139         }
04140     } else {            /* The MaxPrec of c - 1 > The Prec of a + b  */
04141         /*
04142          *    a =   xxxxxxx
04143          *    b =   xxxxxx
04144          *    c = xxxxxxxxxxx
04145          *   c_pos =   |
04146          */
04147         *b_pos = b->Prec;
04148         *a_pos = a->Prec;
04149         *c_pos = right_word + 1;
04150     }
04151     c->Prec = *c_pos;
04152     c->exponent = a->exponent;
04153     if(!AddExponent(c,1)) return (size_t)-1L;
04154     return word_shift;
04155 }
04156 
04157 /*
04158  * Return number og significant digits
04159  *       c = a * b , Where a = a0a1a2 ... an
04160  *             b = b0b1b2 ... bm
04161  *             c = c0c1c2 ... cl
04162  *          a0 a1 ... an   * bm
04163  *       a0 a1 ... an   * bm-1
04164  *         .   .    .
04165  *       .   .   .
04166  *        a0 a1 .... an    * b0
04167  *      +_____________________________
04168  *     c0 c1 c2  ......  cl
04169  *     nc      <---|
04170  *     MaxAB |--------------------|
04171  */
04172 VP_EXPORT size_t
04173 VpMult(Real *c, Real *a, Real *b)
04174 {
04175     size_t MxIndA, MxIndB, MxIndAB, MxIndC;
04176     size_t ind_c, i, ii, nc;
04177     size_t ind_as, ind_ae, ind_bs, ind_be;
04178     BDIGIT carry;
04179     BDIGIT_DBL s;
04180     Real *w;
04181 
04182 #ifdef BIGDECIMAL_DEBUG
04183     if(gfDebug) {
04184         VPrint(stdout, "VpMult(Enter): a=% \n", a);
04185         VPrint(stdout, "      b=% \n", b);
04186     }
04187 #endif /* BIGDECIMAL_DEBUG */
04188 
04189     if(!VpIsDefOP(c,a,b,3)) return 0; /* No significant digit */
04190 
04191     if(VpIsZero(a) || VpIsZero(b)) {
04192         /* at least a or b is zero */
04193         VpSetZero(c,VpGetSign(a)*VpGetSign(b));
04194         return 1; /* 0: 1 significant digit */
04195     }
04196 
04197     if(VpIsOne(a)) {
04198         VpAsgn(c, b, VpGetSign(a));
04199         goto Exit;
04200     }
04201     if(VpIsOne(b)) {
04202         VpAsgn(c, a, VpGetSign(b));
04203         goto Exit;
04204     }
04205     if((b->Prec) >(a->Prec)) {
04206         /* Adjust so that digits(a)>digits(b) */
04207         w = a;
04208         a = b;
04209         b = w;
04210     }
04211     w = NULL;
04212     MxIndA = a->Prec - 1;
04213     MxIndB = b->Prec - 1;
04214     MxIndC = c->MaxPrec - 1;
04215     MxIndAB = a->Prec + b->Prec - 1;
04216 
04217     if(MxIndC < MxIndAB) {    /* The Max. prec. of c < Prec(a)+Prec(b) */
04218         w = c;
04219         c = VpAlloc((size_t)((MxIndAB + 1) * BASE_FIG), "#0");
04220         MxIndC = MxIndAB;
04221     }
04222 
04223     /* set LHSV c info */
04224 
04225     c->exponent = a->exponent;    /* set exponent */
04226     if(!AddExponent(c,b->exponent)) {
04227         if(w) VpFree(c);
04228         return 0;
04229     }
04230     VpSetSign(c,VpGetSign(a)*VpGetSign(b));    /* set sign  */
04231     carry = 0;
04232     nc = ind_c = MxIndAB;
04233     memset(c->frac, 0, (nc + 1) * sizeof(BDIGIT));        /* Initialize c  */
04234     c->Prec = nc + 1;        /* set precision */
04235     for(nc = 0; nc < MxIndAB; ++nc, --ind_c) {
04236         if(nc < MxIndB) {    /* The left triangle of the Fig. */
04237             ind_as = MxIndA - nc;
04238             ind_ae = MxIndA;
04239             ind_bs = MxIndB;
04240             ind_be = MxIndB - nc;
04241         } else if(nc <= MxIndA) {    /* The middle rectangular of the Fig. */
04242             ind_as = MxIndA - nc;
04243             ind_ae = MxIndA -(nc - MxIndB);
04244             ind_bs = MxIndB;
04245             ind_be = 0;
04246         } else if(nc > MxIndA) {    /*  The right triangle of the Fig. */
04247             ind_as = 0;
04248             ind_ae = MxIndAB - nc - 1;
04249             ind_bs = MxIndB -(nc - MxIndA);
04250             ind_be = 0;
04251         }
04252 
04253         for(i = ind_as; i <= ind_ae; ++i) {
04254             s = (BDIGIT_DBL)a->frac[i] * b->frac[ind_bs--];
04255             carry = (BDIGIT)(s / BASE);
04256             s -= (BDIGIT_DBL)carry * BASE;
04257             c->frac[ind_c] += (BDIGIT)s;
04258             if(c->frac[ind_c] >= BASE) {
04259                 s = c->frac[ind_c] / BASE;
04260                 carry += (BDIGIT)s;
04261                 c->frac[ind_c] -= (BDIGIT)(s * BASE);
04262             }
04263             if(carry) {
04264                 ii = ind_c;
04265                 while(ii-- > 0) {
04266                     c->frac[ii] += carry;
04267                     if(c->frac[ii] >= BASE) {
04268                         carry = c->frac[ii] / BASE;
04269                         c->frac[ii] -= (carry * BASE);
04270                     } else {
04271                         break;
04272                     }
04273                 }
04274             }
04275         }
04276     }
04277     if(w != NULL) {        /* free work variable */
04278         VpNmlz(c);
04279         VpAsgn(w, c, 1);
04280         VpFree(c);
04281         c = w;
04282     } else {
04283         VpLimitRound(c,0);
04284     }
04285 
04286 Exit:
04287 #ifdef BIGDECIMAL_DEBUG
04288     if(gfDebug) {
04289         VPrint(stdout, "VpMult(c=a*b): c=% \n", c);
04290         VPrint(stdout, "      a=% \n", a);
04291         VPrint(stdout, "      b=% \n", b);
04292     }
04293 #endif /*BIGDECIMAL_DEBUG */
04294     return c->Prec*BASE_FIG;
04295 }
04296 
04297 /*
04298  *   c = a / b,  remainder = r
04299  */
04300 VP_EXPORT size_t
04301 VpDivd(Real *c, Real *r, Real *a, Real *b)
04302 {
04303     size_t word_a, word_b, word_c, word_r;
04304     size_t i, n, ind_a, ind_b, ind_c, ind_r;
04305     size_t nLoop;
04306     BDIGIT_DBL q, b1, b1p1, b1b2, b1b2p1, r1r2;
04307     BDIGIT borrow, borrow1, borrow2;
04308     BDIGIT_DBL qb;
04309 
04310 #ifdef BIGDECIMAL_DEBUG
04311     if(gfDebug) {
04312         VPrint(stdout, " VpDivd(c=a/b)  a=% \n", a);
04313         VPrint(stdout, "    b=% \n", b);
04314     }
04315 #endif /*BIGDECIMAL_DEBUG */
04316 
04317     VpSetNaN(r);
04318     if(!VpIsDefOP(c,a,b,4)) goto Exit;
04319     if(VpIsZero(a)&&VpIsZero(b)) {
04320         VpSetNaN(c);
04321         return VpException(VP_EXCEPTION_NaN,"(VpDivd) 0/0 not defined(NaN)",0);
04322     }
04323     if(VpIsZero(b)) {
04324         VpSetInf(c,VpGetSign(a)*VpGetSign(b));
04325         return VpException(VP_EXCEPTION_ZERODIVIDE,"(VpDivd) Divide by zero",0);
04326     }
04327     if(VpIsZero(a)) {
04328         /* numerator a is zero  */
04329         VpSetZero(c,VpGetSign(a)*VpGetSign(b));
04330         VpSetZero(r,VpGetSign(a)*VpGetSign(b));
04331         goto Exit;
04332     }
04333     if(VpIsOne(b)) {
04334         /* divide by one  */
04335         VpAsgn(c, a, VpGetSign(b));
04336         VpSetZero(r,VpGetSign(a));
04337         goto Exit;
04338     }
04339 
04340     word_a = a->Prec;
04341     word_b = b->Prec;
04342     word_c = c->MaxPrec;
04343     word_r = r->MaxPrec;
04344 
04345     ind_c = 0;
04346     ind_r = 1;
04347 
04348     if(word_a >= word_r) goto space_error;
04349 
04350     r->frac[0] = 0;
04351     while(ind_r <= word_a) {
04352         r->frac[ind_r] = a->frac[ind_r - 1];
04353         ++ind_r;
04354     }
04355 
04356     while(ind_r < word_r) r->frac[ind_r++] = 0;
04357     while(ind_c < word_c) c->frac[ind_c++] = 0;
04358 
04359     /* initial procedure */
04360     b1 = b1p1 = b->frac[0];
04361     if(b->Prec <= 1) {
04362         b1b2p1 = b1b2 = b1p1 * BASE;
04363     } else {
04364         b1p1 = b1 + 1;
04365         b1b2p1 = b1b2 = b1 * BASE + b->frac[1];
04366         if(b->Prec > 2) ++b1b2p1;
04367     }
04368 
04369     /* */
04370     /* loop start */
04371     ind_c = word_r - 1;
04372     nLoop = Min(word_c,ind_c);
04373     ind_c = 1;
04374     while(ind_c < nLoop) {
04375         if(r->frac[ind_c] == 0) {
04376             ++ind_c;
04377             continue;
04378         }
04379         r1r2 = (BDIGIT_DBL)r->frac[ind_c] * BASE + r->frac[ind_c + 1];
04380         if(r1r2 == b1b2) {
04381             /* The first two word digits is the same */
04382             ind_b = 2;
04383             ind_a = ind_c + 2;
04384             while(ind_b < word_b) {
04385                 if(r->frac[ind_a] < b->frac[ind_b]) goto div_b1p1;
04386                 if(r->frac[ind_a] > b->frac[ind_b]) break;
04387                 ++ind_a;
04388                 ++ind_b;
04389             }
04390             /* The first few word digits of r and b is the same and */
04391             /* the first different word digit of w is greater than that */
04392             /* of b, so quotinet is 1 and just subtract b from r. */
04393             borrow = 0;        /* quotient=1, then just r-b */
04394             ind_b = b->Prec - 1;
04395             ind_r = ind_c + ind_b;
04396             if(ind_r >= word_r) goto space_error;
04397             n = ind_b;
04398             for(i = 0; i <= n; ++i) {
04399                 if(r->frac[ind_r] < b->frac[ind_b] + borrow) {
04400                     r->frac[ind_r] += (BASE - (b->frac[ind_b] + borrow));
04401                     borrow = 1;
04402                 } else {
04403                     r->frac[ind_r] = r->frac[ind_r] - b->frac[ind_b] - borrow;
04404                     borrow = 0;
04405                 }
04406                 --ind_r;
04407                 --ind_b;
04408             }
04409             ++c->frac[ind_c];
04410             goto carry;
04411         }
04412         /* The first two word digits is not the same, */
04413         /* then compare magnitude, and divide actually. */
04414         if(r1r2 >= b1b2p1) {
04415             q = r1r2 / b1b2p1;  /* q == (BDIGIT)q  */
04416             c->frac[ind_c] += (BDIGIT)q;
04417             ind_r = b->Prec + ind_c - 1;
04418             goto sub_mult;
04419         }
04420 
04421 div_b1p1:
04422         if(ind_c + 1 >= word_c) goto out_side;
04423         q = r1r2 / b1p1;  /* q == (BDIGIT)q */
04424         c->frac[ind_c + 1] += (BDIGIT)q;
04425         ind_r = b->Prec + ind_c;
04426 
04427 sub_mult:
04428         borrow1 = borrow2 = 0;
04429         ind_b = word_b - 1;
04430         if(ind_r >= word_r) goto space_error;
04431         n = ind_b;
04432         for(i = 0; i <= n; ++i) {
04433             /* now, perform r = r - q * b */
04434             qb = q * b->frac[ind_b];
04435             if (qb < BASE) borrow1 = 0;
04436             else {
04437                 borrow1 = (BDIGIT)(qb / BASE);
04438                 qb -= (BDIGIT_DBL)borrow1 * BASE;       /* get qb < BASE */
04439             }
04440             if(r->frac[ind_r] < qb) {
04441                 r->frac[ind_r] += (BDIGIT)(BASE - qb);
04442                 borrow2 = borrow2 + borrow1 + 1;
04443             } else {
04444                 r->frac[ind_r] -= (BDIGIT)qb;
04445                 borrow2 += borrow1;
04446             }
04447             if(borrow2) {
04448                 if(r->frac[ind_r - 1] < borrow2) {
04449                     r->frac[ind_r - 1] += (BASE - borrow2);
04450                     borrow2 = 1;
04451                 } else {
04452                     r->frac[ind_r - 1] -= borrow2;
04453                     borrow2 = 0;
04454                 }
04455             }
04456             --ind_r;
04457             --ind_b;
04458         }
04459 
04460         r->frac[ind_r] -= borrow2;
04461 carry:
04462         ind_r = ind_c;
04463         while(c->frac[ind_r] >= BASE) {
04464             c->frac[ind_r] -= BASE;
04465             --ind_r;
04466             ++c->frac[ind_r];
04467         }
04468     }
04469     /* End of operation, now final arrangement */
04470 out_side:
04471     c->Prec = word_c;
04472     c->exponent = a->exponent;
04473     if(!AddExponent(c,2))   return 0;
04474     if(!AddExponent(c,-(b->exponent))) return 0;
04475 
04476     VpSetSign(c,VpGetSign(a)*VpGetSign(b));
04477     VpNmlz(c);            /* normalize c */
04478     r->Prec = word_r;
04479     r->exponent = a->exponent;
04480     if(!AddExponent(r,1)) return 0;
04481     VpSetSign(r,VpGetSign(a));
04482     VpNmlz(r);            /* normalize r(remainder) */
04483     goto Exit;
04484 
04485 space_error:
04486 #ifdef BIGDECIMAL_DEBUG
04487     if(gfDebug) {
04488         printf("   word_a=%lu\n", word_a);
04489         printf("   word_b=%lu\n", word_b);
04490         printf("   word_c=%lu\n", word_c);
04491         printf("   word_r=%lu\n", word_r);
04492         printf("   ind_r =%lu\n", ind_r);
04493     }
04494 #endif /* BIGDECIMAL_DEBUG */
04495     rb_bug("ERROR(VpDivd): space for remainder too small.");
04496 
04497 Exit:
04498 #ifdef BIGDECIMAL_DEBUG
04499     if(gfDebug) {
04500         VPrint(stdout, " VpDivd(c=a/b), c=% \n", c);
04501         VPrint(stdout, "    r=% \n", r);
04502     }
04503 #endif /* BIGDECIMAL_DEBUG */
04504     return c->Prec*BASE_FIG;
04505 }
04506 
04507 /*
04508  *  Input  a = 00000xxxxxxxx En(5 preceeding zeros)
04509  *  Output a = xxxxxxxx En-5
04510  */
04511 static int
04512 VpNmlz(Real *a)
04513 {
04514     size_t ind_a, i;
04515 
04516     if (!VpIsDef(a)) goto NoVal;
04517     if (VpIsZero(a)) goto NoVal;
04518 
04519     ind_a = a->Prec;
04520     while (ind_a--) {
04521         if (a->frac[ind_a]) {
04522             a->Prec = ind_a + 1;
04523             i = 0;
04524             while (a->frac[i] == 0) ++i;        /* skip the first few zeros */
04525             if (i) {
04526                 a->Prec -= i;
04527                 if (!AddExponent(a, -(SIGNED_VALUE)i)) return 0;
04528                 memmove(&a->frac[0], &a->frac[i], a->Prec*sizeof(BDIGIT));
04529             }
04530             return 1;
04531         }
04532     }
04533     /* a is zero(no non-zero digit) */
04534     VpSetZero(a, VpGetSign(a));
04535     return 0;
04536 
04537 NoVal:
04538     a->frac[0] = 0;
04539     a->Prec = 1;
04540     return 0;
04541 }
04542 
04543 /*
04544  *  VpComp = 0  ... if a=b,
04545  *   Pos  ... a>b,
04546  *   Neg  ... a<b.
04547  *   999  ... result undefined(NaN)
04548  */
04549 VP_EXPORT int
04550 VpComp(Real *a, Real *b)
04551 {
04552     int val;
04553     size_t mx, ind;
04554     int e;
04555     val = 0;
04556     if(VpIsNaN(a)||VpIsNaN(b)) return 999;
04557     if(!VpIsDef(a)) {
04558         if(!VpIsDef(b)) e = a->sign - b->sign;
04559         else             e = a->sign;
04560         if(e>0)   return  1;
04561         else if(e<0) return -1;
04562         else   return  0;
04563     }
04564     if(!VpIsDef(b)) {
04565         e = -b->sign;
04566         if(e>0) return  1;
04567         else return -1;
04568     }
04569     /* Zero check */
04570     if(VpIsZero(a)) {
04571         if(VpIsZero(b))      return 0; /* both zero */
04572         val = -VpGetSign(b);
04573         goto Exit;
04574     }
04575     if(VpIsZero(b)) {
04576         val = VpGetSign(a);
04577         goto Exit;
04578     }
04579 
04580     /* compare sign */
04581     if(VpGetSign(a) > VpGetSign(b)) {
04582         val = 1;        /* a>b */
04583         goto Exit;
04584     }
04585     if(VpGetSign(a) < VpGetSign(b)) {
04586         val = -1;        /* a<b */
04587         goto Exit;
04588     }
04589 
04590     /* a and b have same sign, && signe!=0,then compare exponent */
04591     if((a->exponent) >(b->exponent)) {
04592         val = VpGetSign(a);
04593         goto Exit;
04594     }
04595     if((a->exponent) <(b->exponent)) {
04596         val = -VpGetSign(b);
04597         goto Exit;
04598     }
04599 
04600     /* a and b have same exponent, then compare significand. */
04601     mx =((a->Prec) <(b->Prec)) ?(a->Prec) :(b->Prec);
04602     ind = 0;
04603     while(ind < mx) {
04604         if((a->frac[ind]) >(b->frac[ind])) {
04605             val = VpGetSign(a);
04606          goto Exit;
04607         }
04608         if((a->frac[ind]) <(b->frac[ind])) {
04609             val = -VpGetSign(b);
04610             goto Exit;
04611         }
04612         ++ind;
04613     }
04614     if((a->Prec) >(b->Prec)) {
04615         val = VpGetSign(a);
04616     } else if((a->Prec) <(b->Prec)) {
04617         val = -VpGetSign(b);
04618     }
04619 
04620 Exit:
04621     if  (val> 1) val =  1;
04622     else if(val<-1) val = -1;
04623 
04624 #ifdef BIGDECIMAL_DEBUG
04625     if(gfDebug) {
04626         VPrint(stdout, " VpComp a=%\n", a);
04627         VPrint(stdout, "  b=%\n", b);
04628         printf("  ans=%d\n", val);
04629     }
04630 #endif /* BIGDECIMAL_DEBUG */
04631     return (int)val;
04632 }
04633 
04634 #ifdef BIGDECIMAL_ENABLE_VPRINT
04635 /*
04636  *    cntl_chr ... ASCIIZ Character, print control characters
04637  *     Available control codes:
04638  *      %  ... VP variable. To print '%', use '%%'.
04639  *      \n ... new line
04640  *      \b ... backspace
04641  *           ... tab
04642  *     Note: % must must not appear more than once
04643  *    a  ... VP variable to be printed
04644  */
04645 VP_EXPORT int
04646 VPrint(FILE *fp, const char *cntl_chr, Real *a)
04647 {
04648     size_t i, j, nc, nd, ZeroSup;
04649     BDIGIT m, e, nn;
04650 
04651     /* Check if NaN & Inf. */
04652     if(VpIsNaN(a)) {
04653         fprintf(fp,SZ_NaN);
04654         return 8;
04655     }
04656     if(VpIsPosInf(a)) {
04657         fprintf(fp,SZ_INF);
04658         return 8;
04659     }
04660     if(VpIsNegInf(a)) {
04661         fprintf(fp,SZ_NINF);
04662         return 9;
04663     }
04664     if(VpIsZero(a)) {
04665         fprintf(fp,"0.0");
04666         return 3;
04667     }
04668 
04669     j = 0;
04670     nd = nc = 0;        /*  nd : number of digits in fraction part(every 10 digits, */
04671     /*    nd<=10). */
04672     /*  nc : number of caracters printed  */
04673     ZeroSup = 1;        /* Flag not to print the leading zeros as 0.00xxxxEnn */
04674     while(*(cntl_chr + j)) {
04675         if((*(cntl_chr + j) == '%') &&(*(cntl_chr + j + 1) != '%')) {
04676          nc = 0;
04677          if(!VpIsZero(a)) {
04678                 if(VpGetSign(a) < 0) {
04679                     fprintf(fp, "-");
04680                     ++nc;
04681                 }
04682                 nc += fprintf(fp, "0.");
04683                 for(i=0; i < a->Prec; ++i) {
04684                     m = BASE1;
04685                     e = a->frac[i];
04686                     while(m) {
04687                         nn = e / m;
04688                         if((!ZeroSup) || nn) {
04689                             nc += fprintf(fp, "%lu", (unsigned long)nn);    /* The leading zero(s) */
04690                             /* as 0.00xx will not */
04691                             /* be printed. */
04692                             ++nd;
04693                             ZeroSup = 0;    /* Set to print succeeding zeros */
04694                         }
04695                         if(nd >= 10) {    /* print ' ' after every 10 digits */
04696                             nd = 0;
04697                             nc += fprintf(fp, " ");
04698                         }
04699                         e = e - nn * m;
04700                         m /= 10;
04701                     }
04702                 }
04703                 nc += fprintf(fp, "E%"PRIdSIZE, VpExponent10(a));
04704             } else {
04705                 nc += fprintf(fp, "0.0");
04706             }
04707         } else {
04708             ++nc;
04709             if(*(cntl_chr + j) == '\\') {
04710                 switch(*(cntl_chr + j + 1)) {
04711                 case 'n':
04712                     fprintf(fp, "\n");
04713                     ++j;
04714                     break;
04715                 case 't':
04716                     fprintf(fp, "\t");
04717                     ++j;
04718                  break;
04719                 case 'b':
04720                     fprintf(fp, "\n");
04721                     ++j;
04722                     break;
04723                 default:
04724                     fprintf(fp, "%c", *(cntl_chr + j));
04725                     break;
04726                 }
04727             } else {
04728                 fprintf(fp, "%c", *(cntl_chr + j));
04729                 if(*(cntl_chr + j) == '%') ++j;
04730             }
04731         }
04732         j++;
04733     }
04734     return (int)nc;
04735 }
04736 #endif /* BIGDECIMAL_ENABLE_VPRINT */
04737 
04738 static void
04739 VpFormatSt(char *psz, size_t fFmt)
04740 {
04741     size_t ie, i, nf = 0;
04742     char ch;
04743 
04744     if(fFmt<=0) return;
04745 
04746     ie = strlen(psz);
04747     for(i = 0; i < ie; ++i) {
04748         ch = psz[i];
04749         if(!ch) break;
04750         if(ISSPACE(ch) || ch=='-' || ch=='+') continue;
04751         if(ch == '.')                { nf = 0;continue;}
04752         if(ch == 'E') break;
04753         nf++;
04754         if(nf > fFmt) {
04755             memmove(psz + i + 1, psz + i, ie - i + 1);
04756             ++ie;
04757             nf = 0;
04758             psz[i] = ' ';
04759         }
04760     }
04761 }
04762 
04763 VP_EXPORT ssize_t
04764 VpExponent10(Real *a)
04765 {
04766     ssize_t ex;
04767     size_t n;
04768 
04769     if (!VpHasVal(a)) return 0;
04770 
04771     ex = a->exponent * (ssize_t)BASE_FIG;
04772     n = BASE1;
04773     while ((a->frac[0] / n) == 0) {
04774          --ex;
04775          n /= 10;
04776     }
04777     return ex;
04778 }
04779 
04780 VP_EXPORT void
04781 VpSzMantissa(Real *a,char *psz)
04782 {
04783     size_t i, n, ZeroSup;
04784     BDIGIT_DBL m, e, nn;
04785 
04786     if(VpIsNaN(a)) {
04787         sprintf(psz,SZ_NaN);
04788         return;
04789     }
04790     if(VpIsPosInf(a)) {
04791         sprintf(psz,SZ_INF);
04792         return;
04793     }
04794     if(VpIsNegInf(a)) {
04795         sprintf(psz,SZ_NINF);
04796         return;
04797     }
04798 
04799     ZeroSup = 1;        /* Flag not to print the leading zeros as 0.00xxxxEnn */
04800     if(!VpIsZero(a)) {
04801         if(VpGetSign(a) < 0) *psz++ = '-';
04802         n = a->Prec;
04803         for (i=0; i < n; ++i) {
04804             m = BASE1;
04805             e = a->frac[i];
04806             while (m) {
04807                 nn = e / m;
04808                 if((!ZeroSup) || nn) {
04809                     sprintf(psz, "%lu", (unsigned long)nn);    /* The leading zero(s) */
04810                     psz += strlen(psz);
04811                     /* as 0.00xx will be ignored. */
04812                     ZeroSup = 0;    /* Set to print succeeding zeros */
04813                 }
04814                 e = e - nn * m;
04815                 m /= 10;
04816             }
04817         }
04818         *psz = 0;
04819         while(psz[-1]=='0') *(--psz) = 0;
04820     } else {
04821         if(VpIsPosZero(a)) sprintf(psz, "0");
04822         else      sprintf(psz, "-0");
04823     }
04824 }
04825 
04826 VP_EXPORT int
04827 VpToSpecialString(Real *a,char *psz,int fPlus)
04828 /* fPlus =0:default, =1: set ' ' before digits , =2: set '+' before digits. */
04829 {
04830     if(VpIsNaN(a)) {
04831         sprintf(psz,SZ_NaN);
04832         return 1;
04833     }
04834 
04835     if(VpIsPosInf(a)) {
04836         if(fPlus==1) {
04837            *psz++ = ' ';
04838         } else if(fPlus==2) {
04839            *psz++ = '+';
04840         }
04841         sprintf(psz,SZ_INF);
04842         return 1;
04843     }
04844     if(VpIsNegInf(a)) {
04845         sprintf(psz,SZ_NINF);
04846         return 1;
04847     }
04848     if(VpIsZero(a)) {
04849         if(VpIsPosZero(a)) {
04850             if(fPlus==1)      sprintf(psz, " 0.0");
04851             else if(fPlus==2) sprintf(psz, "+0.0");
04852             else              sprintf(psz, "0.0");
04853         } else    sprintf(psz, "-0.0");
04854         return 1;
04855     }
04856     return 0;
04857 }
04858 
04859 VP_EXPORT void
04860 VpToString(Real *a, char *psz, size_t fFmt, int fPlus)
04861 /* fPlus =0:default, =1: set ' ' before digits , =2:set '+' before digits. */
04862 {
04863     size_t i, n, ZeroSup;
04864     BDIGIT shift, m, e, nn;
04865     char *pszSav = psz;
04866     ssize_t ex;
04867 
04868     if (VpToSpecialString(a, psz, fPlus)) return;
04869 
04870     ZeroSup = 1;    /* Flag not to print the leading zeros as 0.00xxxxEnn */
04871 
04872     if (VpGetSign(a) < 0) *psz++ = '-';
04873     else if (fPlus == 1)  *psz++ = ' ';
04874     else if (fPlus == 2)  *psz++ = '+';
04875 
04876     *psz++ = '0';
04877     *psz++ = '.';
04878     n = a->Prec;
04879     for(i=0;i < n;++i) {
04880         m = BASE1;
04881         e = a->frac[i];
04882         while(m) {
04883             nn = e / m;
04884             if((!ZeroSup) || nn) {
04885                 sprintf(psz, "%lu", (unsigned long)nn);    /* The reading zero(s) */
04886                 psz += strlen(psz);
04887                 /* as 0.00xx will be ignored. */
04888                 ZeroSup = 0;    /* Set to print succeeding zeros */
04889             }
04890             e = e - nn * m;
04891             m /= 10;
04892         }
04893     }
04894     ex = a->exponent * (ssize_t)BASE_FIG;
04895     shift = BASE1;
04896     while(a->frac[0] / shift == 0) {
04897         --ex;
04898         shift /= 10;
04899     }
04900     while(psz[-1]=='0') *(--psz) = 0;
04901     sprintf(psz, "E%"PRIdSIZE, ex);
04902     if(fFmt) VpFormatSt(pszSav, fFmt);
04903 }
04904 
04905 VP_EXPORT void
04906 VpToFString(Real *a, char *psz, size_t fFmt, int fPlus)
04907 /* fPlus =0:default,=1: set ' ' before digits ,set '+' before digits. */
04908 {
04909     size_t i, n;
04910     BDIGIT m, e, nn;
04911     char *pszSav = psz;
04912     ssize_t ex;
04913 
04914     if(VpToSpecialString(a,psz,fPlus)) return;
04915 
04916     if(VpGetSign(a) < 0) *psz++ = '-';
04917     else if(fPlus==1)    *psz++ = ' ';
04918     else if(fPlus==2)    *psz++ = '+';
04919 
04920     n  = a->Prec;
04921     ex = a->exponent;
04922     if(ex<=0) {
04923        *psz++ = '0';*psz++ = '.';
04924        while(ex<0) {
04925           for(i=0;i<BASE_FIG;++i) *psz++ = '0';
04926           ++ex;
04927        }
04928        ex = -1;
04929     }
04930 
04931     for(i=0;i < n;++i) {
04932        --ex;
04933        if(i==0 && ex >= 0) {
04934            sprintf(psz, "%lu", (unsigned long)a->frac[i]);
04935            psz += strlen(psz);
04936        } else {
04937            m = BASE1;
04938            e = a->frac[i];
04939            while(m) {
04940                nn = e / m;
04941                *psz++ = (char)(nn + '0');
04942                e = e - nn * m;
04943                m /= 10;
04944            }
04945        }
04946        if(ex == 0) *psz++ = '.';
04947     }
04948     while(--ex>=0) {
04949        m = BASE;
04950        while(m/=10) *psz++ = '0';
04951        if(ex == 0) *psz++ = '.';
04952     }
04953     *psz = 0;
04954     while(psz[-1]=='0') *(--psz) = 0;
04955     if(psz[-1]=='.') sprintf(psz, "0");
04956     if(fFmt) VpFormatSt(pszSav, fFmt);
04957 }
04958 
04959 /*
04960  *  [Output]
04961  *   a[]  ... variable to be assigned the value.
04962  *  [Input]
04963  *   int_chr[]  ... integer part(may include '+/-').
04964  *   ni   ... number of characters in int_chr[],not including '+/-'.
04965  *   frac[]  ... fraction part.
04966  *   nf   ... number of characters in frac[].
04967  *   exp_chr[]  ... exponent part(including '+/-').
04968  *   ne   ... number of characters in exp_chr[],not including '+/-'.
04969  */
04970 VP_EXPORT int
04971 VpCtoV(Real *a, const char *int_chr, size_t ni, const char *frac, size_t nf, const char *exp_chr, size_t ne)
04972 {
04973     size_t i, j, ind_a, ma, mi, me;
04974     size_t loc;
04975     SIGNED_VALUE e, es, eb, ef;
04976     int  sign, signe, exponent_overflow;
04977 
04978     /* get exponent part */
04979     e = 0;
04980     ma = a->MaxPrec;
04981     mi = ni;
04982     me = ne;
04983     signe = 1;
04984     exponent_overflow = 0;
04985     memset(a->frac, 0, ma * sizeof(BDIGIT));
04986     if (ne > 0) {
04987         i = 0;
04988         if (exp_chr[0] == '-') {
04989             signe = -1;
04990             ++i;
04991             ++me;
04992         }
04993         else if (exp_chr[0] == '+') {
04994             ++i;
04995             ++me;
04996         }
04997         while (i < me) {
04998             es = e * (SIGNED_VALUE)BASE_FIG;
04999             e = e * 10 + exp_chr[i] - '0';
05000             if (es > (SIGNED_VALUE)(e*BASE_FIG)) {
05001                 exponent_overflow = 1;
05002                 e = es; /* keep sign */
05003                 break;
05004             }
05005             ++i;
05006         }
05007     }
05008 
05009     /* get integer part */
05010     i = 0;
05011     sign = 1;
05012     if(1 /*ni >= 0*/) {
05013         if(int_chr[0] == '-') {
05014             sign = -1;
05015             ++i;
05016             ++mi;
05017         } else if(int_chr[0] == '+') {
05018             ++i;
05019             ++mi;
05020         }
05021     }
05022 
05023     e = signe * e;        /* e: The value of exponent part. */
05024     e = e + ni;        /* set actual exponent size. */
05025 
05026     if (e > 0) signe = 1;
05027     else       signe = -1;
05028 
05029     /* Adjust the exponent so that it is the multiple of BASE_FIG. */
05030     j = 0;
05031     ef = 1;
05032     while (ef) {
05033         if (e >= 0) eb =  e;
05034         else        eb = -e;
05035         ef = eb / (SIGNED_VALUE)BASE_FIG;
05036         ef = eb - ef * (SIGNED_VALUE)BASE_FIG;
05037         if (ef) {
05038             ++j;        /* Means to add one more preceeding zero */
05039             ++e;
05040         }
05041     }
05042 
05043     eb = e / (SIGNED_VALUE)BASE_FIG;
05044 
05045     if (exponent_overflow) {
05046         int zero = 1;
05047         for (     ; i < mi && zero; i++) zero = int_chr[i] == '0';
05048         for (i = 0; i < nf && zero; i++) zero = frac[i] == '0';
05049         if (!zero && signe > 0) {
05050             VpSetInf(a, sign);
05051             VpException(VP_EXCEPTION_INFINITY, "exponent overflow",0);
05052         }
05053         else VpSetZero(a, sign);
05054         return 1;
05055     }
05056 
05057     ind_a = 0;
05058     while (i < mi) {
05059         a->frac[ind_a] = 0;
05060         while ((j < BASE_FIG) && (i < mi)) {
05061             a->frac[ind_a] = a->frac[ind_a] * 10 + int_chr[i] - '0';
05062             ++j;
05063             ++i;
05064         }
05065         if (i < mi) {
05066             ++ind_a;
05067             if (ind_a >= ma) goto over_flow;
05068             j = 0;
05069         }
05070     }
05071     loc = 1;
05072 
05073     /* get fraction part */
05074 
05075     i = 0;
05076     while(i < nf) {
05077         while((j < BASE_FIG) && (i < nf)) {
05078             a->frac[ind_a] = a->frac[ind_a] * 10 + frac[i] - '0';
05079             ++j;
05080             ++i;
05081         }
05082         if(i < nf) {
05083             ++ind_a;
05084             if(ind_a >= ma) goto over_flow;
05085             j = 0;
05086         }
05087     }
05088     goto Final;
05089 
05090 over_flow:
05091     rb_warn("Conversion from String to BigDecimal overflow (last few digits discarded).");
05092 
05093 Final:
05094     if (ind_a >= ma) ind_a = ma - 1;
05095     while (j < BASE_FIG) {
05096         a->frac[ind_a] = a->frac[ind_a] * 10;
05097         ++j;
05098     }
05099     a->Prec = ind_a + 1;
05100     a->exponent = eb;
05101     VpSetSign(a,sign);
05102     VpNmlz(a);
05103     return 1;
05104 }
05105 
05106 /*
05107  * [Input]
05108  *   *m  ... Real
05109  * [Output]
05110  *   *d  ... fraction part of m(d = 0.xxxxxxx). where # of 'x's is fig.
05111  *   *e  ... exponent of m.
05112  * DBLE_FIG ... Number of digits in a double variable.
05113  *
05114  *  m -> d*10**e, 0<d<BASE
05115  * [Returns]
05116  *   0 ... Zero
05117  *   1 ... Normal
05118  *   2 ... Infinity
05119  *  -1 ... NaN
05120  */
05121 VP_EXPORT int
05122 VpVtoD(double *d, SIGNED_VALUE *e, Real *m)
05123 {
05124     size_t ind_m, mm, fig;
05125     double div;
05126     int    f = 1;
05127 
05128     if(VpIsNaN(m)) {
05129         *d = VpGetDoubleNaN();
05130         *e = 0;
05131         f = -1; /* NaN */
05132         goto Exit;
05133     } else
05134     if(VpIsPosZero(m)) {
05135         *d = 0.0;
05136         *e = 0;
05137         f  = 0;
05138         goto Exit;
05139     } else
05140     if(VpIsNegZero(m)) {
05141         *d = VpGetDoubleNegZero();
05142         *e = 0;
05143         f  = 0;
05144         goto Exit;
05145     } else
05146     if(VpIsPosInf(m)) {
05147         *d = VpGetDoublePosInf();
05148         *e = 0;
05149         f  = 2;
05150         goto Exit;
05151     } else
05152     if(VpIsNegInf(m)) {
05153         *d = VpGetDoubleNegInf();
05154         *e = 0;
05155         f  = 2;
05156         goto Exit;
05157     }
05158     /* Normal number */
05159     fig =(DBLE_FIG + BASE_FIG - 1) / BASE_FIG;
05160     ind_m = 0;
05161     mm = Min(fig,(m->Prec));
05162     *d = 0.0;
05163     div = 1.;
05164     while(ind_m < mm) {
05165         div /= (double)BASE;
05166         *d = *d + (double)m->frac[ind_m++] * div;
05167     }
05168     *e = m->exponent * (SIGNED_VALUE)BASE_FIG;
05169     *d *= VpGetSign(m);
05170 
05171 Exit:
05172 #ifdef BIGDECIMAL_DEBUG
05173     if(gfDebug) {
05174         VPrint(stdout, " VpVtoD: m=%\n", m);
05175         printf("   d=%e * 10 **%ld\n", *d, *e);
05176         printf("   DBLE_FIG = %d\n", DBLE_FIG);
05177     }
05178 #endif /*BIGDECIMAL_DEBUG */
05179     return f;
05180 }
05181 
05182 /*
05183  * m <- d
05184  */
05185 VP_EXPORT void
05186 VpDtoV(Real *m, double d)
05187 {
05188     size_t ind_m, mm;
05189     SIGNED_VALUE ne;
05190     BDIGIT i;
05191     double  val, val2;
05192 
05193     if(isnan(d)) {
05194         VpSetNaN(m);
05195         goto Exit;
05196     }
05197     if(isinf(d)) {
05198         if(d>0.0) VpSetPosInf(m);
05199         else   VpSetNegInf(m);
05200         goto Exit;
05201     }
05202 
05203     if(d == 0.0) {
05204         VpSetZero(m,1);
05205         goto Exit;
05206     }
05207     val =(d > 0.) ? d :(-d);
05208     ne = 0;
05209     if(val >= 1.0) {
05210         while(val >= 1.0) {
05211             val /= (double)BASE;
05212             ++ne;
05213         }
05214     } else {
05215         val2 = 1.0 /(double)BASE;
05216         while(val < val2) {
05217             val *= (double)BASE;
05218             --ne;
05219         }
05220     }
05221     /* Now val = 0.xxxxx*BASE**ne */
05222 
05223     mm = m->MaxPrec;
05224     memset(m->frac, 0, mm * sizeof(BDIGIT));
05225     for(ind_m = 0;val > 0.0 && ind_m < mm;ind_m++) {
05226         val *= (double)BASE;
05227         i = (BDIGIT)val;
05228         val -= (double)i;
05229         m->frac[ind_m] = i;
05230     }
05231     if(ind_m >= mm) ind_m = mm - 1;
05232     VpSetSign(m, (d > 0.0) ? 1 : -1);
05233     m->Prec = ind_m + 1;
05234     m->exponent = ne;
05235 
05236     VpInternalRound(m, 0, (m->Prec > 0) ? m->frac[m->Prec-1] : 0,
05237                       (BDIGIT)(val*(double)BASE));
05238 
05239 Exit:
05240 #ifdef BIGDECIMAL_DEBUG
05241     if(gfDebug) {
05242         printf("VpDtoV d=%30.30e\n", d);
05243         VPrint(stdout, "  m=%\n", m);
05244     }
05245 #endif /* BIGDECIMAL_DEBUG */
05246     return;
05247 }
05248 
05249 /*
05250  *  m <- ival
05251  */
05252 #if 0  /* unused */
05253 VP_EXPORT void
05254 VpItoV(Real *m, SIGNED_VALUE ival)
05255 {
05256     size_t mm, ind_m;
05257     size_t val, v1, v2, v;
05258     int isign;
05259     SIGNED_VALUE ne;
05260 
05261     if(ival == 0) {
05262         VpSetZero(m,1);
05263         goto Exit;
05264     }
05265     isign = 1;
05266     val = ival;
05267     if(ival < 0) {
05268         isign = -1;
05269         val =(size_t)(-ival);
05270     }
05271     ne = 0;
05272     ind_m = 0;
05273     mm = m->MaxPrec;
05274     while(ind_m < mm) {
05275         m->frac[ind_m] = 0;
05276         ++ind_m;
05277     }
05278     ind_m = 0;
05279     while(val > 0) {
05280         if(val) {
05281          v1 = val;
05282          v2 = 1;
05283             while(v1 >= BASE) {
05284                 v1 /= BASE;
05285                 v2 *= BASE;
05286             }
05287             val = val - v2 * v1;
05288             v = v1;
05289         } else {
05290             v = 0;
05291         }
05292         m->frac[ind_m] = v;
05293         ++ind_m;
05294         ++ne;
05295     }
05296     m->Prec = ind_m - 1;
05297     m->exponent = ne;
05298     VpSetSign(m,isign);
05299     VpNmlz(m);
05300 
05301 Exit:
05302 #ifdef BIGDECIMAL_DEBUG
05303     if(gfDebug) {
05304         printf(" VpItoV i=%d\n", ival);
05305         VPrint(stdout, "  m=%\n", m);
05306     }
05307 #endif /* BIGDECIMAL_DEBUG */
05308     return;
05309 }
05310 #endif
05311 
05312 /*
05313  * y = SQRT(x),  y*y - x =>0
05314  */
05315 VP_EXPORT int
05316 VpSqrt(Real *y, Real *x)
05317 {
05318     Real *f = NULL;
05319     Real *r = NULL;
05320     size_t y_prec, f_prec;
05321     SIGNED_VALUE n, e;
05322     SIGNED_VALUE prec;
05323     ssize_t nr;
05324     double val;
05325 
05326     /* Zero, NaN or Infinity ? */
05327     if(!VpHasVal(x)) {
05328         if(VpIsZero(x)||VpGetSign(x)>0) {
05329             VpAsgn(y,x,1);
05330             goto Exit;
05331         }
05332         VpSetNaN(y);
05333         return VpException(VP_EXCEPTION_OP,"(VpSqrt) SQRT(NaN or negative value)",0);
05334         goto Exit;
05335     }
05336 
05337      /* Negative ? */
05338     if(VpGetSign(x) < 0) {
05339         VpSetNaN(y);
05340         return VpException(VP_EXCEPTION_OP,"(VpSqrt) SQRT(negative value)",0);
05341     }
05342 
05343     /* One ? */
05344     if(VpIsOne(x)) {
05345         VpSetOne(y);
05346         goto Exit;
05347     }
05348 
05349     n = (SIGNED_VALUE)y->MaxPrec;
05350     if (x->MaxPrec > (size_t)n) n = (ssize_t)x->MaxPrec;
05351     /* allocate temporally variables  */
05352     f = VpAlloc(y->MaxPrec * (BASE_FIG + 2), "#1");
05353     r = VpAlloc((n + n) * (BASE_FIG + 2), "#1");
05354 
05355     nr = 0;
05356     y_prec = y->MaxPrec;
05357     f_prec = f->MaxPrec;
05358 
05359     prec = x->exponent - (ssize_t)y_prec;
05360     if (x->exponent > 0)
05361         ++prec;
05362     else
05363         --prec;
05364 
05365     VpVtoD(&val, &e, x);    /* val <- x  */
05366     e /= (SIGNED_VALUE)BASE_FIG;
05367     n = e / 2;
05368     if (e - n * 2 != 0) {
05369         val /= BASE;
05370         n = (e + 1) / 2;
05371     }
05372     VpDtoV(y, sqrt(val));    /* y <- sqrt(val) */
05373     y->exponent += n;
05374     n = (SIGNED_VALUE)((DBLE_FIG + BASE_FIG - 1) / BASE_FIG);
05375     y->MaxPrec = Min((size_t)n , y_prec);
05376     f->MaxPrec = y->MaxPrec + 1;
05377     n = (SIGNED_VALUE)(y_prec * BASE_FIG);
05378     if (n < (SIGNED_VALUE)maxnr) n = (SIGNED_VALUE)maxnr;
05379     do {
05380         y->MaxPrec *= 2;
05381         if (y->MaxPrec > y_prec) y->MaxPrec = y_prec;
05382         f->MaxPrec = y->MaxPrec;
05383         VpDivd(f, r, x, y);     /* f = x/y    */
05384         VpAddSub(r, f, y, -1);  /* r = f - y  */
05385         VpMult(f, VpPt5, r);    /* f = 0.5*r  */
05386         if(VpIsZero(f))         goto converge;
05387         VpAddSub(r, f, y, 1);   /* r = y + f  */
05388         VpAsgn(y, r, 1);        /* y = r      */
05389         if(f->exponent <= prec) goto converge;
05390     } while(++nr < n);
05391     /* */
05392 #ifdef BIGDECIMAL_DEBUG
05393     if(gfDebug) {
05394         printf("ERROR(VpSqrt): did not converge within %ld iterations.\n",
05395             nr);
05396     }
05397 #endif /* BIGDECIMAL_DEBUG */
05398     y->MaxPrec = y_prec;
05399 
05400 converge:
05401     VpChangeSign(y, 1);
05402 #ifdef BIGDECIMAL_DEBUG
05403     if(gfDebug) {
05404         VpMult(r, y, y);
05405         VpAddSub(f, x, r, -1);
05406         printf("VpSqrt: iterations = %"PRIdSIZE"\n", nr);
05407         VPrint(stdout, "  y =% \n", y);
05408         VPrint(stdout, "  x =% \n", x);
05409         VPrint(stdout, "  x-y*y = % \n", f);
05410     }
05411 #endif /* BIGDECIMAL_DEBUG */
05412     y->MaxPrec = y_prec;
05413 
05414 Exit:
05415     VpFree(f);
05416     VpFree(r);
05417     return 1;
05418 }
05419 
05420 /*
05421  *
05422  * nf: digit position for operation.
05423  *
05424  */
05425 VP_EXPORT int
05426 VpMidRound(Real *y, unsigned short f, ssize_t nf)
05427 /*
05428  * Round reletively from the decimal point.
05429  *    f: rounding mode
05430  *   nf: digit location to round from the the decimal point.
05431  */
05432 {
05433     /* fracf: any positive digit under rounding position? */
05434     /* fracf_1further: any positive digits under one further than the rounding position? */
05435     /* exptoadd: number of digits needed to compensate negative nf */
05436     int fracf, fracf_1further;
05437     ssize_t n,i,ix,ioffset, exptoadd;
05438     BDIGIT v, shifter;
05439     BDIGIT div;
05440 
05441     nf += y->exponent * (ssize_t)BASE_FIG;
05442     exptoadd=0;
05443     if (nf < 0) {
05444         /* rounding position too left(large). */
05445         if((f!=VP_ROUND_CEIL) && (f!=VP_ROUND_FLOOR)) {
05446             VpSetZero(y,VpGetSign(y)); /* truncate everything */
05447             return 0;
05448         }
05449         exptoadd = -nf;
05450         nf = 0;
05451     }
05452 
05453     ix = nf / (ssize_t)BASE_FIG;
05454     if ((size_t)ix >= y->Prec) return 0;  /* rounding position too right(small). */
05455     v = y->frac[ix];
05456 
05457     ioffset = nf - ix*(ssize_t)BASE_FIG;
05458     n = (ssize_t)BASE_FIG - ioffset - 1;
05459     for (shifter=1,i=0; i<n; ++i) shifter *= 10;
05460 
05461     /* so the representation used (in y->frac) is an array of BDIGIT, where
05462        each BDIGIT contains a value between 0 and BASE-1, consisting of BASE_FIG
05463        decimal places.
05464 
05465        (that numbers of decimal places are typed as ssize_t is somewhat confusing)
05466 
05467        nf is now position (in decimal places) of the digit from the start of
05468           the array.
05469        ix is the position (in BDIGITS) of the BDIGIT containing the decimal digit,
05470           from the start of the array.
05471        v is the value of this BDIGIT
05472        ioffset is the number of extra decimal places along of this decimal digit
05473           within v.
05474        n is the number of decimal digits remaining within v after this decimal digit
05475        shifter is 10**n,
05476        v % shifter are the remaining digits within v
05477        v % (shifter * 10) are the digit together with the remaining digits within v
05478        v / shifter are the digit's predecessors together with the digit
05479        div = v / shifter / 10 is just the digit's precessors
05480        (v / shifter) - div*10 is just the digit, which is what v ends up being reassigned to.
05481     */
05482 
05483     fracf = (v % (shifter * 10) > 0);
05484     fracf_1further = ((v % shifter) > 0);
05485 
05486     v /= shifter;
05487     div = v / 10;
05488     v = v - div*10;
05489     /* now v is just the digit required.
05490        now fracf is whether the digit or any of the remaining digits within v are non-zero
05491        now fracf_1further is whether any of the remaining digits within v are non-zero
05492     */
05493 
05494     /* now check all the remaining BDIGITS for zero-ness a whole BDIGIT at a time.
05495        if we spot any non-zeroness, that means that we foudn a positive digit under
05496        rounding position, and we also found a positive digit under one further than
05497        the rounding position, so both searches (to see if any such non-zero digit exists)
05498        can stop */
05499 
05500     for (i=ix+1; (size_t)i < y->Prec; i++) {
05501         if (y->frac[i] % BASE) {
05502             fracf = fracf_1further = 1;
05503             break;
05504         }
05505     }
05506 
05507     /* now fracf = does any positive digit exist under the rounding position?
05508        now fracf_1further = does any positive digit exist under one further than the
05509        rounding position?
05510        now v = the first digit under the rounding position */
05511 
05512     /* drop digits after pointed digit */
05513     memset(y->frac+ix+1, 0, (y->Prec - (ix+1)) * sizeof(BDIGIT));
05514 
05515     switch(f) {
05516     case VP_ROUND_DOWN: /* Truncate */
05517          break;
05518     case VP_ROUND_UP:   /* Roundup */
05519         if (fracf) ++div;
05520         break;
05521     case VP_ROUND_HALF_UP:
05522         if (v>=5) ++div;
05523         break;
05524     case VP_ROUND_HALF_DOWN:
05525         if (v > 5 || (v == 5 && fracf_1further)) ++div;
05526         break;
05527     case VP_ROUND_CEIL:
05528         if (fracf && (VpGetSign(y)>0)) ++div;
05529         break;
05530     case VP_ROUND_FLOOR:
05531         if (fracf && (VpGetSign(y)<0)) ++div;
05532         break;
05533     case VP_ROUND_HALF_EVEN: /* Banker's rounding */
05534         if (v > 5) ++div;
05535         else if (v == 5) {
05536             if (fracf_1further) {
05537               ++div;
05538             }
05539             else {
05540                 if (ioffset == 0) {
05541                     /* v is the first decimal digit of its BDIGIT;
05542                        need to grab the previous BDIGIT if present
05543                        to check for evenness of the previous decimal
05544                        digit (which is same as that of the BDIGIT since
05545                        base 10 has a factor of 2) */
05546                     if (ix && (y->frac[ix-1] % 2)) ++div;
05547                 }
05548                 else {
05549                     if (div % 2) ++div;
05550                 }
05551             }
05552         }
05553         break;
05554     }
05555     for (i=0; i<=n; ++i) div *= 10;
05556     if (div>=BASE) {
05557         if(ix) {
05558             y->frac[ix] = 0;
05559             VpRdup(y,ix);
05560         } else {
05561             short s = VpGetSign(y);
05562             SIGNED_VALUE e = y->exponent;
05563             VpSetOne(y);
05564             VpSetSign(y, s);
05565             y->exponent = e+1;
05566         }
05567     } else {
05568         y->frac[ix] = div;
05569         VpNmlz(y);
05570     }
05571     if (exptoadd > 0) {
05572         y->exponent += (SIGNED_VALUE)(exptoadd/BASE_FIG);
05573         exptoadd %= (ssize_t)BASE_FIG;
05574         for(i=0;i<exptoadd;i++) {
05575             y->frac[0] *= 10;
05576             if (y->frac[0] >= BASE) {
05577                 y->frac[0] /= BASE;
05578                 y->exponent++;
05579             }
05580         }
05581     }
05582     return 1;
05583 }
05584 
05585 VP_EXPORT int
05586 VpLeftRound(Real *y, unsigned short f, ssize_t nf)
05587 /*
05588  * Round from the left hand side of the digits.
05589  */
05590 {
05591     BDIGIT v;
05592     if (!VpHasVal(y)) return 0; /* Unable to round */
05593     v = y->frac[0];
05594     nf -= VpExponent(y)*(ssize_t)BASE_FIG;
05595     while ((v /= 10) != 0) nf--;
05596     nf += (ssize_t)BASE_FIG-1;
05597     return VpMidRound(y,f,nf);
05598 }
05599 
05600 VP_EXPORT int
05601 VpActiveRound(Real *y, Real *x, unsigned short f, ssize_t nf)
05602 {
05603     /* First,assign whole value in truncation mode */
05604     if (VpAsgn(y, x, 10) <= 1) return 0; /* Zero,NaN,or Infinity */
05605     return VpMidRound(y,f,nf);
05606 }
05607 
05608 static int
05609 VpLimitRound(Real *c, size_t ixDigit)
05610 {
05611     size_t ix = VpGetPrecLimit();
05612     if(!VpNmlz(c))    return -1;
05613     if(!ix)           return 0;
05614     if(!ixDigit) ixDigit = c->Prec-1;
05615     if((ix+BASE_FIG-1)/BASE_FIG > ixDigit+1) return 0;
05616     return VpLeftRound(c, VpGetRoundMode(), (ssize_t)ix);
05617 }
05618 
05619 /* If I understand correctly, this is only ever used to round off the final decimal
05620    digit of precision */
05621 static void
05622 VpInternalRound(Real *c, size_t ixDigit, BDIGIT vPrev, BDIGIT v)
05623 {
05624     int f = 0;
05625 
05626     unsigned short const rounding_mode = VpGetRoundMode();
05627 
05628     if (VpLimitRound(c, ixDigit)) return;
05629     if (!v) return;
05630 
05631     v /= BASE1;
05632     switch (rounding_mode) {
05633     case VP_ROUND_DOWN:
05634         break;
05635     case VP_ROUND_UP:
05636         if (v) f = 1;
05637         break;
05638     case VP_ROUND_HALF_UP:
05639         if (v >= 5) f = 1;
05640         break;
05641     case VP_ROUND_HALF_DOWN:
05642         /* this is ok - because this is the last digit of precision,
05643            the case where v == 5 and some further digits are nonzero
05644            will never occur */
05645         if (v >= 6) f = 1;
05646         break;
05647     case VP_ROUND_CEIL:
05648         if (v && (VpGetSign(c) > 0)) f = 1;
05649         break;
05650     case VP_ROUND_FLOOR:
05651         if (v && (VpGetSign(c) < 0)) f = 1;
05652         break;
05653     case VP_ROUND_HALF_EVEN:  /* Banker's rounding */
05654         /* as per VP_ROUND_HALF_DOWN, because this is the last digit of precision,
05655            there is no case to worry about where v == 5 and some further digits are nonzero */
05656         if (v > 5) f = 1;
05657         else if (v == 5 && vPrev % 2) f = 1;
05658         break;
05659     }
05660     if (f) {
05661         VpRdup(c, ixDigit);
05662         VpNmlz(c);
05663     }
05664 }
05665 
05666 /*
05667  *  Rounds up m(plus one to final digit of m).
05668  */
05669 static int
05670 VpRdup(Real *m, size_t ind_m)
05671 {
05672     BDIGIT carry;
05673 
05674     if (!ind_m) ind_m = m->Prec;
05675 
05676     carry = 1;
05677     while (carry > 0 && (ind_m--)) {
05678         m->frac[ind_m] += carry;
05679         if (m->frac[ind_m] >= BASE) m->frac[ind_m] -= BASE;
05680         else                        carry = 0;
05681     }
05682     if(carry > 0) {        /* Overflow,count exponent and set fraction part be 1  */
05683         if (!AddExponent(m, 1)) return 0;
05684         m->Prec = m->frac[0] = 1;
05685     } else {
05686         VpNmlz(m);
05687     }
05688     return 1;
05689 }
05690 
05691 /*
05692  *  y = x - fix(x)
05693  */
05694 VP_EXPORT void
05695 VpFrac(Real *y, Real *x)
05696 {
05697     size_t my, ind_y, ind_x;
05698 
05699     if(!VpHasVal(x)) {
05700         VpAsgn(y,x,1);
05701         goto Exit;
05702     }
05703 
05704     if (x->exponent > 0 && (size_t)x->exponent >= x->Prec) {
05705         VpSetZero(y,VpGetSign(x));
05706         goto Exit;
05707     }
05708     else if(x->exponent <= 0) {
05709         VpAsgn(y, x, 1);
05710         goto Exit;
05711     }
05712 
05713     /* satisfy: x->exponent > 0 */
05714 
05715     y->Prec = x->Prec - (size_t)x->exponent;
05716     y->Prec = Min(y->Prec, y->MaxPrec);
05717     y->exponent = 0;
05718     VpSetSign(y,VpGetSign(x));
05719     ind_y = 0;
05720     my = y->Prec;
05721     ind_x = x->exponent;
05722     while(ind_y < my) {
05723         y->frac[ind_y] = x->frac[ind_x];
05724         ++ind_y;
05725         ++ind_x;
05726     }
05727     VpNmlz(y);
05728 
05729 Exit:
05730 #ifdef BIGDECIMAL_DEBUG
05731     if(gfDebug) {
05732         VPrint(stdout, "VpFrac y=%\n", y);
05733         VPrint(stdout, "    x=%\n", x);
05734     }
05735 #endif /* BIGDECIMAL_DEBUG */
05736     return;
05737 }
05738 
05739 /*
05740  *   y = x ** n
05741  */
05742 VP_EXPORT int
05743 VpPower(Real *y, Real *x, SIGNED_VALUE n)
05744 {
05745     size_t s, ss;
05746     ssize_t sign;
05747     Real *w1 = NULL;
05748     Real *w2 = NULL;
05749 
05750     if(VpIsZero(x)) {
05751         if(n==0) {
05752            VpSetOne(y);
05753            goto Exit;
05754         }
05755         sign = VpGetSign(x);
05756         if(n<0) {
05757            n = -n;
05758            if(sign<0) sign = (n%2)?(-1):(1);
05759            VpSetInf (y,sign);
05760         } else {
05761            if(sign<0) sign = (n%2)?(-1):(1);
05762            VpSetZero(y,sign);
05763         }
05764         goto Exit;
05765     }
05766     if(VpIsNaN(x)) {
05767         VpSetNaN(y);
05768         goto Exit;
05769     }
05770     if(VpIsInf(x)) {
05771         if(n==0) {
05772             VpSetOne(y);
05773             goto Exit;
05774         }
05775         if(n>0) {
05776             VpSetInf(y, (n%2==0 || VpIsPosInf(x)) ? 1 : -1);
05777             goto Exit;
05778         }
05779         VpSetZero(y, (n%2==0 || VpIsPosInf(x)) ? 1 : -1);
05780         goto Exit;
05781     }
05782 
05783     if((x->exponent == 1) &&(x->Prec == 1) &&(x->frac[0] == 1)) {
05784         /* abs(x) = 1 */
05785         VpSetOne(y);
05786         if(VpGetSign(x) > 0) goto Exit;
05787         if((n % 2) == 0) goto Exit;
05788         VpSetSign(y, -1);
05789         goto Exit;
05790     }
05791 
05792     if(n > 0) sign = 1;
05793     else if(n < 0) {
05794         sign = -1;
05795         n = -n;
05796     } else {
05797         VpSetOne(y);
05798         goto Exit;
05799     }
05800 
05801     /* Allocate working variables  */
05802 
05803     w1 = VpAlloc((y->MaxPrec + 2) * BASE_FIG, "#0");
05804     w2 = VpAlloc((w1->MaxPrec * 2 + 1) * BASE_FIG, "#0");
05805     /* calculation start */
05806 
05807     VpAsgn(y, x, 1);
05808     --n;
05809     while(n > 0) {
05810         VpAsgn(w1, x, 1);
05811         s = 1;
05812         while (ss = s, (s += s) <= (size_t)n) {
05813             VpMult(w2, w1, w1);
05814             VpAsgn(w1, w2, 1);
05815         }
05816         n -= (SIGNED_VALUE)ss;
05817         VpMult(w2, y, w1);
05818         VpAsgn(y, w2, 1);
05819     }
05820     if(sign < 0) {
05821         VpDivd(w1, w2, VpConstOne, y);
05822         VpAsgn(y, w1, 1);
05823     }
05824 
05825 Exit:
05826 #ifdef BIGDECIMAL_DEBUG
05827     if(gfDebug) {
05828         VPrint(stdout, "VpPower y=%\n", y);
05829         VPrint(stdout, "VpPower x=%\n", x);
05830         printf("  n=%d\n", n);
05831     }
05832 #endif /* BIGDECIMAL_DEBUG */
05833     VpFree(w2);
05834     VpFree(w1);
05835     return 1;
05836 }
05837 
05838 #ifdef BIGDECIMAL_DEBUG
05839 int
05840 VpVarCheck(Real * v)
05841 /*
05842  * Checks the validity of the Real variable v.
05843  * [Input]
05844  *   v ... Real *, variable to be checked.
05845  * [Returns]
05846  *   0  ... correct v.
05847  *   other ... error
05848  */
05849 {
05850     size_t i;
05851 
05852     if(v->MaxPrec <= 0) {
05853         printf("ERROR(VpVarCheck): Illegal Max. Precision(=%"PRIuSIZE")\n",
05854             v->MaxPrec);
05855         return 1;
05856     }
05857     if((v->Prec <= 0) ||((v->Prec) >(v->MaxPrec))) {
05858         printf("ERROR(VpVarCheck): Illegal Precision(=%"PRIuSIZE")\n", v->Prec);
05859         printf("       Max. Prec.=%"PRIuSIZE"\n", v->MaxPrec);
05860         return 2;
05861     }
05862     for(i = 0; i < v->Prec; ++i) {
05863         if((v->frac[i] >= BASE)) {
05864             printf("ERROR(VpVarCheck): Illegal fraction\n");
05865             printf("       Frac[%"PRIuSIZE"]=%lu\n", i, v->frac[i]);
05866             printf("       Prec.   =%"PRIuSIZE"\n", v->Prec);
05867             printf("       Exp. =%"PRIdVALUE"\n", v->exponent);
05868             printf("       BASE =%lu\n", BASE);
05869             return 3;
05870         }
05871     }
05872     return 0;
05873 }
05874 #endif /* BIGDECIMAL_DEBUG */
05875