kinteger.c (9125B)
1 /* 2 ** kinteger.c 3 ** Kernel Integers (fixints and bigints) 4 ** See Copyright Notice in klisp.h 5 */ 6 7 #include <stdbool.h> 8 #include <stdint.h> 9 #include <inttypes.h> 10 #include <math.h> 11 12 #include "kinteger.h" 13 #include "kobject.h" 14 #include "kstate.h" 15 #include "kmem.h" 16 #include "kgc.h" 17 18 /* It is used for reading and for creating temps and res in all operations */ 19 /* NOTE: is uint to allow INT32_MIN as positive argument in read */ 20 TValue kbigint_new(klisp_State *K, bool sign, uint32_t digit) 21 { 22 Bigint *new_bigint = klispM_new(K, Bigint); 23 24 /* header + gc_fields */ 25 klispC_link(K, (GCObject *) new_bigint, K_TBIGINT, 0); 26 27 /* bigint specific fields */ 28 /* If later changed to alloc obj: 29 GC: root bigint & put dummy value to work if garbage collections 30 happens while allocating array */ 31 new_bigint->single = digit; 32 new_bigint->digits = &(new_bigint->single); 33 new_bigint->alloc = 1; 34 new_bigint->used = 1; 35 new_bigint->sign = sign? MP_NEG : MP_ZPOS; 36 37 return gc2bigint(new_bigint); 38 } 39 40 /* used in write to destructively get the digits */ 41 /* assumes src is rooted */ 42 TValue kbigint_copy(klisp_State *K, TValue src) 43 { 44 TValue copy = kbigint_make_simple(K); 45 krooted_tvs_push(K, copy); 46 /* arguments are in reverse order with respect to mp_int_copy */ 47 UNUSED(mp_int_init_copy(K, tv2bigint(copy), tv2bigint(src))); 48 krooted_tvs_pop(K); 49 return copy; 50 } 51 52 /* 53 ** read/write interface 54 */ 55 56 /* this works for bigints & fixints, returns true if ok */ 57 bool kinteger_read(klisp_State *K, char *buf, int32_t base, TValue *out, 58 char **end) 59 { 60 TValue res = kbigint_make_simple(K); 61 krooted_tvs_push(K, res); 62 bool ret_val = (mp_int_read_cstring(K, tv2bigint(res), base, 63 buf, end) == MP_OK); 64 krooted_tvs_pop(K); 65 *out = kbigint_try_fixint(K, res); 66 return ret_val; 67 } 68 69 /* this is used by write to estimate the number of chars necessary to 70 print the number */ 71 int32_t kbigint_print_size(TValue tv_bigint, int32_t base) 72 { 73 klisp_assert(ttisbigint(tv_bigint)); 74 return mp_int_string_len(tv2bigint(tv_bigint), base); 75 } 76 77 /* this is used by write */ 78 void kbigint_print_string(klisp_State *K, TValue tv_bigint, int32_t base, 79 char *buf, int32_t limit) 80 { 81 klisp_assert(ttisbigint(tv_bigint)); 82 mp_result res = mp_int_to_string(K, tv2bigint(tv_bigint), base, buf, 83 limit); 84 /* only possible error is truncation */ 85 klisp_assert(res == MP_OK); 86 } 87 88 /* Interface for kgnumbers */ 89 bool kbigint_eqp(TValue tv_bigint1, TValue tv_bigint2) 90 { 91 return (mp_int_compare(tv2bigint(tv_bigint1), 92 tv2bigint(tv_bigint2)) == 0); 93 } 94 95 bool kbigint_ltp(TValue tv_bigint1, TValue tv_bigint2) 96 { 97 return (mp_int_compare(tv2bigint(tv_bigint1), 98 tv2bigint(tv_bigint2)) < 0); 99 } 100 101 bool kbigint_lep(TValue tv_bigint1, TValue tv_bigint2) 102 { 103 return (mp_int_compare(tv2bigint(tv_bigint1), 104 tv2bigint(tv_bigint2)) <= 0); 105 } 106 107 bool kbigint_gtp(TValue tv_bigint1, TValue tv_bigint2) 108 { 109 return (mp_int_compare(tv2bigint(tv_bigint1), 110 tv2bigint(tv_bigint2)) > 0); 111 } 112 113 bool kbigint_gep(TValue tv_bigint1, TValue tv_bigint2) 114 { 115 return (mp_int_compare(tv2bigint(tv_bigint1), 116 tv2bigint(tv_bigint2)) >= 0); 117 } 118 119 /* 120 ** GC: All of these assume the parameters are rooted 121 */ 122 TValue kbigint_plus(klisp_State *K, TValue n1, TValue n2) 123 { 124 TValue res = kbigint_make_simple(K); 125 krooted_tvs_push(K, res); 126 UNUSED(mp_int_add(K, tv2bigint(n1), tv2bigint(n2), tv2bigint(res))); 127 krooted_tvs_pop(K); 128 return kbigint_try_fixint(K, res); 129 } 130 131 TValue kbigint_times(klisp_State *K, TValue n1, TValue n2) 132 { 133 TValue res = kbigint_make_simple(K); 134 krooted_tvs_push(K, res); 135 UNUSED(mp_int_mul(K, tv2bigint(n1), tv2bigint(n2), tv2bigint(res))); 136 krooted_tvs_pop(K); 137 return kbigint_try_fixint(K, res); 138 } 139 140 TValue kbigint_minus(klisp_State *K, TValue n1, TValue n2) 141 { 142 TValue res = kbigint_make_simple(K); 143 krooted_tvs_push(K, res); 144 UNUSED(mp_int_sub(K, tv2bigint(n1), tv2bigint(n2), tv2bigint(res))); 145 krooted_tvs_pop(K); 146 return kbigint_try_fixint(K, res); 147 } 148 149 /* NOTE: n2 can't be zero, that case should be checked before calling this */ 150 TValue kbigint_div_mod(klisp_State *K, TValue n1, TValue n2, TValue *res_r) 151 { 152 TValue tv_q = kbigint_make_simple(K); 153 krooted_tvs_push(K, tv_q); 154 TValue tv_r = kbigint_make_simple(K); 155 krooted_tvs_push(K, tv_r); 156 157 Bigint *n = tv2bigint(n1); 158 Bigint *d = tv2bigint(n2); 159 160 Bigint *q = tv2bigint(tv_q); 161 Bigint *r = tv2bigint(tv_r); 162 163 UNUSED(mp_int_div(K, n, d, q, r)); 164 165 /* Adjust q & r so that 0 <= r < |d| */ 166 if (mp_int_compare_zero(r) < 0) { 167 if (mp_int_compare_zero(d) < 0) { 168 mp_int_sub(K, r, d, r); 169 mp_int_add_value(K, q, 1, q); 170 } else { 171 mp_int_add(K, r, d, r); 172 mp_int_sub_value(K, q, 1, q); 173 } 174 } 175 176 krooted_tvs_pop(K); 177 krooted_tvs_pop(K); 178 179 *res_r = kbigint_try_fixint(K, tv_r); 180 return kbigint_try_fixint(K, tv_q); 181 } 182 183 TValue kbigint_div0_mod0(klisp_State *K, TValue n1, TValue n2, TValue *res_r) 184 { 185 /* GC: root bigints */ 186 TValue tv_q = kbigint_make_simple(K); 187 krooted_tvs_push(K, tv_q); 188 TValue tv_r = kbigint_make_simple(K); 189 krooted_tvs_push(K, tv_r); 190 191 Bigint *n = tv2bigint(n1); 192 Bigint *d = tv2bigint(n2); 193 194 Bigint *q = tv2bigint(tv_q); 195 Bigint *r = tv2bigint(tv_r); 196 UNUSED(mp_int_div(K, n, d, q, r)); 197 198 /* Adjust q & r so that -|d/2| <= r < |d/2| */ 199 /* It seems easier to check -|d| <= 2r < |d| */ 200 TValue tv_two_r = kbigint_make_simple(K); 201 krooted_tvs_push(K, tv_two_r); 202 Bigint *two_r = tv2bigint(tv_two_r); 203 /* two_r = r * 2 = r * 2^1 */ 204 UNUSED(mp_int_mul_pow2(K, r, 1, two_r)); 205 TValue tv_abs_d = kbigint_make_simple(K); 206 krooted_tvs_push(K, tv_abs_d); 207 /* NOTE: this makes a copy if d >= 0 */ 208 Bigint *abs_d = tv2bigint(tv_abs_d); 209 UNUSED(mp_int_abs(K, d, abs_d)); 210 211 /* the case analysis is inverse to that of fixint */ 212 213 /* this checks 2r >= |d| (which is the same r >= |d/2|) */ 214 if (mp_int_compare(two_r, abs_d) >= 0) { 215 if (mp_int_compare_zero(d) < 0) { 216 mp_int_add(K, r, d, r); 217 mp_int_sub_value(K, q, 1, q); 218 } else { 219 mp_int_sub(K, r, d, r); 220 mp_int_add_value(K, q, 1, q); 221 } 222 } else { 223 UNUSED(mp_int_neg(K, abs_d, abs_d)); 224 /* this checks 2r < -|d| (which is the same r < |d/2|) */ 225 if (mp_int_compare(two_r, abs_d) < 0) { 226 if (mp_int_compare_zero(d) < 0) { 227 mp_int_sub(K, r, d, r); 228 mp_int_add_value(K, q, 1, q); 229 } else { 230 mp_int_add(K, r, d, r); 231 mp_int_sub_value(K, q, 1, q); 232 } 233 } 234 } 235 236 krooted_tvs_pop(K); 237 krooted_tvs_pop(K); 238 krooted_tvs_pop(K); 239 krooted_tvs_pop(K); 240 241 *res_r = kbigint_try_fixint(K, tv_r); 242 return kbigint_try_fixint(K, tv_q); 243 } 244 245 bool kbigint_negativep(TValue tv_bigint) 246 { 247 return (mp_int_compare_zero(tv2bigint(tv_bigint)) < 0); 248 } 249 250 bool kbigint_positivep(TValue tv_bigint) 251 { 252 return (mp_int_compare_zero(tv2bigint(tv_bigint)) > 0); 253 } 254 255 bool kbigint_oddp(TValue tv_bigint) 256 { 257 return mp_int_is_odd(tv2bigint(tv_bigint)); 258 } 259 260 bool kbigint_evenp(TValue tv_bigint) 261 { 262 return mp_int_is_even(tv2bigint(tv_bigint)); 263 } 264 265 TValue kbigint_abs(klisp_State *K, TValue tv_bigint) 266 { 267 if (kbigint_negativep(tv_bigint)) { 268 TValue copy = kbigint_make_simple(K); 269 krooted_tvs_push(K, copy); 270 UNUSED(mp_int_abs(K, tv2bigint(tv_bigint), tv2bigint(copy))); 271 krooted_tvs_pop(K); 272 /* NOTE: this can never be a fixint if the parameter was a bigint */ 273 return copy; 274 } else { 275 return tv_bigint; 276 } 277 } 278 279 TValue kbigint_gcd(klisp_State *K, TValue n1, TValue n2) 280 { 281 TValue res = kbigint_make_simple(K); 282 krooted_tvs_push(K, res); 283 UNUSED(mp_int_gcd(K, tv2bigint(n1), tv2bigint(n2), tv2bigint(res))); 284 krooted_tvs_pop(K); 285 return kbigint_try_fixint(K, res); 286 } 287 288 TValue kbigint_lcm(klisp_State *K, TValue n1, TValue n2) 289 { 290 TValue tv_res = kbigint_make_simple(K); 291 krooted_tvs_push(K, tv_res); 292 Bigint *res = tv2bigint(tv_res); 293 /* unlike in kernel, lcm in IMath can return a negative value 294 (if sign a != sign b) */ 295 UNUSED(mp_int_lcm(K, tv2bigint(n1), tv2bigint(n2), res)); 296 UNUSED(mp_int_abs(K, res, res)); 297 krooted_tvs_pop(K); 298 return kbigint_try_fixint(K, tv_res); 299 } 300 301 TValue kinteger_new_uint64(klisp_State *K, uint64_t x) 302 { 303 if (x <= INT32_MAX) { 304 return i2tv((int32_t) x); 305 } else { 306 TValue res = kbigint_make_simple(K); 307 krooted_tvs_push(K, res); 308 309 uint8_t d[8]; 310 for (int i = 7; i >= 0; i--) { 311 d[i] = (x & 0xFF); 312 x >>= 8; 313 } 314 315 mp_int_read_unsigned(K, tv2bigint(res), d, 8); 316 krooted_tvs_pop(K); 317 return res; 318 } 319 }