From: Steven G. Kargl Date: Sun, 4 Aug 2019 15:52:55 +0000 (+0000) Subject: re PR fortran/88227 (ICE in gfc_convert_boz, at fortran/target-memory.c:788) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=efaa05d8fd84dc045ab8f68caeabf9578fd36c21;p=gcc.git re PR fortran/88227 (ICE in gfc_convert_boz, at fortran/target-memory.c:788) 2019-08-04 Steven G. Kargl PR fortran/88227 * check.c (oct2bin): New function. Convert octal string to binary. (hex2bin): New function. Convert hexidecimal string to binary. (bin2real): New function. Convert binary string to REAL. Use oct2bin and hex2bin. (gfc_boz2real): Use fallback conversion bin2real. From-SVN: r274096 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3eb02c25aa5..534ae3575d0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2019-08-04 Steven G. Kargl + + PR fortran/88227 + * check.c (oct2bin): New function. Convert octal string to binary. + (hex2bin): New function. Convert hexidecimal string to binary. + (bin2real): New function. Convert binary string to REAL. Use + oct2bin and hex2bin. + (gfc_boz2real): Use fallback conversion bin2real. + 2019-08-02 Steven G. Kargl PR fortran/90985 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 376edd3ae83..0204961a4d7 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -55,6 +55,7 @@ gfc_invalid_boz (const char *msg, locus *loc) /* Issue an error for an illegal BOZ argument. */ + static bool illegal_boz_arg (gfc_expr *x) { @@ -101,6 +102,167 @@ is_boz_constant (gfc_expr *a) } +/* Convert a octal string into a binary string. This is used in the + fallback conversion of an octal string to a REAL. */ + +static char * +oct2bin(int nbits, char *oct) +{ + const char bits[8][5] = { + "000", "001", "010", "011", "100", "101", "110", "111"}; + + char *buf, *bufp; + int i, j, n; + + j = nbits + 1; + if (nbits == 64) j++; + + bufp = buf = XCNEWVEC (char, j + 1); + memset (bufp, 0, j + 1); + + n = strlen (oct); + for (i = 0; i < n; i++, oct++) + { + j = *oct - 48; + strcpy (bufp, &bits[j][0]); + bufp += 3; + } + + bufp = XCNEWVEC (char, nbits + 1); + if (nbits == 64) + strcpy (bufp, buf + 2); + else + strcpy (bufp, buf + 1); + + free (buf); + + return bufp; +} + + +/* Convert a hexidecimal string into a binary string. This is used in the + fallback conversion of a hexidecimal string to a REAL. */ + +static char * +hex2bin(int nbits, char *hex) +{ + const char bits[16][5] = { + "0000", "0001", "0010", "0011", "0100", "0101", "0110", "0111", + "1000", "1001", "1010", "1011", "1100", "1101", "1110", "1111"}; + + char *buf, *bufp; + int i, j, n; + + bufp = buf = XCNEWVEC (char, nbits + 1); + memset (bufp, 0, nbits + 1); + + n = strlen (hex); + for (i = 0; i < n; i++, hex++) + { + j = *hex; + if (j > 47 && j < 58) + j -= 48; + else if (j > 64 && j < 71) + j -= 55; + else if (j > 96 && j < 103) + j -= 87; + else + gcc_unreachable (); + + strcpy (bufp, &bits[j][0]); + bufp += 4; + } + + return buf; +} + + +/* Fallback conversion of a BOZ string to REAL. */ + +static void +bin2real (gfc_expr *x, int kind) +{ + char buf[114], *sp; + int b, i, ie, t, w; + bool sgn; + mpz_t em; + + i = gfc_validate_kind (BT_REAL, kind, false); + t = gfc_real_kinds[i].digits - 1; + + /* Number of bits in the exponent. */ + if (gfc_real_kinds[i].max_exponent == 16384) + w = 15; + else if (gfc_real_kinds[i].max_exponent == 1024) + w = 11; + else + w = 8; + + if (x->boz.rdx == 16) + sp = hex2bin (gfc_real_kinds[i].mode_precision, x->boz.str); + else if (x->boz.rdx == 8) + sp = oct2bin (gfc_real_kinds[i].mode_precision, x->boz.str); + else + sp = x->boz.str; + + /* Extract sign bit. */ + sgn = *sp != '0'; + + /* Extract biased exponent. */ + memset (buf, 0, 114); + strncpy (buf, ++sp, w); + mpz_init (em); + mpz_set_str (em, buf, 2); + ie = mpz_get_si (em); + + mpfr_init2 (x->value.real, t + 1); + x->ts.type = BT_REAL; + x->ts.kind = kind; + + sp += w; /* Set to first digit in significand. */ + b = (1 << w) - 1; + if ((i == 0 && ie == b) || (i == 1 && ie == b) + || ((i == 2 || i == 3) && ie == b)) + { + bool zeros = true; + if (i == 2) sp++; + for (; *sp; sp++) + { + if (*sp != '0') + { + zeros = false; + break; + } + } + + if (zeros) + mpfr_set_inf (x->value.real, 1); + else + mpfr_set_nan (x->value.real); + } + else + { + if (i == 2) + strncpy (buf, sp, t + 1); + else + { + /* Significand with hidden bit. */ + buf[0] = '1'; + strncpy (&buf[1], sp, t); + } + + /* Convert to significand to integer. */ + mpz_set_str (em, buf, 2); + ie -= ((1 << (w - 1)) - 1); /* Unbiased exponent. */ + mpfr_set_z_2exp (x->value.real, em, ie - t, GFC_RND_MODE); + } + + if (sgn) mpfr_neg (x->value.real, x->value.real, GFC_RND_MODE); + + mpz_clear (em); +} + + /* Fortran 2018 treats a BOZ as simply a string of bits. gfc_boz2real () converts the string into a REAL of the appropriate kind. The treatment of the sign bit is processor dependent. */ @@ -158,21 +320,31 @@ gfc_boz2real (gfc_expr *x, int kind) buf[0] = '1'; } } - + /* Reset BOZ string to the truncated or padded version. */ free (x->boz.str); x->boz.len = len; x->boz.str = XCNEWVEC (char, len + 1); strncpy (x->boz.str, buf, len); - /* Convert to widest possible integer. */ - gfc_boz2int (x, gfc_max_integer_kind); - ts.type = BT_REAL; - ts.kind = kind; - if (!gfc_convert_boz (x, &ts)) + /* For some targets, the largest INTEGER in terms of bits is smaller than + the bits needed to hold the REAL. Fortunately, the kind type parameter + indicates the number of bytes required to an INTEGER and a REAL. */ + if (gfc_max_integer_kind < kind) { - gfc_error ("Failure in conversion of BOZ to REAL at %L", &x->where); - return false; + bin2real (x, kind); + } + else + { + /* Convert to widest possible integer. */ + gfc_boz2int (x, gfc_max_integer_kind); + ts.type = BT_REAL; + ts.kind = kind; + if (!gfc_convert_boz (x, &ts)) + { + gfc_error ("Failure in conversion of BOZ to REAL at %L", &x->where); + return false; + } } return true;