static void java_perform_atof (YYSTYPE *java_lval, char *literal_token, int fflag, int number_beginning) { REAL_VALUE_TYPE value; tree type = (fflag ? FLOAT_TYPE_NODE : DOUBLE_TYPE_NODE); SET_REAL_VALUE_ATOF (value, REAL_VALUE_ATOF (literal_token, TYPE_MODE (type))); if (REAL_VALUE_ISINF (value) || REAL_VALUE_ISNAN (value)) { JAVA_FLOAT_RANGE_ERROR (fflag ? "float" : "double"); value = DCONST0; } else if (IS_ZERO (value)) { /* We check to see if the value is really 0 or if we've found an underflow. We do this in the most primitive imaginable way. */ int really_zero = 1; char *p = literal_token; if (*p == '-') ++p; while (*p && *p != 'e' && *p != 'E') { if (*p != '0' && *p != '.') { really_zero = 0; break; } ++p; } if (! really_zero) { int save_col = ctxp->lexer->position.col; ctxp->lexer->position.col = number_beginning; java_lex_error ("Floating point literal underflow", 0); ctxp->lexer->position.col = save_col; } } SET_LVAL_NODE (build_real (type, value)); }
tree gfc_conv_mpfr_to_tree (mpfr_t f, int kind) { tree res; tree type; mp_exp_t exp; char *p; char *q; int n; int edigits; for (n = 0; gfc_real_kinds[n].kind != 0; n++) { if (gfc_real_kinds[n].kind == kind) break; } gcc_assert (gfc_real_kinds[n].kind); n = MAX (abs (gfc_real_kinds[n].min_exponent), abs (gfc_real_kinds[n].max_exponent)); edigits = 1; while (n > 0) { n = n / 10; edigits += 3; } if (kind == gfc_default_double_kind) p = mpfr_get_str (NULL, &exp, 10, 17, f, GFC_RND_MODE); else p = mpfr_get_str (NULL, &exp, 10, 8, f, GFC_RND_MODE); /* We also have one minus sign, "e", "." and a null terminator. */ q = (char *) gfc_getmem (strlen (p) + edigits + 4); if (p[0]) { if (p[0] == '-') { strcpy (&q[2], &p[1]); q[0] = '-'; q[1] = '.'; } else { strcpy (&q[1], p); q[0] = '.'; } strcat (q, "e"); sprintf (&q[strlen (q)], "%d", (int) exp); } else { strcpy (q, "0"); } type = gfc_get_real_type (kind); res = build_real (type, REAL_VALUE_ATOF (q, TYPE_MODE (type))); gfc_free (q); gfc_free (p); return res; }