krational.h (8051B)
1 /* 2 ** krational.h 3 ** Kernel Rationals (fixrats and bigrats) 4 ** See Copyright Notice in klisp.h 5 */ 6 7 #ifndef krational_h 8 #define krational_h 9 10 #include <stdbool.h> 11 #include <stdint.h> 12 #include <inttypes.h> 13 14 #include "kobject.h" 15 #include "kstate.h" 16 #include "kinteger.h" 17 #include "imrat.h" 18 19 /* TEMP: for now we only implement bigrats (memory allocated) */ 20 21 /* This tries to convert a bigrat to a fixint or a bigint */ 22 static inline TValue kbigrat_try_integer(klisp_State *K, TValue n) 23 { 24 Bigrat *b = tv2bigrat(n); 25 26 if (!mp_rat_is_integer(b)) 27 return n; 28 29 /* sadly we have to repeat the code from try_fixint here... */ 30 Bigint *i = MP_NUMER_P(b); 31 if (MP_USED(i) == 1) { 32 int64_t digit = (int64_t) *(MP_DIGITS(i)); 33 if (MP_SIGN(i) == MP_NEG) digit = -digit; 34 if (kfit_int32_t(digit)) 35 return i2tv((int32_t) digit); 36 /* else fall through */ 37 } 38 /* should alloc a bigint */ 39 /* GC: n may not be rooted */ 40 krooted_tvs_push(K, n); 41 TValue copy = kbigint_copy(K, gc2bigint(i)); 42 krooted_tvs_pop(K); 43 return copy; 44 } 45 46 /* used in reading and for res & temps in operations */ 47 TValue kbigrat_new(klisp_State *K, bool sign, uint32_t num, 48 uint32_t den); 49 50 /* used in write to destructively get the digits */ 51 TValue kbigrat_copy(klisp_State *K, TValue src); 52 53 /* macro to create the simplest rational */ 54 #define kbigrat_make_simple(K_) kbigrat_new(K_, false, 0, 1) 55 56 /* Create a stack allocated bigrat from a bigint, 57 useful for mixed operations, relatively light weight compared 58 to creating it in the heap and burdening the gc */ 59 #define kbind_bigrat_fixint(name, fixint) \ 60 int32_t (KUNIQUE_NAME(i)) = ivalue(fixint); \ 61 Bigrat KUNIQUE_NAME(bigrat_i); \ 62 /* can't use unique_name bigrat because it conflicts */ \ 63 /* numer is 1 */ \ 64 (KUNIQUE_NAME(bigrat_i)).num.single = ({ \ 65 int64_t temp = (KUNIQUE_NAME(i)); \ 66 (uint32_t) ((temp < 0)? -temp : temp); \ 67 }); \ 68 (KUNIQUE_NAME(bigrat_i)).num.digits = \ 69 &((KUNIQUE_NAME(bigrat_i)).num.single); \ 70 (KUNIQUE_NAME(bigrat_i)).num.alloc = 1; \ 71 (KUNIQUE_NAME(bigrat_i)).num.used = 1; \ 72 (KUNIQUE_NAME(bigrat_i)).num.sign = (KUNIQUE_NAME(i)) < 0? \ 73 MP_NEG : MP_ZPOS; \ 74 /* denom is 1 */ \ 75 (KUNIQUE_NAME(bigrat_i)).den.single = 1; \ 76 (KUNIQUE_NAME(bigrat_i)).den.digits = \ 77 &((KUNIQUE_NAME(bigrat_i)).den.single); \ 78 (KUNIQUE_NAME(bigrat_i)).den.alloc = 1; \ 79 (KUNIQUE_NAME(bigrat_i)).den.used = 1; \ 80 (KUNIQUE_NAME(bigrat_i)).den.sign = MP_ZPOS; \ 81 \ 82 Bigrat *name = &(KUNIQUE_NAME(bigrat_i)) 83 84 #define kbind_bigrat_bigint(name, bigint) \ 85 Bigint *KUNIQUE_NAME(bi) = tv2bigint(bigint); \ 86 Bigrat KUNIQUE_NAME(bigrat); \ 87 /* numer is bigint */ \ 88 (KUNIQUE_NAME(bigrat)).num.single = (KUNIQUE_NAME(bi))->single; \ 89 (KUNIQUE_NAME(bigrat)).num.digits = (KUNIQUE_NAME(bi))->digits; \ 90 (KUNIQUE_NAME(bigrat)).num.alloc = (KUNIQUE_NAME(bi))->alloc; \ 91 (KUNIQUE_NAME(bigrat)).num.used = (KUNIQUE_NAME(bi))->used; \ 92 (KUNIQUE_NAME(bigrat)).num.sign = (KUNIQUE_NAME(bi))->sign; \ 93 /* denom is 1 */ \ 94 (KUNIQUE_NAME(bigrat)).den.single = 1; \ 95 (KUNIQUE_NAME(bigrat)).den.digits = \ 96 &((KUNIQUE_NAME(bigrat)).den.single); \ 97 (KUNIQUE_NAME(bigrat)).den.alloc = 1; \ 98 (KUNIQUE_NAME(bigrat)).den.used = 1; \ 99 (KUNIQUE_NAME(bigrat)).den.sign = MP_ZPOS; \ 100 Bigrat *name = &(KUNIQUE_NAME(bigrat)) 101 102 /* XXX: Now that I think about it this (and kensure_bigint) could be more 103 cleanly implemented as a function that takes a pointer... (derp derp) */ 104 105 /* This can be used prior to calling a bigrat functions 106 to automatically convert fixints & bigints to bigrats. 107 NOTE: calls to this macro should go in different lines! 108 and on different lines to calls to kensure_bigint */ 109 #define kensure_bigrat(n) \ 110 /* must use goto, no block should be entered before calling \ 111 kbind_bigrat */ \ 112 if (ttisbigrat(n)) \ 113 goto KUNIQUE_NAME(bigrat_exit_lbl); \ 114 if (ttisbigint(n)) \ 115 goto KUNIQUE_NAME(bigrat_bigint_lbl); \ 116 /* else ttisfixint(n) */ \ 117 kbind_bigrat_fixint(KUNIQUE_NAME(brat_i), (n)); \ 118 (n) = gc2bigrat(KUNIQUE_NAME(brat_i)); \ 119 goto KUNIQUE_NAME(bigrat_exit_lbl); \ 120 KUNIQUE_NAME(bigrat_bigint_lbl): \ 121 ; /* gcc asks for a statement (not a decl) after label */ \ 122 kbind_bigrat_bigint(KUNIQUE_NAME(brat), (n)); \ 123 (n) = gc2bigrat(KUNIQUE_NAME(brat)); \ 124 KUNIQUE_NAME(bigrat_exit_lbl): 125 126 /* 127 ** read/write interface 128 */ 129 /* this works for bigrats, bigints & fixints, returns true if ok */ 130 /* NOTE: doesn't allow decimal */ 131 bool krational_read(klisp_State *K, char *buf, int32_t base, TValue *out, 132 char **end); 133 /* NOTE: allow decimal for use after #e */ 134 bool krational_read_decimal(klisp_State *K, char *buf, int32_t base, TValue *out, 135 char **end, bool *out_decimalp); 136 137 int32_t kbigrat_print_size(TValue tv_bigrat, int32_t base); 138 void kbigrat_print_string(klisp_State *K, TValue tv_bigrat, int32_t base, 139 char *buf, int32_t limit); 140 141 /* Interface for kgnumbers */ 142 bool kbigrat_eqp(klisp_State *K, TValue bigrat1, TValue bigrat2); 143 144 bool kbigrat_ltp(klisp_State *K, TValue bigrat1, TValue bigrat2); 145 bool kbigrat_lep(klisp_State *K, TValue bigrat1, TValue bigrat2); 146 bool kbigrat_gtp(klisp_State *K, TValue bigrat1, TValue bigrat2); 147 bool kbigrat_gep(klisp_State *K, TValue bigrat1, TValue bigrat2); 148 149 TValue kbigrat_plus(klisp_State *K, TValue n1, TValue n2); 150 TValue kbigrat_times(klisp_State *K, TValue n1, TValue n2); 151 TValue kbigrat_minus(klisp_State *K, TValue n1, TValue n2); 152 TValue kbigrat_divided(klisp_State *K, TValue n1, TValue n2); 153 154 TValue kbigrat_div_mod(klisp_State *K, TValue n1, TValue n2, TValue *res_r); 155 TValue kbigrat_div0_mod0(klisp_State *K, TValue n1, TValue n2, TValue *res_r); 156 157 bool kbigrat_negativep(TValue tv_bigrat); 158 bool kbigrat_positivep(TValue tv_bigrat); 159 160 /* needs the state to create a copy if negative */ 161 TValue kbigrat_abs(klisp_State *K, TValue tv_bigrat); 162 163 TValue kbigrat_numerator(klisp_State *K, TValue tv_bigrat); 164 TValue kbigrat_denominator(klisp_State *K, TValue tv_bigrat); 165 166 typedef enum { K_FLOOR, K_CEILING, K_TRUNCATE, K_ROUND_EVEN } kround_mode; 167 TValue kbigrat_to_integer(klisp_State *K, TValue tv_bigrat, kround_mode mode); 168 169 TValue kbigrat_simplest_rational(klisp_State *K, TValue tv_n1, TValue tv_n2); 170 TValue kbigrat_rationalize(klisp_State *K, TValue tv_n1, TValue tv_n2); 171 172 #endif