static void mpfr_set_double_range (void) { mpfr_set_default_prec (54); if (mpfr_get_default_prec () != 54) ERROR ("get_default_prec failed (1)"); mpfr_set_default_prec (53); if ((mpfr_get_default_prec) () != 53) ERROR ("get_default_prec failed (2)"); /* in double precision format, the unbiased exponent is between 0 and 2047, where 0 is used for subnormal numbers, and 2047 for special numbers (infinities, NaN), and the bias is 1023, thus "normal" numbers have an exponent between -1022 and 1023, corresponding to numbers between 2^(-1022) and previous(2^(1024)). (The smallest subnormal number is 0.(0^51)1*2^(-1022)= 2^(-1074).) The smallest normal power of two is 1.0*2^(-1022). The largest normal power of two is 2^1023. (We have to add one for mpfr since mantissa are between 1/2 and 1.) */ set_emin (-1021); set_emax (1024); }
std::string real::get_string(int p) const { std::string string; char *raw_string; mpfr_exp_t exp; if (mpfr_nan_p(r) != 0) { string = "nan"; } else if (mpfr_inf_p(r) != 0) { if (mpfr_sgn(r) < 0) { string = "-inf"; } else { string = "inf"; } } else { // Dynamically allocate a character array to hold the base-10 // representation of the real. raw_string = new char[(int)mpfr_get_default_prec()]; mpfr_get_str(raw_string, &exp, 10, p, r, MPFR_RNDN); string = std::string(raw_string); if (mpfr_zero_p(r) == 0) { // The cast is to prevent a warning in case mpfr_exp_t is not // defined as an int, but as a short or a long. std::sprintf(raw_string, "%d", (int)(exp - 1)); } else { std::sprintf(raw_string, "0"); } if (string[0] == '-') { string = string.substr(0, 2) + std::string(".") + string.substr(2) + std::string("e") + std::string(raw_string); } else { string = string.substr(0, 1) + std::string(".") + string.substr(1) + std::string("e") + std::string(raw_string); } // Free the array. delete[] raw_string; } return string; }
static mpfr_prec_t num_prec(num_t a) { mpfr_prec_t prec; if (a != NULL && a->num_type == NUM_INT) { /* XXX: completely arbitrary! */ return 2048; } else if (a != NULL && a->num_type == NUM_FP) { return mpfr_get_prec(F(a)); } else { return mpfr_get_default_prec(); } }
num_t num_new_fp(int flags, num_t b) { num_t r; r = num_new(flags); r->num_type = NUM_FP; mpfr_init(F(r)); if (b != NULL) { mpfr_prec_t prec_b = num_prec(b); if (prec_b > mpfr_get_default_prec()) mpfr_set_prec(F(r), prec_b); if (b->num_type == NUM_INT) mpfr_set_z(F(r), Z(b), round_mode); else if (b->num_type == NUM_FP) mpfr_set(F(r), F(b), round_mode); } return r; }
bool gfc_convert_boz (gfc_expr *expr, gfc_typespec *ts) { size_t buffer_size, boz_bit_size, ts_bit_size; int index; unsigned char *buffer; if (!expr->is_boz) return true; gcc_assert (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER); /* Don't convert BOZ to logical, character, derived etc. */ if (ts->type == BT_REAL) { buffer_size = size_float (ts->kind); ts_bit_size = buffer_size * 8; } else if (ts->type == BT_COMPLEX) { buffer_size = size_complex (ts->kind); ts_bit_size = buffer_size * 8 / 2; } else return true; /* Convert BOZ to the smallest possible integer kind. */ boz_bit_size = mpz_sizeinbase (expr->value.integer, 2); if (boz_bit_size > ts_bit_size) { gfc_error_now ("BOZ constant at %L is too large (%ld vs %ld bits)", &expr->where, (long) boz_bit_size, (long) ts_bit_size); return false; } for (index = 0; gfc_integer_kinds[index].kind != 0; ++index) if ((unsigned) gfc_integer_kinds[index].bit_size >= ts_bit_size) break; expr->ts.kind = gfc_integer_kinds[index].kind; buffer_size = MAX (buffer_size, size_integer (expr->ts.kind)); buffer = (unsigned char*)alloca (buffer_size); encode_integer (expr->ts.kind, expr->value.integer, buffer, buffer_size); mpz_clear (expr->value.integer); if (ts->type == BT_REAL) { mpfr_init (expr->value.real); gfc_interpret_float (ts->kind, buffer, buffer_size, expr->value.real); } else { #ifdef HAVE_mpc mpc_init2 (expr->value.complex, mpfr_get_default_prec()); #else mpfr_init (expr->value.complex.r); mpfr_init (expr->value.complex.i); #endif gfc_interpret_complex (ts->kind, buffer, buffer_size, #ifdef HAVE_mpc expr->value.complex #else expr->value.complex.r, expr->value.complex.i #endif ); } expr->is_boz = 0; expr->ts.type = ts->type; expr->ts.kind = ts->kind; return true; }
SEXP R_mpfr_set_default_prec(SEXP prec) { // return the previous value int prev = (int) mpfr_get_default_prec(); mpfr_set_default_prec((mpfr_prec_t) asInteger(prec)); return ScalarInteger(prev); }
SEXP R_mpfr_get_default_prec(void) { return ScalarInteger((int) mpfr_get_default_prec()); }
void Lib_Mpcr_Init(MpcrPtr* x) { (*x) = malloc (sizeof(__mpc_struct)); mpc_init2( (mpc_ptr) (*x), mpfr_get_default_prec()); }