Mercurial > hg > xemacs-beta
annotate src/number-mp.c @ 5533:11da5b828d10
shell-command and shell-command-on-region API compliant with FSF 23.3.1
| author | Mats Lidell <mats.lidell@cag.se> |
|---|---|
| date | Sun, 31 Jul 2011 01:29:09 +0200 |
| parents | 2aa9cd456ae7 |
| children | c9e5612f5424 |
| rev | line source |
|---|---|
| 1983 | 1 /* Numeric types for XEmacs using the MP library. |
| 2 Copyright (C) 2004 Jerry James. | |
| 3 | |
| 4 This file is part of XEmacs. | |
| 5 | |
|
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
6 XEmacs is free software: you can redistribute it and/or modify it |
| 1983 | 7 under the terms of the GNU General Public License as published by the |
|
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
8 Free Software Foundation, either version 3 of the License, or (at your |
|
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
9 option) any later version. |
| 1983 | 10 |
| 11 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 14 for more details. | |
| 15 | |
| 16 You should have received a copy of the GNU General Public License | |
|
5405
2aa9cd456ae7
Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5231
diff
changeset
|
17 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 1983 | 18 |
| 19 /* Synched up with: Not in FSF. */ | |
| 20 | |
| 21 #include <config.h> | |
| 22 #include <limits.h> | |
| 23 #include <math.h> | |
| 24 #include "lisp.h" | |
| 25 | |
| 26 static MINT *bignum_bytesize, *bignum_long_sign_bit, *bignum_one, *bignum_two; | |
| 27 MINT *bignum_zero, *intern_bignum; | |
| 28 MINT *bignum_min_int, *bignum_max_int, *bignum_max_uint; | |
| 29 MINT *bignum_min_long, *bignum_max_long, *bignum_max_ulong; | |
| 30 short div_rem; | |
| 31 | |
| 32 char * | |
| 33 bignum_to_string (bignum b, int base) | |
| 34 { | |
| 35 REGISTER unsigned int i; | |
| 36 unsigned int bufsize = 128U, index = 0U; | |
| 37 int sign; | |
| 38 char *buffer = xnew_array (char, 128), *retval; | |
| 39 MINT *quo = MP_ITOM (0); | |
| 40 short rem; | |
| 41 | |
| 42 /* FIXME: signal something if base is < 2 or doesn't fit into a short. */ | |
| 43 | |
| 44 /* Save the sign for later */ | |
| 45 sign = MP_MCMP (b, bignum_zero); | |
| 46 | |
| 47 if (sign == 0) | |
| 48 { | |
| 49 XREALLOC_ARRAY (buffer, char, 2); | |
| 50 buffer[0] = '0'; | |
| 51 buffer[1] = '\0'; | |
| 52 return buffer; | |
| 53 } | |
| 54 /* Copy abs(b) into quo for destructive modification */ | |
| 55 else if (sign < 0) | |
| 56 MP_MSUB (bignum_zero, b, quo); | |
| 57 else | |
| 58 MP_MOVE (b, quo); | |
| 59 | |
| 60 quo = MP_ITOM (0); | |
| 61 | |
| 62 /* Loop over the digits of b (in BASE) and place each one into buffer */ | |
| 63 for (i = 0U; MP_MCMP(quo, bignum_zero) > 0; i++) | |
| 64 { | |
| 65 MP_SDIV (quo, base, quo, &rem); | |
| 66 if (index == bufsize) | |
| 67 { | |
| 68 bufsize <<= 1; | |
| 69 XREALLOC_ARRAY (buffer, char, bufsize); | |
| 70 } | |
| 71 buffer[index++] = rem < 10 ? rem + '0' : rem - 10 + 'a'; | |
| 72 } | |
| 73 MP_MFREE (quo); | |
| 74 | |
| 75 /* Reverse the digits, maybe add a minus sign, and add a null terminator */ | |
| 76 bufsize = index + (sign < 0 ? 1 : 0) + 1; | |
| 77 retval = xnew_array (char, bufsize); | |
| 78 if (sign < 0) | |
| 79 { | |
| 80 retval[0] = '-'; | |
| 81 i = 1; | |
| 82 } | |
| 83 else | |
| 84 i = 0; | |
| 85 for (; i < bufsize - 1; i++) | |
| 86 retval[i] = buffer[--index]; | |
| 87 retval[bufsize - 1] = '\0'; | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4802
diff
changeset
|
88 xfree (buffer); |
| 1983 | 89 return retval; |
| 90 } | |
| 91 | |
| 92 #define BIGNUM_TO_TYPE(type,accumtype) do { \ | |
| 93 MP_MULT (b, quo, quo); \ | |
| 94 for (i = 0U; i < sizeof(type); i++) \ | |
| 95 { \ | |
| 96 MP_SDIV (quo, 256, quo, &rem); \ | |
| 97 retval |= ((accumtype) rem) << (8 * i); \ | |
| 98 } \ | |
| 99 MP_MFREE (quo); \ | |
| 100 } while (0) | |
| 101 | |
| 102 int | |
| 103 bignum_to_int (bignum b) | |
| 104 { | |
| 105 short rem, sign; | |
| 106 unsigned int retval = 0; | |
| 107 REGISTER unsigned int i; | |
| 108 MINT *quo; | |
| 109 | |
| 110 sign = MP_MCMP (b, bignum_zero) < 0 ? -1 : 1; | |
| 111 quo = MP_ITOM (sign); | |
| 112 BIGNUM_TO_TYPE (int, unsigned int); | |
| 113 return ((int) retval) * sign; | |
| 114 } | |
| 115 | |
| 116 unsigned int | |
| 117 bignum_to_uint (bignum b) | |
| 118 { | |
| 119 short rem; | |
| 120 unsigned int retval = 0U; | |
| 121 REGISTER unsigned int i; | |
| 122 MINT *quo; | |
| 123 | |
| 124 quo = MP_ITOM (MP_MCMP (b, bignum_zero) < 0 ? -1 : 1); | |
| 125 BIGNUM_TO_TYPE (unsigned int, unsigned int); | |
| 126 return retval; | |
| 127 } | |
| 128 | |
| 129 long | |
| 130 bignum_to_long (bignum b) | |
| 131 { | |
| 132 short rem, sign; | |
| 133 unsigned long retval = 0L; | |
| 134 REGISTER unsigned int i; | |
| 135 MINT *quo; | |
| 136 | |
| 137 sign = MP_MCMP (b, bignum_zero) < 0 ? -1 : 1; | |
| 138 quo = MP_ITOM (sign); | |
| 139 BIGNUM_TO_TYPE (long, unsigned long); | |
| 140 return ((long) retval) * sign; | |
| 141 } | |
| 142 | |
| 143 unsigned long | |
| 144 bignum_to_ulong (bignum b) | |
| 145 { | |
| 146 short rem; | |
| 147 unsigned long retval = 0UL; | |
| 148 REGISTER unsigned int i; | |
| 149 MINT *quo; | |
| 150 | |
| 151 quo = MP_ITOM (MP_MCMP (b, bignum_zero) < 0 ? -1 : 1); | |
| 152 BIGNUM_TO_TYPE (unsigned long, unsigned long); | |
| 153 return retval; | |
| 154 } | |
| 155 | |
| 156 double | |
| 157 bignum_to_double (bignum b) | |
| 158 { | |
| 159 short rem, sign; | |
| 1990 | 160 double retval = 0.0, factor = 1.0; |
| 1983 | 161 REGISTER unsigned int i; |
| 162 MINT *quo; | |
| 163 | |
| 164 sign = MP_MCMP (b, bignum_zero) < 0 ? -1 : 1; | |
| 165 quo = MP_ITOM (sign); | |
| 166 MP_MULT (b, quo, quo); | |
| 1990 | 167 for (i = 0U; MP_MCMP (quo, bignum_zero) > 0; i++) |
| 1983 | 168 { |
| 169 MP_SDIV (quo, 256, quo, &rem); | |
| 1990 | 170 retval += rem * factor; |
| 171 factor *= 256.0; | |
| 1983 | 172 } |
| 173 MP_MFREE (quo); | |
| 174 return retval * sign; | |
| 175 } | |
| 176 | |
| 177 static short | |
| 178 char_to_number (char c) | |
| 179 { | |
| 180 if (c >= '0' && c <= '9') | |
| 181 return c - '0'; | |
| 182 if (c >= 'a' && c <= 'z') | |
| 183 return c - 'a' + 10; | |
| 184 if (c >= 'A' && c <= 'Z') | |
| 185 return c - 'A' + 10; | |
| 186 return -1; | |
| 187 } | |
| 188 | |
| 189 int | |
| 190 bignum_set_string (bignum b, const char *s, int base) | |
| 191 { | |
| 192 MINT *mbase; | |
| 193 short digit; | |
| 1993 | 194 int neg = 0; |
| 1983 | 195 |
| 196 if (base == 0) | |
| 197 { | |
| 198 if (s[0] == '0' && (s[1] == 'x' || s[1] == 'X')) | |
| 199 { | |
| 200 base = 16; | |
| 201 s += 2; | |
| 202 } | |
| 203 else if (*s == '0') | |
| 204 { | |
| 205 base = 8; | |
| 206 s++; | |
| 207 } | |
| 208 else | |
| 209 base = 10; | |
| 210 } | |
| 211 | |
| 212 /* FIXME: signal something if base is < 2 or doesn't fit into a short. */ | |
| 213 | |
| 1993 | 214 if (*s == '-') |
| 215 { | |
| 216 s++; | |
| 217 neg = 1; | |
| 218 } | |
| 219 | |
| 1983 | 220 mbase = MP_ITOM ((short) base); |
| 221 MP_MOVE (bignum_zero, b); | |
|
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
1993
diff
changeset
|
222 |
| 1983 | 223 for (digit = char_to_number (*s); digit >= 0 && digit < base; |
| 224 digit = char_to_number (*++s)) | |
| 225 { | |
| 226 MINT *temp; | |
| 227 | |
| 228 MP_MULT (b, mbase, b); | |
| 229 temp = MP_ITOM (digit); | |
| 230 MP_MADD (b, temp, b); | |
| 231 MP_MFREE (temp); | |
| 232 } | |
| 233 | |
| 1993 | 234 if (neg) |
| 235 MP_MSUB (bignum_zero, b, b); | |
| 236 | |
| 1983 | 237 return (digit >= 0) ? -1 : 0; |
| 238 } | |
| 239 | |
| 240 void | |
| 241 bignum_set_long (MINT *b, long l) | |
| 242 { | |
| 243 /* Negative l is hard, not least because -LONG_MIN == LONG_MIN. We pretend | |
| 244 that l is unsigned, then subtract off the amount equal to the sign bit. */ | |
| 245 bignum_set_ulong (b, (unsigned long) l); | |
| 246 if (l < 0L) | |
| 247 MP_MSUB (b, bignum_long_sign_bit, b); | |
| 248 } | |
| 249 | |
| 250 void | |
| 251 bignum_set_ulong (bignum b, unsigned long l) | |
| 252 { | |
| 253 REGISTER unsigned int i; | |
| 254 MINT *multiplier = MP_ITOM (1); | |
| 255 | |
| 256 MP_MOVE (bignum_zero, b); | |
| 257 for (i = 0UL; l > 0UL; l >>= 8, i++) | |
| 258 { | |
| 259 MINT *temp = MP_ITOM ((short) (l & 255)); | |
| 260 MP_MULT (multiplier, temp, temp); | |
| 261 MP_MADD (b, temp, b); | |
| 262 MP_MULT (multiplier, bignum_bytesize, multiplier); | |
| 263 MP_MFREE (temp); | |
| 264 } | |
| 265 MP_MFREE (multiplier); | |
| 266 } | |
| 267 | |
| 268 void | |
| 269 bignum_set_double (bignum b, double d) | |
| 270 { | |
| 271 REGISTER unsigned int i; | |
| 272 int negative = (d < 0) ? 1 : 0; | |
| 273 MINT *multiplier = MP_ITOM (1); | |
| 274 | |
| 275 MP_MOVE (bignum_zero, b); | |
| 276 if (negative) | |
| 277 d = -d; | |
| 278 for (i = 0UL; d > 0.0; d /= 256, i++) | |
| 279 { | |
| 280 MINT *temp = MP_ITOM ((short) fmod (d, 256.0)); | |
| 281 MP_MULT (multiplier, temp, temp); | |
| 282 MP_MADD (b, temp, b); | |
| 283 MP_MULT (multiplier, bignum_bytesize, multiplier); | |
| 284 MP_MFREE (temp); | |
| 285 } | |
| 286 MP_MFREE (multiplier); | |
| 287 if (negative) | |
| 288 MP_MSUB (bignum_zero, b, b); | |
| 289 } | |
| 290 | |
| 291 /* Return nonzero if b1 is exactly divisible by b2 */ | |
| 292 int | |
| 293 bignum_divisible_p (bignum b1, bignum b2) | |
| 294 { | |
| 295 int retval; | |
| 296 MINT *rem = MP_ITOM (0); | |
| 297 MP_MDIV (b1, b2, intern_bignum, rem); | |
| 298 retval = (MP_MCMP (rem, bignum_zero) == 0); | |
| 299 MP_MFREE (rem); | |
| 300 return retval; | |
| 301 } | |
| 302 | |
| 303 void bignum_ceil (bignum quotient, bignum N, bignum D) | |
| 304 { | |
| 305 MP_MDIV (N, D, quotient, intern_bignum); | |
| 306 if (MP_MCMP (intern_bignum, bignum_zero) > 0 && | |
| 307 MP_MCMP (quotient, bignum_zero) > 0) | |
| 308 MP_MADD (quotient, bignum_one, quotient); | |
| 309 } | |
| 310 | |
| 311 void bignum_floor (bignum quotient, bignum N, bignum D) | |
| 312 { | |
| 313 MP_MDIV (N, D, quotient, intern_bignum); | |
| 314 if (MP_MCMP (intern_bignum, bignum_zero) > 0 && | |
| 315 MP_MCMP (quotient, bignum_zero) < 0) | |
| 316 MP_MSUB (quotient, bignum_one, quotient); | |
| 317 } | |
| 318 | |
| 319 /* RESULT = N to the POWth power */ | |
| 320 void | |
| 321 bignum_pow (bignum result, bignum n, unsigned long pow) | |
| 322 { | |
| 323 MP_MOVE (bignum_one, result); | |
| 324 for ( ; pow > 0UL; pow--) | |
| 325 MP_MULT (result, n, result); | |
| 326 } | |
| 327 | |
| 328 /* lcm(b1,b2) = b1 * b2 / gcd(b1, b2) */ | |
| 329 void | |
| 330 bignum_lcm (bignum result, bignum b1, bignum b2) | |
| 331 { | |
| 332 MP_MULT (b1, b2, result); | |
| 333 MP_GCD (b1, b2, intern_bignum); | |
| 334 MP_MDIV (result, intern_bignum, result, intern_bignum); | |
| 335 } | |
| 336 | |
| 337 /* FIXME: We can't handle negative args, so right now we just make them | |
| 338 positive before doing anything else. How should we really handle negative | |
| 339 args? */ | |
| 340 #define bignum_bit_op(result, b1, b2, op) \ | |
| 341 REGISTER unsigned int i; \ | |
| 342 MINT *multiplier = MP_ITOM (1), *n1 = MP_ITOM (0), *n2 = MP_ITOM (0); \ | |
| 343 \ | |
| 344 if (MP_MCMP (bignum_zero, b1) > 0) \ | |
| 345 MP_MSUB (bignum_zero, b1, n1); \ | |
| 346 else \ | |
| 347 MP_MOVE (b1, n1); \ | |
| 348 if (MP_MCMP (bignum_zero, b2) > 0) \ | |
| 349 MP_MSUB (bignum_zero, b2, n2); \ | |
| 350 else \ | |
| 351 MP_MOVE (b2, n2); \ | |
| 352 \ | |
| 353 MP_MOVE (bignum_zero, result); \ | |
| 354 \ | |
| 355 for (i = 0UL; MP_MCMP (bignum_zero, n1) < 0 && \ | |
| 356 MP_MCMP (bignum_zero, n2) < 0; i++) \ | |
| 357 { \ | |
| 358 short byte1, byte2; \ | |
| 359 MINT *temp; \ | |
| 360 \ | |
| 361 MP_SDIV (n1, 256, n1, &byte1); \ | |
| 362 MP_SDIV (n2, 256, n2, &byte2); \ | |
| 363 temp = MP_ITOM (byte1 op byte2); \ | |
| 364 MP_MULT (multiplier, temp, temp); \ | |
| 365 MP_MADD (result, temp, result); \ | |
| 366 MP_MULT (multiplier, bignum_bytesize, multiplier); \ | |
| 367 MP_MFREE (temp); \ | |
| 368 } \ | |
| 369 MP_MFREE (n2); \ | |
| 370 MP_MFREE (n1); \ | |
| 371 MP_MFREE (multiplier) | |
| 372 | |
| 373 void | |
| 374 bignum_and (bignum result, bignum b1, bignum b2) | |
| 375 { | |
| 376 bignum_bit_op (result, b1, b2, &); | |
| 377 } | |
| 378 | |
| 379 void | |
| 380 bignum_ior (bignum result, bignum b1, bignum b2) | |
| 381 { | |
| 382 bignum_bit_op (result, b1, b2, |); | |
| 383 } | |
| 384 | |
| 385 void | |
| 386 bignum_xor (bignum result, bignum b1, bignum b2) | |
| 387 { | |
| 388 bignum_bit_op (result, b1, b2, ^); | |
| 389 } | |
| 390 | |
| 391 /* NOT is not well-defined for bignums ... where do you stop flipping bits? | |
| 392 We just flip until we see the last one. This is probably a bad idea. */ | |
| 393 void | |
| 394 bignum_not (bignum result, bignum b) | |
| 395 { | |
| 396 REGISTER unsigned int i; | |
| 397 MINT *multiplier = MP_ITOM (1), *n = MP_ITOM (0); | |
| 398 | |
| 399 if (MP_MCMP (bignum_zero, b) > 0) | |
| 400 MP_MSUB (bignum_zero, b, n); | |
| 401 else | |
| 402 MP_MOVE (b, n); | |
| 403 | |
| 404 MP_MOVE (bignum_zero, result); | |
| 405 | |
| 406 for (i = 0UL; MP_MCMP (bignum_zero, n) < 0; i++) | |
| 407 { | |
| 408 short byte; | |
| 409 MINT *temp; | |
| 410 | |
| 411 MP_SDIV (n, 256, n, &byte); | |
| 412 temp = MP_ITOM (~byte); | |
| 413 MP_MULT (multiplier, temp, temp); | |
| 414 MP_MADD (result, temp, result); | |
| 415 MP_MULT (multiplier, bignum_bytesize, multiplier); | |
| 416 MP_MFREE (temp); | |
| 417 } | |
| 418 MP_MFREE (n); | |
| 419 MP_MFREE (multiplier); | |
| 420 } | |
| 421 | |
| 422 void | |
| 423 bignum_setbit (bignum b, unsigned long bit) | |
| 424 { | |
| 425 bignum_pow (intern_bignum, bignum_two, bit); | |
| 426 bignum_ior (b, b, intern_bignum); | |
| 427 } | |
| 428 | |
| 429 /* This is so evil, even I feel queasy. */ | |
| 430 void | |
| 431 bignum_clrbit (bignum b, unsigned long bit) | |
| 432 { | |
| 433 MINT *num = MP_ITOM (0); | |
| 434 | |
| 435 /* See if the bit is already set, and subtract it off if not */ | |
| 436 MP_MOVE (b, intern_bignum); | |
| 437 bignum_pow (num, bignum_two, bit); | |
| 438 bignum_ior (intern_bignum, intern_bignum, num); | |
| 439 if (MP_MCMP (b, intern_bignum) == 0) | |
| 440 MP_MSUB (b, num, b); | |
| 441 MP_MFREE (num); | |
| 442 } | |
| 443 | |
| 444 int | |
| 445 bignum_testbit (bignum b, unsigned long bit) | |
| 446 { | |
| 447 bignum_pow (intern_bignum, bignum_two, bit); | |
| 448 bignum_and (intern_bignum, b, intern_bignum); | |
| 449 return MP_MCMP (intern_bignum, bignum_zero); | |
| 450 } | |
| 451 | |
| 452 void | |
| 453 bignum_lshift (bignum result, bignum b, unsigned long bits) | |
| 454 { | |
| 455 bignum_pow (intern_bignum, bignum_two, bits); | |
| 456 MP_MULT (b, intern_bignum, result); | |
| 457 } | |
| 458 | |
| 459 void | |
| 460 bignum_rshift (bignum result, bignum b, unsigned long bits) | |
| 461 { | |
| 462 bignum_pow (intern_bignum, bignum_two, bits); | |
| 463 MP_MDIV (b, intern_bignum, result, intern_bignum); | |
| 464 } | |
| 465 | |
| 466 void bignum_random_seed(unsigned long seed) | |
| 467 { | |
| 468 /* FIXME: Implement me */ | |
| 469 } | |
| 470 | |
| 471 void bignum_random(bignum result, bignum limit) | |
| 472 { | |
| 473 /* FIXME: Implement me */ | |
| 474 MP_MOVE (bignum_zero, result); | |
| 475 } | |
| 476 | |
| 477 void | |
| 478 init_number_mp () | |
| 479 { | |
| 480 REGISTER unsigned int i; | |
| 481 | |
| 482 bignum_zero = MP_ITOM (0); | |
| 483 bignum_one = MP_ITOM (1); | |
| 484 bignum_two = MP_ITOM (2); | |
| 485 | |
| 486 /* intern_bignum holds throwaway values from macro expansions in | |
| 487 number-mp.h. Its value is immaterial. */ | |
| 488 intern_bignum = MP_ITOM (0); | |
| 489 | |
| 490 /* bignum_bytesize holds the number of bits in a byte. */ | |
| 491 bignum_bytesize = MP_ITOM (256); | |
| 492 | |
| 493 /* bignum_long_sign_bit holds an adjustment for negative longs. */ | |
| 494 bignum_long_sign_bit = MP_ITOM (256); | |
| 495 for (i = 1UL; i < sizeof (long); i++) | |
| 496 MP_MULT (bignum_bytesize, bignum_long_sign_bit, bignum_long_sign_bit); | |
| 497 | |
| 498 /* The MP interface only supports turning short ints into MINTs, so we have | |
| 499 to set these the hard way. */ | |
| 500 | |
| 501 bignum_min_int = MP_ITOM (0); | |
| 502 bignum_set_long (bignum_min_int, INT_MIN); | |
| 503 | |
| 504 bignum_max_int = MP_ITOM (0); | |
| 505 bignum_set_long (bignum_max_int, INT_MAX); | |
| 506 | |
| 507 bignum_max_uint = MP_ITOM (0); | |
| 508 bignum_set_ulong (bignum_max_uint, UINT_MAX); | |
| 509 | |
| 510 bignum_min_long = MP_ITOM (0); | |
| 511 bignum_set_long (bignum_min_long, LONG_MIN); | |
| 512 | |
| 513 bignum_max_long = MP_ITOM (0); | |
| 514 bignum_set_long (bignum_max_long, LONG_MAX); | |
| 515 | |
| 516 bignum_max_ulong = MP_ITOM (0); | |
| 517 bignum_set_ulong (bignum_max_ulong, ULONG_MAX); | |
| 518 } |