123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962 |
- /* Definitions for the integer types.
- This file is part of khipu.
- khipu is free software: you can redistribute it and/or modify
- it under the terms of the GNU Lesser General Public License as published by
- the Free Software Foundation; either version 3 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU Lesser General Public License for more details.
- You should have received a copy of the GNU Lesser General Public License
- along with this program. If not, see <https://www.gnu.org/licenses/>. */
- #include <cstring>
- #include <climits>
- #include <cstdlib>
- #include "integer.hpp"
- #include "memory.hpp"
- #include "stream.hpp"
- #include "io.hpp"
- KP_DECLS_BEGIN
- result<object> idiv_ii (interpreter *interp, object x, object y)
- {
- int v1 = as_int (x), v2 = as_int (y);
- if (v2 == 0)
- return (interp->raise ("arith-error", "division by zero"));
- kp_return (fixint (v1 / v2));
- }
- result<object> mod_ii (interpreter *interp, object x, object y)
- {
- int v1 = as_int (x), v2 = as_int (y);
- if (v2 == 0)
- return (interp->raise ("arith-error", "modulo by zero"));
- kp_return (fixint (v1 % v2));
- }
- object rsh_ii (interpreter *interp, object x, object y)
- {
- int v2 = as_int (y);
- kp_return (v2 >= 0 ? fixint (as_int (x) >> v2) :
- lsh_ii (interp, x, neg_i (interp, y)));
- }
- static object bigint_lsh (interpreter *, const bigint *, int, int);
- object lsh_ii (interpreter *interp, object x, object y)
- {
- int v1 = as_int (x), v2 = as_int (y);
- if (v2 < 0)
- return (fixint (v1 >> -v2));
- else if (v2 >= FIXINT_BITS ||
- (uintptr_t)abs (v1) > (1u << (FIXINT_BITS - v2)))
- {
- local_varobj<bigint> tmp;
- limb_t data = (limb_t)abs (v1);
- tmp.local_init (&data, 1);
- kp_return (bigint_lsh (interp, &tmp, v2, v1 < 0));
- }
- kp_return (fixint (v1 << v2));
- }
- // Bigint implementation.
- static_assert (alignof (bigint) % alignof (limb_t) == 0,
- "invalid alignment for big integers");
- bigint* bigint::alloc_raw (int len)
- {
- bigint *retp = (bigint *)alloch (sizeof (*retp) + sizeof (limb_t) * len,
- typecode::BIGINT, TYPE_SHIFT + 1);
- retp->len = len;
- retp->data = (limb_t *)&retp[1];
- retp->vo_full |= FLAGS_CONST;
- return (retp);
- }
- object alloc_bigint (interpreter *interp, int len)
- {
- auto retp = bigint::alloc_raw (len);
- interp->alval = retp->as_obj ();
- gc_register (interp, retp, sizeof (*retp) + len * sizeof (limb_t));
- return (interp->alval);
- }
- static inline bigint* get_bigint (object obj, int& sign)
- {
- #ifdef KP_ARCH_WIDE
- sign = varobj_sign (obj);
- #else
- sign = as_bigint(obj)->len < 0;
- #endif
- return (as_bigint (obj));
- }
- #ifdef KP_ARCH_WIDE
- # define make_bigint(ptr, sign) \
- ptrtype ((ptr), typecode::BIGINT) | ((sign) ? SIGN_BIT : 0)
- # define I_ABS(val) val
- #else
- static object make_bigint (bigint *ptr, int sign)
- {
- if (sign)
- ptr->len = -ptr->len;
- return (ptr->as_obj ());
- }
- # define I_ABS abs
- #endif
- // SRC must be allocated, but *not* registered.
- static object
- ret_I (interpreter *interp, bigint *src, int sign)
- {
- if (src->len == 1 && *src->data <= (limb_t)FIXINT_MAX + sign)
- {
- int tmp = sign ? -(int)*src->data : *src->data;
- xfree (src);
- return (fixint (tmp));
- }
- interp->alval = make_bigint (src, sign);
- gc_register (interp, src, sizeof (*src) + src->len * sizeof (limb_t));
- return (interp->alval);
- }
- object bigint::make (interpreter *interp, int64_t val)
- {
- uival uval;
- bigint *ret = as_bigint (alloc_bigint (interp, 2));
- int sign = val < 0 ? (uval.qv = -val, 1) : (uval.qv = val, 0);
- ret->data[0] = uval.limbs.lo, ret->data[1] = uval.limbs.hi;
- ret->len = 1 + (ret->data[1] != 0);
- kp_return (make_bigint (ret, sign));
- }
- object bigint::make (interpreter *interp, uint64_t val)
- {
- bigint *ret = as_bigint (alloc_bigint (interp, 2));
- ret->data[0] = (uint32_t)val, ret->data[1] = (uint32_t)(val >> 32);
- ret->len = 1 + (ret->data[1] != 0);
- kp_return (make_bigint (ret, 0));
- }
- bool bigint::cast (object self, int64_t& out)
- {
- if (!bigint_p (self))
- return (false);
- const bigint *lp = as_bigint (self);
- #ifdef KP_ARCH_WIDE
- int sign = (self & SIGN_BIT) / SIGN_BIT;
- #else
- int sign = lp->len < 0;
- #endif
- if (lp->len > 2)
- return (false);
- uint64_t uv = lp->data[0] +
- (I_ABS (lp->len) < 2 ? 0 : ((uint64_t)lp->data[1] << 32));
- if (uv > (uint64_t)INT64_MAX + sign)
- return (false);
- out = sign ? -(int64_t)uv : uv;
- return (true);
- }
- bool bigint::cast (object self, uint64_t& out)
- {
- if (!bigint_p (self))
- return (false);
- const bigint *lp = as_bigint (self);
- #ifdef KP_ARCH_WIDE
- int sign = (self & SIGN_BIT) / SIGN_BIT;
- #else
- int sign = lp->len < 0;
- #endif
- if (lp->len > 2 || sign)
- return (false);
- out = lp->data[0] + (lp->len < 2 ? 0 : (uint64_t)lp->data[1] << 32);
- return (true);
- }
- uint32_t hash_I (interpreter *interp, object obj)
- {
- int sign;
- const auto lp = get_bigint (obj, sign);
- uint32_t ret = 2 * lp->len;
- for (int i = 0; i < I_ABS (lp->len); ++i)
- ret = mix_hash (ret, lp->data[i]);
- return (sign ? ~ret : ret);
- }
- object add_II (interpreter *interp, object x, object y)
- {
- int s1, s2;
- const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
- if (s1 == s2)
- {
- int xl = I_ABS (v1->len), yl = I_ABS (v2->len), len = max (xl, yl);
- auto ret = bigint::alloc_raw (len + 1);
- ret->len = len + uiadd (ret->data, v1->data, xl, v2->data, yl);
- kp_return (ret_I (interp, ret, s1));
- }
- else if (s1 != 0)
- // -x + y => y - x
- return (sub_II (interp, y, x));
- else
- // x + (-y) => x - y
- return (sub_II (interp, x, y));
- }
- object add_iI (interpreter *interp, object x, object y)
- {
- int sign;
- const auto v2 = get_bigint (y, sign);
- int v1 = as_int (x), yl = I_ABS (v2->len);
- bigint *ret;
- if (v1 == 0)
- return (y);
- else if (!(sign ^ (v1 < 0)))
- {
- ret = bigint::alloc_raw (yl + 1);
- ret->len = yl + uiadd1 (ret->data, v2->data, yl, abs (v1));
- ret->data[yl] = ret->len - yl;
- }
- else
- {
- ret = bigint::alloc_raw (yl);
- ret->len = yl - uisub1 (ret->data, v2->data, yl, abs (v1));
- }
- kp_return (ret_I (interp, ret, sign));
- }
- object sub_II (interpreter *interp, object x, object y)
- {
- int s1, s2, rs;
- auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
- int xl = I_ABS (v1->len), yl = I_ABS (v2->len);
- if (xl < yl)
- {
- swap (v1, v2);
- swap (xl, yl);
- swap (s1, s2);
- }
- auto ret = bigint::alloc_raw (xl + 1);
- if (s1 == s2)
- { // Equal signs - subtract.
- if (xl != yl)
- {
- uisub (ret->data, v1->data, xl, v2->data, yl);
- rs = s1;
- }
- else if (uicmp (v1->data, v1->len, v2->data, v2->len) < 0)
- {
- uisubn (ret->data, v2->data, v1->data, xl);
- rs = !s1;
- }
- else
- {
- uisubn (ret->data, v1->data, v2->data, xl);
- rs = s1;
- }
- ret->len = xl;
- uitrim (ret->data, ret->len);
- }
- else
- { // Different signs - add.
- ret->len = xl + uiadd (ret->data, v1->data, xl, v2->data, yl);
- rs = s1;
- }
- kp_return (ret_I (interp, ret, rs));
- }
- object neg_I (interpreter *interp, object obj)
- {
- #ifdef KP_ARCH_WIDE
- kp_return (obj ^ SIGN_BIT);
- #else
- const bigint *src = as_bigint (obj);
- bigint *ret = as_bigint (alloc_bigint (interp, src->len));
- memcpy (ret->data, src->data, I_ABS (src->len) * sizeof (limb_t));
- ret->len = -src->len;
- kp_return (interp->alval);
- #endif
- }
- object sub_iI (interpreter *interp, object x, object y)
- {
- int sign;
- const auto v2 = get_bigint (y, sign);
- int v1 = as_int (x), yl = I_ABS (v2->len);
- bigint *ret;
- if (v1 == 0)
- return (neg_I (interp, y));
- else if (!(sign ^ (v1 < 0)))
- {
- ret = bigint::alloc_raw (yl);
- ret->len = yl - uisub1 (ret->data, v2->data, yl, abs (v1));
- }
- else
- {
- ret = bigint::alloc_raw (yl + 1);
- ret->len = yl + uiadd1 (ret->data, v2->data, yl, abs (v1));
- ret->data[ret->len] = ret->len - yl;
- }
- kp_return (ret_I (interp, ret, sign ^ 1));
- }
- object mul_II (interpreter *interp, object x, object y)
- {
- int s1, s2;
- const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
- int xl = I_ABS (v1->len), yl = I_ABS (v2->len);
- auto ret = bigint::alloc_raw (xl + yl);
- limb_t cy = v1->data == v2->data ?
- uisqr (interp, ret->data, v1->data, xl) :
- uimul (interp, ret->data, v1->data, xl, v2->data, yl);
- ret->len = xl + yl - (cy == 0);
- kp_return (ret_I (interp, ret, s1 ^ s2));
- }
- object mul_iI (interpreter *interp, object x, object y)
- {
- int sign;
- const auto v2 = get_bigint (y, sign);
- int v1 = as_int (x), yl = I_ABS (v2->len);
- if (v1 == 0)
- kp_return (fixint (0));
- else if (v1 == 1)
- kp_return (y);
- auto ret = bigint::alloc_raw (yl + 1);
- ret->len = yl + uimul1 (ret->data, v2->data, yl, abs (v1));
- kp_return (ret_I (interp, ret, sign ^ (v1 < 0)));
- }
- object idiv_II (interpreter *interp, object x, object y)
- {
- int s1, s2;
- const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
- int xl = I_ABS (v1->len), yl = I_ABS (v2->len);
- if (xl < yl)
- kp_return (fixint (0));
- auto ret = bigint::alloc_raw (xl - yl + 1);
- if (yl == 1)
- {
- ret->len = xl;
- uidivrem1 (ret->data, v1->data, xl, *v2->data);
- uitrim (ret->data, ret->len);
- }
- else
- {
- tmp_allocator ta { interp };
- limb_t *tmp = (limb_t *)ta.alloc ((xl + 1) * sizeof (*tmp));
- ret->len = uidiv (interp, v1->data, xl, v2->data, yl, tmp, false);
- // The quotient is at &TMP[length (Y)].
- memcpy (ret->data, tmp + yl, ret->len * sizeof (limb_t));
- }
- kp_return (ret_I (interp, ret, s1 ^ s2));
- }
- object idiv_iI (interpreter *interp, object, object)
- {
- kp_return (fixint (0));
- }
- result<object> idiv_Ii (interpreter *interp, object x, object y)
- {
- int sign;
- const auto v1 = get_bigint (x, sign);
- int v2 = as_int (y), xl = I_ABS (v1->len);
- if (v2 == 0)
- return (interp->raise ("arith-error", "division by zero"));
- auto ret = bigint::alloc_raw (xl);
- ret->len = xl;
- uidivrem1 (ret->data, v1->data, xl, abs (v2));
- uitrim (ret->data, ret->len);
- kp_return (ret_I (interp, ret, sign ^ (v2 < 0)));
- }
- object mod_II (interpreter *interp, object x, object y)
- {
- int s1, s2;
- const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
- int xl = I_ABS (v1->len), yl = I_ABS (v2->len);
- if (xl < yl)
- kp_return (x);
- else if (v1->data == v2->data)
- kp_return (fixint (s1 ? -1 : 1));
- tmp_allocator ta { interp };
- limb_t *tmp = (limb_t *)ta.alloc ((xl + 1) * sizeof (*tmp));
- auto ret = bigint::alloc_raw (yl);
- ret->len = yl;
-
- uidiv (interp, v1->data, xl, v2->data, yl, tmp, true);
- // Remainder is not normalised.
- uitrim (tmp, ret->len);
- memcpy (ret->data, tmp, ret->len * sizeof (limb_t));
- kp_return (ret_I (interp, ret, s1));
- }
- object mod_iI (interpreter *interp, object x, object)
- {
- kp_return (x);
- }
- result<object> mod_Ii (interpreter *interp, object x, object y)
- {
- int sign, v2 = as_int (y);
- const auto v1 = get_bigint (x, sign);
- int xl = I_ABS (v1->len);
- tmp_allocator ta { interp };
- if (v2 == 0)
- return (interp->raise ("arith-error", "modulo by zero"));
- limb_t *tmp = (limb_t *)ta.alloc (xl * sizeof (*tmp));
- limb_t rem = uidivrem1 (tmp, v1->data, xl, abs (v2));
- kp_return (fixint (sign ? -(int)rem : rem));
- }
- object not_I (interpreter *interp, object obj)
- {
- int sign;
- const auto v1 = get_bigint (obj, sign);
- int xl = I_ABS (v1->len);
- auto ret = bigint::alloc_raw (xl + 1);
- // -x == ~x + 1; therefore: ~x = -x - 1, or -(x + 1).
- ret->len = xl + uiadd1 (ret->data, v1->data, xl, 1);
- kp_return (ret_I (interp, ret, sign ^ 1));
- }
- object land_II (interpreter *interp, object x, object y)
- {
- int i, len, s1, s2;
- auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
- int xl = I_ABS (v1->len), yl = I_ABS (v2->len);
- bigint *ret;
- tmp_allocator ta { interp };
- if (s1 == 0)
- {
- if (s2 == 0)
- {
- len = min (xl, yl);
- for (i = len - 1; i >= 0; --i)
- if ((v1->data[i] & v2->data[i]) != 0)
- break;
- ret = bigint::alloc_raw (len = i + 1);
- for (i = 0; i < len; ++i)
- ret->data[i] = v1->data[i] & v2->data[i];
-
- kp_return (ret_I (interp, ret, 0));
- }
- }
- else if (s2 != 0)
- { // -X & -Y == ((X - 1) | (Y - 1)).
- limb_t *xp = (limb_t *)ta.alloc ((xl + yl) * sizeof (*xp));
- limb_t *yp = xp + xl;
- if (xl > yl)
- {
- swap (xp, yp);
- swap (xl, yl);
- }
- uisub1 (xp, v1->data, xl, 1);
- uisub1 (yp, v2->data, yl, 1);
- ret = bigint::alloc_raw (yl + 1);
- ret->len = yl;
- memcpy (ret->data + xl, yp + xl, (yl - xl) * sizeof (limb_t));
-
- for (i = 0; i < xl; ++i)
- ret->data[i] = xp[i] | yp[i];
-
- limb_t cy = uiadd1 (ret->data, ret->data, ret->len, 1);
- ret->data[ret->len] = cy;
- ret->len += cy != 0;
- kp_return (ret_I (interp, ret, 1));
- }
- else
- { // Compute -X & Y.
- swap (v1, v2);
- swap (xl, yl);
- }
- // At this point Y is negative and 1-extended. X is positive.
- limb_t *xp = (limb_t *)ta.alloc (yl * sizeof (*xp));
- uisub1 (xp, v2->data, yl, 1);
- if (xl > yl)
- {
- ret = bigint::alloc_raw (len = xl);
- memcpy (ret->data + yl, v1->data + yl, (len - yl) * sizeof (limb_t));
- for (i = 0; i < yl; ++i)
- ret->data[i] = v1->data[i] & v2->data[i];
- ret->len = len;
- kp_return (ret_I (interp, ret, 0));
- }
- for (i = xl - 1; i >= 0; --i)
- if ((v1->data[i] & ~v2->data[i]) != 0)
- break;
- if (i < 0)
- kp_return (fixint (0));
- ret = bigint::alloc_raw (len = i + 1);
- for (i = 0; i < len; ++i)
- ret->data[i] = v1->data[i] & ~v2->data[i];
-
- ret->len = len;
- kp_return (ret_I (interp, ret, 0));
- }
- object lor_II (interpreter *interp, object x, object y)
- {
- int s1, s2, len, i;
- auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
- int xl = I_ABS (v1->len), yl = I_ABS (v2->len);
- bigint *ret;
- tmp_allocator ta { interp };
- if (s1 == 0)
- {
- if (s2 == 0)
- {
- if (yl > xl)
- {
- swap (v1, v2);
- swap (xl, yl);
- }
- // Y < X at this point.
- ret = bigint::alloc_raw (xl);
- memcpy (ret->data + yl, v1->data + yl, (xl - yl) * sizeof (limb_t));
- for (i = 0; i < yl; ++i)
- ret->data[i] = v1->data[i] | v2->data[i];
- ret->len = xl;
- kp_return (ret_I (interp, ret, 0));
- }
- }
- else if (s2 != 0)
- { // -X | -Y == ((X - 1) & (Y - 1)).
- len = min (xl, yl);
- limb_t *xp = (limb_t *)ta.alloc (len * 2 * sizeof (*xp));
- limb_t *yp = xp + len;
- uisub1 (xp, v1->data, len, 1);
- uisub1 (yp, v2->data, len, 1);
- for (i = len - 1; i >= 0; --i)
- if ((xp[i] & yp[i]) != 0)
- break;
- if (i < 0)
- return (fixint (1));
- ret = bigint::alloc_raw (len = i + 1);
- uiaddn (ret->data, xp, yp, len);
- ret->data[ret->len = len] = 0;
- uiadd1 (ret->data, ret->data, ret->len + 1, 1);
- ret->len += ret->data[ret->len];
- kp_return (ret_I (interp, ret, 1));
- }
- else
- {
- swap (v1, v2);
- swap (xl, yl);
- }
- limb_t *xp = (limb_t *)ta.alloc (yl * sizeof (*xp));
- limb_t *yp = xp;
- ret = bigint::alloc_raw (yl);
- uisub1 (xp, v2->data, xl, 1);
- int cnt, zl = yl - (yp[yl - 1] == 0);
- if (xl > zl)
- {
- for (i = zl - 1; i >= 0; --i)
- if ((~v1->data[i] & yp[i]) != 0)
- break;
-
- cnt = ret->len = i + 1;
- }
- else
- {
- ret->len = zl;
- memcpy (ret->data + xl, yp + xl, (zl - xl) * sizeof (limb_t));
- cnt = xl;
- }
- if (ret->len != 0)
- {
- for (i = 0; i < cnt; ++i)
- ret->data[i] = yp[i] & ~v1->data[i];
-
- limb_t cy = uiadd1 (ret->data, ret->data, ret->len, 1);
- if (cy != 0)
- ret->data[ret->len++] = cy;
-
- kp_return (ret_I (interp, ret, 1));
- }
- kp_return (fixint (1));
- }
- object xor_II (interpreter *interp, object x, object y)
- {
- int s1, s2, i, len;
- auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
- int xl = I_ABS (v1->len), yl = I_ABS (v2->len);
- bigint *ret;
- tmp_allocator ta { interp };
- if (s1 == 0)
- {
- if (s2 == 0)
- {
- if (yl > xl)
- {
- swap (v1, v2);
- swap (xl, yl);
- }
-
- ret = bigint::alloc_raw (xl);
- memcpy (ret->data + yl, v1->data + yl, (xl - yl) * sizeof (limb_t));
- for (i = 0; i < yl; ++i)
- ret->data[i] = v1->data[i] ^ v2->data[i];
-
- ret->len = xl;
- }
- }
- else if (s2 != 0)
- {
- limb_t *xp = (limb_t *)ta.alloc ((xl + yl) * sizeof (*xp));
- limb_t *yp = xp + xl;
- uisub1 (xp, v1->data, xl, 1);
- uisub1 (yp, v2->data, yl, 1);
-
- if (xl > yl)
- {
- swap (xl, yl);
- swap (xp, yp);
- }
-
- ret = bigint::alloc_raw (yl);
- memcpy (ret->data + xl, yp + xl, (yl - xl) * sizeof (limb_t));
- for (i = 0; i < xl; ++i)
- ret->data[i] = xp[i] ^ yp[i];
- ret->len = yl;
- uitrim (ret->data, ret->len);
- kp_return (ret_I (interp, ret, 0));
- }
- else
- {
- swap (v1, v2);
- swap (xl, yl);
- }
- limb_t *xp = (limb_t *)ta.alloc (yl * sizeof (*xp));
- uisub1 (xp, v2->data, yl, 1);
- len = max (xl, yl) + 1;
- ret = bigint::alloc_raw (len);
- if (xl > yl)
- {
- memcpy (ret->data + yl, v1->data + yl, (xl - yl) * sizeof (limb_t));
- for (i = 0; i < yl; ++i)
- ret->data[i] = v1->data[i] ^ v2->data[i];
-
- ret->len = xl;
- }
- else
- {
- memcpy (ret->data + xl, v2->data + xl, (yl - xl) * sizeof (limb_t));
- for (i = 0; i < xl; ++i)
- ret->data[i] = v1->data[i] ^ v2->data[i];
-
- ret->len = yl;
- }
-
- limb_t cy = uiadd1 (ret->data, ret->data, ret->len, 1);
- ret->data[ret->len] = cy;
- ret->len += (cy != 0);
- uitrim (ret->data, ret->len);
- kp_return (ret_I (interp, ret, 1));
- }
- template <object (*fn) (interpreter *, object, object)>
- object log_function (interpreter *interp, object x, object y)
- {
- int v = as_int (x), sign = 0;
- limb_t limb = v < 0 ? (sign = 1, (limb_t)-v) : v;
- local_varobj<bigint> tmp;
- tmp.local_init (&limb, 1);
- return (fn (interp, y, make_bigint (&tmp, sign)));
- }
- object land_iI (interpreter *interp, object x, object y)
- {
- return (log_function<land_II> (interp, x, y));
- }
- object lor_iI (interpreter *interp, object x, object y)
- {
- return (log_function<lor_II> (interp, x, y));
- }
- object xor_iI (interpreter *interp, object x, object y)
- {
- return (log_function<xor_II> (interp, x, y));
- }
- int cmp_II (interpreter *interp, object x, object y)
- {
- int s1, s2;
- const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
- int ret = s1 != s2 ? 1 :
- uicmp (v1->data, I_ABS (v1->len),
- v2->data, I_ABS (v2->len));
- return (s1 ? -ret : ret);
- }
- int cmp_iI (interpreter *, object, object y)
- {
- #ifdef KP_ARCH_WIDE
- return ((y & SIGN_BIT) ? 1 : -1);
- #else
- return (as_bigint(y)->len < 0 ? 1 : -1);
- #endif
- }
- bool eq_II (interpreter *interp, object x, object y)
- {
- int s1, s2;
- const auto v1 = get_bigint (x, s1), v2 = get_bigint (y, s2);
- return (s1 == s2 && v1->len == v2->len &&
- memcmp (v1->data, v2->data,
- I_ABS (v1->len) * sizeof (*v1->data)) == 0);
- }
- static object
- bigint_lsh (interpreter *interp,
- const bigint *v1, int v2, int sign)
- {
- int delta = v2 / LIMB_BITS, cnt = v2 % LIMB_BITS;
- int xl = I_ABS (v1->len), len = xl + delta;
- auto ret = bigint::alloc_raw (len + 1);
- ret->len = len;
- if (cnt != 0)
- ret->len += uilsh (ret->data + delta, v1->data, xl, cnt);
- else
- memcpy (ret->data + delta, v1->data, xl * sizeof (limb_t));
- memset (ret->data, 0, delta * sizeof (limb_t));
- return (ret_I (interp, ret, sign));
- }
- static object
- bigint_rsh (interpreter *interp,
- const bigint *v1, int v2, int sign)
- {
- int delta = v2 / LIMB_BITS, len = I_ABS (v1->len) - delta;
- if (len <= 0)
- return (fixint (0));
-
- auto ret = bigint::alloc_raw (len);
- int cnt = v2 % KP_LIMB_BITS;
-
- if (cnt != 0)
- ret->len -= 1 - uirsh (ret->data, v1->data + delta, len, cnt);
- else
- memcpy (ret->data, v1->data + delta, ret->len * sizeof (limb_t));
-
- return (ret_I (interp, ret, sign));
- }
- object lsh_Ii (interpreter *interp, object x, object y)
- {
- int sign, v2 = as_int (y);
- const auto v1 = get_bigint (x, sign);
- if (v2 == 0)
- kp_return (x);
- else if (v2 < 0)
- kp_return (bigint_rsh (interp, v1, -v2, sign));
- else
- kp_return (bigint_lsh (interp, v1, v2, sign));
- }
- object rsh_Ii (interpreter *interp, object x, object y)
- {
- int sign, v2 = as_int (y);
- const auto v1 = get_bigint (x, sign);
- if (v2 == 0)
- kp_return (x);
- else if (v2 < 0)
- kp_return (bigint_lsh (interp, v1, -v2, sign));
- else
- kp_return (bigint_rsh (interp, v1, v2, sign));
- }
- // I/O with integers.
- result<int64_t> write_i (interpreter *interp, stream *strm,
- object obj, io_info& info)
- {
- int x = as_int (obj), sign = 0, ret = 0;
- char buf[KP_LIMB_BITS];
- limb_t ux = x < 0 ? (sign = 1, (limb_t)-x) : (limb_t)x;
- char *p = uitostr1 (&buf[sizeof (buf)], ux, info.radix);
- if (sign != 0)
- { ret += KP_TRY (strm->putb (interp, '-')); }
- ret += KP_TRY (strm->wbase (interp, abs (info.radix)));
- ret += KP_TRY (strm->write (interp, p, &buf[sizeof (buf)] - p));
- return (ret);
- }
- result<int64_t> write_I (interpreter *interp, stream *strm,
- object obj, io_info& info)
- {
- const bigint *x = as_bigint (obj);
- int xl = I_ABS (x->len);
- int size = uibsize (info.radix, x->data[xl - 1], xl) + KP_LIMB_BITS;
- tmp_allocator ta { interp };
- char *ptr = (char *)ta.alloc (size);
- int64_t ret = 0;
- size = uitostr (interp, &ptr, size, x->data, xl, info.radix);
- #ifdef KP_ARCH_WIDE
- if (obj & SIGN_BIT)
- #else
- if (x->len < 0)
- #endif
- { ret += KP_TRY (strm->putb (interp, '-')); }
- ret += KP_TRY (strm->wbase (interp, abs (info.radix)));
- ret += KP_TRY (strm->write (interp, ptr, size));
- return (ret);
- }
- result<int64_t> pack_i (interpreter *interp, stream *strm,
- object obj, pack_info&)
- {
- int val = as_int (obj);
- val = (int)KP_TRY (strm->write (interp, &val));
- return (val);
- }
- result<int64_t> pack_I (interpreter *interp, stream *strm,
- object obj, pack_info&)
- {
- int sv;
- const auto bi = get_bigint (obj, sv);
- int len = I_ABS (bi->len);
- int64_t ret = 0;
- sv = sv < 0 ? -len : len;
- ret += KP_TRY (strm->write (interp, &sv));
- ret += KP_TRY (strm->write (interp, bi->data, bi->len * sizeof (*bi->data)));
- return (ret);
- }
- result<object> unpack_i (interpreter *interp, stream *strm,
- pack_info& info, bool)
- {
- int val;
- bool rv = KP_TRY (strm->sread (interp, &val));
- if (rv)
- kp_return (fixint (val));
- return (info.error ("invalid integer read"));
- }
- result<object> unpack_I (interpreter *interp, stream *strm,
- pack_info& info, bool save)
- {
- int len;
- bool rv = KP_TRY (strm->sread (interp, &len));
- if (!rv || !len)
- return (info.error ("invalid bigint length"));
- int sign = len < 0 ? (len = -len, 1) : 0;
- bigint *ret = as_bigint (alloc_bigint (interp, len));
- int nb = KP_TRY (strm->read (interp, ret->data,
- ret->len * sizeof (*ret->data)));
- if (nb < len * (int)sizeof (*ret->data))
- return (info.error ("invalid bigint limbs read"));
- interp->retval = make_bigint (ret, sign);
- if (save)
- KP_VTRY (info.add_mapping (interp, *info.offset, interp->retval));
- return (interp->retval);
- }
- KP_DECLS_END
|