rubysl-bigdecimal 1.0.0

Sign up to get free protection for your applications and to get access to all the features.
Files changed (85) hide show
  1. checksums.yaml +7 -0
  2. data/.gitignore +17 -0
  3. data/.travis.yml +8 -0
  4. data/Gemfile +4 -0
  5. data/LICENSE +25 -0
  6. data/README.md +29 -0
  7. data/Rakefile +1 -0
  8. data/ext/rubysl/bigdecimal/bigdecimal.c +4760 -0
  9. data/ext/rubysl/bigdecimal/bigdecimal.h +220 -0
  10. data/ext/rubysl/bigdecimal/extconf.rb +6 -0
  11. data/lib/bigdecimal.rb +1 -0
  12. data/lib/bigdecimal/README +60 -0
  13. data/lib/bigdecimal/bigdecimal_en.html +796 -0
  14. data/lib/bigdecimal/bigdecimal_ja.html +799 -0
  15. data/lib/bigdecimal/jacobian.rb +85 -0
  16. data/lib/bigdecimal/ludcmp.rb +84 -0
  17. data/lib/bigdecimal/math.rb +235 -0
  18. data/lib/bigdecimal/newton.rb +77 -0
  19. data/lib/bigdecimal/sample/linear.rb +71 -0
  20. data/lib/bigdecimal/sample/nlsolve.rb +38 -0
  21. data/lib/bigdecimal/sample/pi.rb +20 -0
  22. data/lib/bigdecimal/util.rb +65 -0
  23. data/lib/rubysl/bigdecimal.rb +2 -0
  24. data/lib/rubysl/bigdecimal/version.rb +5 -0
  25. data/rubysl-bigdecimal.gemspec +24 -0
  26. data/spec/abs_spec.rb +49 -0
  27. data/spec/add_spec.rb +178 -0
  28. data/spec/case_compare_spec.rb +6 -0
  29. data/spec/ceil_spec.rb +122 -0
  30. data/spec/coerce_spec.rb +25 -0
  31. data/spec/comparison_spec.rb +80 -0
  32. data/spec/div_spec.rb +143 -0
  33. data/spec/divide_spec.rb +6 -0
  34. data/spec/divmod_spec.rb +233 -0
  35. data/spec/double_fig_spec.rb +8 -0
  36. data/spec/eql_spec.rb +5 -0
  37. data/spec/equal_value_spec.rb +6 -0
  38. data/spec/exponent_spec.rb +37 -0
  39. data/spec/finite_spec.rb +34 -0
  40. data/spec/fix_spec.rb +56 -0
  41. data/spec/fixtures/classes.rb +17 -0
  42. data/spec/floor_spec.rb +109 -0
  43. data/spec/frac_spec.rb +47 -0
  44. data/spec/gt_spec.rb +86 -0
  45. data/spec/gte_spec.rb +90 -0
  46. data/spec/induced_from_spec.rb +36 -0
  47. data/spec/infinite_spec.rb +31 -0
  48. data/spec/inspect_spec.rb +40 -0
  49. data/spec/limit_spec.rb +29 -0
  50. data/spec/lt_spec.rb +84 -0
  51. data/spec/lte_spec.rb +90 -0
  52. data/spec/minus_spec.rb +57 -0
  53. data/spec/mode_spec.rb +64 -0
  54. data/spec/modulo_spec.rb +11 -0
  55. data/spec/mult_spec.rb +23 -0
  56. data/spec/multiply_spec.rb +25 -0
  57. data/spec/nan_spec.rb +22 -0
  58. data/spec/new_spec.rb +120 -0
  59. data/spec/nonzero_spec.rb +28 -0
  60. data/spec/plus_spec.rb +49 -0
  61. data/spec/power_spec.rb +5 -0
  62. data/spec/precs_spec.rb +48 -0
  63. data/spec/quo_spec.rb +12 -0
  64. data/spec/remainder_spec.rb +83 -0
  65. data/spec/round_spec.rb +193 -0
  66. data/spec/shared/eql.rb +65 -0
  67. data/spec/shared/modulo.rb +146 -0
  68. data/spec/shared/mult.rb +97 -0
  69. data/spec/shared/power.rb +83 -0
  70. data/spec/shared/quo.rb +59 -0
  71. data/spec/shared/to_int.rb +27 -0
  72. data/spec/sign_spec.rb +46 -0
  73. data/spec/split_spec.rb +87 -0
  74. data/spec/sqrt_spec.rb +111 -0
  75. data/spec/sub_spec.rb +52 -0
  76. data/spec/to_f_spec.rb +54 -0
  77. data/spec/to_i_spec.rb +6 -0
  78. data/spec/to_int_spec.rb +7 -0
  79. data/spec/to_s_spec.rb +71 -0
  80. data/spec/truncate_spec.rb +100 -0
  81. data/spec/uminus_spec.rb +57 -0
  82. data/spec/uplus_spec.rb +19 -0
  83. data/spec/ver_spec.rb +10 -0
  84. data/spec/zero_spec.rb +27 -0
  85. metadata +243 -0
checksums.yaml ADDED
@@ -0,0 +1,7 @@
1
+ ---
2
+ SHA1:
3
+ metadata.gz: 41333a9987e69d300bdf0e97e22079011ba40c5e
4
+ data.tar.gz: 02f1483d9986293cadfe6fcb9e1567a5e4c824c5
5
+ SHA512:
6
+ metadata.gz: 523d5b1fc0b0249f8447d1feda50be12faef1ee40380a2022ec82f81575b876a73bcfa7965918f823b77be2ee2e77d7d3b3ff6c19d2b98572be0ee8d9e888547
7
+ data.tar.gz: 7f0eb82bf50bccbffa147cf89482fd5398bfc68ea44071337271137d58f7b5f4bc5c7d8648c735235cc5b53340371afc9bbcebfe9b872845b1bc21c226063281
data/.gitignore ADDED
@@ -0,0 +1,17 @@
1
+ *.gem
2
+ *.rbc
3
+ .bundle
4
+ .config
5
+ .yardoc
6
+ Gemfile.lock
7
+ InstalledFiles
8
+ _yardoc
9
+ coverage
10
+ doc/
11
+ lib/bundler/man
12
+ pkg
13
+ rdoc
14
+ spec/reports
15
+ test/tmp
16
+ test/version_tmp
17
+ tmp
data/.travis.yml ADDED
@@ -0,0 +1,8 @@
1
+ language: ruby
2
+ before_install:
3
+ - gem update --system
4
+ - gem --version
5
+ - gem install rubysl-bundler
6
+ script: bundle exec mspec spec
7
+ rvm:
8
+ - rbx-nightly-18mode
data/Gemfile ADDED
@@ -0,0 +1,4 @@
1
+ source 'https://rubygems.org'
2
+
3
+ # Specify your gem's dependencies in rubysl-bigdecimal.gemspec
4
+ gemspec
data/LICENSE ADDED
@@ -0,0 +1,25 @@
1
+ Copyright (c) 2013, Brian Shirai
2
+ All rights reserved.
3
+
4
+ Redistribution and use in source and binary forms, with or without
5
+ modification, are permitted provided that the following conditions are met:
6
+
7
+ 1. Redistributions of source code must retain the above copyright notice, this
8
+ list of conditions and the following disclaimer.
9
+ 2. Redistributions in binary form must reproduce the above copyright notice,
10
+ this list of conditions and the following disclaimer in the documentation
11
+ and/or other materials provided with the distribution.
12
+ 3. Neither the name of the library nor the names of its contributors may be
13
+ used to endorse or promote products derived from this software without
14
+ specific prior written permission.
15
+
16
+ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
17
+ AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
18
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
19
+ DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY DIRECT,
20
+ INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
21
+ BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
22
+ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY
23
+ OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
24
+ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
25
+ EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
data/README.md ADDED
@@ -0,0 +1,29 @@
1
+ # Rubysl::Bigdecimal
2
+
3
+ TODO: Write a gem description
4
+
5
+ ## Installation
6
+
7
+ Add this line to your application's Gemfile:
8
+
9
+ gem 'rubysl-bigdecimal'
10
+
11
+ And then execute:
12
+
13
+ $ bundle
14
+
15
+ Or install it yourself as:
16
+
17
+ $ gem install rubysl-bigdecimal
18
+
19
+ ## Usage
20
+
21
+ TODO: Write usage instructions here
22
+
23
+ ## Contributing
24
+
25
+ 1. Fork it
26
+ 2. Create your feature branch (`git checkout -b my-new-feature`)
27
+ 3. Commit your changes (`git commit -am 'Add some feature'`)
28
+ 4. Push to the branch (`git push origin my-new-feature`)
29
+ 5. Create new Pull Request
data/Rakefile ADDED
@@ -0,0 +1 @@
1
+ require "bundler/gem_tasks"
@@ -0,0 +1,4760 @@
1
+ /*
2
+ *
3
+ * Ruby BigDecimal(Variable decimal precision) extension library.
4
+ *
5
+ * Copyright(C) 2002 by Shigeo Kobayashi(shigeo@tinyforest.gr.jp)
6
+ *
7
+ * You may distribute under the terms of either the GNU General Public
8
+ * License or the Artistic License, as specified in the README file
9
+ * of this BigDecimal distribution.
10
+ *
11
+ * NOTE: Change log in this source removed to reduce source code size.
12
+ * See rev. 1.25 if needed.
13
+ *
14
+ */
15
+
16
+ #define RSTRING_NOT_MODIFIED 1
17
+
18
+ #include "ruby.h"
19
+ #include <ctype.h>
20
+ #include <stdio.h>
21
+ #include <stdlib.h>
22
+ #include <string.h>
23
+ #include <errno.h>
24
+ #include <float.h>
25
+ #include <math.h>
26
+
27
+ /* #define ENABLE_NUMERIC_STRING */
28
+
29
+ VALUE rb_cBigDecimal;
30
+
31
+ #include "bigdecimal.h"
32
+
33
+ /* MACRO's to guard objects from GC by keeping them in stack */
34
+ #define ENTER(n) // volatile VALUE vStack[n];int iStack=0
35
+ #define PUSH(x) // vStack[iStack++] = (unsigned long)(x);
36
+ #define SAVE(p) // PUSH(p->obj);
37
+ #define GUARD_OBJ(p,y) {p=y;SAVE(p);}
38
+
39
+ /*
40
+ * ================== Ruby Interface part ==========================
41
+ */
42
+ #define DoSomeOne(x,y,f) rb_num_coerce_bin(x,y,f)
43
+
44
+ #if 0
45
+ /* BigDecimal provides arbitrary-precision floating point decimal arithmetic.
46
+ *
47
+ * Copyright (C) 2002 by Shigeo Kobayashi <shigeo@tinyforest.gr.jp>.
48
+ * You may distribute under the terms of either the GNU General Public
49
+ * License or the Artistic License, as specified in the README file
50
+ * of the BigDecimal distribution.
51
+ *
52
+ * Documented by mathew <meta@pobox.com>.
53
+ *
54
+ * = Introduction
55
+ *
56
+ * Ruby provides built-in support for arbitrary precision integer arithmetic.
57
+ * For example:
58
+ *
59
+ * 42**13 -> 1265437718438866624512
60
+ *
61
+ * BigDecimal provides similar support for very large or very accurate floating
62
+ * point numbers.
63
+ *
64
+ * Decimal arithmetic is also useful for general calculation, because it
65
+ * provides the correct answers people expect--whereas normal binary floating
66
+ * point arithmetic often introduces subtle errors because of the conversion
67
+ * between base 10 and base 2. For example, try:
68
+ *
69
+ * sum = 0
70
+ * for i in (1..10000)
71
+ * sum = sum + 0.0001
72
+ * end
73
+ * print sum
74
+ *
75
+ * and contrast with the output from:
76
+ *
77
+ * require 'bigdecimal'
78
+ *
79
+ * sum = BigDecimal.new("0")
80
+ * for i in (1..10000)
81
+ * sum = sum + BigDecimal.new("0.0001")
82
+ * end
83
+ * print sum
84
+ *
85
+ * Similarly:
86
+ *
87
+ * (BigDecimal.new("1.2") - BigDecimal("1.0")) == BigDecimal("0.2") -> true
88
+ *
89
+ * (1.2 - 1.0) == 0.2 -> false
90
+ *
91
+ * = Special features of accurate decimal arithmetic
92
+ *
93
+ * Because BigDecimal is more accurate than normal binary floating point
94
+ * arithmetic, it requires some special values.
95
+ *
96
+ * == Infinity
97
+ *
98
+ * BigDecimal sometimes needs to return infinity, for example if you divide
99
+ * a value by zero.
100
+ *
101
+ * BigDecimal.new("1.0") / BigDecimal.new("0.0") -> infinity
102
+ *
103
+ * BigDecimal.new("-1.0") / BigDecimal.new("0.0") -> -infinity
104
+ *
105
+ * You can represent infinite numbers to BigDecimal using the strings
106
+ * 'Infinity', '+Infinity' and '-Infinity' (case-sensitive)
107
+ *
108
+ * == Not a Number
109
+ *
110
+ * When a computation results in an undefined value, the special value NaN
111
+ * (for 'not a number') is returned.
112
+ *
113
+ * Example:
114
+ *
115
+ * BigDecimal.new("0.0") / BigDecimal.new("0.0") -> NaN
116
+ *
117
+ * You can also create undefined values. NaN is never considered to be the
118
+ * same as any other value, even NaN itself:
119
+ *
120
+ * n = BigDecimal.new('NaN')
121
+ *
122
+ * n == 0.0 -> nil
123
+ *
124
+ * n == n -> nil
125
+ *
126
+ * == Positive and negative zero
127
+ *
128
+ * If a computation results in a value which is too small to be represented as
129
+ * a BigDecimal within the currently specified limits of precision, zero must
130
+ * be returned.
131
+ *
132
+ * If the value which is too small to be represented is negative, a BigDecimal
133
+ * value of negative zero is returned. If the value is positive, a value of
134
+ * positive zero is returned.
135
+ *
136
+ * BigDecimal.new("1.0") / BigDecimal.new("-Infinity") -> -0.0
137
+ *
138
+ * BigDecimal.new("1.0") / BigDecimal.new("Infinity") -> 0.0
139
+ *
140
+ * (See BigDecimal.mode for how to specify limits of precision.)
141
+ *
142
+ * Note that -0.0 and 0.0 are considered to be the same for the purposes of
143
+ * comparison.
144
+ *
145
+ * Note also that in mathematics, there is no particular concept of negative
146
+ * or positive zero; true mathematical zero has no sign.
147
+ */
148
+ void
149
+ Init_BigDecimal()
150
+ {
151
+ /* This is a #if-ed out function to fool Rdoc into documenting the class. */
152
+ /* The real init function is Init_bigdecimal() further down. */
153
+ }
154
+ #endif
155
+
156
+ /*
157
+ * Returns the BigDecimal version number.
158
+ *
159
+ * Ruby 1.8.0 returns 1.0.0.
160
+ * Ruby 1.8.1 thru 1.8.3 return 1.0.1.
161
+ */
162
+ static VALUE
163
+ BigDecimal_version(VALUE self)
164
+ {
165
+ /*
166
+ * 1.0.0: Ruby 1.8.0
167
+ * 1.0.1: Ruby 1.8.1
168
+ */
169
+ return rb_str_new2("1.0.1");
170
+ }
171
+
172
+ /*
173
+ * VP routines used in BigDecimal part
174
+ */
175
+ static unsigned short VpGetException(void);
176
+ static void VpSetException(unsigned short f);
177
+ static void VpInternalRound(Real *c,int ixDigit,U_LONG vPrev,U_LONG v);
178
+ static int VpLimitRound(Real *c,U_LONG ixDigit);
179
+
180
+ /*
181
+ * **** BigDecimal part ****
182
+ */
183
+
184
+ static void
185
+ BigDecimal_delete(Real *pv)
186
+ {
187
+ VpFree(pv);
188
+ }
189
+
190
+ static VALUE
191
+ ToValue(Real *p)
192
+ {
193
+ if(VpIsNaN(p)) {
194
+ VpException(VP_EXCEPTION_NaN,"Computation results to 'NaN'(Not a Number)",0);
195
+ } else if(VpIsPosInf(p)) {
196
+ VpException(VP_EXCEPTION_INFINITY,"Computation results to 'Infinity'",0);
197
+ } else if(VpIsNegInf(p)) {
198
+ VpException(VP_EXCEPTION_INFINITY,"Computation results to '-Infinity'",0);
199
+ }
200
+ return p->obj;
201
+ }
202
+
203
+ static Real *
204
+ GetVpValue(VALUE v, int must)
205
+ {
206
+ Real *pv;
207
+ VALUE bg;
208
+ char szD[128];
209
+
210
+ switch(TYPE(v))
211
+ {
212
+ case T_DATA:
213
+ if(RDATA(v)->dfree ==(void *) BigDecimal_delete) {
214
+ Data_Get_Struct(v, Real, pv);
215
+ return pv;
216
+ } else {
217
+ goto SomeOneMayDoIt;
218
+ }
219
+ break;
220
+ case T_FIXNUM:
221
+ sprintf(szD, "%ld", FIX2LONG(v));
222
+ return VpCreateRbObject(VpBaseFig() * 2 + 1, szD);
223
+
224
+ #ifdef ENABLE_NUMERIC_STRING
225
+ case T_STRING:
226
+ SafeStringValue(v);
227
+ return VpCreateRbObject(strlen(rb_str_ptr_readonly(v)) + VpBaseFig() + 1,
228
+ rb_str_ptr_readonly(v));
229
+ #endif /* ENABLE_NUMERIC_STRING */
230
+
231
+ case T_BIGNUM:
232
+ bg = rb_big2str(v, 10);
233
+ return VpCreateRbObject(strlen(rb_str_ptr_readonly(bg)) + VpBaseFig() + 1,
234
+ rb_str_ptr_readonly(bg));
235
+ default:
236
+ goto SomeOneMayDoIt;
237
+ }
238
+
239
+ SomeOneMayDoIt:
240
+ if(must) {
241
+ rb_raise(rb_eTypeError, "%s can't be coerced into BigDecimal",
242
+ rb_special_const_p(v)?
243
+ rb_str_ptr_readonly(rb_inspect(v)):
244
+ rb_obj_classname(v)
245
+ );
246
+ }
247
+ return NULL; /* NULL means to coerce */
248
+ }
249
+
250
+ /* call-seq:
251
+ * BigDecimal.double_fig
252
+ *
253
+ * The BigDecimal.double_fig class method returns the number of digits a
254
+ * Float number is allowed to have. The result depends upon the CPU and OS
255
+ * in use.
256
+ */
257
+ static VALUE
258
+ BigDecimal_double_fig(VALUE self)
259
+ {
260
+ return INT2FIX(VpDblFig());
261
+ }
262
+
263
+ /* call-seq:
264
+ * precs
265
+ *
266
+ * Returns an Array of two Integer values.
267
+ *
268
+ * The first value is the current number of significant digits in the
269
+ * BigDecimal. The second value is the maximum number of significant digits
270
+ * for the BigDecimal.
271
+ */
272
+ static VALUE
273
+ BigDecimal_prec(VALUE self)
274
+ {
275
+ ENTER(1);
276
+ Real *p;
277
+ VALUE obj;
278
+
279
+ GUARD_OBJ(p,GetVpValue(self,1));
280
+ obj = rb_assoc_new(INT2NUM(p->Prec*VpBaseFig()),
281
+ INT2NUM(p->MaxPrec*VpBaseFig()));
282
+ return obj;
283
+ }
284
+
285
+ static VALUE
286
+ BigDecimal_hash(VALUE self)
287
+ {
288
+ ENTER(1);
289
+ Real *p;
290
+ U_LONG hash,i;
291
+
292
+ GUARD_OBJ(p,GetVpValue(self,1));
293
+ hash = (U_LONG)p->sign;
294
+ /* hash!=2: the case for 0(1),NaN(0) or +-Infinity(3) is sign itself */
295
+ if(hash==2) {
296
+ for(i = 0; i < p->Prec;i++) {
297
+ hash = 31 * hash + p->frac[i];
298
+ hash ^= p->frac[i];
299
+ }
300
+ hash += p->exponent;
301
+ }
302
+ return INT2FIX(hash);
303
+ }
304
+
305
+ static VALUE
306
+ BigDecimal_dump(int argc, VALUE *argv, VALUE self)
307
+ {
308
+ ENTER(5);
309
+ Real *vp;
310
+ char *psz;
311
+ VALUE dummy;
312
+ volatile VALUE dump;
313
+
314
+ rb_scan_args(argc, argv, "01", &dummy);
315
+ GUARD_OBJ(vp,GetVpValue(self,1));
316
+ dump = rb_str_new(0,VpNumOfChars(vp,"E")+50);
317
+ psz = rb_str_ptr(dump);
318
+ sprintf(psz,"%lu:",VpMaxPrec(vp)*VpBaseFig());
319
+ VpToString(vp, psz+strlen(psz), 0, 0);
320
+ rb_str_resize(dump, strlen(psz));
321
+ return dump;
322
+ }
323
+
324
+ /*
325
+ * Internal method used to provide marshalling support. See the Marshal module.
326
+ */
327
+ static VALUE
328
+ BigDecimal_load(VALUE self, VALUE str)
329
+ {
330
+ ENTER(2);
331
+ Real *pv;
332
+ unsigned char *pch;
333
+ unsigned char ch;
334
+ unsigned long m=0;
335
+
336
+ SafeStringValue(str);
337
+ pch = (unsigned char *)rb_str_ptr_readonly(str);
338
+ /* First get max prec */
339
+ while((*pch)!=(unsigned char)'\0' && (ch=*pch++)!=(unsigned char)':') {
340
+ if(!ISDIGIT(ch)) {
341
+ rb_raise(rb_eTypeError, "load failed: invalid character in the marshaled string");
342
+ }
343
+ m = m*10 + (unsigned long)(ch-'0');
344
+ }
345
+ if(m>VpBaseFig()) m -= VpBaseFig();
346
+ GUARD_OBJ(pv,VpNewRbClass(m,(char *)pch,self));
347
+ m /= VpBaseFig();
348
+ if(m && pv->MaxPrec>m) pv->MaxPrec = m+1;
349
+ return ToValue(pv);
350
+ }
351
+
352
+ /* call-seq:
353
+ * BigDecimal.mode(mode, value)
354
+ *
355
+ * Controls handling of arithmetic exceptions and rounding. If no value
356
+ * is supplied, the current value is returned.
357
+ *
358
+ * Six values of the mode parameter control the handling of arithmetic
359
+ * exceptions:
360
+ *
361
+ * BigDecimal::EXCEPTION_NaN
362
+ * BigDecimal::EXCEPTION_INFINITY
363
+ * BigDecimal::EXCEPTION_UNDERFLOW
364
+ * BigDecimal::EXCEPTION_OVERFLOW
365
+ * BigDecimal::EXCEPTION_ZERODIVIDE
366
+ * BigDecimal::EXCEPTION_ALL
367
+ *
368
+ * For each mode parameter above, if the value set is false, computation
369
+ * continues after an arithmetic exception of the appropriate type.
370
+ * When computation continues, results are as follows:
371
+ *
372
+ * EXCEPTION_NaN:: NaN
373
+ * EXCEPTION_INFINITY:: +infinity or -infinity
374
+ * EXCEPTION_UNDERFLOW:: 0
375
+ * EXCEPTION_OVERFLOW:: +infinity or -infinity
376
+ * EXCEPTION_ZERODIVIDE:: +infinity or -infinity
377
+ *
378
+ * One value of the mode parameter controls the rounding of numeric values:
379
+ * BigDecimal::ROUND_MODE. The values it can take are:
380
+ *
381
+ * ROUND_UP:: round away from zero
382
+ * ROUND_DOWN:: round towards zero (truncate)
383
+ * ROUND_HALF_UP:: round towards the nearest neighbor, unless both neighbors are equidistant, in which case round away from zero. (default)
384
+ * ROUND_HALF_DOWN:: round towards the nearest neighbor, unless both neighbors are equidistant, in which case round towards zero.
385
+ * ROUND_HALF_EVEN:: round towards the nearest neighbor, unless both neighbors are equidistant, in which case round towards the even neighbor (Banker's rounding)
386
+ * ROUND_CEILING:: round towards positive infinity (ceil)
387
+ * ROUND_FLOOR:: round towards negative infinity (floor)
388
+ *
389
+ */
390
+ static VALUE
391
+ BigDecimal_mode(int argc, VALUE *argv, VALUE self)
392
+ {
393
+ VALUE which;
394
+ VALUE val;
395
+ unsigned long f,fo;
396
+
397
+ if(rb_scan_args(argc,argv,"11",&which,&val)==1) val = Qnil;
398
+
399
+ Check_Type(which, T_FIXNUM);
400
+ f = (unsigned long)FIX2INT(which);
401
+
402
+ if(f&VP_EXCEPTION_ALL) {
403
+ /* Exception mode setting */
404
+ fo = VpGetException();
405
+ if(val==Qnil) return INT2FIX(fo);
406
+ if(val!=Qfalse && val!=Qtrue) {
407
+ rb_raise(rb_eTypeError, "second argument must be true or false");
408
+ return Qnil; /* Not reached */
409
+ }
410
+ if(f&VP_EXCEPTION_INFINITY) {
411
+ VpSetException((unsigned short)((val==Qtrue)?(fo|VP_EXCEPTION_INFINITY):
412
+ (fo&(~VP_EXCEPTION_INFINITY))));
413
+ }
414
+ if(f&VP_EXCEPTION_NaN) {
415
+ VpSetException((unsigned short)((val==Qtrue)?(fo|VP_EXCEPTION_NaN):
416
+ (fo&(~VP_EXCEPTION_NaN))));
417
+ }
418
+ fo = VpGetException();
419
+ return INT2FIX(fo);
420
+ }
421
+ if(VP_ROUND_MODE==f) {
422
+ /* Rounding mode setting */
423
+ fo = VpGetRoundMode();
424
+ if(val==Qnil) return INT2FIX(fo);
425
+ Check_Type(val, T_FIXNUM);
426
+ if(!VpIsRoundMode(FIX2INT(val))) {
427
+ rb_raise(rb_eTypeError, "invalid rounding mode");
428
+ return Qnil;
429
+ }
430
+ fo = VpSetRoundMode((unsigned long)FIX2INT(val));
431
+ return INT2FIX(fo);
432
+ }
433
+ rb_raise(rb_eTypeError, "first argument for BigDecimal#mode invalid");
434
+ return Qnil;
435
+ }
436
+
437
+ static U_LONG
438
+ GetAddSubPrec(Real *a, Real *b)
439
+ {
440
+ U_LONG mxs;
441
+ U_LONG mx = a->Prec;
442
+ S_INT d;
443
+
444
+ if(!VpIsDef(a) || !VpIsDef(b)) return (-1L);
445
+ if(mx < b->Prec) mx = b->Prec;
446
+ if(a->exponent!=b->exponent) {
447
+ mxs = mx;
448
+ d = a->exponent - b->exponent;
449
+ if(d<0) d = -d;
450
+ mx = mx+(U_LONG)d;
451
+ if(mx<mxs) {
452
+ return VpException(VP_EXCEPTION_INFINITY,"Exponent overflow",0);
453
+ }
454
+ }
455
+ return mx;
456
+ }
457
+
458
+ static S_INT
459
+ GetPositiveInt(VALUE v)
460
+ {
461
+ S_INT n;
462
+ Check_Type(v, T_FIXNUM);
463
+ n = FIX2INT(v);
464
+ if(n < 0) {
465
+ rb_raise(rb_eArgError, "argument must be positive");
466
+ }
467
+ return n;
468
+ }
469
+
470
+ VP_EXPORT Real *
471
+ VpNewRbClass(U_LONG mx, char *str, VALUE klass)
472
+ {
473
+ Real *pv = VpAlloc(mx,str);
474
+ pv->obj = (VALUE)Data_Wrap_Struct(klass, 0, BigDecimal_delete, pv);
475
+ return pv;
476
+ }
477
+
478
+ VP_EXPORT Real *
479
+ VpCreateRbObject(U_LONG mx, const char *str)
480
+ {
481
+ Real *pv = VpAlloc(mx,str);
482
+ pv->obj = (VALUE)Data_Wrap_Struct(rb_cBigDecimal, 0, BigDecimal_delete, pv);
483
+ return pv;
484
+ }
485
+
486
+ /* Returns True if the value is Not a Number */
487
+ static VALUE
488
+ BigDecimal_IsNaN(VALUE self)
489
+ {
490
+ Real *p = GetVpValue(self,1);
491
+ if(VpIsNaN(p)) return Qtrue;
492
+ return Qfalse;
493
+ }
494
+
495
+ /* Returns True if the value is infinite */
496
+ static VALUE
497
+ BigDecimal_IsInfinite(VALUE self)
498
+ {
499
+ Real *p = GetVpValue(self,1);
500
+ if(VpIsPosInf(p)) return INT2FIX(1);
501
+ if(VpIsNegInf(p)) return INT2FIX(-1);
502
+ return Qnil;
503
+ }
504
+
505
+ /* Returns True if the value is finite (not NaN or infinite) */
506
+ static VALUE
507
+ BigDecimal_IsFinite(VALUE self)
508
+ {
509
+ Real *p = GetVpValue(self,1);
510
+ if(VpIsNaN(p)) return Qfalse;
511
+ if(VpIsInf(p)) return Qfalse;
512
+ return Qtrue;
513
+ }
514
+
515
+ /* Returns the value as an integer (Fixnum or Bignum).
516
+ *
517
+ * If the BigNumber is infinity or NaN, returns nil.
518
+ */
519
+ static VALUE
520
+ BigDecimal_to_i(VALUE self)
521
+ {
522
+ ENTER(5);
523
+ int e,n,i,nf;
524
+ U_LONG v,b,j;
525
+ volatile VALUE str;
526
+ char *psz,*pch;
527
+ Real *p;
528
+
529
+ GUARD_OBJ(p,GetVpValue(self,1));
530
+
531
+ /* Infinity or NaN not converted. */
532
+ if(VpIsNaN(p)) {
533
+ VpException(VP_EXCEPTION_NaN,"Computation results to 'NaN'(Not a Number)",1);
534
+ return Qnil; /* not reached */
535
+ } else if(VpIsPosInf(p)) {
536
+ VpException(VP_EXCEPTION_INFINITY,"Computation results to 'Infinity'",1);
537
+ return Qnil; /* not reached */
538
+ } else if(VpIsNegInf(p)) {
539
+ VpException(VP_EXCEPTION_INFINITY,"Computation results to '-Infinity'",1);
540
+ return Qnil; /* not reached */
541
+ }
542
+
543
+ e = VpExponent10(p);
544
+ if(e<=0) return INT2FIX(0);
545
+ nf = VpBaseFig();
546
+ if(e<=nf) {
547
+ e = VpGetSign(p)*p->frac[0];
548
+ return INT2FIX(e);
549
+ }
550
+ str = rb_str_new(0, e+nf+2);
551
+ psz = rb_str_ptr_readonly(str);
552
+
553
+ n = (e+nf-1)/nf;
554
+ pch = psz;
555
+ if(VpGetSign(p)<0) *pch++ = '-';
556
+ for(i=0;i<n;++i) {
557
+ b = VpBaseVal()/10;
558
+ if(i>=(int)p->Prec) {
559
+ while(b) {
560
+ *pch++ = '0';
561
+ b /= 10;
562
+ }
563
+ continue;
564
+ }
565
+ v = p->frac[i];
566
+ while(b) {
567
+ j = v/b;
568
+ *pch++ = (char)(j + '0');
569
+ v -= j*b;
570
+ b /= 10;
571
+ }
572
+ }
573
+ *pch++ = 0;
574
+ return rb_cstr2inum(psz,10);
575
+ }
576
+
577
+ static VALUE
578
+ BigDecimal_induced_from(VALUE self, VALUE x)
579
+ {
580
+ Real *p = GetVpValue(x,1);
581
+ return p->obj;
582
+ }
583
+
584
+ /* Returns a new Float object having approximately the same value as the
585
+ * BigDecimal number. Normal accuracy limits and built-in errors of binary
586
+ * Float arithmetic apply.
587
+ */
588
+ static VALUE
589
+ BigDecimal_to_f(VALUE self)
590
+ {
591
+ ENTER(1);
592
+ Real *p;
593
+ double d;
594
+ S_LONG e;
595
+ char *buf;
596
+ volatile VALUE str;
597
+
598
+ GUARD_OBJ(p,GetVpValue(self,1));
599
+ if(VpVtoD(&d, &e, p)!=1) return rb_float_new(d);
600
+ if (e > DBL_MAX_10_EXP) goto erange;
601
+ str = rb_str_new(0, VpNumOfChars(p,"E"));
602
+ buf = RSTRING_PTR(str);
603
+ VpToString(p, buf, 0, 0);
604
+ errno = 0;
605
+ d = strtod(buf, 0);
606
+ if(errno == ERANGE) {
607
+ erange:
608
+ VpException(VP_EXCEPTION_OVERFLOW,"BigDecimal to Float conversion",0);
609
+ if(d>0.0) d = VpGetDoublePosInf();
610
+ else d = VpGetDoubleNegInf();
611
+ }
612
+ return rb_float_new(d);
613
+ }
614
+
615
+ /* The coerce method provides support for Ruby type coercion. It is not
616
+ * enabled by default.
617
+ *
618
+ * This means that binary operations like + * / or - can often be performed
619
+ * on a BigDecimal and an object of another type, if the other object can
620
+ * be coerced into a BigDecimal value.
621
+ *
622
+ * e.g.
623
+ * a = BigDecimal.new("1.0")
624
+ * b = a / 2.0 -> 0.5
625
+ *
626
+ * Note that coercing a String to a BigDecimal is not supported by default;
627
+ * it requires a special compile-time option when building Ruby.
628
+ */
629
+ static VALUE
630
+ BigDecimal_coerce(VALUE self, VALUE other)
631
+ {
632
+ ENTER(2);
633
+ VALUE obj;
634
+ Real *b;
635
+ if(TYPE(other) == T_FLOAT) {
636
+ obj = rb_assoc_new(other, BigDecimal_to_f(self));
637
+ } else {
638
+ GUARD_OBJ(b,GetVpValue(other,1));
639
+ obj = rb_assoc_new(b->obj, self);
640
+ }
641
+ return obj;
642
+ }
643
+
644
+ static VALUE
645
+ BigDecimal_uplus(VALUE self)
646
+ {
647
+ return self;
648
+ }
649
+
650
+ /* call-seq:
651
+ * add(value, digits)
652
+ *
653
+ * Add the specified value.
654
+ *
655
+ * e.g.
656
+ * c = a.add(b,n)
657
+ * c = a + b
658
+ *
659
+ * digits:: If specified and less than the number of significant digits of the result, the result is rounded to that number of digits, according to BigDecimal.mode.
660
+ */
661
+ static VALUE
662
+ BigDecimal_add(VALUE self, VALUE r)
663
+ {
664
+ ENTER(5);
665
+ Real *c, *a, *b;
666
+ U_LONG mx;
667
+ GUARD_OBJ(a,GetVpValue(self,1));
668
+ b = GetVpValue(r,0);
669
+ if(!b) return DoSomeOne(self,r,rb_intern("+"));
670
+ SAVE(b);
671
+ if(VpIsNaN(b)) return b->obj;
672
+ if(VpIsNaN(a)) return a->obj;
673
+ mx = GetAddSubPrec(a,b);
674
+ if(mx==(-1L)) {
675
+ GUARD_OBJ(c,VpCreateRbObject(VpBaseFig() + 1, "0"));
676
+ VpAddSub(c, a, b, 1);
677
+ } else {
678
+ GUARD_OBJ(c,VpCreateRbObject(mx *(VpBaseFig() + 1), "0"));
679
+ if(!mx) {
680
+ VpSetInf(c,VpGetSign(a));
681
+ } else {
682
+ VpAddSub(c, a, b, 1);
683
+ }
684
+ }
685
+ return ToValue(c);
686
+ }
687
+
688
+ /* call-seq:
689
+ * sub(value, digits)
690
+ *
691
+ * Subtract the specified value.
692
+ *
693
+ * e.g.
694
+ * c = a.sub(b,n)
695
+ * c = a - b
696
+ *
697
+ * digits:: If specified and less than the number of significant digits of the result, the result is rounded to that number of digits, according to BigDecimal.mode.
698
+ */
699
+ static VALUE
700
+ BigDecimal_sub(VALUE self, VALUE r)
701
+ {
702
+ ENTER(5);
703
+ Real *c, *a, *b;
704
+ U_LONG mx;
705
+
706
+ GUARD_OBJ(a,GetVpValue(self,1));
707
+ b = GetVpValue(r,0);
708
+ if(!b) return DoSomeOne(self,r,rb_intern("-"));
709
+ SAVE(b);
710
+
711
+ if(VpIsNaN(b)) return b->obj;
712
+ if(VpIsNaN(a)) return a->obj;
713
+
714
+ mx = GetAddSubPrec(a,b);
715
+ if(mx==(-1L)) {
716
+ GUARD_OBJ(c,VpCreateRbObject(VpBaseFig() + 1, "0"));
717
+ VpAddSub(c, a, b, -1);
718
+ } else {
719
+ GUARD_OBJ(c,VpCreateRbObject(mx *(VpBaseFig() + 1), "0"));
720
+ if(!mx) {
721
+ VpSetInf(c,VpGetSign(a));
722
+ } else {
723
+ VpAddSub(c, a, b, -1);
724
+ }
725
+ }
726
+ return ToValue(c);
727
+ }
728
+
729
+ static VALUE
730
+ BigDecimalCmp(VALUE self, VALUE r,char op)
731
+ {
732
+ ENTER(5);
733
+ S_INT e;
734
+ Real *a, *b;
735
+ GUARD_OBJ(a,GetVpValue(self,1));
736
+ if(VpIsNaN(a)) return Qfalse;
737
+ b = GetVpValue(r,0);
738
+ if(!b) {
739
+ ID f = 0;
740
+
741
+ switch(op) {
742
+ case '*': f = rb_intern("<=>"); break;
743
+ case '=': f = rb_intern("=="); break;
744
+ case '!': f = rb_intern("!="); break;
745
+ case 'G': f = rb_intern(">="); break;
746
+ case 'L': f = rb_intern("<="); break;
747
+ case '>': f = rb_intern(">"); break;
748
+ case '<': f = rb_intern("<"); break;
749
+ }
750
+ return rb_num_coerce_cmp(self,r,f);
751
+ }
752
+ SAVE(b);
753
+ if(VpIsNaN(b)) return Qfalse;
754
+ e = VpComp(a, b);
755
+ if(e==999) return Qnil;
756
+ switch(op)
757
+ {
758
+ case '*': return INT2FIX(e); /* any op */
759
+ case '=': if(e==0) return Qtrue ; return Qfalse;
760
+ case '!': if(e!=0) return Qtrue ; return Qfalse;
761
+ case 'G': if(e>=0) return Qtrue ; return Qfalse;
762
+ case '>': if(e> 0) return Qtrue ; return Qfalse;
763
+ case 'L': if(e<=0) return Qtrue ; return Qfalse;
764
+ case '<': if(e< 0) return Qtrue ; return Qfalse;
765
+ }
766
+ rb_bug("Undefined operation in BigDecimalCmp()");
767
+ return Qnil; // keep compiler happy
768
+ }
769
+
770
+ /* Returns True if the value is zero. */
771
+ static VALUE
772
+ BigDecimal_zero(VALUE self)
773
+ {
774
+ Real *a = GetVpValue(self,1);
775
+ return VpIsZero(a) ? Qtrue : Qfalse;
776
+ }
777
+
778
+ /* Returns True if the value is non-zero. */
779
+ static VALUE
780
+ BigDecimal_nonzero(VALUE self)
781
+ {
782
+ Real *a = GetVpValue(self,1);
783
+ return VpIsZero(a) ? Qnil : self;
784
+ }
785
+
786
+ /* The comparison operator.
787
+ * a <=> b is 0 if a == b, 1 if a > b, -1 if a < b.
788
+ */
789
+ static VALUE
790
+ BigDecimal_comp(VALUE self, VALUE r)
791
+ {
792
+ Real *a, *b;
793
+ GUARD_OBJ(a,GetVpValue(self,1));
794
+ GUARD_OBJ(b,GetVpValue(self,0));
795
+ if(VpIsNaN(a) || VpIsNaN(b)) return Qnil;
796
+
797
+ return BigDecimalCmp(self, r, '*');
798
+ }
799
+
800
+ /*
801
+ * Tests for value equality; returns true if the values are equal.
802
+ *
803
+ * The == and === operators and the eql? method have the same implementation
804
+ * for BigDecimal.
805
+ *
806
+ * Values may be coerced to perform the comparison:
807
+ *
808
+ * BigDecimal.new('1.0') == 1.0 -> true
809
+ */
810
+ static VALUE
811
+ BigDecimal_eq(VALUE self, VALUE r)
812
+ {
813
+ return BigDecimalCmp(self, r, '=');
814
+ }
815
+
816
+ /* call-seq:
817
+ * a < b
818
+ *
819
+ * Returns true if a is less than b. Values may be coerced to perform the
820
+ * comparison (see ==, coerce).
821
+ */
822
+ static VALUE
823
+ BigDecimal_lt(VALUE self, VALUE r)
824
+ {
825
+ return BigDecimalCmp(self, r, '<');
826
+ }
827
+
828
+ /* call-seq:
829
+ * a <= b
830
+ *
831
+ * Returns true if a is less than or equal to b. Values may be coerced to
832
+ * perform the comparison (see ==, coerce).
833
+ */
834
+ static VALUE
835
+ BigDecimal_le(VALUE self, VALUE r)
836
+ {
837
+ return BigDecimalCmp(self, r, 'L');
838
+ }
839
+
840
+ /* call-seq:
841
+ * a > b
842
+ *
843
+ * Returns true if a is greater than b. Values may be coerced to
844
+ * perform the comparison (see ==, coerce).
845
+ */
846
+ static VALUE
847
+ BigDecimal_gt(VALUE self, VALUE r)
848
+ {
849
+ return BigDecimalCmp(self, r, '>');
850
+ }
851
+
852
+ /* call-seq:
853
+ * a >= b
854
+ *
855
+ * Returns true if a is greater than or equal to b. Values may be coerced to
856
+ * perform the comparison (see ==, coerce)
857
+ */
858
+ static VALUE
859
+ BigDecimal_ge(VALUE self, VALUE r)
860
+ {
861
+ return BigDecimalCmp(self, r, 'G');
862
+ }
863
+
864
+ static VALUE
865
+ BigDecimal_neg(VALUE self)
866
+ {
867
+ ENTER(5);
868
+ Real *c, *a;
869
+ GUARD_OBJ(a,GetVpValue(self,1));
870
+ GUARD_OBJ(c,VpCreateRbObject(a->Prec *(VpBaseFig() + 1), "0"));
871
+ VpAsgn(c, a, -1);
872
+ return ToValue(c);
873
+ }
874
+
875
+ /* call-seq:
876
+ * mult(value, digits)
877
+ *
878
+ * Multiply by the specified value.
879
+ *
880
+ * e.g.
881
+ * c = a.mult(b,n)
882
+ * c = a * b
883
+ *
884
+ * digits:: If specified and less than the number of significant digits of the result, the result is rounded to that number of digits, according to BigDecimal.mode.
885
+ */
886
+ static VALUE
887
+ BigDecimal_mult(VALUE self, VALUE r)
888
+ {
889
+ ENTER(5);
890
+ Real *c, *a, *b;
891
+ U_LONG mx;
892
+
893
+ GUARD_OBJ(a,GetVpValue(self,1));
894
+ b = GetVpValue(r,0);
895
+ if(!b) return DoSomeOne(self,r,rb_intern("*"));
896
+ SAVE(b);
897
+
898
+ mx = a->Prec + b->Prec;
899
+ GUARD_OBJ(c,VpCreateRbObject(mx *(VpBaseFig() + 1), "0"));
900
+ VpMult(c, a, b);
901
+ return ToValue(c);
902
+ }
903
+
904
+ static VALUE
905
+ BigDecimal_divide(Real **c, Real **res, Real **div, VALUE self, VALUE r)
906
+ /* For c = self.div(r): with round operation */
907
+ {
908
+ ENTER(5);
909
+ Real *a, *b;
910
+ U_LONG mx;
911
+
912
+ GUARD_OBJ(a,GetVpValue(self,1));
913
+ b = GetVpValue(r,0);
914
+ if(!b) return DoSomeOne(self,r,rb_intern("/"));
915
+ SAVE(b);
916
+ *div = b;
917
+ mx =(a->MaxPrec + b->MaxPrec + 1) * VpBaseFig();
918
+ GUARD_OBJ((*c),VpCreateRbObject(mx, "#0"));
919
+ GUARD_OBJ((*res),VpCreateRbObject((mx+1) * 2 +(VpBaseFig() + 1), "#0"));
920
+ VpDivd(*c, *res, a, b);
921
+ return (VALUE)0;
922
+ }
923
+
924
+ /* call-seq:
925
+ * div(value, digits)
926
+ * quo(value)
927
+ *
928
+ * Divide by the specified value.
929
+ *
930
+ * e.g.
931
+ * c = a.div(b,n)
932
+ *
933
+ * digits:: If specified and less than the number of significant digits of the result, the result is rounded to that number of digits, according to BigDecimal.mode.
934
+ *
935
+ * If digits is 0, the result is the same as the / operator. If not, the
936
+ * result is an integer BigDecimal, by analogy with Float#div.
937
+ *
938
+ * The alias quo is provided since div(value, 0) is the same as computing
939
+ * the quotient; see divmod.
940
+ */
941
+ static VALUE
942
+ BigDecimal_div(VALUE self, VALUE r)
943
+ /* For c = self/r: with round operation */
944
+ {
945
+ ENTER(5);
946
+ Real *c=NULL, *res=NULL, *div = NULL;
947
+ r = BigDecimal_divide(&c, &res, &div, self, r);
948
+ if(r!=(VALUE)0) return r; /* coerced by other */
949
+ SAVE(c);SAVE(res);SAVE(div);
950
+ /* a/b = c + r/b */
951
+ /* c xxxxx
952
+ r 00000yyyyy ==> (y/b)*BASE >= HALF_BASE
953
+ */
954
+ /* Round */
955
+ if(VpHasVal(div)) { /* frac[0] must be zero for NaN,INF,Zero */
956
+ VpInternalRound(c,0,c->frac[c->Prec-1],(VpBaseVal()*res->frac[0])/div->frac[0]);
957
+ }
958
+ return ToValue(c);
959
+ }
960
+
961
+ /*
962
+ * %: mod = a%b = a - (a.to_f/b).floor * b
963
+ * div = (a.to_f/b).floor
964
+ */
965
+ static VALUE
966
+ BigDecimal_DoDivmod(VALUE self, VALUE r, Real **div, Real **mod, ID op)
967
+ {
968
+ ENTER(8);
969
+ Real *c=NULL, *d=NULL, *res=NULL;
970
+ Real *a, *b;
971
+ U_LONG mx;
972
+
973
+ GUARD_OBJ(a,GetVpValue(self,1));
974
+ b = GetVpValue(r,0);
975
+ if(!b) return DoSomeOne(self,r,op);
976
+ SAVE(b);
977
+
978
+ if(VpIsNaN(a) || VpIsNaN(b)) goto NaN;
979
+ if(VpIsInf(a) || VpIsInf(b)) goto NaN;
980
+ if(VpIsZero(b)) goto NaN;
981
+ if(VpIsZero(a)) {
982
+ GUARD_OBJ(c,VpCreateRbObject(1, "0"));
983
+ GUARD_OBJ(d,VpCreateRbObject(1, "0"));
984
+ *div = d;
985
+ *mod = c;
986
+ return (VALUE)0;
987
+ }
988
+
989
+ mx = a->Prec;
990
+ if(mx<b->Prec) mx = b->Prec;
991
+ mx =(mx + 1) * VpBaseFig();
992
+ GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
993
+ GUARD_OBJ(res,VpCreateRbObject((mx+1) * 2 +(VpBaseFig() + 1), "#0"));
994
+ VpDivd(c, res, a, b);
995
+ mx = c->Prec *(VpBaseFig() + 1);
996
+ GUARD_OBJ(d,VpCreateRbObject(mx, "0"));
997
+ VpActiveRound(d,c,VP_ROUND_DOWN,0);
998
+ VpMult(res,d,b);
999
+ VpAddSub(c,a,res,-1);
1000
+ if(!VpIsZero(c) && (VpGetSign(a)*VpGetSign(b)<0)) {
1001
+ VpAddSub(res,d,VpOne(),-1);
1002
+ VpAddSub(d ,c,b, 1);
1003
+ *div = res;
1004
+ *mod = d;
1005
+ } else {
1006
+ *div = d;
1007
+ *mod = c;
1008
+ }
1009
+ return (VALUE)0;
1010
+
1011
+ NaN:
1012
+ GUARD_OBJ(c,VpCreateRbObject(1, "NaN"));
1013
+ GUARD_OBJ(d,VpCreateRbObject(1, "NaN"));
1014
+ *div = d;
1015
+ *mod = c;
1016
+ return (VALUE)0;
1017
+ }
1018
+
1019
+ /* call-seq:
1020
+ * a % b
1021
+ * a.modulo(b)
1022
+ *
1023
+ * Returns the modulus from dividing by b. See divmod.
1024
+ */
1025
+ static VALUE
1026
+ BigDecimal_mod(VALUE self, VALUE r) /* %: a%b = a - (a.to_f/b).floor * b */
1027
+ {
1028
+ ENTER(3);
1029
+ VALUE obj;
1030
+ Real *div=NULL, *mod=NULL;
1031
+
1032
+ obj = BigDecimal_DoDivmod(self,r,&div,&mod,rb_intern("%"));
1033
+ if(obj!=(VALUE)0) return obj;
1034
+ SAVE(div);SAVE(mod);
1035
+ return ToValue(mod);
1036
+ }
1037
+
1038
+ static VALUE
1039
+ BigDecimal_divremain(VALUE self, VALUE r, Real **dv, Real **rv)
1040
+ {
1041
+ ENTER(10);
1042
+ U_LONG mx;
1043
+ Real *a=NULL, *b=NULL, *c=NULL, *res=NULL, *d=NULL, *rr=NULL, *ff=NULL;
1044
+ Real *f=NULL;
1045
+
1046
+ GUARD_OBJ(a,GetVpValue(self,1));
1047
+ b = GetVpValue(r,0);
1048
+ if(!b) return DoSomeOne(self,r,rb_intern("remainder"));
1049
+ SAVE(b);
1050
+
1051
+ mx =(a->MaxPrec + b->MaxPrec) *VpBaseFig();
1052
+ GUARD_OBJ(c ,VpCreateRbObject(mx, "0"));
1053
+ GUARD_OBJ(res,VpCreateRbObject((mx+1) * 2 +(VpBaseFig() + 1), "#0"));
1054
+ GUARD_OBJ(rr ,VpCreateRbObject((mx+1) * 2 +(VpBaseFig() + 1), "#0"));
1055
+ GUARD_OBJ(ff ,VpCreateRbObject((mx+1) * 2 +(VpBaseFig() + 1), "#0"));
1056
+
1057
+ VpDivd(c, res, a, b);
1058
+
1059
+ mx = c->Prec *(VpBaseFig() + 1);
1060
+
1061
+ GUARD_OBJ(d,VpCreateRbObject(mx, "0"));
1062
+ GUARD_OBJ(f,VpCreateRbObject(mx, "0"));
1063
+
1064
+ VpActiveRound(d,c,VP_ROUND_DOWN,0); /* 0: round off */
1065
+
1066
+ VpFrac(f, c);
1067
+ VpMult(rr,f,b);
1068
+ VpAddSub(ff,res,rr,1);
1069
+
1070
+ *dv = d;
1071
+ *rv = ff;
1072
+ return (VALUE)0;
1073
+ }
1074
+
1075
+ /* Returns the remainder from dividing by the value.
1076
+ *
1077
+ * If the values divided are of the same sign, the remainder is the same as
1078
+ * the modulus (see divmod).
1079
+ *
1080
+ * Otherwise, the remainder is the modulus minus the value divided by.
1081
+ */
1082
+ static VALUE
1083
+ BigDecimal_remainder(VALUE self, VALUE r) /* remainder */
1084
+ {
1085
+ VALUE f;
1086
+ Real *d,*rv=0;
1087
+ f = BigDecimal_divremain(self,r,&d,&rv);
1088
+ if(f!=(VALUE)0) return f;
1089
+ return ToValue(rv);
1090
+ }
1091
+
1092
+ /* Divides by the specified value, and returns the quotient and modulus
1093
+ * as BigDecimal numbers. The quotient is rounded towards negative infinity.
1094
+ *
1095
+ * For example:
1096
+ *
1097
+ * require 'bigdecimal'
1098
+ *
1099
+ * a = BigDecimal.new("42")
1100
+ * b = BigDecimal.new("9")
1101
+ *
1102
+ * q,m = a.divmod(b)
1103
+ *
1104
+ * c = q * b + m
1105
+ *
1106
+ * a == c -> true
1107
+ *
1108
+ * The quotient q is (a/b).floor, and the modulus is the amount that must be
1109
+ * added to q * b to get a.
1110
+ */
1111
+ static VALUE
1112
+ BigDecimal_divmod(VALUE self, VALUE r)
1113
+ {
1114
+ ENTER(5);
1115
+ VALUE obj;
1116
+ Real *div=NULL, *mod=NULL;
1117
+
1118
+ obj = BigDecimal_DoDivmod(self,r,&div,&mod,rb_intern("divmod"));
1119
+ if(obj!=(VALUE)0) return obj;
1120
+ SAVE(div);SAVE(mod);
1121
+ obj = rb_assoc_new(ToValue(div), ToValue(mod));
1122
+ return obj;
1123
+ }
1124
+
1125
+ static VALUE
1126
+ BigDecimal_div2(int argc, VALUE *argv, VALUE self)
1127
+ {
1128
+ ENTER(5);
1129
+ VALUE b,n;
1130
+ int na = rb_scan_args(argc,argv,"11",&b,&n);
1131
+ if(na==1) { /* div in Float sense */
1132
+ VALUE obj;
1133
+ Real *div=NULL;
1134
+ Real *mod;
1135
+ obj = BigDecimal_DoDivmod(self,b,&div,&mod,rb_intern("div"));
1136
+ if(obj!=(VALUE)0) return obj;
1137
+ return ToValue(div);
1138
+ } else { /* div in BigDecimal sense */
1139
+ U_LONG ix = (U_LONG)GetPositiveInt(n);
1140
+ if(ix==0) return BigDecimal_div(self,b);
1141
+ else {
1142
+ Real *res=NULL;
1143
+ Real *av=NULL, *bv=NULL, *cv=NULL;
1144
+ U_LONG mx = (ix+VpBaseFig()*2);
1145
+ U_LONG pl = VpSetPrecLimit(0);
1146
+
1147
+ GUARD_OBJ(cv,VpCreateRbObject(mx,"0"));
1148
+ GUARD_OBJ(av,GetVpValue(self,1));
1149
+ GUARD_OBJ(bv,GetVpValue(b,1));
1150
+ mx = av->Prec + bv->Prec + 2;
1151
+ if(mx <= cv->MaxPrec) mx = cv->MaxPrec+1;
1152
+ GUARD_OBJ(res,VpCreateRbObject((mx * 2 + 2)*VpBaseFig(), "#0"));
1153
+ VpDivd(cv,res,av,bv);
1154
+ VpSetPrecLimit(pl);
1155
+ VpLeftRound(cv,VpGetRoundMode(),ix);
1156
+ return ToValue(cv);
1157
+ }
1158
+ }
1159
+ }
1160
+
1161
+ static VALUE
1162
+ BigDecimal_add2(VALUE self, VALUE b, VALUE n)
1163
+ {
1164
+ ENTER(2);
1165
+ Real *cv;
1166
+ U_LONG mx = (U_LONG)GetPositiveInt(n);
1167
+ if(mx==0) return BigDecimal_add(self,b);
1168
+ else {
1169
+ U_LONG pl = VpSetPrecLimit(0);
1170
+ VALUE c = BigDecimal_add(self,b);
1171
+ VpSetPrecLimit(pl);
1172
+ GUARD_OBJ(cv,GetVpValue(c,1));
1173
+ VpLeftRound(cv,VpGetRoundMode(),mx);
1174
+ return ToValue(cv);
1175
+ }
1176
+ }
1177
+
1178
+ static VALUE
1179
+ BigDecimal_sub2(VALUE self, VALUE b, VALUE n)
1180
+ {
1181
+ ENTER(2);
1182
+ Real *cv;
1183
+ U_LONG mx = (U_LONG)GetPositiveInt(n);
1184
+ if(mx==0) return BigDecimal_sub(self,b);
1185
+ else {
1186
+ U_LONG pl = VpSetPrecLimit(0);
1187
+ VALUE c = BigDecimal_sub(self,b);
1188
+ VpSetPrecLimit(pl);
1189
+ GUARD_OBJ(cv,GetVpValue(c,1));
1190
+ VpLeftRound(cv,VpGetRoundMode(),mx);
1191
+ return ToValue(cv);
1192
+ }
1193
+ }
1194
+
1195
+ static VALUE
1196
+ BigDecimal_mult2(VALUE self, VALUE b, VALUE n)
1197
+ {
1198
+ ENTER(2);
1199
+ Real *cv;
1200
+ U_LONG mx = (U_LONG)GetPositiveInt(n);
1201
+ if(mx==0) return BigDecimal_mult(self,b);
1202
+ else {
1203
+ U_LONG pl = VpSetPrecLimit(0);
1204
+ VALUE c = BigDecimal_mult(self,b);
1205
+ VpSetPrecLimit(pl);
1206
+ GUARD_OBJ(cv,GetVpValue(c,1));
1207
+ VpLeftRound(cv,VpGetRoundMode(),mx);
1208
+ return ToValue(cv);
1209
+ }
1210
+ }
1211
+
1212
+ /* Returns the absolute value.
1213
+ *
1214
+ * BigDecimal('5').abs -> 5
1215
+ *
1216
+ * BigDecimal('-3').abs -> 3
1217
+ */
1218
+ static VALUE
1219
+ BigDecimal_abs(VALUE self)
1220
+ {
1221
+ ENTER(5);
1222
+ Real *c, *a;
1223
+ U_LONG mx;
1224
+
1225
+ GUARD_OBJ(a,GetVpValue(self,1));
1226
+ mx = a->Prec *(VpBaseFig() + 1);
1227
+ GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
1228
+ VpAsgn(c, a, 1);
1229
+ VpChangeSign(c,(S_INT)1);
1230
+ return ToValue(c);
1231
+ }
1232
+
1233
+ /* call-seq:
1234
+ * sqrt(n)
1235
+ *
1236
+ * Returns the square root of the value.
1237
+ *
1238
+ * If n is specified, returns at least that many significant digits.
1239
+ */
1240
+ static VALUE
1241
+ BigDecimal_sqrt(VALUE self, VALUE nFig)
1242
+ {
1243
+ ENTER(5);
1244
+ Real *c, *a;
1245
+ S_INT mx, n;
1246
+
1247
+ GUARD_OBJ(a,GetVpValue(self,1));
1248
+ mx = a->Prec *(VpBaseFig() + 1);
1249
+
1250
+ n = GetPositiveInt(nFig) + VpDblFig() + 1;
1251
+ if(mx <= n) mx = n;
1252
+ GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
1253
+ VpSqrt(c, a);
1254
+ return ToValue(c);
1255
+ }
1256
+
1257
+ /* Return the integer part of the number.
1258
+ */
1259
+ static VALUE
1260
+ BigDecimal_fix(VALUE self)
1261
+ {
1262
+ ENTER(5);
1263
+ Real *c, *a;
1264
+ U_LONG mx;
1265
+
1266
+ GUARD_OBJ(a,GetVpValue(self,1));
1267
+ mx = a->Prec *(VpBaseFig() + 1);
1268
+ GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
1269
+ VpActiveRound(c,a,VP_ROUND_DOWN,0); /* 0: round off */
1270
+ return ToValue(c);
1271
+ }
1272
+
1273
+ /* call-seq:
1274
+ * round(n,mode)
1275
+ *
1276
+ * Round to the nearest 1 (by default), returning the result as a BigDecimal.
1277
+ *
1278
+ * BigDecimal('3.14159').round -> 3
1279
+ *
1280
+ * BigDecimal('8.7').round -> 9
1281
+ *
1282
+ * If n is specified and positive, the fractional part of the result has no
1283
+ * more than that many digits.
1284
+ *
1285
+ * If n is specified and negative, at least that many digits to the left of the
1286
+ * decimal point will be 0 in the result.
1287
+ *
1288
+ * BigDecimal('3.14159').round(3) -> 3.142
1289
+ *
1290
+ * BigDecimal('13345.234').round(-2) -> 13300.0
1291
+ *
1292
+ * The value of the optional mode argument can be used to determine how
1293
+ * rounding is performed; see BigDecimal.mode.
1294
+ */
1295
+ static VALUE
1296
+ BigDecimal_round(int argc, VALUE *argv, VALUE self)
1297
+ {
1298
+ ENTER(5);
1299
+ Real *c, *a;
1300
+ int iLoc = 0;
1301
+ U_LONG mx;
1302
+ VALUE vLoc;
1303
+ VALUE vRound;
1304
+ U_LONG pl;
1305
+
1306
+ int sw = VpGetRoundMode();
1307
+
1308
+ int na = rb_scan_args(argc,argv,"02",&vLoc,&vRound);
1309
+ switch(na) {
1310
+ case 0:
1311
+ iLoc = 0;
1312
+ break;
1313
+ case 1:
1314
+ Check_Type(vLoc, T_FIXNUM);
1315
+ iLoc = FIX2INT(vLoc);
1316
+ break;
1317
+ case 2:
1318
+ Check_Type(vLoc, T_FIXNUM);
1319
+ iLoc = FIX2INT(vLoc);
1320
+ Check_Type(vRound, T_FIXNUM);
1321
+ sw = FIX2INT(vRound);
1322
+ if(!VpIsRoundMode(sw)) {
1323
+ rb_raise(rb_eTypeError, "invalid rounding mode");
1324
+ return Qnil;
1325
+ }
1326
+ break;
1327
+ }
1328
+
1329
+ pl = VpSetPrecLimit(0);
1330
+ GUARD_OBJ(a,GetVpValue(self,1));
1331
+ mx = a->Prec *(VpBaseFig() + 1);
1332
+ GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
1333
+ VpSetPrecLimit(pl);
1334
+ VpActiveRound(c,a,sw,iLoc);
1335
+ return ToValue(c);
1336
+ }
1337
+
1338
+ /* call-seq:
1339
+ * truncate(n)
1340
+ *
1341
+ * Truncate to the nearest 1, returning the result as a BigDecimal.
1342
+ *
1343
+ * BigDecimal('3.14159').truncate -> 3
1344
+ *
1345
+ * BigDecimal('8.7').truncate -> 8
1346
+ *
1347
+ * If n is specified and positive, the fractional part of the result has no
1348
+ * more than that many digits.
1349
+ *
1350
+ * If n is specified and negative, at least that many digits to the left of the
1351
+ * decimal point will be 0 in the result.
1352
+ *
1353
+ * BigDecimal('3.14159').truncate(3) -> 3.141
1354
+ *
1355
+ * BigDecimal('13345.234').truncate(-2) -> 13300.0
1356
+ */
1357
+ static VALUE
1358
+ BigDecimal_truncate(int argc, VALUE *argv, VALUE self)
1359
+ {
1360
+ ENTER(5);
1361
+ Real *c, *a;
1362
+ int iLoc;
1363
+ U_LONG mx;
1364
+ VALUE vLoc;
1365
+ U_LONG pl = VpSetPrecLimit(0);
1366
+
1367
+ if(rb_scan_args(argc,argv,"01",&vLoc)==0) {
1368
+ iLoc = 0;
1369
+ } else {
1370
+ Check_Type(vLoc, T_FIXNUM);
1371
+ iLoc = FIX2INT(vLoc);
1372
+ }
1373
+
1374
+ GUARD_OBJ(a,GetVpValue(self,1));
1375
+ mx = a->Prec *(VpBaseFig() + 1);
1376
+ GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
1377
+ VpSetPrecLimit(pl);
1378
+ VpActiveRound(c,a,VP_ROUND_DOWN,iLoc); /* 0: truncate */
1379
+ return ToValue(c);
1380
+ }
1381
+
1382
+ /* Return the fractional part of the number.
1383
+ */
1384
+ static VALUE
1385
+ BigDecimal_frac(VALUE self)
1386
+ {
1387
+ ENTER(5);
1388
+ Real *c, *a;
1389
+ U_LONG mx;
1390
+
1391
+ GUARD_OBJ(a,GetVpValue(self,1));
1392
+ mx = a->Prec *(VpBaseFig() + 1);
1393
+ GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
1394
+ VpFrac(c, a);
1395
+ return ToValue(c);
1396
+ }
1397
+
1398
+ /* call-seq:
1399
+ * floor(n)
1400
+ *
1401
+ * Return the largest integer less than or equal to the value, as a BigDecimal.
1402
+ *
1403
+ * BigDecimal('3.14159').floor -> 3
1404
+ *
1405
+ * BigDecimal('-9.1').floor -> -10
1406
+ *
1407
+ * If n is specified and positive, the fractional part of the result has no
1408
+ * more than that many digits.
1409
+ *
1410
+ * If n is specified and negative, at least that
1411
+ * many digits to the left of the decimal point will be 0 in the result.
1412
+ *
1413
+ * BigDecimal('3.14159').floor(3) -> 3.141
1414
+ *
1415
+ * BigDecimal('13345.234').floor(-2) -> 13300.0
1416
+ */
1417
+ static VALUE
1418
+ BigDecimal_floor(int argc, VALUE *argv, VALUE self)
1419
+ {
1420
+ ENTER(5);
1421
+ Real *c, *a;
1422
+ U_LONG mx;
1423
+ int iLoc;
1424
+ VALUE vLoc;
1425
+ U_LONG pl = VpSetPrecLimit(0);
1426
+
1427
+ if(rb_scan_args(argc,argv,"01",&vLoc)==0) {
1428
+ iLoc = 0;
1429
+ } else {
1430
+ Check_Type(vLoc, T_FIXNUM);
1431
+ iLoc = FIX2INT(vLoc);
1432
+ }
1433
+
1434
+ GUARD_OBJ(a,GetVpValue(self,1));
1435
+ mx = a->Prec *(VpBaseFig() + 1);
1436
+ GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
1437
+ VpSetPrecLimit(pl);
1438
+ VpActiveRound(c,a,VP_ROUND_FLOOR,iLoc);
1439
+ return ToValue(c);
1440
+ }
1441
+
1442
+ /* call-seq:
1443
+ * ceil(n)
1444
+ *
1445
+ * Return the smallest integer greater than or equal to the value, as a BigDecimal.
1446
+ *
1447
+ * BigDecimal('3.14159').ceil -> 4
1448
+ *
1449
+ * BigDecimal('-9.1').ceil -> -9
1450
+ *
1451
+ * If n is specified and positive, the fractional part of the result has no
1452
+ * more than that many digits.
1453
+ *
1454
+ * If n is specified and negative, at least that
1455
+ * many digits to the left of the decimal point will be 0 in the result.
1456
+ *
1457
+ * BigDecimal('3.14159').ceil(3) -> 3.142
1458
+ *
1459
+ * BigDecimal('13345.234').ceil(-2) -> 13400.0
1460
+ */
1461
+ static VALUE
1462
+ BigDecimal_ceil(int argc, VALUE *argv, VALUE self)
1463
+ {
1464
+ ENTER(5);
1465
+ Real *c, *a;
1466
+ U_LONG mx;
1467
+ int iLoc;
1468
+ VALUE vLoc;
1469
+ U_LONG pl = VpSetPrecLimit(0);
1470
+
1471
+ if(rb_scan_args(argc,argv,"01",&vLoc)==0) {
1472
+ iLoc = 0;
1473
+ } else {
1474
+ Check_Type(vLoc, T_FIXNUM);
1475
+ iLoc = FIX2INT(vLoc);
1476
+ }
1477
+
1478
+ GUARD_OBJ(a,GetVpValue(self,1));
1479
+ mx = a->Prec *(VpBaseFig() + 1);
1480
+ GUARD_OBJ(c,VpCreateRbObject(mx, "0"));
1481
+ VpSetPrecLimit(pl);
1482
+ VpActiveRound(c,a,VP_ROUND_CEIL,iLoc);
1483
+ return ToValue(c);
1484
+ }
1485
+
1486
+ /* call-seq:
1487
+ * to_s(s)
1488
+ *
1489
+ * Converts the value to a string.
1490
+ *
1491
+ * The default format looks like 0.xxxxEnn.
1492
+ *
1493
+ * The optional parameter s consists of either an integer; or an optional '+'
1494
+ * or ' ', followed by an optional number, followed by an optional 'E' or 'F'.
1495
+ *
1496
+ * If there is a '+' at the start of s, positive values are returned with
1497
+ * a leading '+'.
1498
+ *
1499
+ * A space at the start of s returns positive values with a leading space.
1500
+ *
1501
+ * If s contains a number, a space is inserted after each group of that many
1502
+ * fractional digits.
1503
+ *
1504
+ * If s ends with an 'E', engineering notation (0.xxxxEnn) is used.
1505
+ *
1506
+ * If s ends with an 'F', conventional floating point notation is used.
1507
+ *
1508
+ * Examples:
1509
+ *
1510
+ * BigDecimal.new('-123.45678901234567890').to_s('5F') -> '-123.45678 90123 45678 9'
1511
+ *
1512
+ * BigDecimal.new('123.45678901234567890').to_s('+8F') -> '+123.45678901 23456789'
1513
+ *
1514
+ * BigDecimal.new('123.45678901234567890').to_s(' F') -> ' 123.4567890123456789'
1515
+ */
1516
+ static VALUE
1517
+ BigDecimal_to_s(int argc, VALUE *argv, VALUE self)
1518
+ {
1519
+ ENTER(5);
1520
+ int fmt=0; /* 0:E format */
1521
+ int fPlus=0; /* =0:default,=1: set ' ' before digits ,set '+' before digits. */
1522
+ Real *vp;
1523
+ volatile VALUE str;
1524
+ char *psz;
1525
+ char ch;
1526
+ U_LONG nc;
1527
+ S_INT mc = 0;
1528
+ VALUE f;
1529
+
1530
+ GUARD_OBJ(vp,GetVpValue(self,1));
1531
+
1532
+ if(rb_scan_args(argc,argv,"01",&f)==1) {
1533
+ if(TYPE(f)==T_STRING) {
1534
+ SafeStringValue(f);
1535
+ psz = rb_str_ptr_readonly(f);
1536
+ if(*psz==' ') {
1537
+ fPlus = 1; psz++;
1538
+ } else if(*psz=='+') {
1539
+ fPlus = 2; psz++;
1540
+ }
1541
+ while((ch=*psz++)!=0) {
1542
+ if(ISSPACE(ch)) continue;
1543
+ if(!ISDIGIT(ch)) {
1544
+ if(ch=='F' || ch=='f') fmt = 1; /* F format */
1545
+ break;
1546
+ }
1547
+ mc = mc * 10 + ch - '0';
1548
+ }
1549
+ } else {
1550
+ mc = GetPositiveInt(f);
1551
+ }
1552
+ }
1553
+ if(fmt) {
1554
+ nc = VpNumOfChars(vp,"F");
1555
+ } else {
1556
+ nc = VpNumOfChars(vp,"E");
1557
+ }
1558
+ if(mc>0) nc += (nc + mc - 1) / mc + 1;
1559
+
1560
+ str = rb_str_new(0, nc);
1561
+ psz = rb_str_ptr(str);
1562
+
1563
+ if(fmt) {
1564
+ VpToFString(vp, psz, mc, fPlus);
1565
+ } else {
1566
+ VpToString (vp, psz, mc, fPlus);
1567
+ }
1568
+ rb_str_resize(str, strlen(psz));
1569
+ return str;
1570
+ }
1571
+
1572
+ /* Splits a BigDecimal number into four parts, returned as an array of values.
1573
+ *
1574
+ * The first value represents the sign of the BigDecimal, and is -1 or 1, or 0
1575
+ * if the BigDecimal is Not a Number.
1576
+ *
1577
+ * The second value is a string representing the significant digits of the
1578
+ * BigDecimal, with no leading zeros.
1579
+ *
1580
+ * The third value is the base used for arithmetic (currently always 10) as an
1581
+ * Integer.
1582
+ *
1583
+ * The fourth value is an Integer exponent.
1584
+ *
1585
+ * If the BigDecimal can be represented as 0.xxxxxx*10**n, then xxxxxx is the
1586
+ * string of significant digits with no leading zeros, and n is the exponent.
1587
+ *
1588
+ * From these values, you can translate a BigDecimal to a float as follows:
1589
+ *
1590
+ * sign, significant_digits, base, exponent = a.split
1591
+ * f = sign * "0.#{significant_digits}".to_f * (base ** exponent)
1592
+ *
1593
+ * (Note that the to_f method is provided as a more convenient way to translate
1594
+ * a BigDecimal to a Float.)
1595
+ */
1596
+ static VALUE
1597
+ BigDecimal_split(VALUE self)
1598
+ {
1599
+ ENTER(5);
1600
+ Real *vp;
1601
+ VALUE obj,str;
1602
+ S_LONG e;
1603
+ S_LONG s;
1604
+ char *psz1;
1605
+
1606
+ GUARD_OBJ(vp,GetVpValue(self,1));
1607
+ str = rb_str_new(0, VpNumOfChars(vp,"E"));
1608
+ psz1 = rb_str_ptr(str);
1609
+ VpSzMantissa(vp,psz1);
1610
+ s = 1;
1611
+ if(psz1[0]=='-') {
1612
+ int len = strlen(psz1+1);
1613
+
1614
+ memmove(psz1, psz1+1, len);
1615
+ psz1[len] = '\0';
1616
+ s = -1;
1617
+ }
1618
+ if(psz1[0]=='N') s=0; /* NaN */
1619
+ e = VpExponent10(vp);
1620
+
1621
+ obj = rb_ary_new2(4);
1622
+ rb_ary_push(obj, INT2FIX(s));
1623
+ rb_ary_push(obj, str);
1624
+ rb_str_resize(str, strlen(psz1));
1625
+ rb_ary_push(obj, INT2FIX(10));
1626
+ rb_ary_push(obj, INT2NUM(e));
1627
+ return obj;
1628
+ }
1629
+
1630
+ /* Returns the exponent of the BigDecimal number, as an Integer.
1631
+ *
1632
+ * If the number can be represented as 0.xxxxxx*10**n where xxxxxx is a string
1633
+ * of digits with no leading zeros, then n is the exponent.
1634
+ */
1635
+ static VALUE
1636
+ BigDecimal_exponent(VALUE self)
1637
+ {
1638
+ S_LONG e = VpExponent10(GetVpValue(self,1));
1639
+ return INT2NUM(e);
1640
+ }
1641
+
1642
+ /* Returns debugging information about the value as a string of comma-separated
1643
+ * values in angle brackets with a leading #:
1644
+ *
1645
+ * BigDecimal.new("1234.5678").inspect ->
1646
+ * "#<BigDecimal:b7ea1130,'0.12345678E4',8(12)>"
1647
+ *
1648
+ * The first part is the address, the second is the value as a string, and
1649
+ * the final part ss(mm) is the current number of significant digits and the
1650
+ * maximum number of significant digits, respectively.
1651
+ */
1652
+ static VALUE
1653
+ BigDecimal_inspect(VALUE self)
1654
+ {
1655
+ ENTER(5);
1656
+ Real *vp;
1657
+ volatile VALUE obj;
1658
+ unsigned int nc;
1659
+ char *psz, *tmp;
1660
+
1661
+ GUARD_OBJ(vp,GetVpValue(self,1));
1662
+ nc = VpNumOfChars(vp,"E");
1663
+ nc +=(nc + 9) / 10;
1664
+
1665
+ obj = rb_str_new(0, nc+256);
1666
+ psz = rb_str_ptr(obj);
1667
+ sprintf(psz,"#<BigDecimal:%lx,'",(long unsigned int)self);
1668
+ tmp = psz + strlen(psz);
1669
+ VpToString(vp, tmp, 10, 0);
1670
+ tmp += strlen(tmp);
1671
+ sprintf(tmp,"',%lu(%lu)>",VpPrec(vp)*VpBaseFig(),VpMaxPrec(vp)*VpBaseFig());
1672
+ rb_str_resize(obj, strlen(psz));
1673
+ return obj;
1674
+ }
1675
+
1676
+ /* call-seq:
1677
+ * power(n)
1678
+ *
1679
+ * Returns the value raised to the power of n. Note that n must be an Integer.
1680
+ *
1681
+ * Also available as the operator **
1682
+ */
1683
+ static VALUE
1684
+ BigDecimal_power(VALUE self, VALUE p)
1685
+ {
1686
+ ENTER(5);
1687
+ Real *x, *y;
1688
+ S_LONG mp, ma, n;
1689
+
1690
+ Check_Type(p, T_FIXNUM);
1691
+ n = FIX2INT(p);
1692
+ ma = n;
1693
+ if(ma < 0) ma = -ma;
1694
+ if(ma == 0) ma = 1;
1695
+
1696
+ GUARD_OBJ(x,GetVpValue(self,1));
1697
+ if(VpIsDef(x)) {
1698
+ mp = x->Prec *(VpBaseFig() + 1);
1699
+ GUARD_OBJ(y,VpCreateRbObject(mp *(ma + 1), "0"));
1700
+ } else {
1701
+ GUARD_OBJ(y,VpCreateRbObject(1, "0"));
1702
+ }
1703
+ VpPower(y, x, n);
1704
+ return ToValue(y);
1705
+ }
1706
+
1707
+ static VALUE
1708
+ BigDecimal_global_new(int argc, VALUE *argv, VALUE self)
1709
+ {
1710
+ ENTER(5);
1711
+ Real *pv;
1712
+ S_LONG mf;
1713
+ VALUE nFig;
1714
+ VALUE iniValue;
1715
+
1716
+ if(rb_scan_args(argc,argv,"11",&iniValue,&nFig)==1) {
1717
+ mf = 0;
1718
+ } else {
1719
+ mf = GetPositiveInt(nFig);
1720
+ }
1721
+ SafeStringValue(iniValue);
1722
+ GUARD_OBJ(pv,VpCreateRbObject(mf, rb_str_ptr_readonly(iniValue)));
1723
+ return ToValue(pv);
1724
+ }
1725
+
1726
+ /* call-seq:
1727
+ * new(initial, digits)
1728
+ *
1729
+ * Create a new BigDecimal object.
1730
+ *
1731
+ * initial:: The initial value, as a String. Spaces are ignored, unrecognized characters terminate the value.
1732
+ *
1733
+ * digits:: The number of significant digits, as a Fixnum. If omitted or 0, the number of significant digits is determined from the initial value.
1734
+ *
1735
+ * The actual number of significant digits used in computation is usually
1736
+ * larger than the specified number.
1737
+ */
1738
+ static VALUE
1739
+ BigDecimal_new(int argc, VALUE *argv, VALUE self)
1740
+ {
1741
+ ENTER(5);
1742
+ Real *pv;
1743
+ S_LONG mf;
1744
+ VALUE nFig;
1745
+ VALUE iniValue;
1746
+
1747
+ if(rb_scan_args(argc,argv,"11",&iniValue,&nFig)==1) {
1748
+ mf = 0;
1749
+ } else {
1750
+ mf = GetPositiveInt(nFig);
1751
+ }
1752
+ SafeStringValue(iniValue);
1753
+ GUARD_OBJ(pv,VpNewRbClass(mf, rb_str_ptr_readonly(iniValue),self));
1754
+ return ToValue(pv);
1755
+ }
1756
+
1757
+ /* call-seq:
1758
+ * BigDecimal.limit(digits)
1759
+ *
1760
+ * Limit the number of significant digits in newly created BigDecimal
1761
+ * numbers to the specified value. Rounding is performed as necessary,
1762
+ * as specified by BigDecimal.mode.
1763
+ *
1764
+ * A limit of 0, the default, means no upper limit.
1765
+ *
1766
+ * The limit specified by this method takes priority over any limit
1767
+ * specified to instance methods such as ceil, floor, truncate, or round.
1768
+ */
1769
+ static VALUE
1770
+ BigDecimal_limit(int argc, VALUE *argv, VALUE self)
1771
+ {
1772
+ VALUE nFig;
1773
+ VALUE nCur = INT2NUM(VpGetPrecLimit());
1774
+
1775
+ if(rb_scan_args(argc,argv,"01",&nFig)==1) {
1776
+ int nf;
1777
+ if(nFig==Qnil) return nCur;
1778
+ Check_Type(nFig, T_FIXNUM);
1779
+ nf = FIX2INT(nFig);
1780
+ if(nf<0) {
1781
+ rb_raise(rb_eArgError, "argument must be positive");
1782
+ }
1783
+ VpSetPrecLimit(nf);
1784
+ }
1785
+ return nCur;
1786
+ }
1787
+
1788
+ /* Returns the sign of the value.
1789
+ *
1790
+ * Returns a positive value if > 0, a negative value if < 0, and a
1791
+ * zero if == 0.
1792
+ *
1793
+ * The specific value returned indicates the type and sign of the BigDecimal,
1794
+ * as follows:
1795
+ *
1796
+ * BigDecimal::SIGN_NaN:: value is Not a Number
1797
+ * BigDecimal::SIGN_POSITIVE_ZERO:: value is +0
1798
+ * BigDecimal::SIGN_NEGATIVE_ZERO:: value is -0
1799
+ * BigDecimal::SIGN_POSITIVE_INFINITE:: value is +infinity
1800
+ * BigDecimal::SIGN_NEGATIVE_INFINITE:: value is -infinity
1801
+ * BigDecimal::SIGN_POSITIVE_FINITE:: value is positive
1802
+ * BigDecimal::SIGN_NEGATIVE_FINITE:: value is negative
1803
+ */
1804
+ static VALUE
1805
+ BigDecimal_sign(VALUE self)
1806
+ { /* sign */
1807
+ int s = GetVpValue(self,1)->sign;
1808
+ return INT2FIX(s);
1809
+ }
1810
+
1811
+ void
1812
+ Init_bigdecimal(void)
1813
+ {
1814
+ /* Initialize VP routines */
1815
+ VpInit((U_LONG)0);
1816
+
1817
+ /* Class and method registration */
1818
+ rb_cBigDecimal = rb_define_class("BigDecimal",rb_cNumeric);
1819
+
1820
+ /* Global function */
1821
+ rb_define_global_function("BigDecimal", BigDecimal_global_new, -1);
1822
+
1823
+ /* Class methods */
1824
+ rb_define_singleton_method(rb_cBigDecimal, "new", BigDecimal_new, -1);
1825
+ rb_define_singleton_method(rb_cBigDecimal, "mode", BigDecimal_mode, -1);
1826
+ rb_define_singleton_method(rb_cBigDecimal, "limit", BigDecimal_limit, -1);
1827
+ rb_define_singleton_method(rb_cBigDecimal, "double_fig", BigDecimal_double_fig, 0);
1828
+ rb_define_singleton_method(rb_cBigDecimal, "induced_from",BigDecimal_induced_from, 1);
1829
+ rb_define_singleton_method(rb_cBigDecimal, "_load", BigDecimal_load, 1);
1830
+ rb_define_singleton_method(rb_cBigDecimal, "ver", BigDecimal_version, 0);
1831
+
1832
+ /* Constants definition */
1833
+
1834
+ /*
1835
+ * Base value used in internal calculations. On a 32 bit system, BASE
1836
+ * is 10000, indicating that calculation is done in groups of 4 digits.
1837
+ * (If it were larger, BASE**2 wouldn't fit in 32 bits, so you couldn't
1838
+ * guarantee that two groups could always be multiplied together without
1839
+ * overflow.)
1840
+ */
1841
+ rb_define_const(rb_cBigDecimal, "BASE", INT2FIX((S_INT)VpBaseVal()));
1842
+
1843
+ /* Exceptions */
1844
+
1845
+ /*
1846
+ * 0xff: Determines whether overflow, underflow or zero divide result in
1847
+ * an exception being thrown. See BigDecimal.mode.
1848
+ */
1849
+ rb_define_const(rb_cBigDecimal, "EXCEPTION_ALL",INT2FIX(VP_EXCEPTION_ALL));
1850
+
1851
+ /*
1852
+ * 0x02: Determines what happens when the result of a computation is not a
1853
+ * number (NaN). See BigDecimal.mode.
1854
+ */
1855
+ rb_define_const(rb_cBigDecimal, "EXCEPTION_NaN",INT2FIX(VP_EXCEPTION_NaN));
1856
+
1857
+ /*
1858
+ * 0x01: Determines what happens when the result of a computation is
1859
+ * infinity. See BigDecimal.mode.
1860
+ */
1861
+ rb_define_const(rb_cBigDecimal, "EXCEPTION_INFINITY",INT2FIX(VP_EXCEPTION_INFINITY));
1862
+
1863
+ /*
1864
+ * 0x04: Determines what happens when the result of a computation is an
1865
+ * underflow (a result too small to be represented). See BigDecimal.mode.
1866
+ */
1867
+ rb_define_const(rb_cBigDecimal, "EXCEPTION_UNDERFLOW",INT2FIX(VP_EXCEPTION_UNDERFLOW));
1868
+
1869
+ /*
1870
+ * 0x01: Determines what happens when the result of a computation is an
1871
+ * underflow (a result too large to be represented). See BigDecimal.mode.
1872
+ */
1873
+ rb_define_const(rb_cBigDecimal, "EXCEPTION_OVERFLOW",INT2FIX(VP_EXCEPTION_OVERFLOW));
1874
+
1875
+ /*
1876
+ * 0x01: Determines what happens when a division by zero is performed.
1877
+ * See BigDecimal.mode.
1878
+ */
1879
+ rb_define_const(rb_cBigDecimal, "EXCEPTION_ZERODIVIDE",INT2FIX(VP_EXCEPTION_ZERODIVIDE));
1880
+
1881
+ /*
1882
+ * 0x100: Determines what happens when a result must be rounded in order to
1883
+ * fit in the appropriate number of significant digits. See
1884
+ * BigDecimal.mode.
1885
+ */
1886
+ rb_define_const(rb_cBigDecimal, "ROUND_MODE",INT2FIX(VP_ROUND_MODE));
1887
+
1888
+ /* 1: Indicates that values should be rounded away from zero. See
1889
+ * BigDecimal.mode.
1890
+ */
1891
+ rb_define_const(rb_cBigDecimal, "ROUND_UP",INT2FIX(VP_ROUND_UP));
1892
+
1893
+ /* 2: Indicates that values should be rounded towards zero. See
1894
+ * BigDecimal.mode.
1895
+ */
1896
+ rb_define_const(rb_cBigDecimal, "ROUND_DOWN",INT2FIX(VP_ROUND_DOWN));
1897
+
1898
+ /* 3: Indicates that digits >= 5 should be rounded up, others rounded down.
1899
+ * See BigDecimal.mode. */
1900
+ rb_define_const(rb_cBigDecimal, "ROUND_HALF_UP",INT2FIX(VP_ROUND_HALF_UP));
1901
+
1902
+ /* 4: Indicates that digits >= 6 should be rounded up, others rounded down.
1903
+ * See BigDecimal.mode.
1904
+ */
1905
+ rb_define_const(rb_cBigDecimal, "ROUND_HALF_DOWN",INT2FIX(VP_ROUND_HALF_DOWN));
1906
+ /* 5: Round towards +infinity. See BigDecimal.mode. */
1907
+ rb_define_const(rb_cBigDecimal, "ROUND_CEILING",INT2FIX(VP_ROUND_CEIL));
1908
+
1909
+ /* 6: Round towards -infinity. See BigDecimal.mode. */
1910
+ rb_define_const(rb_cBigDecimal, "ROUND_FLOOR",INT2FIX(VP_ROUND_FLOOR));
1911
+
1912
+ /* 7: Round towards the even neighbor. See BigDecimal.mode. */
1913
+ rb_define_const(rb_cBigDecimal, "ROUND_HALF_EVEN",INT2FIX(VP_ROUND_HALF_EVEN));
1914
+
1915
+ /* 0: Indicates that a value is not a number. See BigDecimal.sign. */
1916
+ rb_define_const(rb_cBigDecimal, "SIGN_NaN",INT2FIX(VP_SIGN_NaN));
1917
+
1918
+ /* 1: Indicates that a value is +0. See BigDecimal.sign. */
1919
+ rb_define_const(rb_cBigDecimal, "SIGN_POSITIVE_ZERO",INT2FIX(VP_SIGN_POSITIVE_ZERO));
1920
+
1921
+ /* -1: Indicates that a value is -0. See BigDecimal.sign. */
1922
+ rb_define_const(rb_cBigDecimal, "SIGN_NEGATIVE_ZERO",INT2FIX(VP_SIGN_NEGATIVE_ZERO));
1923
+
1924
+ /* 2: Indicates that a value is positive and finite. See BigDecimal.sign. */
1925
+ rb_define_const(rb_cBigDecimal, "SIGN_POSITIVE_FINITE",INT2FIX(VP_SIGN_POSITIVE_FINITE));
1926
+
1927
+ /* -2: Indicates that a value is negative and finite. See BigDecimal.sign. */
1928
+ rb_define_const(rb_cBigDecimal, "SIGN_NEGATIVE_FINITE",INT2FIX(VP_SIGN_NEGATIVE_FINITE));
1929
+
1930
+ /* 3: Indicates that a value is positive and infinite. See BigDecimal.sign. */
1931
+ rb_define_const(rb_cBigDecimal, "SIGN_POSITIVE_INFINITE",INT2FIX(VP_SIGN_POSITIVE_INFINITE));
1932
+
1933
+ /* -3: Indicates that a value is negative and infinite. See BigDecimal.sign. */
1934
+ rb_define_const(rb_cBigDecimal, "SIGN_NEGATIVE_INFINITE",INT2FIX(VP_SIGN_NEGATIVE_INFINITE));
1935
+
1936
+ /* instance methods */
1937
+ rb_define_method(rb_cBigDecimal, "precs", BigDecimal_prec, 0);
1938
+
1939
+ rb_define_method(rb_cBigDecimal, "add", BigDecimal_add2, 2);
1940
+ rb_define_method(rb_cBigDecimal, "sub", BigDecimal_sub2, 2);
1941
+ rb_define_method(rb_cBigDecimal, "mult", BigDecimal_mult2, 2);
1942
+ rb_define_method(rb_cBigDecimal, "div",BigDecimal_div2, -1);
1943
+ rb_define_method(rb_cBigDecimal, "hash", BigDecimal_hash, 0);
1944
+ rb_define_method(rb_cBigDecimal, "to_s", BigDecimal_to_s, -1);
1945
+ rb_define_method(rb_cBigDecimal, "to_i", BigDecimal_to_i, 0);
1946
+ rb_define_method(rb_cBigDecimal, "to_int", BigDecimal_to_i, 0);
1947
+ rb_define_method(rb_cBigDecimal, "split", BigDecimal_split, 0);
1948
+ rb_define_method(rb_cBigDecimal, "+", BigDecimal_add, 1);
1949
+ rb_define_method(rb_cBigDecimal, "-", BigDecimal_sub, 1);
1950
+ rb_define_method(rb_cBigDecimal, "+@", BigDecimal_uplus, 0);
1951
+ rb_define_method(rb_cBigDecimal, "-@", BigDecimal_neg, 0);
1952
+ rb_define_method(rb_cBigDecimal, "*", BigDecimal_mult, 1);
1953
+ rb_define_method(rb_cBigDecimal, "/", BigDecimal_div, 1);
1954
+ rb_define_method(rb_cBigDecimal, "quo", BigDecimal_div, 1);
1955
+ rb_define_method(rb_cBigDecimal, "%", BigDecimal_mod, 1);
1956
+ rb_define_method(rb_cBigDecimal, "modulo", BigDecimal_mod, 1);
1957
+ rb_define_method(rb_cBigDecimal, "remainder", BigDecimal_remainder, 1);
1958
+ rb_define_method(rb_cBigDecimal, "divmod", BigDecimal_divmod, 1);
1959
+ /* rb_define_method(rb_cBigDecimal, "dup", BigDecimal_dup, 0); */
1960
+ rb_define_method(rb_cBigDecimal, "to_f", BigDecimal_to_f, 0);
1961
+ rb_define_method(rb_cBigDecimal, "abs", BigDecimal_abs, 0);
1962
+ rb_define_method(rb_cBigDecimal, "sqrt", BigDecimal_sqrt, 1);
1963
+ rb_define_method(rb_cBigDecimal, "fix", BigDecimal_fix, 0);
1964
+ rb_define_method(rb_cBigDecimal, "round", BigDecimal_round, -1);
1965
+ rb_define_method(rb_cBigDecimal, "frac", BigDecimal_frac, 0);
1966
+ rb_define_method(rb_cBigDecimal, "floor", BigDecimal_floor, -1);
1967
+ rb_define_method(rb_cBigDecimal, "ceil", BigDecimal_ceil, -1);
1968
+ rb_define_method(rb_cBigDecimal, "power", BigDecimal_power, 1);
1969
+ rb_define_method(rb_cBigDecimal, "**", BigDecimal_power, 1);
1970
+ rb_define_method(rb_cBigDecimal, "<=>", BigDecimal_comp, 1);
1971
+ rb_define_method(rb_cBigDecimal, "==", BigDecimal_eq, 1);
1972
+ rb_define_method(rb_cBigDecimal, "===", BigDecimal_eq, 1);
1973
+ rb_define_method(rb_cBigDecimal, "eql?", BigDecimal_eq, 1);
1974
+ rb_define_method(rb_cBigDecimal, "<", BigDecimal_lt, 1);
1975
+ rb_define_method(rb_cBigDecimal, "<=", BigDecimal_le, 1);
1976
+ rb_define_method(rb_cBigDecimal, ">", BigDecimal_gt, 1);
1977
+ rb_define_method(rb_cBigDecimal, ">=", BigDecimal_ge, 1);
1978
+ rb_define_method(rb_cBigDecimal, "zero?", BigDecimal_zero, 0);
1979
+ rb_define_method(rb_cBigDecimal, "nonzero?", BigDecimal_nonzero, 0);
1980
+ rb_define_method(rb_cBigDecimal, "coerce", BigDecimal_coerce, 1);
1981
+ rb_define_method(rb_cBigDecimal, "inspect", BigDecimal_inspect, 0);
1982
+ rb_define_method(rb_cBigDecimal, "exponent", BigDecimal_exponent, 0);
1983
+ rb_define_method(rb_cBigDecimal, "sign", BigDecimal_sign, 0);
1984
+ rb_define_method(rb_cBigDecimal, "nan?", BigDecimal_IsNaN, 0);
1985
+ rb_define_method(rb_cBigDecimal, "infinite?", BigDecimal_IsInfinite, 0);
1986
+ rb_define_method(rb_cBigDecimal, "finite?", BigDecimal_IsFinite, 0);
1987
+ rb_define_method(rb_cBigDecimal, "truncate", BigDecimal_truncate, -1);
1988
+ rb_define_method(rb_cBigDecimal, "_dump", BigDecimal_dump, -1);
1989
+ }
1990
+
1991
+ /*
1992
+ *
1993
+ * ============================================================================
1994
+ *
1995
+ * vp_ routines begin from here.
1996
+ *
1997
+ * ============================================================================
1998
+ *
1999
+ */
2000
+ #ifdef _DEBUG
2001
+ static int gfDebug = 1; /* Debug switch */
2002
+ static int gfCheckVal = 1; /* Value checking flag in VpNmlz() */
2003
+ #endif /* _DEBUG */
2004
+
2005
+ static U_LONG gnPrecLimit = 0; /* Global upper limit of the precision newly allocated */
2006
+ static U_LONG gfRoundMode = VP_ROUND_HALF_UP; /* Mode for general rounding operation */
2007
+
2008
+ #ifndef BASE_FIG
2009
+ static U_LONG BASE_FIG = 4; /* =log10(BASE) */
2010
+ static U_LONG BASE = 10000L; /* Base value(value must be 10**BASE_FIG) */
2011
+ /* The value of BASE**2 + BASE must be represented */
2012
+ /* within one U_LONG. */
2013
+ static U_LONG HALF_BASE = 5000L;/* =BASE/2 */
2014
+ static U_LONG BASE1 = 1000L; /* =BASE/10 */
2015
+ #else
2016
+ #ifndef BASE
2017
+ #error BASE_FIG is defined but BASE is not
2018
+ #endif
2019
+ #define HALF_BASE (BASE/2)
2020
+ #define BASE1 (BASE/10)
2021
+ #endif
2022
+ #ifndef DBLE_FIG
2023
+ #define DBLE_FIG (DBL_DIG+1) /* figure of double */
2024
+ #endif
2025
+
2026
+ static Real *VpConstOne; /* constant 1.0 */
2027
+ static Real *VpPt5; /* constant 0.5 */
2028
+ #define maxnr 100UL /* Maximum iterations for calcurating sqrt. */
2029
+ /* used in VpSqrt() */
2030
+
2031
+ /* ETC */
2032
+ #define MemCmp(x,y,z) memcmp(x,y,z)
2033
+ #define StrCmp(x,y) strcmp(x,y)
2034
+
2035
+ static int VpIsDefOP(Real *c,Real *a,Real *b,int sw);
2036
+ static int AddExponent(Real *a,S_INT n);
2037
+ static U_LONG VpAddAbs(Real *a,Real *b,Real *c);
2038
+ static U_LONG VpSubAbs(Real *a,Real *b,Real *c);
2039
+ static U_LONG VpSetPTR(Real *a,Real *b,Real *c,U_LONG *a_pos,U_LONG *b_pos,U_LONG *c_pos,U_LONG *av,U_LONG *bv);
2040
+ static int VpNmlz(Real *a);
2041
+ static void VpFormatSt(char *psz,S_INT fFmt);
2042
+ static int VpRdup(Real *m,U_LONG ind_m);
2043
+
2044
+ #ifdef _DEBUG
2045
+ static int gnAlloc=0; /* Memory allocation counter */
2046
+ #endif /* _DEBUG */
2047
+
2048
+ VP_EXPORT void *
2049
+ VpMemAlloc(U_LONG mb)
2050
+ {
2051
+ void *p = xmalloc((unsigned int)mb);
2052
+ if(!p) {
2053
+ VpException(VP_EXCEPTION_MEMORY,"failed to allocate memory",1);
2054
+ }
2055
+ memset(p,0,mb);
2056
+ #ifdef _DEBUG
2057
+ gnAlloc++; /* Count allocation call */
2058
+ #endif /* _DEBUG */
2059
+ return p;
2060
+ }
2061
+
2062
+ VP_EXPORT void
2063
+ VpFree(Real *pv)
2064
+ {
2065
+ if(pv != NULL) {
2066
+ xfree(pv);
2067
+ #ifdef _DEBUG
2068
+ gnAlloc--; /* Decrement allocation count */
2069
+ if(gnAlloc==0) {
2070
+ printf(" *************** All memories allocated freed ****************");
2071
+ getchar();
2072
+ }
2073
+ if(gnAlloc<0) {
2074
+ printf(" ??????????? Too many memory free calls(%d) ?????????????\n",gnAlloc);
2075
+ getchar();
2076
+ }
2077
+ #endif /* _DEBUG */
2078
+ }
2079
+ }
2080
+
2081
+ /*
2082
+ * EXCEPTION Handling.
2083
+ */
2084
+ static unsigned short gfDoException = 0; /* Exception flag */
2085
+
2086
+ static unsigned short
2087
+ VpGetException (void)
2088
+ {
2089
+ return gfDoException;
2090
+ }
2091
+
2092
+ static void
2093
+ VpSetException(unsigned short f)
2094
+ {
2095
+ gfDoException = f;
2096
+ }
2097
+
2098
+ /* These 2 functions added at v1.1.7 */
2099
+ VP_EXPORT U_LONG
2100
+ VpGetPrecLimit(void)
2101
+ {
2102
+ return gnPrecLimit;
2103
+ }
2104
+
2105
+ VP_EXPORT U_LONG
2106
+ VpSetPrecLimit(U_LONG n)
2107
+ {
2108
+ U_LONG s = gnPrecLimit;
2109
+ gnPrecLimit = n;
2110
+ return s;
2111
+ }
2112
+
2113
+ VP_EXPORT unsigned long
2114
+ VpGetRoundMode(void)
2115
+ {
2116
+ return gfRoundMode;
2117
+ }
2118
+
2119
+ VP_EXPORT int
2120
+ VpIsRoundMode(unsigned long n)
2121
+ {
2122
+ if(n==VP_ROUND_UP || n!=VP_ROUND_DOWN ||
2123
+ n==VP_ROUND_HALF_UP || n!=VP_ROUND_HALF_DOWN ||
2124
+ n==VP_ROUND_CEIL || n!=VP_ROUND_FLOOR ||
2125
+ n==VP_ROUND_HALF_EVEN
2126
+ ) return 1;
2127
+ return 0;
2128
+ }
2129
+
2130
+ VP_EXPORT unsigned long
2131
+ VpSetRoundMode(unsigned long n)
2132
+ {
2133
+ if(VpIsRoundMode(n)) gfRoundMode = n;
2134
+ return gfRoundMode;
2135
+ }
2136
+
2137
+ /*
2138
+ * 0.0 & 1.0 generator
2139
+ * These gZero_..... and gOne_..... can be any name
2140
+ * referenced from nowhere except Zero() and One().
2141
+ * gZero_..... and gOne_..... must have global scope
2142
+ * (to let the compiler know they may be changed in outside
2143
+ * (... but not actually..)).
2144
+ */
2145
+ volatile const double gZero_ABCED9B1_CE73__00400511F31D = 0.0;
2146
+ volatile const double gOne_ABCED9B4_CE73__00400511F31D = 1.0;
2147
+ static double
2148
+ Zero(void)
2149
+ {
2150
+ return gZero_ABCED9B1_CE73__00400511F31D;
2151
+ }
2152
+
2153
+ static double
2154
+ One(void)
2155
+ {
2156
+ return gOne_ABCED9B4_CE73__00400511F31D;
2157
+ }
2158
+
2159
+ VP_EXPORT U_LONG
2160
+ VpBaseFig(void)
2161
+ {
2162
+ return BASE_FIG;
2163
+ }
2164
+
2165
+ VP_EXPORT U_LONG
2166
+ VpDblFig(void)
2167
+ {
2168
+ return DBLE_FIG;
2169
+ }
2170
+
2171
+ VP_EXPORT U_LONG
2172
+ VpBaseVal(void)
2173
+ {
2174
+ return BASE;
2175
+ }
2176
+
2177
+ /*
2178
+ ----------------------------------------------------------------
2179
+ Value of sign in Real structure is reserved for future use.
2180
+ short sign;
2181
+ ==0 : NaN
2182
+ 1 : Positive zero
2183
+ -1 : Negative zero
2184
+ 2 : Positive number
2185
+ -2 : Negative number
2186
+ 3 : Positive infinite number
2187
+ -3 : Negative infinite number
2188
+ ----------------------------------------------------------------
2189
+ */
2190
+
2191
+ VP_EXPORT double
2192
+ VpGetDoubleNaN(void) /* Returns the value of NaN */
2193
+ {
2194
+ static double fNaN = 0.0;
2195
+ if(fNaN==0.0) fNaN = Zero()/Zero();
2196
+ return fNaN;
2197
+ }
2198
+
2199
+ VP_EXPORT double
2200
+ VpGetDoublePosInf(void) /* Returns the value of +Infinity */
2201
+ {
2202
+ static double fInf = 0.0;
2203
+ if(fInf==0.0) fInf = One()/Zero();
2204
+ return fInf;
2205
+ }
2206
+
2207
+ VP_EXPORT double
2208
+ VpGetDoubleNegInf(void) /* Returns the value of -Infinity */
2209
+ {
2210
+ static double fInf = 0.0;
2211
+ if(fInf==0.0) fInf = -(One()/Zero());
2212
+ return fInf;
2213
+ }
2214
+
2215
+ VP_EXPORT double
2216
+ VpGetDoubleNegZero(void) /* Returns the value of -0 */
2217
+ {
2218
+ static double nzero = 1000.0;
2219
+ if(nzero!=0.0) nzero = (One()/VpGetDoubleNegInf());
2220
+ return nzero;
2221
+ }
2222
+
2223
+ #if 0
2224
+ VP_EXPORT int
2225
+ VpIsNegDoubleZero(double v)
2226
+ {
2227
+ double z = VpGetDoubleNegZero();
2228
+ return MemCmp(&v,&z,sizeof(v))==0;
2229
+ }
2230
+ #endif
2231
+
2232
+ VP_EXPORT int
2233
+ VpException(unsigned short f, const char *str,int always)
2234
+ {
2235
+ VALUE exc;
2236
+ int fatal=0;
2237
+
2238
+ if(f==VP_EXCEPTION_OP || f==VP_EXCEPTION_MEMORY) always = 1;
2239
+
2240
+ if(always||(gfDoException&f)) {
2241
+ switch(f)
2242
+ {
2243
+ /*
2244
+ case VP_EXCEPTION_ZERODIVIDE:
2245
+ case VP_EXCEPTION_OVERFLOW:
2246
+ */
2247
+ case VP_EXCEPTION_INFINITY:
2248
+ exc = rb_eFloatDomainError;
2249
+ goto raise;
2250
+ case VP_EXCEPTION_NaN:
2251
+ exc = rb_eFloatDomainError;
2252
+ goto raise;
2253
+ case VP_EXCEPTION_UNDERFLOW:
2254
+ exc = rb_eFloatDomainError;
2255
+ goto raise;
2256
+ case VP_EXCEPTION_OP:
2257
+ exc = rb_eFloatDomainError;
2258
+ goto raise;
2259
+ case VP_EXCEPTION_MEMORY:
2260
+ fatal = 1;
2261
+ goto raise;
2262
+ default:
2263
+ fatal = 1;
2264
+ goto raise;
2265
+ }
2266
+ }
2267
+ return 0; /* 0 Means VpException() raised no exception */
2268
+
2269
+ raise:
2270
+ if(fatal) rb_fatal("%s", str);
2271
+ else rb_raise(exc, "%s", str);
2272
+ return 0;
2273
+ }
2274
+
2275
+ /* Throw exception or returns 0,when resulting c is Inf or NaN */
2276
+ /* sw=1:+ 2:- 3:* 4:/ */
2277
+ static int
2278
+ VpIsDefOP(Real *c,Real *a,Real *b,int sw)
2279
+ {
2280
+ if(VpIsNaN(a) || VpIsNaN(b)) {
2281
+ /* at least a or b is NaN */
2282
+ VpSetNaN(c);
2283
+ goto NaN;
2284
+ }
2285
+
2286
+ if(VpIsInf(a)) {
2287
+ if(VpIsInf(b)) {
2288
+ switch(sw)
2289
+ {
2290
+ case 1: /* + */
2291
+ if(VpGetSign(a)==VpGetSign(b)) {
2292
+ VpSetInf(c,VpGetSign(a));
2293
+ goto Inf;
2294
+ } else {
2295
+ VpSetNaN(c);
2296
+ goto NaN;
2297
+ }
2298
+ case 2: /* - */
2299
+ if(VpGetSign(a)!=VpGetSign(b)) {
2300
+ VpSetInf(c,VpGetSign(a));
2301
+ goto Inf;
2302
+ } else {
2303
+ VpSetNaN(c);
2304
+ goto NaN;
2305
+ }
2306
+ break;
2307
+ case 3: /* * */
2308
+ VpSetInf(c,VpGetSign(a)*VpGetSign(b));
2309
+ goto Inf;
2310
+ break;
2311
+ case 4: /* / */
2312
+ VpSetNaN(c);
2313
+ goto NaN;
2314
+ }
2315
+ VpSetNaN(c);
2316
+ goto NaN;
2317
+ }
2318
+ /* Inf op Finite */
2319
+ switch(sw)
2320
+ {
2321
+ case 1: /* + */
2322
+ case 2: /* - */
2323
+ VpSetInf(c,VpGetSign(a));
2324
+ break;
2325
+ case 3: /* * */
2326
+ if(VpIsZero(b)) {
2327
+ VpSetNaN(c);
2328
+ goto NaN;
2329
+ }
2330
+ VpSetInf(c,VpGetSign(a)*VpGetSign(b));
2331
+ break;
2332
+ case 4: /* / */
2333
+ VpSetInf(c,VpGetSign(a)*VpGetSign(b));
2334
+ }
2335
+ goto Inf;
2336
+ }
2337
+
2338
+ if(VpIsInf(b)) {
2339
+ switch(sw)
2340
+ {
2341
+ case 1: /* + */
2342
+ VpSetInf(c,VpGetSign(b));
2343
+ break;
2344
+ case 2: /* - */
2345
+ VpSetInf(c,-VpGetSign(b));
2346
+ break;
2347
+ case 3: /* * */
2348
+ if(VpIsZero(a)) {
2349
+ VpSetNaN(c);
2350
+ goto NaN;
2351
+ }
2352
+ VpSetInf(c,VpGetSign(a)*VpGetSign(b));
2353
+ break;
2354
+ case 4: /* / */
2355
+ VpSetZero(c,VpGetSign(a)*VpGetSign(b));
2356
+ }
2357
+ goto Inf;
2358
+ }
2359
+ return 1; /* Results OK */
2360
+
2361
+ Inf:
2362
+ return VpException(VP_EXCEPTION_INFINITY,"Computation results to 'Infinity'",0);
2363
+ NaN:
2364
+ return VpException(VP_EXCEPTION_NaN,"Computation results to 'NaN'",0);
2365
+ }
2366
+
2367
+ /*
2368
+ ----------------------------------------------------------------
2369
+ */
2370
+
2371
+ /*
2372
+ * returns number of chars needed to represent vp in specified format.
2373
+ */
2374
+ VP_EXPORT U_LONG
2375
+ VpNumOfChars(Real *vp,const char *pszFmt)
2376
+ {
2377
+ S_INT ex;
2378
+ U_LONG nc;
2379
+
2380
+ if(vp == NULL) return BASE_FIG*2+6;
2381
+ if(!VpIsDef(vp)) return 32; /* not sure,may be OK */
2382
+
2383
+ switch(*pszFmt)
2384
+ {
2385
+ case 'F':
2386
+ nc = BASE_FIG*(vp->Prec + 1)+2;
2387
+ ex = vp->exponent;
2388
+ if(ex<0) {
2389
+ nc += BASE_FIG*(-ex);
2390
+ } else {
2391
+ if(ex > (S_INT)vp->Prec) {
2392
+ nc += BASE_FIG*(ex - (S_INT)vp->Prec);
2393
+ }
2394
+ }
2395
+ break;
2396
+ case 'E':
2397
+ default:
2398
+ nc = BASE_FIG*(vp->Prec + 2)+6; /* 3: sign + exponent chars */
2399
+ }
2400
+ return nc;
2401
+ }
2402
+
2403
+ /*
2404
+ * Initializer for Vp routines and constants used.
2405
+ * [Input]
2406
+ * BaseVal: Base value(assigned to BASE) for Vp calculation.
2407
+ * It must be the form BaseVal=10**n.(n=1,2,3,...)
2408
+ * If Base <= 0L,then the BASE will be calcurated so
2409
+ * that BASE is as large as possible satisfying the
2410
+ * relation MaxVal <= BASE*(BASE+1). Where the value
2411
+ * MaxVal is the largest value which can be represented
2412
+ * by one U_LONG word(LONG) in the computer used.
2413
+ *
2414
+ * [Returns]
2415
+ * DBLE_FIG ... OK
2416
+ */
2417
+ VP_EXPORT U_LONG
2418
+ VpInit(U_LONG BaseVal)
2419
+ {
2420
+ /* Setup +/- Inf NaN -0 */
2421
+ VpGetDoubleNaN();
2422
+ VpGetDoublePosInf();
2423
+ VpGetDoubleNegInf();
2424
+ VpGetDoubleNegZero();
2425
+
2426
+ #ifndef BASE_FIG
2427
+ if(BaseVal <= 0) {
2428
+ U_LONG w;
2429
+ /* Base <= 0, then determine Base by calcuration. */
2430
+ BASE = 1;
2431
+ while(
2432
+ (BASE > 0) &&
2433
+ ((w = BASE *(BASE + 1)) > BASE) &&((w / BASE) ==(BASE + 1))
2434
+ ) {
2435
+ BaseVal = BASE;
2436
+ BASE = BaseVal * 10L;
2437
+ }
2438
+ }
2439
+ /* Set Base Values */
2440
+ BASE = BaseVal;
2441
+ HALF_BASE = BASE / 2;
2442
+ BASE1 = BASE / 10;
2443
+ BASE_FIG = 0;
2444
+ while(BaseVal /= 10) ++BASE_FIG;
2445
+ #endif
2446
+
2447
+ /* Allocates Vp constants. */
2448
+ VpConstOne = VpAlloc((U_LONG)1, "1");
2449
+ VpPt5 = VpAlloc((U_LONG)1, ".5");
2450
+
2451
+ #ifdef _DEBUG
2452
+ gnAlloc = 0;
2453
+ #endif /* _DEBUG */
2454
+
2455
+ #ifdef _DEBUG
2456
+ if(gfDebug) {
2457
+ printf("VpInit: BaseVal = %lu\n", BaseVal);
2458
+ printf(" BASE = %lu\n", BASE);
2459
+ printf(" HALF_BASE = %lu\n", HALF_BASE);
2460
+ printf(" BASE1 = %lu\n", BASE1);
2461
+ printf(" BASE_FIG = %lu\n", BASE_FIG);
2462
+ printf(" DBLE_FIG = %lu\n", DBLE_FIG);
2463
+ }
2464
+ #endif /* _DEBUG */
2465
+
2466
+ return DBLE_FIG;
2467
+ }
2468
+
2469
+ VP_EXPORT Real *
2470
+ VpOne(void)
2471
+ {
2472
+ return VpConstOne;
2473
+ }
2474
+
2475
+ /* If exponent overflows,then raise exception or returns 0 */
2476
+ static int
2477
+ AddExponent(Real *a,S_INT n)
2478
+ {
2479
+ S_INT e = a->exponent;
2480
+ S_INT m = e+n;
2481
+ S_INT eb,mb;
2482
+ if(e>0) {
2483
+ if(n>0) {
2484
+ mb = m*BASE_FIG;
2485
+ eb = e*BASE_FIG;
2486
+ if(mb<eb) goto overflow;
2487
+ }
2488
+ } else if(n<0) {
2489
+ mb = m*BASE_FIG;
2490
+ eb = e*BASE_FIG;
2491
+ if(mb>eb) goto underflow;
2492
+ }
2493
+ a->exponent = m;
2494
+ return 1;
2495
+
2496
+ /* Overflow/Underflow ==> Raise exception or returns 0 */
2497
+ underflow:
2498
+ VpSetZero(a,VpGetSign(a));
2499
+ return VpException(VP_EXCEPTION_UNDERFLOW,"Exponent underflow",0);
2500
+
2501
+ overflow:
2502
+ VpSetInf(a,VpGetSign(a));
2503
+ return VpException(VP_EXCEPTION_OVERFLOW,"Exponent overflow",0);
2504
+ }
2505
+
2506
+ /*
2507
+ * Allocates variable.
2508
+ * [Input]
2509
+ * mx ... allocation unit, if zero then mx is determined by szVal.
2510
+ * The mx is the number of effective digits can to be stored.
2511
+ * szVal ... value assigned(char). If szVal==NULL,then zero is assumed.
2512
+ * If szVal[0]=='#' then Max. Prec. will not be considered(1.1.7),
2513
+ * full precision specified by szVal is allocated.
2514
+ *
2515
+ * [Returns]
2516
+ * Pointer to the newly allocated variable, or
2517
+ * NULL be returned if memory allocation is failed,or any error.
2518
+ */
2519
+ VP_EXPORT Real *
2520
+ VpAlloc(U_LONG mx, const char *szVal)
2521
+ {
2522
+ U_LONG i, ni, ipn, ipf, nf, ipe, ne, nalloc;
2523
+ char v,*psz;
2524
+ int sign=1;
2525
+ Real *vp = NULL;
2526
+ U_LONG mf = VpGetPrecLimit();
2527
+ volatile VALUE buf;
2528
+
2529
+ mx = (mx + BASE_FIG - 1) / BASE_FIG + 1; /* Determine allocation unit. */
2530
+ if(szVal) {
2531
+ while(ISSPACE(*szVal)) szVal++;
2532
+ if(*szVal!='#') {
2533
+ if(mf) {
2534
+ mf = (mf + BASE_FIG - 1) / BASE_FIG + 2; /* Needs 1 more for div */
2535
+ if(mx>mf) {
2536
+ mx = mf;
2537
+ }
2538
+ }
2539
+ } else {
2540
+ ++szVal;
2541
+ }
2542
+ } else {
2543
+ /* necessary to be able to store */
2544
+ /* at least mx digits. */
2545
+ /* szVal==NULL ==> allocate zero value. */
2546
+ vp = (Real *) VpMemAlloc(sizeof(Real) + mx * sizeof(U_LONG));
2547
+ /* xmalloc() alway returns(or throw interruption) */
2548
+ vp->MaxPrec = mx; /* set max precision */
2549
+ VpSetZero(vp,1); /* initialize vp to zero. */
2550
+ return vp;
2551
+ }
2552
+
2553
+ /* Skip all '_' after digit: 2006-6-30 */
2554
+ ni = 0;
2555
+ buf = rb_str_new(0,strlen(szVal)+1);
2556
+ psz = rb_str_ptr_readonly(buf);
2557
+ i = 0;
2558
+ ipn = 0;
2559
+ while((psz[i]=szVal[ipn])!=0) {
2560
+ if(ISDIGIT(psz[i])) ++ni;
2561
+ if(psz[i]=='_') {
2562
+ if(ni>0) {ipn++;continue;}
2563
+ psz[i]=0;
2564
+ break;
2565
+ }
2566
+ ++i; ++ipn;
2567
+ }
2568
+ /* Skip trailing spaces */
2569
+ while((--i)>0) {
2570
+ if(ISSPACE(psz[i])) psz[i] = 0;
2571
+ else break;
2572
+ }
2573
+ szVal = psz;
2574
+
2575
+ /* Check on Inf & NaN */
2576
+ if(StrCmp(szVal,SZ_PINF)==0 ||
2577
+ StrCmp(szVal,SZ_INF)==0 ) {
2578
+ vp = (Real *) VpMemAlloc(sizeof(Real) + sizeof(U_LONG));
2579
+ vp->MaxPrec = 1; /* set max precision */
2580
+ VpSetPosInf(vp);
2581
+ return vp;
2582
+ }
2583
+ if(StrCmp(szVal,SZ_NINF)==0) {
2584
+ vp = (Real *) VpMemAlloc(sizeof(Real) + sizeof(U_LONG));
2585
+ vp->MaxPrec = 1; /* set max precision */
2586
+ VpSetNegInf(vp);
2587
+ return vp;
2588
+ }
2589
+ if(StrCmp(szVal,SZ_NaN)==0) {
2590
+ vp = (Real *) VpMemAlloc(sizeof(Real) + sizeof(U_LONG));
2591
+ vp->MaxPrec = 1; /* set max precision */
2592
+ VpSetNaN(vp);
2593
+ return vp;
2594
+ }
2595
+
2596
+ /* check on number szVal[] */
2597
+ ipn = i = 0;
2598
+ if (szVal[i] == '-') {sign=-1;++i;}
2599
+ else if(szVal[i] == '+') ++i;
2600
+ /* Skip digits */
2601
+ ni = 0; /* digits in mantissa */
2602
+ while((v = szVal[i]) != 0) {
2603
+ if(!ISDIGIT(v)) break;
2604
+ ++i;
2605
+ ++ni;
2606
+ }
2607
+ nf = 0;
2608
+ ipf = 0;
2609
+ ipe = 0;
2610
+ ne = 0;
2611
+ if(v) {
2612
+ /* other than digit nor \0 */
2613
+ if(szVal[i] == '.') { /* xxx. */
2614
+ ++i;
2615
+ ipf = i;
2616
+ while((v = szVal[i]) != 0) { /* get fraction part. */
2617
+ if(!ISDIGIT(v)) break;
2618
+ ++i;
2619
+ ++nf;
2620
+ }
2621
+ }
2622
+ ipe = 0; /* Exponent */
2623
+
2624
+ switch(szVal[i]) {
2625
+ case '\0': break;
2626
+ case 'e':
2627
+ case 'E':
2628
+ case 'd':
2629
+ case 'D':
2630
+ ++i;
2631
+ ipe = i;
2632
+ v = szVal[i];
2633
+ if((v == '-') ||(v == '+')) ++i;
2634
+ while((v=szVal[i])!=0) {
2635
+ if(!ISDIGIT(v)) break;
2636
+ ++i;
2637
+ ++ne;
2638
+ }
2639
+ break;
2640
+ default:
2641
+ break;
2642
+ }
2643
+ }
2644
+ nalloc =(ni + nf + BASE_FIG - 1) / BASE_FIG + 1; /* set effective allocation */
2645
+ /* units for szVal[] */
2646
+ if(mx <= 0) mx = 1;
2647
+ nalloc = Max(nalloc, mx);
2648
+ mx = nalloc;
2649
+ vp =(Real *) VpMemAlloc(sizeof(Real) + mx * sizeof(U_LONG));
2650
+ /* xmalloc() alway returns(or throw interruption) */
2651
+ vp->MaxPrec = mx; /* set max precision */
2652
+ VpSetZero(vp,sign);
2653
+ VpCtoV(vp, &(szVal[ipn]), ni, &(szVal[ipf]), nf, &(szVal[ipe]), ne);
2654
+ return vp;
2655
+ }
2656
+
2657
+ /*
2658
+ * Assignment(c=a).
2659
+ * [Input]
2660
+ * a ... RHSV
2661
+ * isw ... switch for assignment.
2662
+ * c = a when isw > 0
2663
+ * c = -a when isw < 0
2664
+ * if c->MaxPrec < a->Prec,then round operation
2665
+ * will be performed.
2666
+ * [Output]
2667
+ * c ... LHSV
2668
+ */
2669
+ VP_EXPORT int
2670
+ VpAsgn(Real *c, Real *a, int isw)
2671
+ {
2672
+ U_LONG n;
2673
+ if(VpIsNaN(a)) {
2674
+ VpSetNaN(c);
2675
+ return 0;
2676
+ }
2677
+ if(VpIsInf(a)) {
2678
+ VpSetInf(c,isw*VpGetSign(a));
2679
+ return 0;
2680
+ }
2681
+
2682
+ /* check if the RHS is zero */
2683
+ if(!VpIsZero(a)) {
2684
+ c->exponent = a->exponent; /* store exponent */
2685
+ VpSetSign(c,(isw*VpGetSign(a))); /* set sign */
2686
+ n =(a->Prec < c->MaxPrec) ?(a->Prec) :(c->MaxPrec);
2687
+ c->Prec = n;
2688
+ memcpy(c->frac, a->frac, n * sizeof(U_LONG));
2689
+ /* Needs round ? */
2690
+ if(isw!=10) {
2691
+ /* Not in ActiveRound */
2692
+ if(c->Prec < a->Prec) {
2693
+ VpInternalRound(c,n,(n>0)?a->frac[n-1]:0,a->frac[n]);
2694
+ } else {
2695
+ VpLimitRound(c,0);
2696
+ }
2697
+ }
2698
+ } else {
2699
+ /* The value of 'a' is zero. */
2700
+ VpSetZero(c,isw*VpGetSign(a));
2701
+ return 1;
2702
+ }
2703
+ return c->Prec*BASE_FIG;
2704
+ }
2705
+
2706
+ /*
2707
+ * c = a + b when operation = 1 or 2
2708
+ * = a - b when operation = -1 or -2.
2709
+ * Returns number of significant digits of c
2710
+ */
2711
+ VP_EXPORT int
2712
+ VpAddSub(Real *c, Real *a, Real *b, int operation)
2713
+ {
2714
+ S_INT sw, isw;
2715
+ Real *a_ptr, *b_ptr;
2716
+ U_LONG n, na, nb, i;
2717
+ U_LONG mrv;
2718
+
2719
+ #ifdef _DEBUG
2720
+ if(gfDebug) {
2721
+ VPrint(stdout, "VpAddSub(enter) a=% \n", a);
2722
+ VPrint(stdout, " b=% \n", b);
2723
+ printf(" operation=%d\n", operation);
2724
+ }
2725
+ #endif /* _DEBUG */
2726
+
2727
+ if(!VpIsDefOP(c,a,b,(operation>0)?1:2)) return 0; /* No significant digits */
2728
+
2729
+ /* check if a or b is zero */
2730
+ if(VpIsZero(a)) {
2731
+ /* a is zero,then assign b to c */
2732
+ if(!VpIsZero(b)) {
2733
+ VpAsgn(c, b, operation);
2734
+ } else {
2735
+ /* Both a and b are zero. */
2736
+ if(VpGetSign(a)<0 && operation*VpGetSign(b)<0) {
2737
+ /* -0 -0 */
2738
+ VpSetZero(c,-1);
2739
+ } else {
2740
+ VpSetZero(c,1);
2741
+ }
2742
+ return 1; /* 0: 1 significant digits */
2743
+ }
2744
+ return c->Prec*BASE_FIG;
2745
+ }
2746
+ if(VpIsZero(b)) {
2747
+ /* b is zero,then assign a to c. */
2748
+ VpAsgn(c, a, 1);
2749
+ return c->Prec*BASE_FIG;
2750
+ }
2751
+
2752
+ if(operation < 0) sw = -1;
2753
+ else sw = 1;
2754
+
2755
+ /* compare absolute value. As a result,|a_ptr|>=|b_ptr| */
2756
+ if(a->exponent > b->exponent) {
2757
+ a_ptr = a;
2758
+ b_ptr = b;
2759
+ } /* |a|>|b| */
2760
+ else if(a->exponent < b->exponent) {
2761
+ a_ptr = b;
2762
+ b_ptr = a;
2763
+ } /* |a|<|b| */
2764
+ else {
2765
+ /* Exponent part of a and b is the same,then compare fraction */
2766
+ /* part */
2767
+ na = a->Prec;
2768
+ nb = b->Prec;
2769
+ n = Min(na, nb);
2770
+ for(i=0;i < n; ++i) {
2771
+ if(a->frac[i] > b->frac[i]) {
2772
+ a_ptr = a;
2773
+ b_ptr = b;
2774
+ goto end_if;
2775
+ } else if(a->frac[i] < b->frac[i]) {
2776
+ a_ptr = b;
2777
+ b_ptr = a;
2778
+ goto end_if;
2779
+ }
2780
+ }
2781
+ if(na > nb) {
2782
+ a_ptr = a;
2783
+ b_ptr = b;
2784
+ goto end_if;
2785
+ } else if(na < nb) {
2786
+ a_ptr = b;
2787
+ b_ptr = a;
2788
+ goto end_if;
2789
+ }
2790
+ /* |a| == |b| */
2791
+ if(VpGetSign(a) + sw *VpGetSign(b) == 0) {
2792
+ VpSetZero(c,1); /* abs(a)=abs(b) and operation = '-' */
2793
+ return c->Prec*BASE_FIG;
2794
+ }
2795
+ a_ptr = a;
2796
+ b_ptr = b;
2797
+ }
2798
+
2799
+ end_if:
2800
+ isw = VpGetSign(a) + sw *VpGetSign(b);
2801
+ /*
2802
+ * isw = 0 ...( 1)+(-1),( 1)-( 1),(-1)+(1),(-1)-(-1)
2803
+ * = 2 ...( 1)+( 1),( 1)-(-1)
2804
+ * =-2 ...(-1)+(-1),(-1)-( 1)
2805
+ * If isw==0, then c =(Sign a_ptr)(|a_ptr|-|b_ptr|)
2806
+ * else c =(Sign ofisw)(|a_ptr|+|b_ptr|)
2807
+ */
2808
+ if(isw) { /* addition */
2809
+ VpSetSign(c,(S_INT)1);
2810
+ mrv = VpAddAbs(a_ptr, b_ptr, c);
2811
+ VpSetSign(c,isw / 2);
2812
+ } else { /* subtraction */
2813
+ VpSetSign(c,(S_INT)1);
2814
+ mrv = VpSubAbs(a_ptr, b_ptr, c);
2815
+ if(a_ptr == a) {
2816
+ VpSetSign(c,VpGetSign(a));
2817
+ } else {
2818
+ VpSetSign(c,VpGetSign(a_ptr) * sw);
2819
+ }
2820
+ }
2821
+ VpInternalRound(c,0,(c->Prec>0)?c->frac[c->Prec-1]:0,mrv);
2822
+
2823
+ #ifdef _DEBUG
2824
+ if(gfDebug) {
2825
+ VPrint(stdout, "VpAddSub(result) c=% \n", c);
2826
+ VPrint(stdout, " a=% \n", a);
2827
+ VPrint(stdout, " b=% \n", b);
2828
+ printf(" operation=%d\n", operation);
2829
+ }
2830
+ #endif /* _DEBUG */
2831
+ return c->Prec*BASE_FIG;
2832
+ }
2833
+
2834
+ /*
2835
+ * Addition of two variable precisional variables
2836
+ * a and b assuming abs(a)>abs(b).
2837
+ * c = abs(a) + abs(b) ; where |a|>=|b|
2838
+ */
2839
+ static U_LONG
2840
+ VpAddAbs(Real *a, Real *b, Real *c)
2841
+ {
2842
+ U_LONG word_shift;
2843
+ U_LONG carry;
2844
+ U_LONG ap;
2845
+ U_LONG bp;
2846
+ U_LONG cp;
2847
+ U_LONG a_pos;
2848
+ U_LONG b_pos;
2849
+ U_LONG c_pos;
2850
+ U_LONG av, bv, mrv;
2851
+
2852
+ #ifdef _DEBUG
2853
+ if(gfDebug) {
2854
+ VPrint(stdout, "VpAddAbs called: a = %\n", a);
2855
+ VPrint(stdout, " b = %\n", b);
2856
+ }
2857
+ #endif /* _DEBUG */
2858
+
2859
+ word_shift = VpSetPTR(a, b, c, &ap, &bp, &cp, &av, &bv);
2860
+ a_pos = ap;
2861
+ b_pos = bp;
2862
+ c_pos = cp;
2863
+ if(word_shift==-1L) return 0; /* Overflow */
2864
+ if(b_pos == -1L) goto Assign_a;
2865
+
2866
+ mrv = av + bv; /* Most right val. Used for round. */
2867
+
2868
+ /* Just assign the last few digits of b to c because a has no */
2869
+ /* corresponding digits to be added. */
2870
+ while(b_pos + word_shift > a_pos) {
2871
+ --c_pos;
2872
+ if(b_pos > 0) {
2873
+ c->frac[c_pos] = b->frac[--b_pos];
2874
+ } else {
2875
+ --word_shift;
2876
+ c->frac[c_pos] = 0;
2877
+ }
2878
+ }
2879
+
2880
+ /* Just assign the last few digits of a to c because b has no */
2881
+ /* corresponding digits to be added. */
2882
+ bv = b_pos + word_shift;
2883
+ while(a_pos > bv) {
2884
+ c->frac[--c_pos] = a->frac[--a_pos];
2885
+ }
2886
+ carry = 0; /* set first carry be zero */
2887
+
2888
+ /* Now perform addition until every digits of b will be */
2889
+ /* exhausted. */
2890
+ while(b_pos > 0) {
2891
+ c->frac[--c_pos] = a->frac[--a_pos] + b->frac[--b_pos] + carry;
2892
+ if(c->frac[c_pos] >= BASE) {
2893
+ c->frac[c_pos] -= BASE;
2894
+ carry = 1;
2895
+ } else {
2896
+ carry = 0;
2897
+ }
2898
+ }
2899
+
2900
+ /* Just assign the first few digits of a with considering */
2901
+ /* the carry obtained so far because b has been exhausted. */
2902
+ while(a_pos > 0) {
2903
+ c->frac[--c_pos] = a->frac[--a_pos] + carry;
2904
+ if(c->frac[c_pos] >= BASE) {
2905
+ c->frac[c_pos] -= BASE;
2906
+ carry = 1;
2907
+ } else {
2908
+ carry = 0;
2909
+ }
2910
+ }
2911
+ if(c_pos) c->frac[c_pos - 1] += carry;
2912
+ goto Exit;
2913
+
2914
+ Assign_a:
2915
+ VpAsgn(c, a, 1);
2916
+ mrv = 0;
2917
+
2918
+ Exit:
2919
+
2920
+ #ifdef _DEBUG
2921
+ if(gfDebug) {
2922
+ VPrint(stdout, "VpAddAbs exit: c=% \n", c);
2923
+ }
2924
+ #endif /* _DEBUG */
2925
+ return mrv;
2926
+ }
2927
+
2928
+ /*
2929
+ * c = abs(a) - abs(b)
2930
+ */
2931
+ static U_LONG
2932
+ VpSubAbs(Real *a, Real *b, Real *c)
2933
+ {
2934
+ U_LONG word_shift;
2935
+ U_LONG mrv;
2936
+ U_LONG borrow;
2937
+ U_LONG ap;
2938
+ U_LONG bp;
2939
+ U_LONG cp;
2940
+ U_LONG a_pos;
2941
+ U_LONG b_pos;
2942
+ U_LONG c_pos;
2943
+ U_LONG av, bv;
2944
+
2945
+ #ifdef _DEBUG
2946
+ if(gfDebug) {
2947
+ VPrint(stdout, "VpSubAbs called: a = %\n", a);
2948
+ VPrint(stdout, " b = %\n", b);
2949
+ }
2950
+ #endif /* _DEBUG */
2951
+
2952
+ word_shift = VpSetPTR(a, b, c, &ap, &bp, &cp, &av, &bv);
2953
+ a_pos = ap;
2954
+ b_pos = bp;
2955
+ c_pos = cp;
2956
+ if(word_shift==-1L) return 0; /* Overflow */
2957
+ if(b_pos == -1L) goto Assign_a;
2958
+
2959
+ if(av >= bv) {
2960
+ mrv = av - bv;
2961
+ borrow = 0;
2962
+ } else {
2963
+ mrv = 0;
2964
+ borrow = 1;
2965
+ }
2966
+
2967
+ /* Just assign the values which are the BASE subtracted by */
2968
+ /* each of the last few digits of the b because the a has no */
2969
+ /* corresponding digits to be subtracted. */
2970
+ if(b_pos + word_shift > a_pos) {
2971
+ while(b_pos + word_shift > a_pos) {
2972
+ --c_pos;
2973
+ if(b_pos > 0) {
2974
+ c->frac[c_pos] = BASE - b->frac[--b_pos] - borrow;
2975
+ } else {
2976
+ --word_shift;
2977
+ c->frac[c_pos] = BASE - borrow;
2978
+ }
2979
+ borrow = 1;
2980
+ }
2981
+ }
2982
+ /* Just assign the last few digits of a to c because b has no */
2983
+ /* corresponding digits to subtract. */
2984
+
2985
+ bv = b_pos + word_shift;
2986
+ while(a_pos > bv) {
2987
+ c->frac[--c_pos] = a->frac[--a_pos];
2988
+ }
2989
+
2990
+ /* Now perform subtraction until every digits of b will be */
2991
+ /* exhausted. */
2992
+ while(b_pos > 0) {
2993
+ --c_pos;
2994
+ if(a->frac[--a_pos] < b->frac[--b_pos] + borrow) {
2995
+ c->frac[c_pos] = BASE + a->frac[a_pos] - b->frac[b_pos] - borrow;
2996
+ borrow = 1;
2997
+ } else {
2998
+ c->frac[c_pos] = a->frac[a_pos] - b->frac[b_pos] - borrow;
2999
+ borrow = 0;
3000
+ }
3001
+ }
3002
+
3003
+ /* Just assign the first few digits of a with considering */
3004
+ /* the borrow obtained so far because b has been exhausted. */
3005
+ while(a_pos > 0) {
3006
+ --c_pos;
3007
+ if(a->frac[--a_pos] < borrow) {
3008
+ c->frac[c_pos] = BASE + a->frac[a_pos] - borrow;
3009
+ borrow = 1;
3010
+ } else {
3011
+ c->frac[c_pos] = a->frac[a_pos] - borrow;
3012
+ borrow = 0;
3013
+ }
3014
+ }
3015
+ if(c_pos) c->frac[c_pos - 1] -= borrow;
3016
+ goto Exit;
3017
+
3018
+ Assign_a:
3019
+ VpAsgn(c, a, 1);
3020
+ mrv = 0;
3021
+
3022
+ Exit:
3023
+ #ifdef _DEBUG
3024
+ if(gfDebug) {
3025
+ VPrint(stdout, "VpSubAbs exit: c=% \n", c);
3026
+ }
3027
+ #endif /* _DEBUG */
3028
+ return mrv;
3029
+ }
3030
+
3031
+ /*
3032
+ * Note: If(av+bv)>= HALF_BASE,then 1 will be added to the least significant
3033
+ * digit of c(In case of addition).
3034
+ * ------------------------- figure of output -----------------------------------
3035
+ * a = xxxxxxxxxxx
3036
+ * b = xxxxxxxxxx
3037
+ * c =xxxxxxxxxxxxxxx
3038
+ * word_shift = | |
3039
+ * right_word = | | (Total digits in RHSV)
3040
+ * left_word = | | (Total digits in LHSV)
3041
+ * a_pos = |
3042
+ * b_pos = |
3043
+ * c_pos = |
3044
+ */
3045
+ static U_LONG
3046
+ VpSetPTR(Real *a, Real *b, Real *c, U_LONG *a_pos, U_LONG *b_pos, U_LONG *c_pos, U_LONG *av, U_LONG *bv)
3047
+ {
3048
+ U_LONG left_word, right_word, word_shift;
3049
+ c->frac[0] = 0;
3050
+ *av = *bv = 0;
3051
+ word_shift =((a->exponent) -(b->exponent));
3052
+ left_word = b->Prec + word_shift;
3053
+ right_word = Max((a->Prec),left_word);
3054
+ left_word =(c->MaxPrec) - 1; /* -1 ... prepare for round up */
3055
+ /*
3056
+ * check if 'round' is needed.
3057
+ */
3058
+ if(right_word > left_word) { /* round ? */
3059
+ /*---------------------------------
3060
+ * Actual size of a = xxxxxxAxx
3061
+ * Actual size of b = xxxBxxxxx
3062
+ * Max. size of c = xxxxxx
3063
+ * Round off = |-----|
3064
+ * c_pos = |
3065
+ * right_word = |
3066
+ * a_pos = |
3067
+ */
3068
+ *c_pos = right_word = left_word + 1; /* Set resulting precision */
3069
+ /* be equal to that of c */
3070
+ if((a->Prec) >=(c->MaxPrec)) {
3071
+ /*
3072
+ * a = xxxxxxAxxx
3073
+ * c = xxxxxx
3074
+ * a_pos = |
3075
+ */
3076
+ *a_pos = left_word;
3077
+ *av = a->frac[*a_pos]; /* av is 'A' shown in above. */
3078
+ } else {
3079
+ /*
3080
+ * a = xxxxxxx
3081
+ * c = xxxxxxxxxx
3082
+ * a_pos = |
3083
+ */
3084
+ *a_pos = a->Prec;
3085
+ }
3086
+ if((b->Prec + word_shift) >= c->MaxPrec) {
3087
+ /*
3088
+ * a = xxxxxxxxx
3089
+ * b = xxxxxxxBxxx
3090
+ * c = xxxxxxxxxxx
3091
+ * b_pos = |
3092
+ */
3093
+ if(c->MaxPrec >=(word_shift + 1)) {
3094
+ *b_pos = c->MaxPrec - word_shift - 1;
3095
+ *bv = b->frac[*b_pos];
3096
+ } else {
3097
+ *b_pos = -1L;
3098
+ }
3099
+ } else {
3100
+ /*
3101
+ * a = xxxxxxxxxxxxxxxx
3102
+ * b = xxxxxx
3103
+ * c = xxxxxxxxxxxxx
3104
+ * b_pos = |
3105
+ */
3106
+ *b_pos = b->Prec;
3107
+ }
3108
+ } else { /* The MaxPrec of c - 1 > The Prec of a + b */
3109
+ /*
3110
+ * a = xxxxxxx
3111
+ * b = xxxxxx
3112
+ * c = xxxxxxxxxxx
3113
+ * c_pos = |
3114
+ */
3115
+ *b_pos = b->Prec;
3116
+ *a_pos = a->Prec;
3117
+ *c_pos = right_word + 1;
3118
+ }
3119
+ c->Prec = *c_pos;
3120
+ c->exponent = a->exponent;
3121
+ if(!AddExponent(c,(S_LONG)1)) return (-1L);
3122
+ return word_shift;
3123
+ }
3124
+
3125
+ /*
3126
+ * Return number og significant digits
3127
+ * c = a * b , Where a = a0a1a2 ... an
3128
+ * b = b0b1b2 ... bm
3129
+ * c = c0c1c2 ... cl
3130
+ * a0 a1 ... an * bm
3131
+ * a0 a1 ... an * bm-1
3132
+ * . . .
3133
+ * . . .
3134
+ * a0 a1 .... an * b0
3135
+ * +_____________________________
3136
+ * c0 c1 c2 ...... cl
3137
+ * nc <---|
3138
+ * MaxAB |--------------------|
3139
+ */
3140
+ VP_EXPORT int
3141
+ VpMult(Real *c, Real *a, Real *b)
3142
+ {
3143
+ U_LONG MxIndA, MxIndB, MxIndAB, MxIndC;
3144
+ U_LONG ind_c, i, ii, nc;
3145
+ U_LONG ind_as, ind_ae, ind_bs, ind_be;
3146
+ U_LONG Carry, s;
3147
+ Real *w;
3148
+
3149
+ #ifdef _DEBUG
3150
+ if(gfDebug) {
3151
+ VPrint(stdout, "VpMult(Enter): a=% \n", a);
3152
+ VPrint(stdout, " b=% \n", b);
3153
+ }
3154
+ #endif /* _DEBUG */
3155
+
3156
+ if(!VpIsDefOP(c,a,b,3)) return 0; /* No significant digit */
3157
+
3158
+ if(VpIsZero(a) || VpIsZero(b)) {
3159
+ /* at least a or b is zero */
3160
+ VpSetZero(c,VpGetSign(a)*VpGetSign(b));
3161
+ return 1; /* 0: 1 significant digit */
3162
+ }
3163
+
3164
+ if(VpIsOne(a)) {
3165
+ VpAsgn(c, b, VpGetSign(a));
3166
+ goto Exit;
3167
+ }
3168
+ if(VpIsOne(b)) {
3169
+ VpAsgn(c, a, VpGetSign(b));
3170
+ goto Exit;
3171
+ }
3172
+ if((b->Prec) >(a->Prec)) {
3173
+ /* Adjust so that digits(a)>digits(b) */
3174
+ w = a;
3175
+ a = b;
3176
+ b = w;
3177
+ }
3178
+ w = NULL;
3179
+ MxIndA = a->Prec - 1;
3180
+ MxIndB = b->Prec - 1;
3181
+ MxIndC = c->MaxPrec - 1;
3182
+ MxIndAB = a->Prec + b->Prec - 1;
3183
+
3184
+ if(MxIndC < MxIndAB) { /* The Max. prec. of c < Prec(a)+Prec(b) */
3185
+ w = c;
3186
+ c = VpAlloc((U_LONG)((MxIndAB + 1) * BASE_FIG), "#0");
3187
+ MxIndC = MxIndAB;
3188
+ }
3189
+
3190
+ /* set LHSV c info */
3191
+
3192
+ c->exponent = a->exponent; /* set exponent */
3193
+ if(!AddExponent(c,b->exponent)) return 0;
3194
+ VpSetSign(c,VpGetSign(a)*VpGetSign(b)); /* set sign */
3195
+ Carry = 0;
3196
+ nc = ind_c = MxIndAB;
3197
+ memset(c->frac, 0, (nc + 1) * sizeof(U_LONG)); /* Initialize c */
3198
+ c->Prec = nc + 1; /* set precision */
3199
+ for(nc = 0; nc < MxIndAB; ++nc, --ind_c) {
3200
+ if(nc < MxIndB) { /* The left triangle of the Fig. */
3201
+ ind_as = MxIndA - nc;
3202
+ ind_ae = MxIndA;
3203
+ ind_bs = MxIndB;
3204
+ ind_be = MxIndB - nc;
3205
+ } else if(nc <= MxIndA) { /* The middle rectangular of the Fig. */
3206
+ ind_as = MxIndA - nc;
3207
+ ind_ae = MxIndA -(nc - MxIndB);
3208
+ ind_bs = MxIndB;
3209
+ ind_be = 0;
3210
+ } else if(nc > MxIndA) { /* The right triangle of the Fig. */
3211
+ ind_as = 0;
3212
+ ind_ae = MxIndAB - nc - 1;
3213
+ ind_bs = MxIndB -(nc - MxIndA);
3214
+ ind_be = 0;
3215
+ }
3216
+
3217
+ for(i = ind_as; i <= ind_ae; ++i) {
3218
+ s =((a->frac[i]) *(b->frac[ind_bs--]));
3219
+ Carry = s / BASE;
3220
+ s = s -(Carry * BASE);
3221
+ c->frac[ind_c] += s;
3222
+ if(c->frac[ind_c] >= BASE) {
3223
+ s = c->frac[ind_c] / BASE;
3224
+ Carry += s;
3225
+ c->frac[ind_c] -= (s * BASE);
3226
+ }
3227
+ if(Carry) {
3228
+ ii = ind_c;
3229
+ while((--ii) >= 0) {
3230
+ c->frac[ii] += Carry;
3231
+ if(c->frac[ii] >= BASE) {
3232
+ Carry = c->frac[ii] / BASE;
3233
+ c->frac[ii] -=(Carry * BASE);
3234
+ } else {
3235
+ break;
3236
+ }
3237
+ }
3238
+ }
3239
+ }
3240
+ }
3241
+ if(w != NULL) { /* free work variable */
3242
+ VpNmlz(c);
3243
+ VpAsgn(w, c, 1);
3244
+ VpFree(c);
3245
+ c = w;
3246
+ } else {
3247
+ VpLimitRound(c,0);
3248
+ }
3249
+
3250
+ Exit:
3251
+ #ifdef _DEBUG
3252
+ if(gfDebug) {
3253
+ VPrint(stdout, "VpMult(c=a*b): c=% \n", c);
3254
+ VPrint(stdout, " a=% \n", a);
3255
+ VPrint(stdout, " b=% \n", b);
3256
+ }
3257
+ #endif /*_DEBUG */
3258
+ return c->Prec*BASE_FIG;
3259
+ }
3260
+
3261
+ /*
3262
+ * c = a / b, remainder = r
3263
+ */
3264
+ VP_EXPORT int
3265
+ VpDivd(Real *c, Real *r, Real *a, Real *b)
3266
+ {
3267
+ U_LONG word_a, word_b, word_c, word_r;
3268
+ U_LONG i, n, ind_a, ind_b, ind_c, ind_r;
3269
+ U_LONG nLoop;
3270
+ U_LONG q, b1, b1p1, b1b2, b1b2p1, r1r2;
3271
+ U_LONG borrow, borrow1, borrow2, qb;
3272
+
3273
+ #ifdef _DEBUG
3274
+ if(gfDebug) {
3275
+ VPrint(stdout, " VpDivd(c=a/b) a=% \n", a);
3276
+ VPrint(stdout, " b=% \n", b);
3277
+ }
3278
+ #endif /*_DEBUG */
3279
+
3280
+ VpSetNaN(r);
3281
+ if(!VpIsDefOP(c,a,b,4)) goto Exit;
3282
+ if(VpIsZero(a)&&VpIsZero(b)) {
3283
+ VpSetNaN(c);
3284
+ return VpException(VP_EXCEPTION_NaN,"(VpDivd) 0/0 not defined(NaN)",0);
3285
+ }
3286
+ if(VpIsZero(b)) {
3287
+ VpSetInf(c,VpGetSign(a)*VpGetSign(b));
3288
+ return VpException(VP_EXCEPTION_ZERODIVIDE,"(VpDivd) Divide by zero",0);
3289
+ }
3290
+ if(VpIsZero(a)) {
3291
+ /* numerator a is zero */
3292
+ VpSetZero(c,VpGetSign(a)*VpGetSign(b));
3293
+ VpSetZero(r,VpGetSign(a)*VpGetSign(b));
3294
+ goto Exit;
3295
+ }
3296
+ if(VpIsOne(b)) {
3297
+ /* divide by one */
3298
+ VpAsgn(c, a, VpGetSign(b));
3299
+ VpSetZero(r,VpGetSign(a));
3300
+ goto Exit;
3301
+ }
3302
+
3303
+ word_a = a->Prec;
3304
+ word_b = b->Prec;
3305
+ word_c = c->MaxPrec;
3306
+ word_r = r->MaxPrec;
3307
+
3308
+ ind_c = 0;
3309
+ ind_r = 1;
3310
+
3311
+ if(word_a >= word_r) goto space_error;
3312
+
3313
+ r->frac[0] = 0;
3314
+ while(ind_r <= word_a) {
3315
+ r->frac[ind_r] = a->frac[ind_r - 1];
3316
+ ++ind_r;
3317
+ }
3318
+
3319
+ while(ind_r < word_r) r->frac[ind_r++] = 0;
3320
+ while(ind_c < word_c) c->frac[ind_c++] = 0;
3321
+
3322
+ /* initial procedure */
3323
+ b1 = b1p1 = b->frac[0];
3324
+ if(b->Prec <= 1) {
3325
+ b1b2p1 = b1b2 = b1p1 * BASE;
3326
+ } else {
3327
+ b1p1 = b1 + 1;
3328
+ b1b2p1 = b1b2 = b1 * BASE + b->frac[1];
3329
+ if(b->Prec > 2) ++b1b2p1;
3330
+ }
3331
+
3332
+ /* */
3333
+ /* loop start */
3334
+ ind_c = word_r - 1;
3335
+ nLoop = Min(word_c,ind_c);
3336
+ ind_c = 1;
3337
+ while(ind_c < nLoop) {
3338
+ if(r->frac[ind_c] == 0) {
3339
+ ++ind_c;
3340
+ continue;
3341
+ }
3342
+ r1r2 = r->frac[ind_c] * BASE + r->frac[ind_c + 1];
3343
+ if(r1r2 == b1b2) {
3344
+ /* The first two word digits is the same */
3345
+ ind_b = 2;
3346
+ ind_a = ind_c + 2;
3347
+ while(ind_b < word_b) {
3348
+ if(r->frac[ind_a] < b->frac[ind_b]) goto div_b1p1;
3349
+ if(r->frac[ind_a] > b->frac[ind_b]) break;
3350
+ ++ind_a;
3351
+ ++ind_b;
3352
+ }
3353
+ /* The first few word digits of r and b is the same and */
3354
+ /* the first different word digit of w is greater than that */
3355
+ /* of b, so quotinet is 1 and just subtract b from r. */
3356
+ borrow = 0; /* quotient=1, then just r-b */
3357
+ ind_b = b->Prec - 1;
3358
+ ind_r = ind_c + ind_b;
3359
+ if(ind_r >= word_r) goto space_error;
3360
+ n = ind_b;
3361
+ for(i = 0; i <= n; ++i) {
3362
+ if(r->frac[ind_r] < b->frac[ind_b] + borrow) {
3363
+ r->frac[ind_r] +=(BASE -(b->frac[ind_b] + borrow));
3364
+ borrow = 1;
3365
+ } else {
3366
+ r->frac[ind_r] = r->frac[ind_r] - b->frac[ind_b] - borrow;
3367
+ borrow = 0;
3368
+ }
3369
+ --ind_r;
3370
+ --ind_b;
3371
+ }
3372
+ ++(c->frac[ind_c]);
3373
+ goto carry;
3374
+ }
3375
+ /* The first two word digits is not the same, */
3376
+ /* then compare magnitude, and divide actually. */
3377
+ if(r1r2 >= b1b2p1) {
3378
+ q = r1r2 / b1b2p1;
3379
+ c->frac[ind_c] += q;
3380
+ ind_r = b->Prec + ind_c - 1;
3381
+ goto sub_mult;
3382
+ }
3383
+
3384
+ div_b1p1:
3385
+ if(ind_c + 1 >= word_c) goto out_side;
3386
+ q = r1r2 / b1p1;
3387
+ c->frac[ind_c + 1] += q;
3388
+ ind_r = b->Prec + ind_c;
3389
+
3390
+ sub_mult:
3391
+ borrow1 = borrow2 = 0;
3392
+ ind_b = word_b - 1;
3393
+ if(ind_r >= word_r) goto space_error;
3394
+ n = ind_b;
3395
+ for(i = 0; i <= n; ++i) {
3396
+ /* now, perform r = r - q * b */
3397
+ qb = q *(b->frac[ind_b]);
3398
+ if(qb < BASE) borrow1 = 0;
3399
+ else {
3400
+ borrow1 = qb / BASE;
3401
+ qb = qb - borrow1 * BASE;
3402
+ }
3403
+ if(r->frac[ind_r] < qb) {
3404
+ r->frac[ind_r] +=(BASE - qb);
3405
+ borrow2 = borrow2 + borrow1 + 1;
3406
+ } else {
3407
+ r->frac[ind_r] -= qb;
3408
+ borrow2 += borrow1;
3409
+ }
3410
+ if(borrow2) {
3411
+ if(r->frac[ind_r - 1] < borrow2) {
3412
+ r->frac[ind_r - 1] +=(BASE - borrow2);
3413
+ borrow2 = 1;
3414
+ } else {
3415
+ r->frac[ind_r - 1] -= borrow2;
3416
+ borrow2 = 0;
3417
+ }
3418
+ }
3419
+ --ind_r;
3420
+ --ind_b;
3421
+ }
3422
+
3423
+ r->frac[ind_r] -= borrow2;
3424
+ carry:
3425
+ ind_r = ind_c;
3426
+ while(c->frac[ind_r] >= BASE) {
3427
+ c->frac[ind_r] -= BASE;
3428
+ --ind_r;
3429
+ ++(c->frac[ind_r]);
3430
+ }
3431
+ }
3432
+ /* End of operation, now final arrangement */
3433
+ out_side:
3434
+ c->Prec = word_c;
3435
+ c->exponent = a->exponent;
3436
+ if(!AddExponent(c,(S_LONG)2)) return 0;
3437
+ if(!AddExponent(c,-(b->exponent))) return 0;
3438
+
3439
+ VpSetSign(c,VpGetSign(a)*VpGetSign(b));
3440
+ VpNmlz(c); /* normalize c */
3441
+ r->Prec = word_r;
3442
+ r->exponent = a->exponent;
3443
+ if(!AddExponent(r,(S_LONG)1)) return 0;
3444
+ VpSetSign(r,VpGetSign(a));
3445
+ VpNmlz(r); /* normalize r(remainder) */
3446
+ goto Exit;
3447
+
3448
+ space_error:
3449
+ #ifdef _DEBUG
3450
+ if(gfDebug) {
3451
+ printf(" word_a=%lu\n", word_a);
3452
+ printf(" word_b=%lu\n", word_b);
3453
+ printf(" word_c=%lu\n", word_c);
3454
+ printf(" word_r=%lu\n", word_r);
3455
+ printf(" ind_r =%lu\n", ind_r);
3456
+ }
3457
+ #endif /* _DEBUG */
3458
+ rb_bug("ERROR(VpDivd): space for remainder too small.");
3459
+
3460
+ Exit:
3461
+ #ifdef _DEBUG
3462
+ if(gfDebug) {
3463
+ VPrint(stdout, " VpDivd(c=a/b), c=% \n", c);
3464
+ VPrint(stdout, " r=% \n", r);
3465
+ }
3466
+ #endif /* _DEBUG */
3467
+ return c->Prec*BASE_FIG;
3468
+ }
3469
+
3470
+ /*
3471
+ * Input a = 00000xxxxxxxx En(5 preceeding zeros)
3472
+ * Output a = xxxxxxxx En-5
3473
+ */
3474
+ static int
3475
+ VpNmlz(Real *a)
3476
+ {
3477
+ U_LONG ind_a, i;
3478
+
3479
+ if(!VpIsDef(a)) goto NoVal;
3480
+ if(VpIsZero(a)) goto NoVal;
3481
+
3482
+ ind_a = a->Prec;
3483
+ while(ind_a--) {
3484
+ if(a->frac[ind_a]) {
3485
+ a->Prec = ind_a + 1;
3486
+ i = 0;
3487
+ while(a->frac[i] == 0) ++i; /* skip the first few zeros */
3488
+ if(i) {
3489
+ a->Prec -= i;
3490
+ if(!AddExponent(a,-((S_INT)i))) return 0;
3491
+ memmove(&(a->frac[0]),&(a->frac[i]),(a->Prec)*sizeof(U_LONG));
3492
+ }
3493
+ return 1;
3494
+ }
3495
+ }
3496
+ /* a is zero(no non-zero digit) */
3497
+ VpSetZero(a,VpGetSign(a));
3498
+ return 0;
3499
+
3500
+ NoVal:
3501
+ a->frac[0] = 0;
3502
+ a->Prec=1;
3503
+ return 0;
3504
+ }
3505
+
3506
+ /*
3507
+ * VpComp = 0 ... if a=b,
3508
+ * Pos ... a>b,
3509
+ * Neg ... a<b.
3510
+ * 999 ... result undefined(NaN)
3511
+ */
3512
+ VP_EXPORT int
3513
+ VpComp(Real *a, Real *b)
3514
+ {
3515
+ int val;
3516
+ U_LONG mx, ind;
3517
+ int e;
3518
+ val = 0;
3519
+ if(VpIsNaN(a)||VpIsNaN(b)) return 999;
3520
+ if(!VpIsDef(a)) {
3521
+ if(!VpIsDef(b)) e = a->sign - b->sign;
3522
+ else e = a->sign;
3523
+ if(e>0) return 1;
3524
+ else if(e<0) return -1;
3525
+ else return 0;
3526
+ }
3527
+ if(!VpIsDef(b)) {
3528
+ e = -b->sign;
3529
+ if(e>0) return 1;
3530
+ else return -1;
3531
+ }
3532
+ /* Zero check */
3533
+ if(VpIsZero(a)) {
3534
+ if(VpIsZero(b)) return 0; /* both zero */
3535
+ val = -VpGetSign(b);
3536
+ goto Exit;
3537
+ }
3538
+ if(VpIsZero(b)) {
3539
+ val = VpGetSign(a);
3540
+ goto Exit;
3541
+ }
3542
+
3543
+ /* compare sign */
3544
+ if(VpGetSign(a) > VpGetSign(b)) {
3545
+ val = 1; /* a>b */
3546
+ goto Exit;
3547
+ }
3548
+ if(VpGetSign(a) < VpGetSign(b)) {
3549
+ val = -1; /* a<b */
3550
+ goto Exit;
3551
+ }
3552
+
3553
+ /* a and b have same sign, && signe!=0,then compare exponent */
3554
+ if((a->exponent) >(b->exponent)) {
3555
+ val = VpGetSign(a);
3556
+ goto Exit;
3557
+ }
3558
+ if((a->exponent) <(b->exponent)) {
3559
+ val = -VpGetSign(b);
3560
+ goto Exit;
3561
+ }
3562
+
3563
+ /* a and b have same exponent, then compare significand. */
3564
+ mx =((a->Prec) <(b->Prec)) ?(a->Prec) :(b->Prec);
3565
+ ind = 0;
3566
+ while(ind < mx) {
3567
+ if((a->frac[ind]) >(b->frac[ind])) {
3568
+ val = VpGetSign(a);
3569
+ goto Exit;
3570
+ }
3571
+ if((a->frac[ind]) <(b->frac[ind])) {
3572
+ val = -VpGetSign(b);
3573
+ goto Exit;
3574
+ }
3575
+ ++ind;
3576
+ }
3577
+ if((a->Prec) >(b->Prec)) {
3578
+ val = VpGetSign(a);
3579
+ } else if((a->Prec) <(b->Prec)) {
3580
+ val = -VpGetSign(b);
3581
+ }
3582
+
3583
+ Exit:
3584
+ if (val> 1) val = 1;
3585
+ else if(val<-1) val = -1;
3586
+
3587
+ #ifdef _DEBUG
3588
+ if(gfDebug) {
3589
+ VPrint(stdout, " VpComp a=%\n", a);
3590
+ VPrint(stdout, " b=%\n", b);
3591
+ printf(" ans=%d\n", val);
3592
+ }
3593
+ #endif /* _DEBUG */
3594
+ return (int)val;
3595
+ }
3596
+
3597
+ #ifdef _DEBUG
3598
+ /*
3599
+ * cntl_chr ... ASCIIZ Character, print control characters
3600
+ * Available control codes:
3601
+ * % ... VP variable. To print '%', use '%%'.
3602
+ * \n ... new line
3603
+ * \b ... backspace
3604
+ * ... tab
3605
+ * Note: % must must not appear more than once
3606
+ * a ... VP variable to be printed
3607
+ */
3608
+ VP_EXPORT int
3609
+ VPrint(FILE *fp, char *cntl_chr, Real *a)
3610
+ {
3611
+ U_LONG i, j, nc, nd, ZeroSup;
3612
+ U_LONG n, m, e, nn;
3613
+
3614
+ /* Check if NaN & Inf. */
3615
+ if(VpIsNaN(a)) {
3616
+ fprintf(fp,SZ_NaN);
3617
+ return 8;
3618
+ }
3619
+ if(VpIsPosInf(a)) {
3620
+ fprintf(fp,SZ_INF);
3621
+ return 8;
3622
+ }
3623
+ if(VpIsNegInf(a)) {
3624
+ fprintf(fp,SZ_NINF);
3625
+ return 9;
3626
+ }
3627
+ if(VpIsZero(a)) {
3628
+ fprintf(fp,"0.0");
3629
+ return 3;
3630
+ }
3631
+
3632
+ j = 0;
3633
+ nd = nc = 0; /* nd : number of digits in fraction part(every 10 digits, */
3634
+ /* nd<=10). */
3635
+ /* nc : number of caracters printed */
3636
+ ZeroSup = 1; /* Flag not to print the leading zeros as 0.00xxxxEnn */
3637
+ while(*(cntl_chr + j)) {
3638
+ if((*(cntl_chr + j) == '%') &&(*(cntl_chr + j + 1) != '%')) {
3639
+ nc = 0;
3640
+ if(!VpIsZero(a)) {
3641
+ if(VpGetSign(a) < 0) {
3642
+ fprintf(fp, "-");
3643
+ ++nc;
3644
+ }
3645
+ nc += fprintf(fp, "0.");
3646
+ n = a->Prec;
3647
+ for(i=0;i < n;++i) {
3648
+ m = BASE1;
3649
+ e = a->frac[i];
3650
+ while(m) {
3651
+ nn = e / m;
3652
+ if((!ZeroSup) || nn) {
3653
+ nc += fprintf(fp, "%lu", nn); /* The reading zero(s) */
3654
+ /* as 0.00xx will not */
3655
+ /* be printed. */
3656
+ ++nd;
3657
+ ZeroSup = 0; /* Set to print succeeding zeros */
3658
+ }
3659
+ if(nd >= 10) { /* print ' ' after every 10 digits */
3660
+ nd = 0;
3661
+ nc += fprintf(fp, " ");
3662
+ }
3663
+ e = e - nn * m;
3664
+ m /= 10;
3665
+ }
3666
+ }
3667
+ nc += fprintf(fp, "E%ld", VpExponent10(a));
3668
+ } else {
3669
+ nc += fprintf(fp, "0.0");
3670
+ }
3671
+ } else {
3672
+ ++nc;
3673
+ if(*(cntl_chr + j) == '\\') {
3674
+ switch(*(cntl_chr + j + 1)) {
3675
+ case 'n':
3676
+ fprintf(fp, "\n");
3677
+ ++j;
3678
+ break;
3679
+ case 't':
3680
+ fprintf(fp, "\t");
3681
+ ++j;
3682
+ break;
3683
+ case 'b':
3684
+ fprintf(fp, "\n");
3685
+ ++j;
3686
+ break;
3687
+ default:
3688
+ fprintf(fp, "%c", *(cntl_chr + j));
3689
+ break;
3690
+ }
3691
+ } else {
3692
+ fprintf(fp, "%c", *(cntl_chr + j));
3693
+ if(*(cntl_chr + j) == '%') ++j;
3694
+ }
3695
+ }
3696
+ j++;
3697
+ }
3698
+ return (int)nc;
3699
+ }
3700
+ #endif /* _DEBUG */
3701
+
3702
+ static void
3703
+ VpFormatSt(char *psz,S_INT fFmt)
3704
+ {
3705
+ U_LONG ie;
3706
+ U_LONG i;
3707
+ S_INT nf = 0;
3708
+ char ch;
3709
+
3710
+ if(fFmt<=0) return;
3711
+
3712
+ ie = strlen(psz);
3713
+ for(i = 0; i < ie; ++i) {
3714
+ ch = psz[i];
3715
+ if(!ch) break;
3716
+ if(ISSPACE(ch) || ch=='-' || ch=='+') continue;
3717
+ if(ch == '.') { nf = 0;continue;}
3718
+ if(ch == 'E') break;
3719
+ nf++;
3720
+ if(nf > fFmt) {
3721
+ memmove(psz + i + 1, psz + i, ie - i + 1);
3722
+ ++ie;
3723
+ nf = 0;
3724
+ psz[i] = ' ';
3725
+ }
3726
+ }
3727
+ }
3728
+
3729
+ VP_EXPORT S_LONG
3730
+ VpExponent10(Real *a)
3731
+ {
3732
+ S_LONG ex;
3733
+ U_LONG n;
3734
+
3735
+ if(!VpHasVal(a)) return 0;
3736
+
3737
+ ex =(a->exponent) * BASE_FIG;
3738
+ n = BASE1;
3739
+ while((a->frac[0] / n) == 0) {
3740
+ --ex;
3741
+ n /= 10;
3742
+ }
3743
+ return ex;
3744
+ }
3745
+
3746
+ VP_EXPORT void
3747
+ VpSzMantissa(Real *a,char *psz)
3748
+ {
3749
+ U_LONG i, ZeroSup;
3750
+ U_LONG n, m, e, nn;
3751
+
3752
+ if(VpIsNaN(a)) {
3753
+ sprintf(psz,SZ_NaN);
3754
+ return;
3755
+ }
3756
+ if(VpIsPosInf(a)) {
3757
+ sprintf(psz,SZ_INF);
3758
+ return;
3759
+ }
3760
+ if(VpIsNegInf(a)) {
3761
+ sprintf(psz,SZ_NINF);
3762
+ return;
3763
+ }
3764
+
3765
+ ZeroSup = 1; /* Flag not to print the leading zeros as 0.00xxxxEnn */
3766
+ if(!VpIsZero(a)) {
3767
+ if(VpGetSign(a) < 0) *psz++ = '-';
3768
+ n = a->Prec;
3769
+ for(i=0;i < n;++i) {
3770
+ m = BASE1;
3771
+ e = a->frac[i];
3772
+ while(m) {
3773
+ nn = e / m;
3774
+ if((!ZeroSup) || nn) {
3775
+ sprintf(psz, "%lu", nn); /* The reading zero(s) */
3776
+ psz += strlen(psz);
3777
+ /* as 0.00xx will be ignored. */
3778
+ ZeroSup = 0; /* Set to print succeeding zeros */
3779
+ }
3780
+ e = e - nn * m;
3781
+ m /= 10;
3782
+ }
3783
+ }
3784
+ *psz = 0;
3785
+ while(psz[-1]=='0') *(--psz) = 0;
3786
+ } else {
3787
+ if(VpIsPosZero(a)) sprintf(psz, "0");
3788
+ else sprintf(psz, "-0");
3789
+ }
3790
+ }
3791
+
3792
+ VP_EXPORT int
3793
+ VpToSpecialString(Real *a,char *psz,int fPlus)
3794
+ /* fPlus =0:default, =1: set ' ' before digits , =2: set '+' before digits. */
3795
+ {
3796
+ if(VpIsNaN(a)) {
3797
+ sprintf(psz,SZ_NaN);
3798
+ return 1;
3799
+ }
3800
+
3801
+ if(VpIsPosInf(a)) {
3802
+ if(fPlus==1) {
3803
+ *psz++ = ' ';
3804
+ } else if(fPlus==2) {
3805
+ *psz++ = '+';
3806
+ }
3807
+ sprintf(psz,SZ_INF);
3808
+ return 1;
3809
+ }
3810
+ if(VpIsNegInf(a)) {
3811
+ sprintf(psz,SZ_NINF);
3812
+ return 1;
3813
+ }
3814
+ if(VpIsZero(a)) {
3815
+ if(VpIsPosZero(a)) {
3816
+ if(fPlus==1) sprintf(psz, " 0.0");
3817
+ else if(fPlus==2) sprintf(psz, "+0.0");
3818
+ else sprintf(psz, "0.0");
3819
+ } else sprintf(psz, "-0.0");
3820
+ return 1;
3821
+ }
3822
+ return 0;
3823
+ }
3824
+
3825
+ VP_EXPORT void
3826
+ VpToString(Real *a,char *psz,int fFmt,int fPlus)
3827
+ /* fPlus =0:default, =1: set ' ' before digits , =2:set '+' before digits. */
3828
+ {
3829
+ U_LONG i, ZeroSup;
3830
+ U_LONG n, m, e, nn;
3831
+ char *pszSav = psz;
3832
+ S_LONG ex;
3833
+
3834
+ if(VpToSpecialString(a,psz,fPlus)) return;
3835
+
3836
+ ZeroSup = 1; /* Flag not to print the leading zeros as 0.00xxxxEnn */
3837
+
3838
+ if(VpGetSign(a) < 0) *psz++ = '-';
3839
+ else if(fPlus==1) *psz++ = ' ';
3840
+ else if(fPlus==2) *psz++ = '+';
3841
+
3842
+ *psz++ = '0';
3843
+ *psz++ = '.';
3844
+ n = a->Prec;
3845
+ for(i=0;i < n;++i) {
3846
+ m = BASE1;
3847
+ e = a->frac[i];
3848
+ while(m) {
3849
+ nn = e / m;
3850
+ if((!ZeroSup) || nn) {
3851
+ sprintf(psz, "%lu", nn); /* The reading zero(s) */
3852
+ psz += strlen(psz);
3853
+ /* as 0.00xx will be ignored. */
3854
+ ZeroSup = 0; /* Set to print succeeding zeros */
3855
+ }
3856
+ e = e - nn * m;
3857
+ m /= 10;
3858
+ }
3859
+ }
3860
+ ex =(a->exponent) * BASE_FIG;
3861
+ n = BASE1;
3862
+ while((a->frac[0] / n) == 0) {
3863
+ --ex;
3864
+ n /= 10;
3865
+ }
3866
+ while(psz[-1]=='0') *(--psz) = 0;
3867
+ sprintf(psz, "E%ld", ex);
3868
+ if(fFmt) VpFormatSt(pszSav, fFmt);
3869
+ }
3870
+
3871
+ VP_EXPORT void
3872
+ VpToFString(Real *a,char *psz,int fFmt,int fPlus)
3873
+ /* fPlus =0:default,=1: set ' ' before digits ,set '+' before digits. */
3874
+ {
3875
+ U_LONG i;
3876
+ U_LONG n, m, e, nn;
3877
+ char *pszSav = psz;
3878
+ S_LONG ex;
3879
+
3880
+ if(VpToSpecialString(a,psz,fPlus)) return;
3881
+
3882
+ if(VpGetSign(a) < 0) *psz++ = '-';
3883
+ else if(fPlus==1) *psz++ = ' ';
3884
+ else if(fPlus==2) *psz++ = '+';
3885
+
3886
+ n = a->Prec;
3887
+ ex = a->exponent;
3888
+ if(ex<=0) {
3889
+ *psz++ = '0';*psz++ = '.';
3890
+ while(ex<0) {
3891
+ for(i=0;i<BASE_FIG;++i) *psz++ = '0';
3892
+ ++ex;
3893
+ }
3894
+ ex = -1;
3895
+ }
3896
+
3897
+ for(i=0;i < n;++i) {
3898
+ --ex;
3899
+ if(i==0 && ex >= 0) {
3900
+ sprintf(psz, "%lu", a->frac[i]);
3901
+ psz += strlen(psz);
3902
+ } else {
3903
+ m = BASE1;
3904
+ e = a->frac[i];
3905
+ while(m) {
3906
+ nn = e / m;
3907
+ *psz++ = (char)(nn + '0');
3908
+ e = e - nn * m;
3909
+ m /= 10;
3910
+ }
3911
+ }
3912
+ if(ex == 0) *psz++ = '.';
3913
+ }
3914
+ while(--ex>=0) {
3915
+ m = BASE;
3916
+ while(m/=10) *psz++ = '0';
3917
+ if(ex == 0) *psz++ = '.';
3918
+ }
3919
+ *psz = 0;
3920
+ while(psz[-1]=='0') *(--psz) = 0;
3921
+ if(psz[-1]=='.') sprintf(psz, "0");
3922
+ if(fFmt) VpFormatSt(pszSav, fFmt);
3923
+ }
3924
+
3925
+ /*
3926
+ * [Output]
3927
+ * a[] ... variable to be assigned the value.
3928
+ * [Input]
3929
+ * int_chr[] ... integer part(may include '+/-').
3930
+ * ni ... number of characters in int_chr[],not including '+/-'.
3931
+ * frac[] ... fraction part.
3932
+ * nf ... number of characters in frac[].
3933
+ * exp_chr[] ... exponent part(including '+/-').
3934
+ * ne ... number of characters in exp_chr[],not including '+/-'.
3935
+ */
3936
+ VP_EXPORT int
3937
+ VpCtoV(Real *a, const char *int_chr, U_LONG ni, const char *frac, U_LONG nf, const char *exp_chr, U_LONG ne)
3938
+ {
3939
+ U_LONG i, j, ind_a, ma, mi, me;
3940
+ U_LONG loc;
3941
+ S_INT e,es, eb, ef;
3942
+ S_INT sign, signe;
3943
+ /* get exponent part */
3944
+ e = 0;
3945
+ ma = a->MaxPrec;
3946
+ mi = ni;
3947
+ me = ne;
3948
+ signe = 1;
3949
+ memset(a->frac, 0, ma * sizeof(U_LONG));
3950
+ if(ne > 0) {
3951
+ i = 0;
3952
+ if(exp_chr[0] == '-') {
3953
+ signe = -1;
3954
+ ++i;
3955
+ ++me;
3956
+ } else if(exp_chr[0] == '+') {
3957
+ ++i;
3958
+ ++me;
3959
+ }
3960
+ while(i < me) {
3961
+ es = e*((S_INT)BASE_FIG);
3962
+ e = e * 10 + exp_chr[i] - '0';
3963
+ if(es>e*((S_INT)BASE_FIG)) {
3964
+ return VpException(VP_EXCEPTION_INFINITY,"exponent overflow",0);
3965
+ }
3966
+ ++i;
3967
+ }
3968
+ }
3969
+
3970
+ /* get integer part */
3971
+ i = 0;
3972
+ sign = 1;
3973
+ if(ni >= 0) {
3974
+ if(int_chr[0] == '-') {
3975
+ sign = -1;
3976
+ ++i;
3977
+ ++mi;
3978
+ } else if(int_chr[0] == '+') {
3979
+ ++i;
3980
+ ++mi;
3981
+ }
3982
+ }
3983
+
3984
+ e = signe * e; /* e: The value of exponent part. */
3985
+ e = e + ni; /* set actual exponent size. */
3986
+
3987
+ if(e > 0) signe = 1;
3988
+ else signe = -1;
3989
+
3990
+ /* Adjust the exponent so that it is the multiple of BASE_FIG. */
3991
+ j = 0;
3992
+ ef = 1;
3993
+ while(ef) {
3994
+ if(e>=0) eb = e;
3995
+ else eb = -e;
3996
+ ef = eb / ((S_INT)BASE_FIG);
3997
+ ef = eb - ef * ((S_INT)BASE_FIG);
3998
+ if(ef) {
3999
+ ++j; /* Means to add one more preceeding zero */
4000
+ ++e;
4001
+ }
4002
+ }
4003
+
4004
+ eb = e / ((S_INT)BASE_FIG);
4005
+
4006
+ ind_a = 0;
4007
+ while(i < mi) {
4008
+ a->frac[ind_a] = 0;
4009
+ while((j < (U_LONG)BASE_FIG) &&(i < mi)) {
4010
+ a->frac[ind_a] = a->frac[ind_a] * 10 + int_chr[i] - '0';
4011
+ ++j;
4012
+ ++i;
4013
+ }
4014
+ if(i < mi) {
4015
+ ++ind_a;
4016
+ if(ind_a >= ma) goto over_flow;
4017
+ j = 0;
4018
+ }
4019
+ }
4020
+ loc = 1;
4021
+
4022
+ /* get fraction part */
4023
+
4024
+ i = 0;
4025
+ while(i < nf) {
4026
+ while((j < (U_LONG)BASE_FIG) &&(i < nf)) {
4027
+ a->frac[ind_a] = a->frac[ind_a] * 10 + frac[i] - '0';
4028
+ ++j;
4029
+ ++i;
4030
+ }
4031
+ if(i < nf) {
4032
+ ++ind_a;
4033
+ if(ind_a >= ma) goto over_flow;
4034
+ j = 0;
4035
+ }
4036
+ }
4037
+ goto Final;
4038
+
4039
+ over_flow:
4040
+ rb_warn("Conversion from String to BigDecimal overflow (last few digits discarded).");
4041
+
4042
+ Final:
4043
+ if(ind_a >= ma) ind_a = ma - 1;
4044
+ while(j < (U_LONG)BASE_FIG) {
4045
+ a->frac[ind_a] = a->frac[ind_a] * 10;
4046
+ ++j;
4047
+ }
4048
+ a->Prec = ind_a + 1;
4049
+ a->exponent = eb;
4050
+ VpSetSign(a,sign);
4051
+ VpNmlz(a);
4052
+ return 1;
4053
+ }
4054
+
4055
+ /*
4056
+ * [Input]
4057
+ * *m ... Real
4058
+ * [Output]
4059
+ * *d ... fraction part of m(d = 0.xxxxxxx). where # of 'x's is fig.
4060
+ * *e ... U_LONG,exponent of m.
4061
+ * DBLE_FIG ... Number of digits in a double variable.
4062
+ *
4063
+ * m -> d*10**e, 0<d<BASE
4064
+ * [Returns]
4065
+ * 0 ... Zero
4066
+ * 1 ... Normal
4067
+ * 2 ... Infinity
4068
+ * -1 ... NaN
4069
+ */
4070
+ VP_EXPORT int
4071
+ VpVtoD(double *d, S_LONG *e, Real *m)
4072
+ {
4073
+ U_LONG ind_m, mm, fig;
4074
+ double div;
4075
+ int f = 1;
4076
+
4077
+ if(VpIsNaN(m)) {
4078
+ *d = VpGetDoubleNaN();
4079
+ *e = 0;
4080
+ f = -1; /* NaN */
4081
+ goto Exit;
4082
+ } else
4083
+ if(VpIsPosZero(m)) {
4084
+ *d = 0.0;
4085
+ *e = 0;
4086
+ f = 0;
4087
+ goto Exit;
4088
+ } else
4089
+ if(VpIsNegZero(m)) {
4090
+ *d = VpGetDoubleNegZero();
4091
+ *e = 0;
4092
+ f = 0;
4093
+ goto Exit;
4094
+ } else
4095
+ if(VpIsPosInf(m)) {
4096
+ *d = VpGetDoublePosInf();
4097
+ *e = 0;
4098
+ f = 2;
4099
+ goto Exit;
4100
+ } else
4101
+ if(VpIsNegInf(m)) {
4102
+ *d = VpGetDoubleNegInf();
4103
+ *e = 0;
4104
+ f = 2;
4105
+ goto Exit;
4106
+ }
4107
+ /* Normal number */
4108
+ fig =(DBLE_FIG + BASE_FIG - 1) / BASE_FIG;
4109
+ ind_m = 0;
4110
+ mm = Min(fig,(m->Prec));
4111
+ *d = 0.0;
4112
+ div = 1.;
4113
+ while(ind_m < mm) {
4114
+ div /=(double)((S_INT)BASE);
4115
+ *d = *d +((double) ((S_INT)m->frac[ind_m++])) * div;
4116
+ }
4117
+ *e = m->exponent * ((S_INT)BASE_FIG);
4118
+ *d *= VpGetSign(m);
4119
+
4120
+ Exit:
4121
+ #ifdef _DEBUG
4122
+ if(gfDebug) {
4123
+ VPrint(stdout, " VpVtoD: m=%\n", m);
4124
+ printf(" d=%e * 10 **%ld\n", *d, *e);
4125
+ printf(" DBLE_FIG = %ld\n", DBLE_FIG);
4126
+ }
4127
+ #endif /*_DEBUG */
4128
+ return f;
4129
+ }
4130
+
4131
+ /*
4132
+ * m <- d
4133
+ */
4134
+ VP_EXPORT void
4135
+ VpDtoV(Real *m, double d)
4136
+ {
4137
+ U_LONG i, ind_m, mm;
4138
+ U_LONG ne;
4139
+ double val, val2;
4140
+
4141
+ if(isnan(d)) {
4142
+ VpSetNaN(m);
4143
+ goto Exit;
4144
+ }
4145
+ if(isinf(d)) {
4146
+ if(d>0.0) VpSetPosInf(m);
4147
+ else VpSetNegInf(m);
4148
+ goto Exit;
4149
+ }
4150
+
4151
+ if(d == 0.0) {
4152
+ VpSetZero(m,1);
4153
+ goto Exit;
4154
+ }
4155
+ val =(d > 0.) ? d :(-d);
4156
+ ne = 0;
4157
+ if(val >= 1.0) {
4158
+ while(val >= 1.0) {
4159
+ val /=(double)((S_INT)BASE);
4160
+ ++ne;
4161
+ }
4162
+ } else {
4163
+ val2 = 1.0 /(double)((S_INT)BASE);
4164
+ while(val < val2) {
4165
+ val *=(double)((S_INT)BASE);
4166
+ --ne;
4167
+ }
4168
+ }
4169
+ /* Now val = 0.xxxxx*BASE**ne */
4170
+
4171
+ mm = m->MaxPrec;
4172
+ memset(m->frac, 0, mm * sizeof(U_LONG));
4173
+ for(ind_m = 0;val > 0.0 && ind_m < mm;ind_m++) {
4174
+ val *=(double)((S_INT)BASE);
4175
+ i =(U_LONG) val;
4176
+ val -=(double)((S_INT)i);
4177
+ m->frac[ind_m] = i;
4178
+ }
4179
+ if(ind_m >= mm) ind_m = mm - 1;
4180
+ if(d > 0.0) {
4181
+ VpSetSign(m, (S_INT)1);
4182
+ } else {
4183
+ VpSetSign(m,-(S_INT)1);
4184
+ }
4185
+ m->Prec = ind_m + 1;
4186
+ m->exponent = ne;
4187
+
4188
+ VpInternalRound(m,0,(m->Prec>0)?m->frac[m->Prec-1]:0,
4189
+ (U_LONG)(val*((double)((S_INT)BASE))));
4190
+
4191
+ Exit:
4192
+ #ifdef _DEBUG
4193
+ if(gfDebug) {
4194
+ printf("VpDtoV d=%30.30e\n", d);
4195
+ VPrint(stdout, " m=%\n", m);
4196
+ }
4197
+ #endif /* _DEBUG */
4198
+ return;
4199
+ }
4200
+
4201
+ #if 0
4202
+ /*
4203
+ * m <- ival
4204
+ */
4205
+ VP_EXPORT void
4206
+ VpItoV(Real *m, S_INT ival)
4207
+ {
4208
+ U_LONG mm, ind_m;
4209
+ U_LONG val, v1, v2, v;
4210
+ int isign;
4211
+ S_INT ne;
4212
+
4213
+ if(ival == 0) {
4214
+ VpSetZero(m,1);
4215
+ goto Exit;
4216
+ }
4217
+ isign = 1;
4218
+ val = ival;
4219
+ if(ival < 0) {
4220
+ isign = -1;
4221
+ val =(U_LONG)(-ival);
4222
+ }
4223
+ ne = 0;
4224
+ ind_m = 0;
4225
+ mm = m->MaxPrec;
4226
+ while(ind_m < mm) {
4227
+ m->frac[ind_m] = 0;
4228
+ ++ind_m;
4229
+ }
4230
+ ind_m = 0;
4231
+ while(val > 0) {
4232
+ if(val) {
4233
+ v1 = val;
4234
+ v2 = 1;
4235
+ while(v1 >= BASE) {
4236
+ v1 /= BASE;
4237
+ v2 *= BASE;
4238
+ }
4239
+ val = val - v2 * v1;
4240
+ v = v1;
4241
+ } else {
4242
+ v = 0;
4243
+ }
4244
+ m->frac[ind_m] = v;
4245
+ ++ind_m;
4246
+ ++ne;
4247
+ }
4248
+ m->Prec = ind_m - 1;
4249
+ m->exponent = ne;
4250
+ VpSetSign(m,isign);
4251
+ VpNmlz(m);
4252
+
4253
+ Exit:
4254
+ #ifdef _DEBUG
4255
+ if(gfDebug) {
4256
+ printf(" VpItoV i=%d\n", ival);
4257
+ VPrint(stdout, " m=%\n", m);
4258
+ }
4259
+ #endif /* _DEBUG */
4260
+ return;
4261
+ }
4262
+ #endif
4263
+
4264
+ /*
4265
+ * y = SQRT(x), y*y - x =>0
4266
+ */
4267
+ VP_EXPORT int
4268
+ VpSqrt(Real *y, Real *x)
4269
+ {
4270
+ Real *f = NULL;
4271
+ Real *r = NULL;
4272
+ S_LONG y_prec, f_prec;
4273
+ S_LONG n;
4274
+ S_LONG e;
4275
+ S_LONG prec;
4276
+ S_LONG nr;
4277
+ double val;
4278
+
4279
+ /* Zero, NaN or Infinity ? */
4280
+ if(!VpHasVal(x)) {
4281
+ if(VpIsZero(x)||VpGetSign(x)>0) {
4282
+ VpAsgn(y,x,1);
4283
+ goto Exit;
4284
+ }
4285
+ VpSetNaN(y);
4286
+ return VpException(VP_EXCEPTION_OP,"(VpSqrt) SQRT(NaN or negative value)",0);
4287
+ goto Exit;
4288
+ }
4289
+
4290
+ /* Negative ? */
4291
+ if(VpGetSign(x) < 0) {
4292
+ VpSetNaN(y);
4293
+ return VpException(VP_EXCEPTION_OP,"(VpSqrt) SQRT(negative value)",0);
4294
+ }
4295
+
4296
+ /* One ? */
4297
+ if(VpIsOne(x)) {
4298
+ VpSetOne(y);
4299
+ goto Exit;
4300
+ }
4301
+
4302
+ n = (S_LONG)y->MaxPrec;
4303
+ if((S_LONG)x->MaxPrec > n) n = (S_LONG)x->MaxPrec;
4304
+ /* allocate temporally variables */
4305
+ f = VpAlloc(y->MaxPrec *(BASE_FIG + 2), "#1");
4306
+ r = VpAlloc((n + n) *(BASE_FIG + 2), "#1");
4307
+
4308
+ nr = 0;
4309
+ y_prec = (S_LONG)y->MaxPrec;
4310
+ f_prec = (S_LONG)f->MaxPrec;
4311
+
4312
+ prec = x->exponent;
4313
+ if(prec > 0) ++prec;
4314
+ else --prec;
4315
+ prec = prec - (S_LONG)y->MaxPrec;
4316
+ VpVtoD(&val, &e, x); /* val <- x */
4317
+ e /= ((S_LONG)BASE_FIG);
4318
+ n = e / 2;
4319
+ if(e - n * 2 != 0) {
4320
+ val /=(double)((S_INT)BASE);
4321
+ n =(e + 1) / 2;
4322
+ }
4323
+ VpDtoV(y, sqrt(val)); /* y <- sqrt(val) */
4324
+ y->exponent += n;
4325
+ n = (DBLE_FIG + BASE_FIG - 1) / BASE_FIG;
4326
+ y->MaxPrec = (U_LONG)Min(n , y_prec);
4327
+ f->MaxPrec = y->MaxPrec + 1;
4328
+ n = y_prec*((S_LONG)BASE_FIG);
4329
+ if((U_LONG)n<maxnr) n = (U_LONG)maxnr;
4330
+ do {
4331
+ y->MaxPrec *= 2;
4332
+ if(y->MaxPrec > (U_LONG)y_prec) y->MaxPrec = (U_LONG)y_prec;
4333
+ f->MaxPrec = y->MaxPrec;
4334
+ VpDivd(f, r, x, y); /* f = x/y */
4335
+ VpAddSub(r, f, y, -1); /* r = f - y */
4336
+ VpMult(f, VpPt5, r); /* f = 0.5*r */
4337
+ if(VpIsZero(f)) goto converge;
4338
+ VpAddSub(r, f, y, 1); /* r = y + f */
4339
+ VpAsgn(y, r, 1); /* y = r */
4340
+ if(f->exponent <= prec) goto converge;
4341
+ } while(++nr < n);
4342
+ /* */
4343
+ #ifdef _DEBUG
4344
+ if(gfDebug) {
4345
+ printf("ERROR(VpSqrt): did not converge within %ld iterations.\n",
4346
+ nr);
4347
+ }
4348
+ #endif /* _DEBUG */
4349
+ y->MaxPrec = y_prec;
4350
+
4351
+ converge:
4352
+ VpChangeSign(y,(S_INT)1);
4353
+ #ifdef _DEBUG
4354
+ if(gfDebug) {
4355
+ VpMult(r, y, y);
4356
+ VpAddSub(f, x, r, -1);
4357
+ printf("VpSqrt: iterations = %lu\n", nr);
4358
+ VPrint(stdout, " y =% \n", y);
4359
+ VPrint(stdout, " x =% \n", x);
4360
+ VPrint(stdout, " x-y*y = % \n", f);
4361
+ }
4362
+ #endif /* _DEBUG */
4363
+ y->MaxPrec = y_prec;
4364
+
4365
+ Exit:
4366
+ VpFree(f);
4367
+ VpFree(r);
4368
+ return 1;
4369
+ }
4370
+
4371
+ /*
4372
+ *
4373
+ * f = 0: Round off/Truncate, 1: round up, 2:ceil, 3: floor, 4: Banker's rounding
4374
+ * nf: digit position for operation.
4375
+ *
4376
+ */
4377
+ VP_EXPORT int
4378
+ VpMidRound(Real *y, int f, int nf)
4379
+ /*
4380
+ * Round reletively from the decimal point.
4381
+ * f: rounding mode
4382
+ * nf: digit location to round from the the decimal point.
4383
+ */
4384
+ {
4385
+ /* fracf: any positive digit under rounding position? */
4386
+ /* fracf_1further: any positive digits under one further than the rounding position? */
4387
+ /* exptoadd: number of digits needed to compensate negative nf */
4388
+ int n,i,ix,ioffset,fracf,exptoadd, fracf_1further;
4389
+ U_LONG v,shifter;
4390
+ U_LONG div;
4391
+
4392
+ nf += y->exponent*((int)BASE_FIG);
4393
+ exptoadd=0;
4394
+ if (nf < 0) {
4395
+ /* rounding position too left(large). */
4396
+ if((f!=VP_ROUND_CEIL) && (f!=VP_ROUND_FLOOR)) {
4397
+ VpSetZero(y,VpGetSign(y)); /* truncate everything */
4398
+ return 0;
4399
+ }
4400
+ exptoadd = -nf;
4401
+ nf = 0;
4402
+ }
4403
+ /* ix: x->fraq[ix] contains round position */
4404
+ ix = nf/(int)BASE_FIG;
4405
+ if(((U_LONG)ix)>=y->Prec) return 0; /* Unable to round */
4406
+ ioffset = nf - ix*((int)BASE_FIG);
4407
+
4408
+ v = y->frac[ix];
4409
+ /* drop digits after pointed digit */
4410
+ n = BASE_FIG - ioffset - 1;
4411
+ for(shifter=1,i=0;i<n;++i) shifter *= 10;
4412
+ fracf = (v%(shifter*10) > 0);
4413
+ fracf_1further = ((v % shifter) > 0);
4414
+
4415
+ v /= shifter;
4416
+ div = v/10;
4417
+ v = v - div*10;
4418
+ for (i=ix+1; (size_t)i < y->Prec; i++) {
4419
+ if (y->frac[i] % BASE) {
4420
+ fracf = fracf_1further = 1;
4421
+ break;
4422
+ }
4423
+ }
4424
+
4425
+ memset(y->frac+ix+1, 0, (y->Prec - (ix+1)) * sizeof(U_LONG));
4426
+ switch(f) {
4427
+ case VP_ROUND_DOWN: /* Truncate */
4428
+ break;
4429
+ case VP_ROUND_UP: /* Roundup */
4430
+ if(fracf) ++div;
4431
+ break;
4432
+ case VP_ROUND_HALF_UP: /* Round half up */
4433
+ if(v>=5) ++div;
4434
+ break;
4435
+ case VP_ROUND_HALF_DOWN: /* Round half down */
4436
+ if (v > 5 || (v == 5 && fracf_1further)) ++div;
4437
+ break;
4438
+ case VP_ROUND_CEIL: /* ceil */
4439
+ if(fracf && (VpGetSign(y)>0)) ++div;
4440
+ break;
4441
+ case VP_ROUND_FLOOR: /* floor */
4442
+ if(fracf && (VpGetSign(y)<0)) ++div;
4443
+ break;
4444
+ case VP_ROUND_HALF_EVEN: /* Banker's rounding */
4445
+ if(v>5) ++div;
4446
+ else if(v==5) {
4447
+ if (v > 5) ++div;
4448
+ else if (v == 5) {
4449
+ if (fracf_1further) {
4450
+ ++div;
4451
+ } else {
4452
+ if (ioffset == 0) {
4453
+ if (ix && (y->frac[ix-1] % 2)) ++div;
4454
+ } else {
4455
+ if (div % 2) ++div;
4456
+ }
4457
+ }
4458
+ }
4459
+ }
4460
+ break;
4461
+ }
4462
+ for(i=0;i<=n;++i) div *= 10;
4463
+ if(div>=BASE) {
4464
+ if(ix) {
4465
+ y->frac[ix] = 0;
4466
+ VpRdup(y,ix);
4467
+ } else {
4468
+ S_INT s = VpGetSign(y);
4469
+ int e = y->exponent;
4470
+ VpSetOne(y);
4471
+ VpSetSign(y,s);
4472
+ y->exponent = e+1;
4473
+ }
4474
+ } else {
4475
+ y->frac[ix] = div;
4476
+ VpNmlz(y);
4477
+ }
4478
+ if (exptoadd > 0) {
4479
+ y->exponent += exptoadd/BASE_FIG;
4480
+ exptoadd %= BASE_FIG;
4481
+ for(i=0;i<exptoadd;i++) {
4482
+ y->frac[0] *= 10;
4483
+ if (y->frac[0] >= BASE) {
4484
+ y->frac[0] /= BASE;
4485
+ y->exponent++;
4486
+ }
4487
+ }
4488
+ }
4489
+ return 1;
4490
+ }
4491
+
4492
+ VP_EXPORT int
4493
+ VpLeftRound(Real *y, int f, int nf)
4494
+ /*
4495
+ * Round from the left hand side of the digits.
4496
+ */
4497
+ {
4498
+ U_LONG v;
4499
+ if(!VpHasVal(y)) return 0; /* Unable to round */
4500
+ v = y->frac[0];
4501
+ nf -= VpExponent(y)*BASE_FIG;
4502
+ while((v /= 10) != 0) nf--;
4503
+ nf += (BASE_FIG-1);
4504
+ return VpMidRound(y,f,nf);
4505
+ }
4506
+
4507
+ VP_EXPORT int
4508
+ VpActiveRound(Real *y, Real *x, int f, int nf)
4509
+ {
4510
+ /* First,assign whole value in truncation mode */
4511
+ if(VpAsgn(y, x, 10)<=1) return 0; /* Zero,NaN,or Infinity */
4512
+ return VpMidRound(y,f,nf);
4513
+ }
4514
+
4515
+ static int
4516
+ VpLimitRound(Real *c,U_LONG ixDigit)
4517
+ {
4518
+ U_LONG ix = VpGetPrecLimit();
4519
+ if(!VpNmlz(c)) return -1;
4520
+ if(!ix) return 0;
4521
+ if(!ixDigit) ixDigit = c->Prec-1;
4522
+ if((ix+BASE_FIG-1)/BASE_FIG > ixDigit+1) return 0;
4523
+ return VpLeftRound(c,VpGetRoundMode(),ix);
4524
+ }
4525
+
4526
+ static void
4527
+ VpInternalRound(Real *c,int ixDigit,U_LONG vPrev,U_LONG v)
4528
+ {
4529
+ int f = 0;
4530
+
4531
+ if(VpLimitRound(c,ixDigit)) return;
4532
+ if(!v) return;
4533
+
4534
+ v /= BASE1;
4535
+ switch(gfRoundMode) {
4536
+ case VP_ROUND_DOWN:
4537
+ break;
4538
+ case VP_ROUND_UP:
4539
+ if(v) f = 1;
4540
+ break;
4541
+ case VP_ROUND_HALF_UP:
4542
+ if(v >= 5) f = 1;
4543
+ break;
4544
+ case VP_ROUND_HALF_DOWN:
4545
+ if(v >= 6) f = 1;
4546
+ break;
4547
+ case VP_ROUND_CEIL: /* ceil */
4548
+ if(v && (VpGetSign(c)>0)) f = 1;
4549
+ break;
4550
+ case VP_ROUND_FLOOR: /* floor */
4551
+ if(v && (VpGetSign(c)<0)) f = 1;
4552
+ break;
4553
+ case VP_ROUND_HALF_EVEN: /* Banker's rounding */
4554
+ if (v > 5) f = 1;
4555
+ else if (v == 5 && vPrev % 2) f = 1;
4556
+ break;
4557
+ }
4558
+ if(f) {
4559
+ VpRdup(c,ixDigit); /* round up */
4560
+ VpNmlz(c);
4561
+ }
4562
+ }
4563
+
4564
+ /*
4565
+ * Rounds up m(plus one to final digit of m).
4566
+ */
4567
+ static int
4568
+ VpRdup(Real *m,U_LONG ind_m)
4569
+ {
4570
+ U_LONG carry;
4571
+
4572
+ if(!ind_m) ind_m = m->Prec;
4573
+
4574
+ carry = 1;
4575
+ while(carry > 0 && (ind_m--)) {
4576
+ m->frac[ind_m] += carry;
4577
+ if(m->frac[ind_m] >= BASE) m->frac[ind_m] -= BASE;
4578
+ else carry = 0;
4579
+ }
4580
+ if(carry > 0) { /* Overflow,count exponent and set fraction part be 1 */
4581
+ if(!AddExponent(m,(S_LONG)1)) return 0;
4582
+ m->Prec = m->frac[0] = 1;
4583
+ } else {
4584
+ VpNmlz(m);
4585
+ }
4586
+ return 1;
4587
+ }
4588
+
4589
+ /*
4590
+ * y = x - fix(x)
4591
+ */
4592
+ VP_EXPORT void
4593
+ VpFrac(Real *y, Real *x)
4594
+ {
4595
+ U_LONG my, ind_y, ind_x;
4596
+
4597
+ if(!VpHasVal(x)) {
4598
+ VpAsgn(y,x,1);
4599
+ goto Exit;
4600
+ }
4601
+
4602
+ if(x->exponent > 0 && (U_LONG)x->exponent >= x->Prec) {
4603
+ VpSetZero(y,VpGetSign(x));
4604
+ goto Exit;
4605
+ } else if(x->exponent <= 0) {
4606
+ VpAsgn(y, x, 1);
4607
+ goto Exit;
4608
+ }
4609
+
4610
+ y->Prec = x->Prec -(U_LONG) x->exponent;
4611
+ y->Prec = Min(y->Prec, y->MaxPrec);
4612
+ y->exponent = 0;
4613
+ VpSetSign(y,VpGetSign(x));
4614
+ ind_y = 0;
4615
+ my = y->Prec;
4616
+ ind_x = x->exponent;
4617
+ while(ind_y < my) {
4618
+ y->frac[ind_y] = x->frac[ind_x];
4619
+ ++ind_y;
4620
+ ++ind_x;
4621
+ }
4622
+ VpNmlz(y);
4623
+
4624
+ Exit:
4625
+ #ifdef _DEBUG
4626
+ if(gfDebug) {
4627
+ VPrint(stdout, "VpFrac y=%\n", y);
4628
+ VPrint(stdout, " x=%\n", x);
4629
+ }
4630
+ #endif /* _DEBUG */
4631
+ return;
4632
+ }
4633
+
4634
+ /*
4635
+ * y = x ** n
4636
+ */
4637
+ VP_EXPORT int
4638
+ VpPower(Real *y, Real *x, S_INT n)
4639
+ {
4640
+ U_LONG s, ss;
4641
+ S_LONG sign;
4642
+ Real *w1 = NULL;
4643
+ Real *w2 = NULL;
4644
+
4645
+ if(VpIsZero(x)) {
4646
+ if(n==0) {
4647
+ VpSetOne(y);
4648
+ goto Exit;
4649
+ }
4650
+ sign = VpGetSign(x);
4651
+ if(n<0) {
4652
+ n = -n;
4653
+ if(sign<0) sign = (n%2)?(-1):(1);
4654
+ VpSetInf (y,sign);
4655
+ } else {
4656
+ if(sign<0) sign = (n%2)?(-1):(1);
4657
+ VpSetZero(y,sign);
4658
+ }
4659
+ goto Exit;
4660
+ }
4661
+ if(!VpIsDef(x)) {
4662
+ VpSetNaN(y); /* Not sure !!! */
4663
+ goto Exit;
4664
+ }
4665
+
4666
+ if((x->exponent == 1) &&(x->Prec == 1) &&(x->frac[0] == 1)) {
4667
+ /* abs(x) = 1 */
4668
+ VpSetOne(y);
4669
+ if(VpGetSign(x) > 0) goto Exit;
4670
+ if((n % 2) == 0) goto Exit;
4671
+ VpSetSign(y,-(S_INT)1);
4672
+ goto Exit;
4673
+ }
4674
+
4675
+ if(n > 0) sign = 1;
4676
+ else if(n < 0) {
4677
+ sign = -1;
4678
+ n = -n;
4679
+ } else {
4680
+ VpSetOne(y);
4681
+ goto Exit;
4682
+ }
4683
+
4684
+ /* Allocate working variables */
4685
+
4686
+ w1 = VpAlloc((y->MaxPrec + 2) * BASE_FIG, "#0");
4687
+ w2 = VpAlloc((w1->MaxPrec * 2 + 1) * BASE_FIG, "#0");
4688
+ /* calculation start */
4689
+
4690
+ VpAsgn(y, x, 1);
4691
+ --n;
4692
+ while(n > 0) {
4693
+ VpAsgn(w1, x, 1);
4694
+ s = 1;
4695
+ loop1: ss = s;
4696
+ s += s;
4697
+ if(s >(U_LONG) n) goto out_loop1;
4698
+ VpMult(w2, w1, w1);
4699
+ VpAsgn(w1, w2, 1);
4700
+ goto loop1;
4701
+ out_loop1:
4702
+ n -= ss;
4703
+ VpMult(w2, y, w1);
4704
+ VpAsgn(y, w2, 1);
4705
+ }
4706
+ if(sign < 0) {
4707
+ VpDivd(w1, w2, VpConstOne, y);
4708
+ VpAsgn(y, w1, 1);
4709
+ }
4710
+
4711
+ Exit:
4712
+ #ifdef _DEBUG
4713
+ if(gfDebug) {
4714
+ VPrint(stdout, "VpPower y=%\n", y);
4715
+ VPrint(stdout, "VpPower x=%\n", x);
4716
+ printf(" n=%d\n", n);
4717
+ }
4718
+ #endif /* _DEBUG */
4719
+ VpFree(w2);
4720
+ VpFree(w1);
4721
+ return 1;
4722
+ }
4723
+
4724
+ #ifdef _DEBUG
4725
+ int
4726
+ VpVarCheck(Real * v)
4727
+ /*
4728
+ * Checks the validity of the Real variable v.
4729
+ * [Input]
4730
+ * v ... Real *, variable to be checked.
4731
+ * [Returns]
4732
+ * 0 ... correct v.
4733
+ * other ... error
4734
+ */
4735
+ {
4736
+ U_LONG i;
4737
+
4738
+ if(v->MaxPrec <= 0) {
4739
+ printf("ERROR(VpVarCheck): Illegal Max. Precision(=%lu)\n",
4740
+ v->MaxPrec);
4741
+ return 1;
4742
+ }
4743
+ if((v->Prec <= 0) ||((v->Prec) >(v->MaxPrec))) {
4744
+ printf("ERROR(VpVarCheck): Illegal Precision(=%lu)\n", v->Prec);
4745
+ printf(" Max. Prec.=%lu\n", v->MaxPrec);
4746
+ return 2;
4747
+ }
4748
+ for(i = 0; i < v->Prec; ++i) {
4749
+ if((v->frac[i] >= BASE)) {
4750
+ printf("ERROR(VpVarCheck): Illegal fraction\n");
4751
+ printf(" Frac[%ld]=%lu\n", i, v->frac[i]);
4752
+ printf(" Prec. =%lu\n", v->Prec);
4753
+ printf(" Exp. =%d\n", v->exponent);
4754
+ printf(" BASE =%lu\n", BASE);
4755
+ return 3;
4756
+ }
4757
+ }
4758
+ return 0;
4759
+ }
4760
+ #endif /* _DEBUG */