This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [PATCH] PR fortran/88227 -- Revenge of the BOZ
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Thu, 1 Aug 2019 14:13:12 -0700
- Subject: Re: [PATCH] PR fortran/88227 -- Revenge of the BOZ
- References: <20190728234102.GA73232@troutmask.apl.washington.edu>
- Reply-to: sgk at troutmask dot apl dot washington dot edu
Ping.
--
steve
On Sun, Jul 28, 2019 at 04:41:02PM -0700, Steve Kargl wrote:
> The attach patch fixes a problem with the conversion of a
> BOZ literal constant to a REAL where the size of the REAL
> exceeds the size of the largest INTEGER. The problem can
> be seen on 32-bit targets that provide support for REAL(10)
> and/or REAL(16), or it can be seen with a multilib target
> when using -m32 and REAL(10) and/or REAL(16).
>
> If needed, the patch converts an octal or hexidecimal string
> to the equivalent binary string, and then converts the binary
> string to a REAL. In principle, bin2real() can convert to
> REAL(4), REAL(8), REAL(10), and REAL(16), but I have elected
> to use the old conversion method if the size of the largest
> INTEGER exceeds the size the REAL(XXX) of interest. A future
> patch may remove the old method and make this new approach the
> only way to convert a BOZ.
>
> I have attached a short test program. There is no testcase
> for testsuite.
>
> PLEASE TEST.
>
> 2019-07-28 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.
>
> --
> Steve
> Index: gcc/fortran/check.c
> ===================================================================
> --- gcc/fortran/check.c (revision 273766)
> +++ gcc/fortran/check.c (working copy)
> @@ -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;
> subroutine foo10
>
> implicit none
>
> real(10) b, o, z, x
>
> b = real(b'010000000000000011001001000011111101101010100010001000010110100&
> &01100000000000000', 10)
> o = real(o'100001444176652104132140000', 10);
> z = real(z'4000C90FDAA22168C000', 10)
> print '(G0/,G0/,G0)', b, o, z
>
> b = real(b'011111111111111110000000000000000000000000000000000000000000000&
> &00000000000000000', 10)
> o = real(o'177777000000000000000000000', 10)
> z = real(z'7FFF8000000000000000', 10)
> print '(3(G0,1X))', b, o, z
>
> b = real(b'111111111111111110000000000000000000000000000000000000000000000&
> &00000000000000000', 10)
> o = real(o'377777000000000000000000000', 10)
> z = real(z'FFFF8000000000000000', 10)
> print '(3(G0,1X))', b, o, z
>
> b = real(b'111111111111111111000000000000000000000000000000000000000000000&
> &00000000000000000', 10)
> o = real(o'377777400000000000000000000', 10)
> z = real(z'FFFFC000000000000000', 10)
> print '(3(G0,1X))', b, o, z
>
> b = real(b'011111111111111111000000000000000000000000000000000000000000000&
> &00000000000000000', 10)
> o = real(o'177777400000000000000000000', 10)
> z = real(z'7FFFC000000000000000', 10)
> print '(3(G0,1X))', b, o, z
>
> end subroutine foo10
>
> subroutine foo16
>
> implicit none
>
> real(16) b, o, z, x
>
> b = real(b'010000000000000010010010000111111011010101000100010000101101000&
> &11000010001101001100010011000110011000101000101110000000110111000', 16)
> o = real(o'1000011103755242102643021514230630505600670', 16);
> z = real(z'4000921FB54442D18469898CC51701B8', 16)
> print '(G0/,G0/,G0)', b, o, z
>
> b = real(b'011111111111111100000000000000000000000000000000000000000000000&
> &00000000000000000000000000000000000000000000000000000000000000000', 16)
> o = real(o'1777760000000000000000000000000000000000000', 16)
> z = real(z'7FFF0000000000000000000000000000', 16)
> print '(3(G0,1X))', b, o, z
>
> b = real(b'111111111111111100000000000000000000000000000000000000000000000&
> &00000000000000000000000000000000000000000000000000000000000000000', 16)
> o = real(o'3777760000000000000000000000000000000000000', 16)
> z = real(z'FFFF0000000000000000000000000000', 16)
> print '(3(G0,1X))', b, o, z
>
> b = real(b'111111111111111110000000000000000000000000000000000000000000000&
> &00000000000000000000000000000000000000000000000000000000000000000', 16)
> o = real(o'3777770000000000000000000000000000000000000', 16)
> z = real(z'FFFF8000000000000000000000000000', 16)
> print '(3(G0,1X))', b, o, z
>
> b = real(b'011111111111111110000000000000000000000000000000000000000000000&
> &00000000000000000000000000000000000000000000000000000000000000000', 16)
> o = real(o'1777770000000000000000000000000000000000000', 16)
> z = real(z'7FFF8000000000000000000000000000', 16)
> print '(3(G0,1X))', b, o, z
>
> end subroutine foo16
>
> program foo
> call foo10
> print *
> call foo16
> end program foo
--
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow