1 #ifndef R_MPFR_MUTILS_H
2 #define R_MPFR_MUTILS_H
3
4 /* #ifdef __cplusplus */
5 /* extern "C" { */
6 /* #endif */
7
8 #include <ctype.h>
9
10 #include <stdarg.h>
11 /* for va_list ..*/
12
13 #include <R.h> /* includes Rconfig.h */
14 #include <Rversion.h>
15 #include <Rinternals.h>
16 // previously from <Rdefines.h> :
17 #ifndef GET_SLOT
18 # define GET_SLOT(x, what) R_do_slot(x, what)
19 # define SET_SLOT(x, what, value) R_do_slot_assign(x, what, value)
20 # define MAKE_CLASS(what) R_do_MAKE_CLASS(what)
21 # define NEW_OBJECT(class_def) R_do_new_object(class_def)
22 #endif
23
24 #include <R_ext/Print.h>
25
26 /* must come *after* the above, e.g., for
27 mpfr_out_str() (which needs stdio): */
28 #include <gmp.h>
29 #include <mpfr.h>
30
31 #ifdef ENABLE_NLS
32 #include <libintl.h>
33 #define _(String) dgettext ("Rmpfr", String)
34 #else
35 #define _(String) (String)
36 #endif
37
38 #if (MPFR_VERSION < MPFR_VERSION_NUM(3,0,0))
39 /* define back-compatibility types:*/
40 # define MPFR_RNDD GMP_RNDD
41 # define MPFR_RNDN GMP_RNDN
42 # define MPFR_RNDU GMP_RNDU
43 # define MPFR_RNDZ GMP_RNDZ
44 // # define MPFR_RNDA GMP_RNDA
45
46 # define mpfr_exp_t mp_exp_t
47
48 #endif
49
50 /*----------------------------------------*/
51
52 #ifdef _in_Rmpfr_init_
53 /* global */ int R_mpfr_debug_ = 0;
54 #else
55 extern int R_mpfr_debug_;
56 #endif
57
58 /* A version of Rprintf() .. but only printing when R_mpfr_debug_ is large enough :*/
R_mpfr_dbg_printf(int dbg_level,const char * format,...)59 static R_INLINE void R_mpfr_dbg_printf(int dbg_level, const char *format, ...)
60 {
61 if(R_mpfr_debug_ && R_mpfr_debug_ >= dbg_level) {
62 va_list(ap);
63 Rprintf(".mpfr_debug[%d]: ", R_mpfr_debug_);
64 va_start(ap, format);
65 REvprintf(format, ap);
66 va_end(ap);
67 }
68 }
R_mpfr_dbg_printf_0(int dbg_level,const char * format,...)69 static R_INLINE void R_mpfr_dbg_printf_0(int dbg_level, const char *format, ...)
70 {
71 if(R_mpfr_debug_ && R_mpfr_debug_ >= dbg_level) {
72 va_list(ap);
73 va_start(ap, format);
74 REvprintf(format, ap);
75 va_end(ap);
76 }
77 }
78
79
80
81 /* This is from Matrix/src/Mutils.h : */
82 static R_INLINE
ALLOC_SLOT(SEXP obj,SEXP nm,SEXPTYPE type,int length)83 SEXP ALLOC_SLOT(SEXP obj, SEXP nm, SEXPTYPE type, int length)
84 {
85 SEXP val = allocVector(type, length);
86
87 SET_SLOT(obj, nm, val);
88 return val;
89 }
90
91 #define N_LIMBS(_PREC_) ceil(((double)_PREC_)/mp_bits_per_limb)
92
R_mpfr_nr_limbs(mpfr_t r)93 static R_INLINE int R_mpfr_nr_limbs(mpfr_t r)
94 {
95 return N_LIMBS(mpfr_get_prec(r));
96 }
97
98 // Note: "in theory" we could set precBits > INT_MAX, but currently not in Rmpfr:
R_mpfr_check_prec(int prec)99 static R_INLINE void R_mpfr_check_prec(int prec)
100 {
101 if(prec == NA_INTEGER)
102 error("Precision(bit) is NA (probably from coercion)");
103 if(prec < MPFR_PREC_MIN)
104 error("Precision(bit) = %d < %ld (= MPFR_PREC_MIN)", prec, (long)MPFR_PREC_MIN);
105 /* 2018-01-01 gives a WARNING with clang:
106 Found the following significant warnings:
107 ./Rmpfr_utils.h:89:13: warning: comparison of constant 9223372036854775807 with expression of type 'int' is always false [-Wtautological-constant-out-of-range-compare]
108
109 ... of course, I don't want a WARN in the CRAN checks, hence disable (for now):
110 if(prec > MPFR_PREC_MAX)
111 error("Precision(bit) = %d > %ld (= MPFR_PREC_MAX)", prec, (long)MPFR_PREC_MAX);
112 */
113 return;
114 }
115
116 #define R_mpfr_prec(x) INTEGER(GET_SLOT(x, Rmpfr_precSym))[0]
117
118
119 #define MISMATCH_WARN \
120 if (mismatch) \
121 warning(_("longer object length is not a multiple of shorter object length"))
122
123 #define SET_MISMATCH \
124 if (nx == ny || nx == 1 || ny == 1) mismatch = 0; \
125 else if (nx > 0 && ny > 0) { \
126 if (nx > ny) mismatch = nx % ny; \
127 else mismatch = ny % nx; \
128 }
129
130
131
132 /* ./convert.c : */
133 mpfr_rnd_t R_rnd2MP(SEXP rnd_mode);
134 SEXP d2mpfr1 (SEXP x, SEXP prec, SEXP rnd_mode);
135 SEXP d2mpfr1_(double x, int i_prec, mpfr_rnd_t rnd);
136 SEXP d2mpfr1_list(SEXP x, SEXP prec, SEXP rnd_mode);
137 SEXP mpfr2d(SEXP x, SEXP rnd_mode);
138 SEXP mpfr2i(SEXP x, SEXP rnd_mode);
139 SEXP mpfr2str(SEXP x, SEXP digits, SEXP maybe_full, SEXP base);
140 SEXP str2mpfr1_list(SEXP x, SEXP prec, SEXP base, SEXP rnd_mode);
141 SEXP R_mpfr_formatinfo(SEXP x);
142
143 #ifdef R_had_R_Outputfile_in_API
144 # ifndef WIN32
145 SEXP print_mpfr (SEXP x, SEXP digits);
146 SEXP print_mpfr1(SEXP x, SEXP digits);
147 # endif
148 #endif
149
150 SEXP Rmpfr_minus(SEXP x);
151 SEXP Rmpfr_abs(SEXP x);
152 SEXP Math_mpfr(SEXP x, SEXP op);
153 SEXP Arith_mpfr(SEXP x, SEXP y, SEXP op);
154 SEXP Arith_mpfr_i(SEXP x, SEXP y, SEXP op);
155 SEXP Arith_i_mpfr(SEXP x, SEXP y, SEXP op);
156 SEXP Arith_mpfr_d(SEXP x, SEXP y, SEXP op);
157 SEXP Arith_d_mpfr(SEXP x, SEXP y, SEXP op);
158
159 SEXP Compare_mpfr(SEXP x, SEXP y, SEXP op);
160 SEXP Compare_mpfr_i(SEXP x, SEXP y, SEXP op);
161 SEXP Compare_mpfr_d(SEXP x, SEXP y, SEXP op);
162
163 SEXP Summary_mpfr(SEXP x, SEXP na_rm, SEXP op);
164 SEXP R_mpfr_sumprod(SEXP x, SEXP y, SEXP minPrec, SEXP alternating);
165
166 #ifdef __NOT_ANY_MORE__
167 /* deprecated: */
168 SEXP exp_mpfr1(SEXP x);
169 SEXP log_mpfr1(SEXP x);
170 #endif
171
172 void R_asMPFR(SEXP x, mpfr_ptr r);
173 SEXP MPFR_as_R(mpfr_t r);
174
175 /* ./utils.c */
176 SEXP R_mpfr_set_debug(SEXP I);
177 SEXP R_mpfr_set_default_prec(SEXP prec);
178 SEXP R_mpfr_get_default_prec(void);
179 int mpfr_erange_int_p(void);
180 SEXP R_mpfr_erange_int_p(void);
181 SEXP R_mpfr_get_erange(SEXP kind);
182 SEXP R_mpfr_set_erange(SEXP kind, SEXP val);
183 SEXP R_mpfr_prec_range(SEXP ind);
184 SEXP R_mpfr_get_version(void);
185 SEXP R_mpfr_get_GMP_numb_bits(void);
186 SEXP R_mpfr_2exp(SEXP x);
187 SEXP R_mpfr_ldexp(SEXP f, SEXP E, SEXP rnd_mode);
188 SEXP R_mpfr_frexp(SEXP x, SEXP rnd_mode);
189
190
191
192 SEXP const_asMpfr(SEXP I, SEXP prec, SEXP rnd_mode);
193
194 SEXP R_mpfr_is_finite(SEXP x); SEXP R_mpfr_is_finite_A(SEXP x);
195 SEXP R_mpfr_is_infinite(SEXP x);SEXP R_mpfr_is_infinite_A(SEXP x);
196 SEXP R_mpfr_is_integer(SEXP x); SEXP R_mpfr_is_integer_A(SEXP x);
197 SEXP R_mpfr_is_na(SEXP x); SEXP R_mpfr_is_na_A(SEXP x);
198 SEXP R_mpfr_is_zero(SEXP x); SEXP R_mpfr_is_zero_A(SEXP x);
199
200 SEXP R_mpfr_atan2(SEXP x, SEXP y, SEXP rnd_mode);
201 SEXP R_mpfr_hypot(SEXP x, SEXP y, SEXP rnd_mode);
202 SEXP R_mpfr_beta (SEXP x, SEXP y, SEXP rnd_mode);
203 SEXP R_mpfr_lbeta(SEXP x, SEXP y, SEXP rnd_mode);
204 SEXP R_mpfr_igamma(SEXP a, SEXP x, SEXP rnd_mode);
205
206 SEXP R_mpfr_jn(SEXP x, SEXP n, SEXP rnd_mode);
207 SEXP R_mpfr_yn(SEXP x, SEXP n, SEXP rnd_mode);
208 SEXP R_mpfr_fac (SEXP n, SEXP prec, SEXP rnd_mode);
209 SEXP R_mpfr_choose(SEXP a, SEXP n, SEXP rnd_mode);
210 SEXP R_mpfr_poch (SEXP a, SEXP n, SEXP rnd_mode);
211 SEXP R_mpfr_round (SEXP x, SEXP prec, SEXP rnd_mode);
212
213 /* #ifdef __cplusplus */
214 /* } */
215 /* #endif */
216
217 #endif /* R_MPFR_MUTILS_H_ */
218