ray 0.0.1 → 0.1.0.pre1

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