1/* 2 Title: Arbitrary Precision Package. 3 Author: Dave Matthews, Cambridge University Computer Laboratory 4 5 Further modification Copyright 2010, 2012, 2015 David C. J. Matthews 6 7 Copyright (c) 2000 8 Cambridge University Technical Services Limited 9 10 This library is free software; you can redistribute it and/or 11 modify it under the terms of the GNU Lesser General Public 12 License version 2.1 as published by the Free Software Foundation. 13 14 This library is distributed in the hope that it will be useful, 15 but WITHOUT ANY WARRANTY; without even the implied warranty of 16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 17 Lesser General Public License for more details. 18 19 You should have received a copy of the GNU Lesser General Public 20 License along with this library; if not, write to the Free Software 21 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA 22*/ 23 24/* 25Arbitrary precision package in C. 26 27Integers are held in two formats in this system, long-form and short-form. 28The two are distinquished by the integer tag bit, short-form having the tag 29bit set and pointers to long-form being untagged. 30The long-form integers use the standard Poly format for multi-word 31objects, with the length count and flags in the word just before the object 32pointed to. The sign of long-form integers is coded in one of the flag bits. 33Short integers are signed quantities, and can be directly 34manipulated by the relevant instructions, but if overflow occurs then the full 35long versions of the operations will need to be called. 36Long-form integers are held as vectors of bytes (i.e. unsigned char) 37low-order byte first. It is assumed that a ``byte'' will hold an 8-bit 38quantity and a ``long'' at least two ``bytes''. It is essential that unsigned 39values are used. 40Integers are always stored in the least possible number of words, and 41will be shortened to the short-form when possible. 42 43Thanks are due to D. Knuth for the long division algorithm. 44*/ 45 46#ifdef HAVE_CONFIG_H 47#include "config.h" 48#elif defined(_WIN32) 49#include "winconfig.h" 50#else 51#error "No configuration file" 52#endif 53 54#ifdef HAVE_STDIO_H 55#include <stdio.h> 56#endif 57 58#ifdef HAVE_STDLIB_H 59#include <stdlib.h> 60#endif 61 62#ifdef HAVE_STRING_H 63#include <string.h> 64#endif 65 66#ifdef HAVE_ALLOCA_H 67#include <alloca.h> 68#endif 69 70#ifdef HAVE_MALLOC_H 71#include <malloc.h> 72#endif 73 74#ifdef HAVE_ASSERT_H 75#include <assert.h> 76#define ASSERT(x) assert(x) 77#else 78#define ASSERT(x) 79#endif 80 81#ifdef HAVE_GMP_H 82#include <gmp.h> 83#define USE_GMP 1 84#endif 85 86#include "globals.h" 87#include "sys.h" 88#include "run_time.h" 89#include "arb.h" 90#include "save_vec.h" 91#include "processes.h" 92#include "memmgr.h" 93#include "rtsentry.h" 94#include "profiling.h" 95 96extern "C" { 97 POLYEXTERNALSYMBOL POLYUNSIGNED PolyAddArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2); 98 POLYEXTERNALSYMBOL POLYUNSIGNED PolySubtractArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2); 99 POLYEXTERNALSYMBOL POLYUNSIGNED PolyMultiplyArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2); 100 POLYEXTERNALSYMBOL POLYUNSIGNED PolyDivideArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2); 101 POLYEXTERNALSYMBOL POLYUNSIGNED PolyRemainderArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2); 102 POLYEXTERNALSYMBOL POLYUNSIGNED PolyQuotRemArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2, PolyWord arg3); 103 POLYEXTERNALSYMBOL POLYSIGNED PolyCompareArbitrary(PolyWord arg1, PolyWord arg2); 104 POLYEXTERNALSYMBOL POLYUNSIGNED PolyGCDArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2); 105 POLYEXTERNALSYMBOL POLYUNSIGNED PolyLCMArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2); 106 POLYEXTERNALSYMBOL POLYUNSIGNED PolyGetLowOrderAsLargeWord(PolyObject *threadId, PolyWord arg); 107 POLYEXTERNALSYMBOL POLYUNSIGNED PolyOrArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2); 108 POLYEXTERNALSYMBOL POLYUNSIGNED PolyAndArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2); 109 POLYEXTERNALSYMBOL POLYUNSIGNED PolyXorArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2); 110} 111 112static Handle add_longc(TaskData *taskData, Handle,Handle); 113static Handle sub_longc(TaskData *taskData, Handle,Handle); 114static Handle quot_rem_c(TaskData *taskData, Handle,Handle,Handle); 115static Handle or_longc(TaskData *taskData, Handle,Handle); 116static Handle and_longc(TaskData *taskData, Handle,Handle); 117static Handle xor_longc(TaskData *taskData, Handle,Handle); 118static Handle neg_longc(TaskData *taskData, Handle); 119 120static Handle gcd_arbitrary(TaskData *taskData, Handle,Handle); 121static Handle lcm_arbitrary(TaskData *taskData, Handle,Handle); 122 123// Number of bits in a Poly word. N.B. This is not necessarily the same as SIZEOF_VOIDP. 124#define BITS_PER_POLYWORD (SIZEOF_VOIDP*8) 125 126#ifdef USE_GMP 127#if (BITS_PER_POLYWORD > GMP_LIMB_BITS) 128// We're assuming that every GMP limb occupies at least one word 129#error "Size of GMP limb is less than a Poly word" 130#endif 131#endif 132 133#ifdef USE_GMP 134#define DEREFLIMBHANDLE(_x) ((mp_limb_t *)DEREFHANDLE(_x)) 135 136// Returns the length of the argument with trailing zeros removed. 137static mp_size_t numLimbs(PolyWord x) 138{ 139 mp_size_t lu = OBJECT_LENGTH(x)*sizeof(PolyWord)/sizeof(mp_limb_t); 140 mp_limb_t *u = (mp_limb_t *)x.AsObjPtr(); 141 while (lu > 0 && u[lu-1] == 0) lu--; 142 return lu; 143} 144 145#else 146// Returns the length of the argument with trailing zeros removed. 147 148static POLYUNSIGNED get_length(PolyWord x) 149{ 150 byte *u = (byte *)x.AsObjPtr(); 151 POLYUNSIGNED lu = OBJECT_LENGTH(x)*sizeof(PolyWord); 152 153 for( ; (lu > 0) && (u[lu-1] == 0); lu--) 154 { 155 /* do nothing */ 156 } 157 158 return lu; 159} 160#endif 161 162// Return a uintptr_t value i.e. unsigned 32-bits on 32-bit architecture and 64-bits on 64-bit architecture. 163POLYUNSIGNED getPolyUnsigned(TaskData *taskData, PolyWord number) 164{ 165 if ( IS_INT(number) ) 166 { 167 POLYSIGNED i = UNTAGGED(number); 168 if ( i < 0 ) raise_exception0(taskData, EXC_size ); 169 return i; 170 } 171 else 172 { 173 if (OBJ_IS_NEGATIVE(GetLengthWord(number))) raise_exception0(taskData, EXC_size ); 174#ifdef USE_GMP 175 unsigned length = numLimbs(number); 176 if (length > 1) raise_exception0(taskData, EXC_size); 177 mp_limb_t first = *(mp_limb_t*)number.AsCodePtr(); 178#if (BITS_PER_POLYWORD < GMP_NUMB_BITS) 179 if (first > (mp_limb_t)1 << BITS_PER_POLYWORD) 180 raise_exception0(taskData, EXC_size); 181#endif 182 return first; 183#else 184 byte *ptr = number.AsCodePtr(); 185 POLYUNSIGNED length = get_length(number); 186 if (length > sizeof(PolyWord) ) raise_exception0(taskData, EXC_size); 187 POLYSIGNED c = 0; 188 while ( length-- ) c = (c << 8) | ((byte *) ptr)[length]; 189 return c; 190#endif 191 } 192} 193 194#define MAX_INT_PLUS1 ((POLYUNSIGNED)0x80 << ( (sizeof(PolyWord)-1) *8)) 195// Return an intptr_t value i.e. signed 32-bits on 32-bit architecture and 64-bits on 64-bit architecture. 196POLYSIGNED getPolySigned(TaskData *taskData, PolyWord number) 197{ 198 if ( IS_INT(number) ) 199 { 200 return UNTAGGED(number); 201 } 202 else 203 { 204 int sign = OBJ_IS_NEGATIVE(GetLengthWord(number)) ? -1 : 0; 205#ifdef USE_GMP 206 unsigned length = numLimbs(number); 207 if (length > 1) raise_exception0(taskData, EXC_size); 208 mp_limb_t c = *(mp_limb_t*)number.AsCodePtr(); 209#else 210 POLYUNSIGNED length = get_length(number); 211 POLYUNSIGNED c = 0; 212 byte *ptr = number.AsCodePtr(); 213 214 if ( length > sizeof(PolyWord) ) raise_exception0(taskData, EXC_size ); 215 216 while ( length-- ) 217 { 218 c = (c << 8) | ptr[length]; 219 } 220#endif 221 if ( sign == 0 && c < MAX_INT_PLUS1) return (POLYSIGNED)c; 222 if ( sign != 0 && c <= MAX_INT_PLUS1) return -((POLYSIGNED)c); 223 224 raise_exception0(taskData, EXC_size ); 225 /*NOTREACHED*/ 226 return 0; 227 } 228} 229 230short get_C_short(TaskData *taskData, PolyWord number) 231{ 232 int i = (int)get_C_long(taskData, number); 233 234 if ( i <= 32767 && i >= -32768 ) return i; 235 236 raise_exception0(taskData, EXC_size ); 237 /*NOTREACHED*/ 238 return 0; 239} 240 241unsigned short get_C_ushort(TaskData *taskData, PolyWord number) 242{ 243 POLYUNSIGNED u = get_C_ulong(taskData, number ); 244 245 if ( u <= 65535 ) return (short)u; 246 247 raise_exception0(taskData, EXC_size ); 248 /*NOTREACHED*/ 249 return 0; 250} 251 252#if (SIZEOF_LONG == SIZEOF_VOIDP) 253unsigned get_C_unsigned(TaskData *taskData, PolyWord number) 254{ 255 return get_C_ulong(taskData, number); 256} 257 258int get_C_int(TaskData *taskData, PolyWord number) 259{ 260 return get_C_long(taskData, number); 261} 262#else 263// Poly words are the same size as a pointer but that may 264// not be the same as int or long. 265unsigned get_C_unsigned(TaskData *taskData, PolyWord number) 266{ 267 POLYUNSIGNED res = get_C_ulong(taskData, number); 268 unsigned result = (unsigned)res; 269 if ((POLYUNSIGNED)result != res) 270 raise_exception0(taskData, EXC_size); 271 return result; 272} 273 274int get_C_int(TaskData *taskData, PolyWord number) 275{ 276 POLYSIGNED res = get_C_long(taskData, number); 277 int result = (int)res; 278 if ((POLYSIGNED)result != res) 279 raise_exception0(taskData, EXC_size); 280 return result; 281 282} 283#endif 284 285static Handle get_long(Handle x, Handle extend, int *sign) 286{ 287 if (IS_INT(DEREFWORD(x))) 288 { 289 // Short form - put it in the temporary. 290 POLYSIGNED x_v = UNTAGGED(DEREFWORD(x)); 291 if (x_v >= 0) *sign = 0; 292 else /* Negative */ 293 { 294 *sign = -1; 295 x_v = -x_v; 296 } 297 #ifdef USE_GMP 298 mp_limb_t *u = DEREFLIMBHANDLE(extend); 299 *u = x_v; 300#else 301 byte *u = DEREFBYTEHANDLE(extend); 302 303 /* Put into extend buffer, low order byte first. */ 304 for (unsigned i = 0; i < sizeof(PolyWord); i++) 305 { 306 u[i] = x_v & 0xff; 307 x_v = x_v >> 8; 308 } 309#endif 310 return extend; 311 } 312 else 313 { /* Long-form - x is an address. */ 314 *sign = OBJ_IS_NEGATIVE(GetLengthWord(DEREFWORD(x))) ? -1 : 0; 315 return x; 316 } 317} 318 319#ifndef USE_GMP 320static Handle copy_long(TaskData *taskData, Handle x, POLYUNSIGNED lx) 321{ 322 Handle y = alloc_and_save(taskData, WORDS(lx), F_BYTE_OBJ|F_MUTABLE_BIT); 323 324 // copy the bytes 325 byte *v = DEREFBYTEHANDLE(y); 326 memcpy(v, DEREFBYTEHANDLE(x), lx); 327 return y; 328} 329#endif 330 331/* make_canonical is used to force a result into its shortest form, 332 in the style of get_length, but also may convert its argument 333 from long to short integer */ 334static Handle make_canonical(TaskData *taskData, Handle x, int sign) 335{ 336#ifdef USE_GMP 337 unsigned size = numLimbs(DEREFWORD(x)); 338 if (size <= 1) // May be zero if the result is zero. 339 { 340 mp_limb_t r = *DEREFLIMBHANDLE(x); 341 if (r <= MAXTAGGED || (r == MAXTAGGED+1 && sign < 0)) 342 { 343 if (sign < 0) 344 return taskData->saveVec.push(TAGGED(-(POLYSIGNED)r)); 345 else 346 return taskData->saveVec.push(TAGGED(r)); 347 } 348 } 349 // Throw away any unused words. 350 DEREFWORDHANDLE(x)->SetLengthWord(WORDS(size*sizeof(mp_limb_t)), F_BYTE_OBJ | (sign < 0 ? F_NEGATIVE_BIT: 0)); 351 return x; 352#else 353 /* get length in BYTES */ 354 POLYUNSIGNED size = get_length(DEREFWORD(x)); 355 356 // We can use the short representation if it will fit in a word. 357 if (size <= sizeof(PolyWord)) 358 { 359 /* Convert the digits. */ 360 byte *u = DEREFBYTEHANDLE(x); 361 POLYUNSIGNED r = 0; 362 for (unsigned i=0; i < sizeof(PolyWord); i++) 363 { 364 r |= ((POLYUNSIGNED)u[i]) << (8*i); 365 } 366 367 /* Check for MAXTAGGED+1 before subtraction 368 in case MAXTAGGED is 0x7fffffff */ 369 370 if (r <= MAXTAGGED || (r == MAXTAGGED+1 && sign < 0)) 371 { 372 if (sign < 0) 373 return taskData->saveVec.push(TAGGED(-(POLYSIGNED)r)); 374 else 375 return taskData->saveVec.push(TAGGED(r)); 376 } 377 } 378 379 /* The length word of the object is changed to reflect the new length. 380 This is safe because any words thrown away must be zero. */ 381 DEREFWORDHANDLE(x)->SetLengthWord(WORDS(size), F_BYTE_OBJ | (sign < 0 ? F_NEGATIVE_BIT: 0)); 382 383 return x; 384#endif 385} 386 387Handle ArbitraryPrecionFromSigned(TaskData *taskData, POLYSIGNED val) 388/* Called from routines in the run-time system to generate an arbitrary 389 precision integer from a word value. */ 390{ 391 if (val <= MAXTAGGED && val >= -MAXTAGGED-1) /* No overflow */ 392 return taskData->saveVec.push(TAGGED(val)); 393 394 POLYUNSIGNED uval = val < 0 ? -val : val; 395#ifdef USE_GMP 396 Handle y = alloc_and_save(taskData, WORDS(sizeof(mp_limb_t)), ((val < 0) ? F_NEGATIVE_BIT : 0)| F_BYTE_OBJ); 397 mp_limb_t *v = DEREFLIMBHANDLE(y); 398 *v = uval; 399#else 400 Handle y = alloc_and_save(taskData, 1, ((val < 0) ? F_NEGATIVE_BIT : 0)| F_BYTE_OBJ); 401 byte *v = DEREFBYTEHANDLE(y); 402 for (POLYUNSIGNED i = 0; uval != 0; i++) 403 { 404 v[i] = (byte)(uval & 0xff); 405 uval >>= 8; 406 } 407#endif 408 return y; 409} 410 411Handle ArbitraryPrecionFromUnsigned(TaskData *taskData, POLYUNSIGNED uval) 412/* Called from routines in the run-time system to generate an arbitrary 413 precision integer from an unsigned value. */ 414{ 415 if (uval <= MAXTAGGED) return taskData->saveVec.push(TAGGED(uval)); 416 #ifdef USE_GMP 417 Handle y = alloc_and_save(taskData, WORDS(sizeof(mp_limb_t)), F_BYTE_OBJ); 418 mp_limb_t *v = DEREFLIMBHANDLE(y); 419 *v = uval; 420#else 421 Handle y = alloc_and_save(taskData, 1, F_BYTE_OBJ); 422 byte *v = DEREFBYTEHANDLE(y); 423 for (POLYUNSIGNED i = 0; uval != 0; i++) 424 { 425 v[i] = (byte)(uval & 0xff); 426 uval >>= 8; 427 } 428#endif 429 return y; 430} 431 432 433Handle Make_arbitrary_precision(TaskData *taskData, int val) 434{ 435 return ArbitraryPrecionFromSigned(taskData, val); 436} 437 438Handle Make_arbitrary_precision(TaskData *taskData, unsigned uval) 439{ 440 return ArbitraryPrecionFromUnsigned(taskData, uval); 441} 442 443Handle Make_arbitrary_precision(TaskData *taskData, long val) 444{ 445 return ArbitraryPrecionFromSigned(taskData, val); 446} 447 448Handle Make_arbitrary_precision(TaskData *taskData, unsigned long uval) 449{ 450 return ArbitraryPrecionFromUnsigned(taskData, uval); 451} 452 453#ifdef HAVE_LONG_LONG 454#if SIZEOF_LONG_LONG <= SIZEOF_VOIDP 455Handle Make_arbitrary_precision(TaskData *taskData, long long val) 456{ 457 return ArbitraryPrecionFromSigned(taskData, val); 458} 459 460Handle Make_arbitrary_precision(TaskData *taskData, unsigned long long uval) 461{ 462 return ArbitraryPrecionFromUnsigned(taskData, uval); 463} 464#else 465// 32-bit implementation. 466Handle Make_arbitrary_precision(TaskData *taskData, long long val) 467{ 468 if (val <= (long long)(MAXTAGGED) && val >= -((long long)(MAXTAGGED))-1) /* No overflow */ 469 return taskData->saveVec.push(TAGGED((POLYSIGNED)val)); 470 // Recursive call to handle the high-order part 471 Handle hi = Make_arbitrary_precision(taskData, val >> (sizeof(int32_t) * 8)); 472 // The low-order part is treated as UNsigned. 473 Handle lo = Make_arbitrary_precision(taskData, (uint32_t)val); 474 Handle twoTo16 = taskData->saveVec.push(TAGGED(65536)); 475 Handle twoTo32 = mult_longc(taskData, twoTo16, twoTo16); 476 return add_longc(taskData, mult_longc(taskData, hi, twoTo32), lo); 477} 478 479Handle Make_arbitrary_precision(TaskData *taskData, unsigned long long uval) 480{ 481 if (uval <= (unsigned long long)(MAXTAGGED)) 482 return taskData->saveVec.push(TAGGED((POLYUNSIGNED)uval)); 483 // Recursive call to handle the high-order part 484 Handle hi = Make_arbitrary_precision(taskData, uval >> (sizeof(uint32_t) * 8)); 485 Handle lo = Make_arbitrary_precision(taskData, (uint32_t)uval); 486 Handle twoTo16 = taskData->saveVec.push(TAGGED(65536)); 487 Handle twoTo32 = mult_longc(taskData, twoTo16, twoTo16); 488 return add_longc(taskData, mult_longc(taskData, hi, twoTo32), lo); 489} 490#endif 491#endif 492 493#if defined(_WIN32) 494// Creates an arbitrary precision number from two words. 495// Used only in Windows for FILETIME and file-size. 496Handle Make_arb_from_32bit_pair(TaskData *taskData, uint32_t hi, uint32_t lo) 497{ 498 Handle hHi = Make_arbitrary_precision(taskData, hi); 499 Handle hLo = Make_arbitrary_precision(taskData, lo); 500 Handle twoTo16 = taskData->saveVec.push(TAGGED(65536)); 501 Handle twoTo32 = mult_longc(taskData, twoTo16, twoTo16); 502 return add_longc(taskData, mult_longc(taskData, hHi, twoTo32), hLo); 503} 504 505// Convert a Windows FILETIME into an arbitrary precision integer 506Handle Make_arb_from_Filetime(TaskData *taskData, const FILETIME &ft) 507{ 508 return Make_arb_from_32bit_pair(taskData, ft.dwHighDateTime, ft.dwLowDateTime); 509} 510#endif 511 512/* Returns hi*scale+lo as an arbitrary precision number. Currently used 513 for Unix time values where the time is returned as two words, a number 514 of seconds and a number of microseconds and we wish to return the 515 result as a number of microseconds. */ 516Handle Make_arb_from_pair_scaled(TaskData *taskData, unsigned hi, unsigned lo, unsigned scale) 517{ 518 /* We might be able to compute the number as a 64 bit quantity and 519 then convert it but this is probably more portable. It does risk 520 overflowing the save vector. */ 521 Handle hHi = Make_arbitrary_precision(taskData, hi); 522 Handle hLo = Make_arbitrary_precision(taskData, lo); 523 Handle hScale = Make_arbitrary_precision(taskData, scale); 524 return add_longc(taskData, mult_longc(taskData, hHi, hScale), hLo); 525} 526 527Handle neg_longc(TaskData *taskData, Handle x) 528{ 529 if (IS_INT(DEREFWORD(x))) 530 { 531 POLYSIGNED s = UNTAGGED(DEREFWORD(x)); 532 if (s != -MAXTAGGED-1) // If it won't overflow 533 return taskData->saveVec.push(TAGGED(-s)); 534 } 535 536 // Either overflow or long argument - convert to long form. 537#if USE_GMP 538 PolyWord x_extend[1+WORDS(sizeof(mp_limb_t))]; 539#else 540 PolyWord x_extend[2]; 541#endif 542 SaveVecEntry x_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(x_extend[1]))); 543 Handle x_ehandle = &x_extend_addr; 544 545 int sign_x; 546 Handle long_x = get_long(x, x_ehandle, &sign_x); 547 548#ifdef USE_GMP 549 POLYUNSIGNED lx = numLimbs(DEREFWORD(long_x))*sizeof(mp_limb_t); 550#else 551 /* Get length of arg. */ 552 POLYUNSIGNED lx = get_length(DEREFWORD(long_x)); 553#endif 554 Handle long_y = alloc_and_save(taskData, WORDS(lx), F_MUTABLE_BIT|F_BYTE_OBJ); 555 byte *v = DEREFBYTEHANDLE(long_y); 556 memcpy(v, DEREFBYTEHANDLE(long_x), lx); 557#ifndef USE_GMP 558 // Make sure the last word is zero. We may have unused bytes there. 559 memset(v+lx, 0, WORDS(lx)*sizeof(PolyWord)-lx); 560#endif 561 562 /* Return the value with the sign changed. */ 563 return make_canonical(taskData, long_y, sign_x ^ -1); 564} /* neg_longc */ 565 566#ifdef USE_GMP 567static Handle add_unsigned_long(TaskData *taskData, Handle x, Handle y, int sign) 568{ 569 /* find the longer number */ 570 mp_size_t lx = numLimbs(DEREFWORD(x)); 571 mp_size_t ly = numLimbs(DEREFWORD(y)); 572 mp_limb_t *u; /* limb-pointer for longer number */ 573 mp_limb_t *v; /* limb-pointer for shorter number */ 574 Handle z; 575 mp_size_t lu; /* length of u in limbs */ 576 mp_size_t lv; /* length of v in limbs */ 577 578 if (lx < ly) 579 { 580 // Get result vector. It must be 1 limb longer than u 581 // to have space for any carry. 582 z = alloc_and_save(taskData, WORDS((ly+1)*sizeof(mp_limb_t)), F_MUTABLE_BIT|F_BYTE_OBJ); 583 584 /* now safe to dereference pointers */ 585 u = DEREFLIMBHANDLE(y); lu = ly; 586 v = DEREFLIMBHANDLE(x); lv = lx; 587 } 588 else 589 { 590 // Get result vector. It must be 1 limb longer than u 591 // to have space for any carry. 592 z = alloc_and_save(taskData, WORDS((lx+1)*sizeof(mp_limb_t)), F_MUTABLE_BIT|F_BYTE_OBJ); 593 594 /* now safe to dereference pointers */ 595 u = DEREFLIMBHANDLE(x); lu = lx; 596 v = DEREFLIMBHANDLE(y); lv = ly; 597 } 598 599 mp_limb_t *w = DEREFLIMBHANDLE(z); 600 // Do the addition. 601 mp_limb_t carry = 0; 602 if (lv != 0) carry = mpn_add_n(w, u, v, lv); 603 // Add the carry to the rest of the longer number. 604 if (lu != lv) carry = mpn_add_1(w+lv, u+lv, lu-lv, carry); 605 // Put the remaining carry in the final limb. 606 w[lu] = carry; 607 return make_canonical(taskData, z, sign); 608} 609#else 610static Handle add_unsigned_long(TaskData *taskData, Handle x, Handle y, int sign) 611{ 612 byte *u; /* byte-pointer for longer number */ 613 byte *v; /* byte-pointer for shorter number */ 614 Handle z; 615 616 POLYUNSIGNED lu; /* length of u in bytes */ 617 POLYUNSIGNED lv; /* length of v in bytes */ 618 619 /* find the longer number */ 620 POLYUNSIGNED lx = get_length(DEREFWORD(x)); 621 POLYUNSIGNED ly = get_length(DEREFWORD(y)); 622 623 /* Make ``u'' the longer. */ 624 if (lx < ly) 625 { 626 // Get result vector. It must be 1 byte longer than u 627 // to have space for any carry. 628 z = alloc_and_save(taskData, WORDS(ly+1), F_MUTABLE_BIT|F_BYTE_OBJ); 629 630 /* now safe to dereference pointers */ 631 u = DEREFBYTEHANDLE(y); lu = ly; 632 v = DEREFBYTEHANDLE(x); lv = lx; 633 } 634 635 else 636 { 637 // Get result vector. It must be 1 byte longer than u 638 // to have space for any carry, plus one byte for the sign. 639 z = alloc_and_save(taskData, WORDS(lx+2), F_MUTABLE_BIT|F_BYTE_OBJ); 640 641 /* now safe to dereference pointers */ 642 u = DEREFBYTEHANDLE(x); lu = lx; 643 v = DEREFBYTEHANDLE(y); lv = ly; 644 } 645 646 /* do the actual addition */ 647 byte *w = DEREFBYTEHANDLE(z); 648 unsigned carry = 0; 649 POLYUNSIGNED i = 0; 650 651 /* Do the additions */ 652 for( ; i < lv; i++) 653 { 654 carry += u[i] + v[i]; 655 w[i] = carry & 0xff; 656 carry >>= 8; 657 } 658 659 /* Add the carry to the rest of ``u''. */ 660 for( ; i < lu; i++) 661 { 662 carry += u[i]; 663 w[i] = carry & 0xff; 664 carry >>= 8; 665 } 666 667 /* Finally put the carry into the last byte */ 668 w[i] = (byte)carry; 669 670 return make_canonical(taskData, z, sign); 671} /* add_unsigned_long */ 672#endif 673 674#ifdef USE_GMP 675static Handle sub_unsigned_long(TaskData *taskData, Handle x, Handle y, int sign) 676{ 677 mp_limb_t *u; /* limb-pointer alias for larger number */ 678 mp_limb_t *v; /* limb-pointer alias for smaller number */ 679 mp_size_t lu; /* length of u in limbs */ 680 mp_size_t lv; /* length of v in limbs */ 681 Handle z; 682 683 /* get the larger argument into ``u'' */ 684 /* This is necessary so that we can discard */ 685 /* the borrow at the end of the subtraction */ 686 mp_size_t lx = numLimbs(DEREFWORD(x)); 687 mp_size_t ly = numLimbs(DEREFWORD(y)); 688 689 // Find the larger number. Check the lengths first and if they're equal the values. 690 int res; 691 if (lx < ly) res = -1; 692 else if (lx > ly) res = 1; 693 else res = mpn_cmp(DEREFLIMBHANDLE(x), DEREFLIMBHANDLE(y), lx); 694 695 // If they're equal the result is zero. 696 if (res == 0) return taskData->saveVec.push(TAGGED(0)); /* They are equal */ 697 698 if (res < 0) 699 { 700 sign ^= -1; /* swap sign of result */ 701 z = alloc_and_save(taskData, WORDS(ly*sizeof(mp_limb_t)), F_MUTABLE_BIT|F_BYTE_OBJ); 702 703 /* now safe to dereference pointers */ 704 u = DEREFLIMBHANDLE(y); lu = ly; 705 v = DEREFLIMBHANDLE(x); lv = lx; 706 } 707 else 708 { 709 z = alloc_and_save(taskData, WORDS(lx*sizeof(mp_limb_t)), F_MUTABLE_BIT|F_BYTE_OBJ); 710 711 /* now safe to dereference pointers */ 712 u = DEREFLIMBHANDLE(x); lu = lx; 713 v = DEREFLIMBHANDLE(y); lv = ly; 714 } 715 716 mp_limb_t *w = DEREFLIMBHANDLE(z); 717 // Do the subtraction. 718 mp_limb_t borrow = 0; 719 if (lv != 0) borrow = mpn_sub_n(w, u, v, lv); 720 // Subtract the borrow from the rest of the longer number. 721 if (lu != lv) borrow = mpn_sub_1(w+lv, u+lv, lu-lv, borrow); 722 return make_canonical(taskData, z, sign); 723} 724#else 725static Handle sub_unsigned_long(TaskData *taskData, Handle x, Handle y, int sign) 726{ 727 byte *u; /* byte-pointer alias for larger number */ 728 byte *v; /* byte-pointer alias for smaller number */ 729 POLYUNSIGNED lu; /* length of u in bytes */ 730 POLYUNSIGNED lv; /* length of v in bytes */ 731 Handle z; 732 733 /* get the larger argument into ``u'' */ 734 /* This is necessary so that we can discard */ 735 /* the borrow at the end of the subtraction */ 736 POLYUNSIGNED lx = get_length(DEREFWORD(x)); 737 POLYUNSIGNED ly = get_length(DEREFWORD(y)); 738 739 if (lx < ly) 740 { 741 sign ^= -1; /* swap sign of result SPF 21/1/94 */ 742 z = alloc_and_save(taskData, WORDS(ly+1), F_MUTABLE_BIT|F_BYTE_OBJ); 743 744 745 /* now safe to dereference pointers */ 746 u = DEREFBYTEHANDLE(y); lu = ly; 747 v = DEREFBYTEHANDLE(x); lv = lx; 748 } 749 else if (ly < lx) 750 { 751 z = alloc_and_save(taskData, WORDS(lx+1), F_MUTABLE_BIT|F_BYTE_OBJ); 752 753 /* now safe to dereference pointers */ 754 u = DEREFBYTEHANDLE(x); lu = lx; 755 v = DEREFBYTEHANDLE(y); lv = ly; 756 } 757 758 else /* lx == ly */ 759 { /* Must look at the numbers to decide which is bigger. */ 760 POLYUNSIGNED i = lx; 761 while (i > 0 && DEREFBYTEHANDLE(x)[i-1] == DEREFBYTEHANDLE(y)[i-1]) i--; 762 763 if (i == 0) return taskData->saveVec.push(TAGGED(0)); /* They are equal */ 764 765 if (DEREFBYTEHANDLE(x)[i-1] < DEREFBYTEHANDLE(y)[i-1]) 766 { 767 sign ^= -1; /* swap sign of result SPF 21/1/94 */ 768 z = alloc_and_save(taskData, WORDS(ly+1), F_MUTABLE_BIT|F_BYTE_OBJ); 769 770 /* now safe to dereference pointers */ 771 u = DEREFBYTEHANDLE(y); lu = ly; 772 v = DEREFBYTEHANDLE(x); lv = lx; 773 } 774 else 775 { 776 z = alloc_and_save(taskData, WORDS(lx+1), F_MUTABLE_BIT|F_BYTE_OBJ); 777 778 /* now safe to dereference pointers */ 779 u = DEREFBYTEHANDLE(x); lu = lx; 780 v = DEREFBYTEHANDLE(y); lv = ly; 781 } 782 } 783 784 byte *w = DEREFBYTEHANDLE(z); 785 unsigned borrow = 1; /* Becomes 0 if there is a borrow */ 786 POLYUNSIGNED i = 0; 787 788 /* Do the subtractions */ 789 for( ; i < lv; i++) 790 { 791 borrow += 255 + u[i] - v[i]; 792 w[i] = borrow & 0xff; 793 borrow >>= 8; 794 } 795 796 /* Add the borrow into the rest of ``u''. */ 797 for( ; i < lu; i++) 798 { 799 borrow += 255 + u[i]; 800 w[i] = borrow & 0xff; 801 borrow >>= 8; 802 } 803 804 return make_canonical(taskData, z, sign); 805} /* sub_unsigned_long */ 806#endif 807 808Handle add_longc(TaskData *taskData, Handle y, Handle x) 809{ 810 if (IS_INT(DEREFWORD(x)) && IS_INT(DEREFWORD(y))) 811 { /* Both short */ 812 /* The easiest way to do the addition is simply *x-1+*y, but that 813 makes it more difficult to check for overflow. */ 814 POLYSIGNED t = UNTAGGED(DEREFWORD(x)) + UNTAGGED(DEREFWORD(y)); 815 if (t <= MAXTAGGED && t >= -MAXTAGGED-1) /* No overflow */ 816 { 817 return taskData->saveVec.push(TAGGED(t)); 818 } 819 } 820 821#if USE_GMP 822 PolyWord x_extend[1+WORDS(sizeof(mp_limb_t))]; 823 PolyWord y_extend[1+WORDS(sizeof(mp_limb_t))]; 824#else 825 PolyWord x_extend[2], y_extend[2]; 826#endif 827 SaveVecEntry x_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(x_extend[1]))); 828 Handle x_ehandle = &x_extend_addr; 829 SaveVecEntry y_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(y_extend[1]))); 830 Handle y_ehandle = &y_extend_addr; 831 832 /* Either overflow or long arguments - convert to long form */ 833 int sign_x, sign_y; 834 Handle long_x = get_long(x, x_ehandle, &sign_x); 835 Handle long_y = get_long(y, y_ehandle, &sign_y); 836 837 /* Work out whether to add or subtract */ 838 if ((sign_y ^ sign_x) >= 0) /* signs the same? */ 839 /* sign(x) * (abs(x) + abs(y)) */ 840 return add_unsigned_long(taskData, long_x, long_y, sign_x); 841 else 842 /* sign(x) * (abs(x) - abs(y)) */ 843 return sub_unsigned_long(taskData, long_x, long_y, sign_x); 844} /* add_longc */ 845 846Handle sub_longc(TaskData *taskData, Handle y, Handle x) 847{ 848 if (IS_INT(DEREFWORD(x)) && 849 IS_INT(DEREFWORD(y))) /* Both short */ 850 { 851 /* The easiest way to do the subtraction is simply *x-*y+1, but that 852 makes it more difficult to check for overflow. */ 853 POLYSIGNED t = UNTAGGED(DEREFWORD(x)) - UNTAGGED(DEREFWORD(y)); 854 if (t <= MAXTAGGED && t >= -MAXTAGGED-1) /* No overflow */ 855 return taskData->saveVec.push(TAGGED(t)); 856 } 857 858#if USE_GMP 859 PolyWord x_extend[1+WORDS(sizeof(mp_limb_t))]; 860 PolyWord y_extend[1+WORDS(sizeof(mp_limb_t))]; 861#else 862 PolyWord x_extend[2], y_extend[2]; 863#endif 864 SaveVecEntry x_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(x_extend[1]))); 865 Handle x_ehandle = &x_extend_addr; 866 SaveVecEntry y_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(y_extend[1]))); 867 Handle y_ehandle = &y_extend_addr; 868 869 /* Either overflow or long arguments. */ 870 int sign_x, sign_y; 871 Handle long_x = get_long(x, x_ehandle, &sign_x); /* Convert to long form */ 872 Handle long_y = get_long(y, y_ehandle, &sign_y); 873 874 /* If the signs are different add the two values. */ 875 if ((sign_y ^ sign_x) < 0) /* signs differ */ 876 { /* sign(x) * (abs(x) + abs(y)) */ 877 return add_unsigned_long(taskData, long_x, long_y, sign_x); 878 } 879 else 880 { /* sign(x) * (abs(x) - abs(y)) */ 881 return sub_unsigned_long(taskData, long_x, long_y, sign_x); 882 } 883} /* sub_longc */ 884 885 886Handle mult_longc(TaskData *taskData, Handle y, Handle x) 887{ 888 889#if USE_GMP 890 PolyWord x_extend[1+WORDS(sizeof(mp_limb_t))]; 891 PolyWord y_extend[1+WORDS(sizeof(mp_limb_t))]; 892#else 893 PolyWord x_extend[2], y_extend[2]; 894#endif 895 SaveVecEntry x_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(x_extend[1]))); 896 Handle x_ehandle = &x_extend_addr; 897 SaveVecEntry y_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(y_extend[1]))); 898 Handle y_ehandle = &y_extend_addr; 899 900 /* Either overflow or long arguments. */ 901 int sign_x, sign_y; 902 Handle long_x = get_long(x, x_ehandle, &sign_x); /* Convert to long form */ 903 Handle long_y = get_long(y, y_ehandle, &sign_y); 904 905#if USE_GMP 906 mp_size_t lx = numLimbs(DEREFWORD(long_x)); 907 mp_size_t ly = numLimbs(DEREFWORD(long_y)); 908 909 // Check for zero args. 910 if (lx == 0 || ly == 0) return taskData->saveVec.push(TAGGED(0)); 911 912 Handle z = alloc_and_save(taskData, WORDS((lx+ly)*sizeof(mp_limb_t)), F_MUTABLE_BIT|F_BYTE_OBJ); 913 mp_limb_t *w = DEREFLIMBHANDLE(z); 914 mp_limb_t *u = DEREFLIMBHANDLE(long_x), *v = DEREFLIMBHANDLE(long_y); 915 916 // The first argument must be the longer. 917 if (lx < ly) mpn_mul(w, v, ly, u, lx); 918 else mpn_mul(w, u, lx, v, ly); 919 920 return make_canonical(taskData, z, sign_x ^ sign_y); 921 922#else 923 /* Get lengths of args. */ 924 POLYUNSIGNED lx = get_length(DEREFWORD(long_x)); 925 POLYUNSIGNED ly = get_length(DEREFWORD(long_y)); 926 927 // Check for zero args. 928 if (lx == 0 || ly == 0) return taskData->saveVec.push(TAGGED(0)); 929 930 /* Get space for result */ 931 Handle long_z = alloc_and_save(taskData, WORDS(lx+ly+1), F_MUTABLE_BIT|F_BYTE_OBJ); 932 933 /* Can now load the actual addresses because they will not change now. */ 934 byte *u = DEREFBYTEHANDLE(long_x); 935 byte *v = DEREFBYTEHANDLE(long_y); 936 byte *w = DEREFBYTEHANDLE(long_z); 937 938 for(POLYUNSIGNED i = 0; i < lx; i++) 939 { 940 POLYUNSIGNED j; 941 long r = 0; /* Set the carry to zero */ 942 for(j = 0; j < ly; j++) 943 { 944 /* Compute the product. */ 945 r += u[i] * v[j]; 946 /* Now add in to the result. */ 947 r += w[i+j]; 948 w[i+j] = r & 0xff; 949 r >>= 8; 950 } 951 /* Put in any carry. */ 952 w[i+j] = (byte)r; 953 } 954 955 return make_canonical(taskData, long_z, sign_x ^ sign_y); 956#endif 957} /* mult_long */ 958 959#ifndef USE_GMP 960static void div_unsigned_long(byte *u, byte *v, byte *remres, byte *divres, POLYUNSIGNED lu, POLYUNSIGNED lv) 961// Unsigned division. This is the main divide and remainder routine. 962// remres must be at least lu+1 bytes long 963// divres must be at least lu-lv+1 bytes long but can be zero if not required 964{ 965 POLYUNSIGNED i,j; 966 long r; 967 968 /* Find out how far to shift v to get a 1 in the top bit. */ 969 int bits = 0; 970 for(r = v[lv-1]; r < 128; r <<= 1) bits++; /* 128 ??? */ 971 972 /* Shift u that amount into res. We have allowed enough room for 973 overflow. */ 974 r = 0; 975 for (i = 0; i < lu; i++) 976 { 977 r |= u[i] << bits; /*``Or in'' the new bits after shifting*/ 978 remres[i] = r & 0xff; /* Put into the destination. */ 979 r >>= 8; /* and shift down the carry. */ 980 } 981 remres[i] = (byte)r; /* Put in the carry */ 982 983 /* And v that amount. It has already been copied. */ 984 if ( bits ) 985 { 986 r = 0; 987 for (i = 0; i < lv; i++) 988 { r |= v[i] << bits; v[i] = r & 0xff; r >>= 8; } 989 /* No carry */ 990 } 991 992 for(j = lu; j >= lv; j--) 993 { 994 /* j iterates over the higher digits of the dividend until we are left 995 with a number which is less than the divisor. This is the remainder. */ 996 long quotient, dividend, r; 997 dividend = remres[j]*256 + remres[j-1]; 998 quotient = (remres[j] == v[lv-1]) ? 255 : dividend/(long)v[lv-1]; 999 1000 if (lv != 1) 1001 { 1002 while ((long)v[lv-2]*quotient > 1003 (dividend - quotient*(long)v[lv-1])*256 + (long)remres[j-2]) 1004 { 1005 quotient--; 1006 } 1007 } 1008 1009 /* The quotient is at most 1 too large */ 1010 /* Subtract the product of this with ``v'' from ``res''. */ 1011 r = 1; /* Initial borrow */ 1012 for(i = 0; i < lv; i++) 1013 { 1014 r += 255 + remres[j-lv+i] - quotient * v[i]; 1015 remres[j-lv+i] = r & 0xff; 1016 r >>= 8; 1017 } 1018 1019 r += remres[j]; /* Borrow from leading digit. */ 1020 /* If we are left with a borrow when the subtraction is complete the 1021 quotient must have been too big. We add ``v'' to the dividend and 1022 subtract 1 from the quotient. */ 1023 if (r == 0 /* would be 1 if there were no borrow */) 1024 { 1025 quotient --; 1026 r = 0; 1027 for (i = 0; i < lv; i++) 1028 { 1029 r += v[i] + remres[j-lv+i]; 1030 remres[j-lv+i] = r & 0xff; 1031 r >>= 8; 1032 } 1033 } 1034 /* Place the next digit of quotient in result */ 1035 if (divres) divres[j-lv] = (byte)quotient; 1036 } 1037 1038 /* Likewise the remainder. */ 1039 if (bits) 1040 { 1041 r = 0; 1042 j = lv; 1043 while (j > 0) 1044 { 1045 j--; 1046 r |= remres[j]; 1047 remres[j] = (r >> bits) & 0xff; 1048 r = (r & 0xff) << 8; 1049 } 1050 } 1051} /* div_unsigned_long */ 1052#endif 1053 1054// Common code for div and mod. Returns handles to the results. 1055static void quotRem(TaskData *taskData, Handle y, Handle x, Handle &remHandle, Handle &divHandle) 1056{ 1057 if (IS_INT(DEREFWORD(x)) && 1058 IS_INT(DEREFWORD(y))) /* Both short */ 1059 { 1060 POLYSIGNED xs = UNTAGGED(DEREFWORD(x)); 1061 POLYSIGNED ys = UNTAGGED(DEREFWORD(y)); 1062 /* Raise exceptions if dividing by zero. */ 1063 if (ys == 0) 1064 raise_exception0(taskData, EXC_divide); 1065 1066 /* Only possible overflow is minint div -1 */ 1067 if (xs != -MAXTAGGED-1 || ys != -1) { 1068 divHandle = taskData->saveVec.push(TAGGED(xs / ys)); 1069 remHandle = taskData->saveVec.push(TAGGED(xs % ys)); 1070 return; 1071 } 1072 } 1073 1074#if USE_GMP 1075 PolyWord x_extend[1+WORDS(sizeof(mp_limb_t))]; 1076 PolyWord y_extend[1+WORDS(sizeof(mp_limb_t))]; 1077#else 1078 PolyWord x_extend[2], y_extend[2]; 1079#endif 1080 SaveVecEntry x_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(x_extend[1]))); 1081 Handle x_ehandle = &x_extend_addr; 1082 SaveVecEntry y_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(y_extend[1]))); 1083 Handle y_ehandle = &y_extend_addr; 1084 1085 int sign_x, sign_y; 1086 Handle long_x = get_long(x, x_ehandle, &sign_x); 1087 Handle long_y = get_long(y, y_ehandle, &sign_y); 1088 1089#ifdef USE_GMP 1090 /* Get lengths of args. */ 1091 mp_size_t lx = numLimbs(DEREFWORD(long_x)); 1092 mp_size_t ly = numLimbs(DEREFWORD(long_y)); 1093 1094 // If length of v is zero raise divideerror. 1095 if (ly == 0) raise_exception0(taskData, EXC_divide); 1096 if (lx < ly) { 1097 divHandle = taskData->saveVec.push(TAGGED(0)); 1098 remHandle = x; /* When x < y remainder is x. */ 1099 return; 1100 } 1101 1102 Handle remRes = alloc_and_save(taskData, WORDS(ly*sizeof(mp_limb_t)), F_MUTABLE_BIT|F_BYTE_OBJ); 1103 Handle divRes = alloc_and_save(taskData, WORDS((lx-ly+1)*sizeof(mp_limb_t)), F_MUTABLE_BIT|F_BYTE_OBJ); 1104 1105 mp_limb_t *u = DEREFLIMBHANDLE(long_x), *v = DEREFLIMBHANDLE(long_y); 1106 mp_limb_t *quotient = DEREFLIMBHANDLE(divRes); 1107 mp_limb_t *remainder = DEREFLIMBHANDLE(remRes); 1108 1109 // Do the division. 1110 mpn_tdiv_qr(quotient, remainder, 0, u, lx, v, ly); 1111 1112 // Return the results. 1113 remHandle = make_canonical(taskData, remRes, sign_x /* Same sign as dividend */); 1114 divHandle = make_canonical(taskData, divRes, sign_x ^ sign_y); 1115#else 1116 /* Get lengths of args. */ 1117 POLYUNSIGNED lx = get_length(DEREFWORD(long_x)); 1118 POLYUNSIGNED ly = get_length(DEREFWORD(long_y)); 1119 1120 /* If length of y is zero raise divideerror */ 1121 if (ly == 0) raise_exception0(taskData, EXC_divide); 1122 // If the length of divisor is less than the dividend the quotient is zero. 1123 if (lx < ly) { 1124 divHandle = taskData->saveVec.push(TAGGED(0)); 1125 remHandle = x; /* When x < y remainder is x. */ 1126 return; 1127 } 1128 1129 /* copy in case it needs shifting */ 1130 long_y = copy_long(taskData, long_y, ly); 1131 1132 Handle divRes = alloc_and_save(taskData, WORDS(lx-ly+1), F_MUTABLE_BIT|F_BYTE_OBJ); 1133 Handle remRes = alloc_and_save(taskData, WORDS(lx+1), F_MUTABLE_BIT|F_BYTE_OBJ); 1134 1135 div_unsigned_long 1136 (DEREFBYTEHANDLE(long_x), 1137 DEREFBYTEHANDLE(long_y), 1138 DEREFBYTEHANDLE(remRes), DEREFBYTEHANDLE(divRes), 1139 lx, ly); 1140 1141 /* Clear the rest */ 1142 for(POLYUNSIGNED i=ly; i < lx+1; i++) 1143 { 1144 DEREFBYTEHANDLE(remRes)[i] = 0; 1145 } 1146 1147 remHandle = make_canonical(taskData, remRes, sign_x /* Same sign as dividend */ ); 1148 divHandle = make_canonical(taskData, divRes, sign_x ^ sign_y); 1149#endif 1150} 1151 1152// This returns x divided by y. This always rounds towards zero so 1153// corresponds to Int.quot in ML not Int.div. 1154Handle div_longc(TaskData *taskData, Handle y, Handle x) 1155{ 1156 Handle remHandle, divHandle; 1157 quotRem(taskData, y, x, remHandle, divHandle); 1158 return divHandle; 1159} 1160 1161Handle rem_longc(TaskData *taskData, Handle y, Handle x) 1162{ 1163 Handle remHandle, divHandle; 1164 quotRem(taskData, y, x, remHandle, divHandle); 1165 return remHandle; 1166} 1167 1168// Return quot and rem as a pair. 1169Handle quot_rem_c(TaskData *taskData, Handle result, Handle y, Handle x) 1170{ 1171 // The result handle will almost certainly point into the stack. 1172 // This should now be safe within the GC. 1173 Handle remHandle, divHandle; 1174 quotRem(taskData, y, x, remHandle, divHandle); 1175 1176 DEREFHANDLE(result)->Set(0, divHandle->Word()); 1177 DEREFHANDLE(result)->Set(1, remHandle->Word()); 1178 return taskData->saveVec.push(TAGGED(0)); 1179} 1180 1181#if defined(_WIN32) 1182// Return a FILETIME from an arbitrary precision number. On both 32-bit and 64-bit Windows 1183// this is a pair of 32-bit values. 1184void getFileTimeFromArb(TaskData *taskData, Handle numHandle, PFILETIME ft) 1185{ 1186 Handle twoTo16 = taskData->saveVec.push(TAGGED(65536)); 1187 Handle twoTo32 = mult_longc(taskData, twoTo16, twoTo16); 1188 Handle highPart, lowPart; 1189 quotRem(taskData, twoTo32, numHandle, lowPart, highPart); 1190 ft->dwLowDateTime = get_C_unsigned(taskData, lowPart->Word()); 1191 ft->dwHighDateTime = get_C_unsigned(taskData, highPart->Word()); 1192} 1193#endif 1194 1195/* compare_unsigned is passed LONG integers only */ 1196static int compare_unsigned(PolyWord x, PolyWord y) 1197{ 1198#ifdef USE_GMP 1199 mp_size_t lx = numLimbs(x); 1200 mp_size_t ly = numLimbs(y); 1201 1202 if (lx != ly) /* u > v if u longer than v */ 1203 { 1204 return (lx > ly ? 1 : -1); 1205 } 1206 return mpn_cmp((mp_limb_t *)x.AsCodePtr(), (mp_limb_t *)y.AsCodePtr(), lx); 1207#else 1208 /* First look at the lengths */ 1209 POLYUNSIGNED lx = get_length(x); 1210 POLYUNSIGNED ly = get_length(y); 1211 1212 if (lx != ly) /* u > v if u longer than v */ 1213 { 1214 return (lx > ly ? 1 : -1); 1215 } 1216 1217 // Same length - look at the values. */ 1218 byte *u = x.AsCodePtr(); 1219 byte *v = y.AsCodePtr(); 1220 1221 POLYUNSIGNED i = lx; 1222 while (i > 0) 1223 { 1224 i--; 1225 if (u[i] != v[i]) 1226 { 1227 return u[i] > v[i] ? 1 : -1; 1228 } 1229 } 1230 /* Must be equal */ 1231 return 0; 1232#endif 1233} 1234 1235int compareLong(PolyWord y, PolyWord x) 1236{ 1237 // Test if the values are bitwise equal. If either is short 1238 // this is the only case where the values could be equal. 1239 if (x == y) // Equal 1240 return 0; 1241 1242 if (x.IsTagged()) 1243 { 1244 // x is short. 1245 if (y.IsTagged()) { 1246 // Both short. We've already tested for equality. 1247 if (x.UnTagged() < y.UnTagged()) 1248 return -1; // Less 1249 else return 1; // Greater 1250 } 1251 // y is not short. Just test the sign. If it's negative 1252 // it must be less than any short value and if it's positive 1253 // it must be greater. 1254 if (OBJ_IS_NEGATIVE(GetLengthWord(y))) 1255 return 1; // x is greater 1256 else return -1; // x is less 1257 } 1258 1259 // x is not short 1260 if (y.IsTagged()) 1261 { 1262 // y is short. Just test the sign of x 1263 if (OBJ_IS_NEGATIVE(GetLengthWord(x))) 1264 return -1; // x is less 1265 else return 1; // x is greater 1266 } 1267 1268 // Must both be long. We may be able to determine the result based purely on the sign bits. 1269 if (! OBJ_IS_NEGATIVE(GetLengthWord(x))) /* x is positive */ 1270 { 1271 if (! OBJ_IS_NEGATIVE(GetLengthWord(y))) /* y also positive */ 1272 { 1273 return compare_unsigned(x, y); 1274 } 1275 else /* y negative so x > y */ 1276 { 1277 return 1; 1278 } 1279 } 1280 else 1281 { /* x is negative */ 1282 if (OBJ_IS_NEGATIVE(GetLengthWord(y))) /* y also negative */ 1283 { 1284 return compare_unsigned(y, x); 1285 } 1286 else /* y positive so x < y */ 1287 { 1288 return -1; 1289 } 1290 } 1291} /* compareLong */ 1292 1293/* logical_long. General purpose function for binary logical operations. */ 1294static Handle logical_long(TaskData *taskData, Handle x, Handle y, int signX, int signY, 1295 unsigned(*op)(unsigned, unsigned)) 1296{ 1297 byte *u; /* byte-pointer for longer number */ 1298 byte *v; /* byte-pointer for shorter number */ 1299 Handle z; 1300 int sign, signU, signV; 1301 1302 POLYUNSIGNED lu; /* length of u in bytes */ 1303 POLYUNSIGNED lv; /* length of v in bytes */ 1304 1305 { /* find the longer number */ 1306#ifdef USE_GMP 1307 POLYUNSIGNED lx = numLimbs(DEREFWORD(x)) * sizeof(mp_limb_t); 1308 POLYUNSIGNED ly = numLimbs(DEREFWORD(y)) * sizeof(mp_limb_t); 1309#else 1310 POLYUNSIGNED lx = get_length(DEREFWORD(x)); 1311 POLYUNSIGNED ly = get_length(DEREFWORD(y)); 1312#endif 1313 1314 /* Make ``u'' the longer. */ 1315 if (lx < ly) 1316 { 1317 // Get result vector. There can't be any carry at the end so 1318 // we just need to make this as large as the larger number. 1319 z = alloc_and_save(taskData, WORDS(ly), F_MUTABLE_BIT|F_BYTE_OBJ); 1320 1321 /* now safe to dereference pointers */ 1322 u = DEREFBYTEHANDLE(y); lu = ly; 1323 v = DEREFBYTEHANDLE(x); lv = lx; 1324 signU = signY; signV = signX; 1325 } 1326 1327 else 1328 { 1329 /* Get result vector. */ 1330 z = alloc_and_save(taskData, WORDS(lx+1), F_MUTABLE_BIT|F_BYTE_OBJ); 1331 1332 /* now safe to dereference pointers */ 1333 u = DEREFBYTEHANDLE(x); lu = lx; 1334 v = DEREFBYTEHANDLE(y); lv = ly; 1335 signU = signX; signV = signY; 1336 } 1337 } 1338 1339 sign = (*op)(signU, signV); /* -1 if negative, 0 if positive. */ 1340 1341 { /* do the actual operations */ 1342 byte *w = DEREFBYTEHANDLE(z); 1343 int borrowU = 1, borrowV = 1, borrowW = 1; 1344 POLYUNSIGNED i = 0; 1345 1346 /* Do the operations. */ 1347 for( ; i < lv; i++) 1348 { 1349 int wI; 1350 /* Have to convert negative values to twos complement. */ 1351 if (signU) borrowU += 255 - u[i]; 1352 else borrowU = u[i]; 1353 if (signV) borrowV += 255 - v[i]; 1354 else borrowV = v[i]; 1355 wI = (*op)(borrowU, borrowV) & 255; 1356 if (sign) 1357 { 1358 /* Have to convert the result back to twos complement. */ 1359 borrowW += 255 - wI; 1360 w[i] = borrowW & 255; 1361 borrowW >>= 8; 1362 } 1363 else w[i] = wI; 1364 borrowU >>= 8; 1365 borrowV >>= 8; 1366 } 1367 /* At this point the borrow of V should be zero. */ 1368 ASSERT(signV == 0 || borrowV == 0); 1369 1370 /* Continue with ``u''. */ 1371 for( ; i < lu; i++) 1372 { 1373 int wI; 1374 if (signU) borrowU += 255 - u[i]; 1375 else borrowU = u[i]; 1376 if (signV) borrowV = 255; else borrowV = 0; 1377 wI = (*op)(borrowU, borrowV) & 255; 1378 if (sign) 1379 { 1380 /* Have to convert the result back to twos complement. */ 1381 borrowW += 255 - wI; 1382 w[i] = borrowW & 255; 1383 borrowW >>= 8; 1384 } 1385 else w[i] = wI; 1386 borrowU >>= 8; 1387 borrowV >>= 8; 1388 } 1389 /* We should now no longer have any borrows. */ 1390 ASSERT(signU == 0 || borrowU == 0); 1391 ASSERT(sign == 0 || borrowW == 0); 1392 } 1393 1394 return make_canonical(taskData, z, sign); 1395} /* logical_long */ 1396 1397static unsigned doAnd(unsigned i, unsigned j) 1398{ 1399 return i & j; 1400} 1401 1402static unsigned doOr(unsigned i, unsigned j) 1403{ 1404 return i | j; 1405} 1406 1407static unsigned doXor(unsigned i, unsigned j) 1408{ 1409 return i ^ j; 1410} 1411 1412Handle and_longc(TaskData *taskData, Handle y, Handle x) 1413{ 1414 if (IS_INT(DEREFWORD(x)) && 1415 IS_INT(DEREFWORD(y))) /* Both short */ 1416 { 1417 /* There's no problem with overflow so we can just AND together 1418 the values. */ 1419 POLYSIGNED t = UNTAGGED(DEREFWORD(x)) & UNTAGGED(DEREFWORD(y)); 1420 return taskData->saveVec.push(TAGGED(t)); 1421 } 1422 1423#if USE_GMP 1424 PolyWord x_extend[1+WORDS(sizeof(mp_limb_t))]; 1425 PolyWord y_extend[1+WORDS(sizeof(mp_limb_t))]; 1426#else 1427 PolyWord x_extend[2], y_extend[2]; 1428#endif 1429 SaveVecEntry x_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(x_extend[1]))); 1430 Handle x_ehandle = &x_extend_addr; 1431 SaveVecEntry y_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(y_extend[1]))); 1432 Handle y_ehandle = &y_extend_addr; 1433 1434 // Convert to long form. 1435 int sign_x, sign_y; 1436 Handle long_x = get_long(x, x_ehandle, &sign_x); 1437 Handle long_y = get_long(y, y_ehandle, &sign_y); 1438 1439 return logical_long(taskData, long_x, long_y, sign_x, sign_y, doAnd); 1440} 1441 1442Handle or_longc(TaskData *taskData, Handle y, Handle x) 1443{ 1444 if (IS_INT(DEREFWORD(x)) && 1445 IS_INT(DEREFWORD(y))) /* Both short */ 1446 { 1447 /* There's no problem with overflow so we can just OR together 1448 the values. */ 1449 POLYSIGNED t = UNTAGGED(DEREFWORD(x)) | UNTAGGED(DEREFWORD(y)); 1450 return taskData->saveVec.push(TAGGED(t)); 1451 } 1452 1453#if USE_GMP 1454 PolyWord x_extend[1+WORDS(sizeof(mp_limb_t))]; 1455 PolyWord y_extend[1+WORDS(sizeof(mp_limb_t))]; 1456#else 1457 PolyWord x_extend[2], y_extend[2]; 1458#endif 1459 SaveVecEntry x_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(x_extend[1]))); 1460 Handle x_ehandle = &x_extend_addr; 1461 SaveVecEntry y_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(y_extend[1]))); 1462 Handle y_ehandle = &y_extend_addr; 1463 1464 // Convert to long form. 1465 int sign_x, sign_y; 1466 Handle long_x = get_long(x, x_ehandle, &sign_x); 1467 Handle long_y = get_long(y, y_ehandle, &sign_y); 1468 1469 return logical_long(taskData, long_x, long_y, sign_x, sign_y, doOr); 1470} 1471 1472Handle xor_longc(TaskData *taskData, Handle y, Handle x) 1473{ 1474 if (IS_INT(DEREFWORD(x)) && 1475 IS_INT(DEREFWORD(y))) /* Both short */ 1476 { 1477 /* There's no problem with overflow so we can just XOR together 1478 the values. */ 1479 POLYSIGNED t = UNTAGGED(DEREFWORD(x)) ^ UNTAGGED(DEREFWORD(y)); 1480 return taskData->saveVec.push(TAGGED(t)); 1481 } 1482 1483#if USE_GMP 1484 PolyWord x_extend[1+WORDS(sizeof(mp_limb_t))]; 1485 PolyWord y_extend[1+WORDS(sizeof(mp_limb_t))]; 1486#else 1487 PolyWord x_extend[2], y_extend[2]; 1488#endif 1489 SaveVecEntry x_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(x_extend[1]))); 1490 Handle x_ehandle = &x_extend_addr; 1491 SaveVecEntry y_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(y_extend[1]))); 1492 Handle y_ehandle = &y_extend_addr; 1493 1494 // Convert to long form. 1495 int sign_x, sign_y; 1496 Handle long_x = get_long(x, x_ehandle, &sign_x); 1497 Handle long_y = get_long(y, y_ehandle, &sign_y); 1498 1499 return logical_long(taskData, long_x, long_y, sign_x, sign_y, doXor); 1500} 1501 1502// Convert a long precision value to floating point 1503double get_arbitrary_precision_as_real(PolyWord x) 1504{ 1505 if (IS_INT(x)) { 1506 POLYSIGNED t = UNTAGGED(x); 1507 return (double)t; 1508 } 1509 double acc = 0; 1510#if USE_GMP 1511 mp_limb_t *u = (mp_limb_t *)(x.AsObjPtr()); 1512 mp_size_t lx = numLimbs(x); 1513 for ( ; lx > 0; lx--) { 1514 int ll = sizeof(mp_limb_t); 1515 for ( ; ll > 0 ; ll-- ) { 1516 acc = acc * 256; 1517 } 1518 acc = acc + (double)u[lx-1]; 1519 } 1520#else 1521 byte *u = (byte *)(x.AsObjPtr()); 1522 POLYUNSIGNED lx = OBJECT_LENGTH(x)*sizeof(PolyWord); 1523 for( ; lx > 0; lx--) { 1524 acc = acc * 256 + (double)u[lx-1]; 1525 } 1526#endif 1527 if (OBJ_IS_NEGATIVE(GetLengthWord(x))) 1528 return -acc; 1529 else return acc; 1530} 1531 1532 1533/* Arbitrary precision GCD function. This is really included to make 1534 use of GMP's GCD function that selects an algorithm based on the 1535 length of the arguments. */ 1536 1537#ifdef USE_GMP 1538Handle gcd_arbitrary(TaskData *taskData, Handle x, Handle y) 1539{ 1540 /* mpn_gcd requires that each argument is odd and its first argument must be 1541 no longer than its second. This requires shifting before the call and after 1542 the result has been returned. This code is modelled roughly on the high level 1543 mpz_gcd call in GMP. */ 1544 PolyWord x_extend[1+WORDS(sizeof(mp_limb_t))]; 1545 PolyWord y_extend[1+WORDS(sizeof(mp_limb_t))]; 1546 SaveVecEntry x_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(x_extend[1]))); 1547 Handle x_ehandle = &x_extend_addr; 1548 SaveVecEntry y_extend_addr = SaveVecEntry(PolyWord::FromStackAddr(&(y_extend[1]))); 1549 Handle y_ehandle = &y_extend_addr; 1550 int sign_x, sign_y; // Signs are ignored - the result is always positive. 1551 Handle long_x = get_long(x, x_ehandle, &sign_x); 1552 Handle long_y = get_long(y, y_ehandle, &sign_y); 1553 1554 mp_size_t lx = numLimbs(DEREFWORD(long_x)); 1555 mp_size_t ly = numLimbs(DEREFWORD(long_y)); 1556 1557 // Test for zero length and therefore zero argument 1558 if (lx == 0) 1559 { 1560 // GCD(0,y) = abs(y) 1561 if (sign_y) 1562 return neg_longc(taskData, y); 1563 else return y; 1564 } 1565 if (ly == 0) 1566 { 1567 // GCD(x,0 = abs(x) 1568 if (sign_x) 1569 return neg_longc(taskData, x); 1570 else return x; 1571 } 1572 // If one of the arguments is a single limb we can use the special case. 1573 // This doesn't require shifting. It also doesn't say that it could 1574 // overwrite the arguments. 1575 if (lx == 1 || ly == 1) 1576 { 1577 mp_limb_t g = 1578 (lx == 1) ? mpn_gcd_1(DEREFLIMBHANDLE(long_y), ly, *DEREFLIMBHANDLE(long_x)) : 1579 mpn_gcd_1(DEREFLIMBHANDLE(long_x), lx, *DEREFLIMBHANDLE(long_y)); 1580 if (g <= MAXTAGGED) 1581 return taskData->saveVec.push(TAGGED(g)); 1582 // Need to allocate space. 1583 Handle r = alloc_and_save(taskData, WORDS(sizeof(mp_limb_t)), F_BYTE_OBJ); 1584 *(DEREFLIMBHANDLE(r)) = g; 1585 return r; 1586 } 1587 1588 // Memory for result. This can be up to the shorter of the two. 1589 // We rely on this zero the memory because we may not set every word here. 1590 Handle r = alloc_and_save(taskData, WORDS((lx < ly ? lx : ly)*sizeof(mp_limb_t)), F_BYTE_OBJ|F_MUTABLE_BIT); 1591 // Can now dereference the handles. 1592 mp_limb_t *xl = DEREFLIMBHANDLE(long_x); 1593 mp_limb_t *yl = DEREFLIMBHANDLE(long_y); 1594 mp_limb_t *rl = DEREFLIMBHANDLE(r); 1595 1596 unsigned xZeroLimbs = 0, xZeroBits = 0; 1597 // Remove whole limbs of zeros. There must be a word which is non-zero. 1598 while (*xl == 0) { xl++; xZeroLimbs++; lx--; } 1599 // Count the low-order bits and shift by that amount. 1600 mp_limb_t t = *xl; 1601 while ((t & 1) == 0) { t = t >> 1; xZeroBits++; } 1602 // Copy the non-zero limbs into a temporary, shifting if necessary. 1603 mp_limb_t *xC = (mp_limb_t*)alloca(lx * sizeof(mp_limb_t)); 1604 if (xZeroBits != 0) 1605 { 1606 mpn_rshift(xC, xl, lx, xZeroBits); 1607 if (xC[lx-1] == 0) lx--; 1608 } 1609 else memcpy(xC, xl, lx * sizeof(mp_limb_t)); 1610 1611 unsigned yZeroLimbs = 0, yZeroBits = 0; 1612 while (*yl == 0) { yl++; yZeroLimbs++; ly--; } 1613 t = *yl; 1614 while ((t & 1) == 0) { t = t >> 1; yZeroBits++; } 1615 mp_limb_t *yC = (mp_limb_t*)alloca(ly * sizeof(mp_limb_t)); 1616 if (yZeroBits != 0) 1617 { 1618 mpn_rshift(yC, yl, ly, yZeroBits); 1619 if (yC[ly-1] == 0) ly--; 1620 } 1621 else memcpy(yC, yl, ly * sizeof(mp_limb_t)); 1622 1623 // The result length and shift is the smaller of these 1624 unsigned rZeroLimbs, rZeroBits; 1625 if (xZeroLimbs < yZeroLimbs || (xZeroLimbs == yZeroLimbs && xZeroBits < yZeroBits)) 1626 { 1627 rZeroLimbs = xZeroLimbs; 1628 rZeroBits = xZeroBits; 1629 } 1630 else 1631 { 1632 rZeroLimbs = yZeroLimbs; 1633 rZeroBits = yZeroBits; 1634 } 1635 // Now actually compute the GCD 1636 if (lx < ly || (lx == ly && xC[lx-1] < yC[ly-1])) 1637 lx = mpn_gcd(xC, yC, ly, xC, lx); 1638 else 1639 lx = mpn_gcd(xC, xC, lx, yC, ly); 1640 // Shift the temporary result into the final area. 1641 if (rZeroBits != 0) 1642 { 1643 t = mpn_lshift(rl+rZeroLimbs, xC, lx, rZeroBits); 1644 if (t != 0) 1645 rl[rZeroLimbs+lx] = t; 1646 } 1647 else memcpy(rl+rZeroLimbs, xC, lx * sizeof(mp_limb_t)); 1648 1649 return make_canonical(taskData, r, false); 1650} 1651 1652#else 1653// Fallback version for when GMP is not defined. 1654static Handle gxd(TaskData *taskData, Handle x, Handle y) 1655{ 1656 Handle marker = taskData->saveVec.mark(); 1657 while (1) 1658 { 1659 if (DEREFWORD(y) == TAGGED(0)) 1660 return x; 1661 1662 Handle res = rem_longc(taskData, y, x); 1663 PolyWord newY = res->Word(); 1664 PolyWord newX = y->Word(); 1665 taskData->saveVec.reset(marker); 1666 y = taskData->saveVec.push(newY); 1667 x = taskData->saveVec.push(newX); 1668 } 1669} 1670 1671static Handle absValue(TaskData *taskData, Handle x) 1672{ 1673 if (IS_INT(DEREFWORD(x))) 1674 { 1675 if (UNTAGGED(DEREFWORD(x)) < 0) 1676 return neg_longc(taskData, x); 1677 } 1678 else if (OBJ_IS_NEGATIVE(GetLengthWord(DEREFWORD(x)))) 1679 return neg_longc(taskData, x); 1680 return x; 1681} 1682 1683Handle gcd_arbitrary(TaskData *taskData, Handle x, Handle y) 1684{ 1685 x = absValue(taskData, x); 1686 y = absValue(taskData, y); 1687 1688 if (compareLong(y->Word(), x->Word()) < 0) 1689 return gxd(taskData, y, x); 1690 else return gxd(taskData, x, y); 1691} 1692#endif 1693 1694// This is provided as an adjunct to GCD. Using this saves the RTS 1695// calls necessary for the division and multiplication. 1696Handle lcm_arbitrary(TaskData *taskData, Handle x, Handle y) 1697{ 1698 Handle g = gcd_arbitrary(taskData, x, y); 1699 return mult_longc(taskData, x, div_longc(taskData, g, y)); 1700} 1701 1702POLYUNSIGNED PolyAddArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2) 1703{ 1704 TaskData *taskData = TaskData::FindTaskForId(threadId); 1705 ASSERT(taskData != 0); 1706 taskData->PreRTSCall(); 1707 Handle reset = taskData->saveVec.mark(); 1708 Handle pushedArg1 = taskData->saveVec.push(arg1); 1709 Handle pushedArg2 = taskData->saveVec.push(arg2); 1710 Handle result = 0; 1711 1712 if (profileMode == kProfileEmulation) 1713 taskData->addProfileCount(1); 1714 1715 try { 1716 // Could raise an exception if out of memory. 1717 result = add_longc(taskData, pushedArg2, pushedArg1); 1718 } 1719 catch (...) { } // If an ML exception is raised 1720 1721 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1722 taskData->PostRTSCall(); 1723 if (result == 0) return TAGGED(0).AsUnsigned(); 1724 else return result->Word().AsUnsigned(); 1725} 1726 1727POLYUNSIGNED PolySubtractArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2) 1728{ 1729 TaskData *taskData = TaskData::FindTaskForId(threadId); 1730 ASSERT(taskData != 0); 1731 taskData->PreRTSCall(); 1732 Handle reset = taskData->saveVec.mark(); 1733 Handle pushedArg1 = taskData->saveVec.push(arg1); 1734 Handle pushedArg2 = taskData->saveVec.push(arg2); 1735 Handle result = 0; 1736 1737 if (profileMode == kProfileEmulation) 1738 taskData->addProfileCount(1); 1739 1740 try { 1741 result = sub_longc(taskData, pushedArg2, pushedArg1); 1742 } catch (...) { } // If an ML exception is raised 1743 1744 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1745 taskData->PostRTSCall(); 1746 if (result == 0) return TAGGED(0).AsUnsigned(); 1747 else return result->Word().AsUnsigned(); 1748} 1749 1750POLYUNSIGNED PolyMultiplyArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2) 1751{ 1752 TaskData *taskData = TaskData::FindTaskForId(threadId); 1753 ASSERT(taskData != 0); 1754 taskData->PreRTSCall(); 1755 Handle reset = taskData->saveVec.mark(); 1756 Handle pushedArg1 = taskData->saveVec.push(arg1); 1757 Handle pushedArg2 = taskData->saveVec.push(arg2); 1758 Handle result = 0; 1759 1760 if (profileMode == kProfileEmulation) 1761 taskData->addProfileCount(1); 1762 1763 try { 1764 result = mult_longc(taskData, pushedArg2, pushedArg1); 1765 } catch (...) { } // If an ML exception is raised 1766 1767 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1768 taskData->PostRTSCall(); 1769 if (result == 0) return TAGGED(0).AsUnsigned(); 1770 else return result->Word().AsUnsigned(); 1771} 1772 1773POLYUNSIGNED PolyDivideArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2) 1774{ 1775 TaskData *taskData = TaskData::FindTaskForId(threadId); 1776 ASSERT(taskData != 0); 1777 taskData->PreRTSCall(); 1778 Handle reset = taskData->saveVec.mark(); 1779 Handle pushedArg1 = taskData->saveVec.push(arg1); 1780 Handle pushedArg2 = taskData->saveVec.push(arg2); 1781 Handle result = 0; 1782 1783 if (profileMode == kProfileEmulation) 1784 taskData->addProfileCount(1); 1785 1786 try { 1787 // May raise divide exception 1788 result = div_longc(taskData, pushedArg2, pushedArg1); 1789 } catch (...) { } // If an ML exception is raised 1790 1791 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1792 taskData->PostRTSCall(); 1793 if (result == 0) return TAGGED(0).AsUnsigned(); 1794 else return result->Word().AsUnsigned(); 1795} 1796 1797POLYUNSIGNED PolyRemainderArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2) 1798{ 1799 TaskData *taskData = TaskData::FindTaskForId(threadId); 1800 ASSERT(taskData != 0); 1801 taskData->PreRTSCall(); 1802 Handle reset = taskData->saveVec.mark(); 1803 Handle pushedArg1 = taskData->saveVec.push(arg1); 1804 Handle pushedArg2 = taskData->saveVec.push(arg2); 1805 Handle result = 0; 1806 1807 if (profileMode == kProfileEmulation) 1808 taskData->addProfileCount(1); 1809 1810 try { 1811 result = rem_longc(taskData, pushedArg2, pushedArg1); 1812 } catch (...) { } // If an ML exception is raised 1813 1814 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1815 taskData->PostRTSCall(); 1816 if (result == 0) return TAGGED(0).AsUnsigned(); 1817 else return result->Word().AsUnsigned(); 1818} 1819 1820POLYUNSIGNED PolyQuotRemArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2, PolyWord arg3) 1821{ 1822 TaskData *taskData = TaskData::FindTaskForId(threadId); 1823 ASSERT(taskData != 0); 1824 taskData->PreRTSCall(); 1825 Handle reset = taskData->saveVec.mark(); 1826 Handle pushedArg1 = taskData->saveVec.push(arg1); 1827 Handle pushedArg2 = taskData->saveVec.push(arg2); 1828 Handle pushedArg3 = taskData->saveVec.push(arg3); 1829 1830 if (profileMode == kProfileEmulation) 1831 taskData->addProfileCount(1); 1832 1833 try { 1834 quot_rem_c(taskData, pushedArg3, pushedArg2, pushedArg1); 1835 } catch (...) { } // If an ML exception is raised 1836 1837 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1838 taskData->PostRTSCall(); 1839 return 0; // Result is unit 1840} 1841 1842// This can be a fast call. It does not need to allocate or use handles. 1843POLYSIGNED PolyCompareArbitrary(PolyWord arg1, PolyWord arg2) 1844{ 1845 return TAGGED(compareLong(arg2, arg1)).AsSigned(); 1846} 1847 1848POLYUNSIGNED PolyGCDArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2) 1849{ 1850 TaskData *taskData = TaskData::FindTaskForId(threadId); 1851 ASSERT(taskData != 0); 1852 taskData->PreRTSCall(); 1853 Handle reset = taskData->saveVec.mark(); 1854 Handle pushedArg1 = taskData->saveVec.push(arg1); 1855 Handle pushedArg2 = taskData->saveVec.push(arg2); 1856 Handle result = 0; 1857 1858 try { 1859 result = gcd_arbitrary(taskData, pushedArg2, pushedArg1); 1860 // Generally shouldn't raise an exception but might run out of store. 1861 } catch (...) { } // If an ML exception is raised 1862 1863 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1864 taskData->PostRTSCall(); 1865 if (result == 0) return TAGGED(0).AsUnsigned(); 1866 else return result->Word().AsUnsigned(); 1867} 1868 1869POLYUNSIGNED PolyLCMArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2) 1870{ 1871 TaskData *taskData = TaskData::FindTaskForId(threadId); 1872 ASSERT(taskData != 0); 1873 taskData->PreRTSCall(); 1874 Handle reset = taskData->saveVec.mark(); 1875 Handle pushedArg1 = taskData->saveVec.push(arg1); 1876 Handle pushedArg2 = taskData->saveVec.push(arg2); 1877 Handle result = 0; 1878 1879 try { 1880 result = lcm_arbitrary(taskData, pushedArg2, pushedArg1); 1881 // Generally shouldn't raise an exception but might run out of store. 1882 } catch (...) { } // If an ML exception is raised 1883 1884 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1885 taskData->PostRTSCall(); 1886 if (result == 0) return TAGGED(0).AsUnsigned(); 1887 else return result->Word().AsUnsigned(); 1888} 1889 1890// Extract the low order part of an arbitrary precision value as a boxed LargeWord.word 1891// value. If the value is negative it is treated as a twos complement value. 1892// This is used Word.fromLargeInt and LargeWord.fromLargeInt with long-form 1893// arbitrary precision values. 1894POLYUNSIGNED PolyGetLowOrderAsLargeWord(PolyObject *threadId, PolyWord arg) 1895{ 1896 TaskData *taskData = TaskData::FindTaskForId(threadId); 1897 ASSERT(taskData != 0); 1898 taskData->PreRTSCall(); 1899 Handle reset = taskData->saveVec.mark(); 1900 POLYSIGNED p = 0; 1901 1902 if (arg.IsTagged()) 1903 p = arg.UnTagged(); 1904 else 1905 { 1906 bool negative = OBJ_IS_NEGATIVE(GetLengthWord(arg)) ? true : false; 1907#ifdef USE_GMP 1908 mp_limb_t c = *(mp_limb_t*)arg.AsCodePtr(); 1909 p = c; 1910#else 1911 POLYUNSIGNED length = get_length(arg); 1912 if (length > sizeof(PolyWord)) length = sizeof(PolyWord); 1913 byte *ptr = arg.AsCodePtr(); 1914 while (length--) 1915 { 1916 p = (p << 8) | ptr[length]; 1917 } 1918#endif 1919 if (negative) p = -p; 1920 } 1921 1922 Handle result = alloc_and_save(taskData, 1, F_BYTE_OBJ); 1923 result->WordP()->Set(0, PolyWord::FromUnsigned(p)); 1924 1925 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1926 taskData->PostRTSCall(); 1927 return result->Word().AsUnsigned(); 1928 1929 1930} 1931 1932POLYUNSIGNED PolyOrArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2) 1933{ 1934 TaskData *taskData = TaskData::FindTaskForId(threadId); 1935 ASSERT(taskData != 0); 1936 taskData->PreRTSCall(); 1937 Handle reset = taskData->saveVec.mark(); 1938 Handle pushedArg1 = taskData->saveVec.push(arg1); 1939 Handle pushedArg2 = taskData->saveVec.push(arg2); 1940 Handle result = 0; 1941 1942 try { 1943 // Could raise an exception if out of memory. 1944 result = or_longc(taskData, pushedArg2, pushedArg1); 1945 } 1946 catch (...) { } // If an ML exception is raised 1947 1948 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1949 taskData->PostRTSCall(); 1950 if (result == 0) return TAGGED(0).AsUnsigned(); 1951 else return result->Word().AsUnsigned(); 1952} 1953 1954POLYUNSIGNED PolyAndArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2) 1955{ 1956 TaskData *taskData = TaskData::FindTaskForId(threadId); 1957 ASSERT(taskData != 0); 1958 taskData->PreRTSCall(); 1959 Handle reset = taskData->saveVec.mark(); 1960 Handle pushedArg1 = taskData->saveVec.push(arg1); 1961 Handle pushedArg2 = taskData->saveVec.push(arg2); 1962 Handle result = 0; 1963 1964 try { 1965 // Could raise an exception if out of memory. 1966 result = and_longc(taskData, pushedArg2, pushedArg1); 1967 } 1968 catch (...) { } // If an ML exception is raised 1969 1970 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1971 taskData->PostRTSCall(); 1972 if (result == 0) return TAGGED(0).AsUnsigned(); 1973 else return result->Word().AsUnsigned(); 1974} 1975 1976POLYUNSIGNED PolyXorArbitrary(PolyObject *threadId, PolyWord arg1, PolyWord arg2) 1977{ 1978 TaskData *taskData = TaskData::FindTaskForId(threadId); 1979 ASSERT(taskData != 0); 1980 taskData->PreRTSCall(); 1981 Handle reset = taskData->saveVec.mark(); 1982 Handle pushedArg1 = taskData->saveVec.push(arg1); 1983 Handle pushedArg2 = taskData->saveVec.push(arg2); 1984 Handle result = 0; 1985 1986 try { 1987 // Could raise an exception if out of memory. 1988 result = xor_longc(taskData, pushedArg2, pushedArg1); 1989 } 1990 catch (...) { } // If an ML exception is raised 1991 1992 taskData->saveVec.reset(reset); // Ensure the save vec is reset 1993 taskData->PostRTSCall(); 1994 if (result == 0) return TAGGED(0).AsUnsigned(); 1995 else return result->Word().AsUnsigned(); 1996} 1997 1998struct _entrypts arbitraryPrecisionEPT[] = 1999{ 2000 { "PolyAddArbitrary", (polyRTSFunction)&PolyAddArbitrary}, 2001 { "PolySubtractArbitrary", (polyRTSFunction)&PolySubtractArbitrary}, 2002 { "PolyMultiplyArbitrary", (polyRTSFunction)&PolyMultiplyArbitrary}, 2003 { "PolyDivideArbitrary", (polyRTSFunction)&PolyDivideArbitrary}, 2004 { "PolyRemainderArbitrary", (polyRTSFunction)&PolyRemainderArbitrary}, 2005 { "PolyQuotRemArbitrary", (polyRTSFunction)&PolyQuotRemArbitrary}, 2006 { "PolyCompareArbitrary", (polyRTSFunction)&PolyCompareArbitrary}, 2007 { "PolyGCDArbitrary", (polyRTSFunction)&PolyGCDArbitrary}, 2008 { "PolyLCMArbitrary", (polyRTSFunction)&PolyLCMArbitrary}, 2009 { "PolyGetLowOrderAsLargeWord", (polyRTSFunction)&PolyGetLowOrderAsLargeWord}, 2010 { "PolyOrArbitrary", (polyRTSFunction)&PolyOrArbitrary}, 2011 { "PolyAndArbitrary", (polyRTSFunction)&PolyAndArbitrary}, 2012 { "PolyXorArbitrary", (polyRTSFunction)&PolyXorArbitrary}, 2013 2014 { NULL, NULL} // End of list. 2015}; 2016