Commit efaa05d8 by Steven G. Kargl

re PR fortran/88227 (ICE in gfc_convert_boz, at fortran/target-memory.c:788)

2019-08-04  Steven G. Kargl  <kargl@gcc.gnu.org>

	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
parent 011fc8c6
2019-08-04 Steven G. Kargl <kargl@gcc.gnu.org>
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 <kargl@gcc.gnu.org>
PR fortran/90985
......
......@@ -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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment