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