| Message ID | 20190728234102.GA73232@troutmask.apl.washington.edu |
|---|---|
| State | New |
| Headers | show |
| Series | PR fortran/88227 -- Revenge of the BOZ | expand |
Ping.
Last call. T-12.
Hi Steve, This is OK. Thanks for working on it. Paul On Thu, 1 Aug 2019 at 22:13, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote: > > 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
On Sun, Aug 04, 2019 at 03:14:53PM +0100, Paul Richard Thomas wrote: > Hi Steve, > > This is OK. > > Thanks for working on it. > > Paul > Thanks. BTW, I started to read your SELECT RANK patch. From I read, it looks good. When you're ready with a final patch, feel free to ping me.
Hi Steve, I know you already committed this but please let me add a remark or two. On Sun, 28 Jul 2019 16:41:02 -0700 Steve Kargl <sgk@troutmask.apl.washington.edu> wrote: > 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); Just cosmetics since it should be optimized away, but the memset is redundant, XCNEWVEC aka xcalloc already clears the memory resp. allocates cleared memory. > + > + 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); Since you strcpy below, a XNEWVEC should suffice, i.e. you don't need cleared memory since strcpy also copies the trailing null byte. > + 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); Like above, memset is redundant. > + > + 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. */ /to s/s/to/the/ thanks, > + 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;
On Tue, Aug 06, 2019 at 04:27:46PM +0200, Bernhard Reutner-Fischer wrote: > Hi Steve, > > I know you already committed this but please let me add a remark or two. > > On Sun, 28 Jul 2019 16:41:02 -0700 > Steve Kargl <sgk@troutmask.apl.washington.edu> wrote: > > > + > > + bufp = buf = XCNEWVEC (char, j + 1); > > + memset (bufp, 0, j + 1); > > Just cosmetics since it should be optimized away, but the memset is > redundant, XCNEWVEC aka xcalloc already clears the memory resp. > allocates cleared memory. > I wasn't sure if XCNEWVEC zeroed memory. The patch builds the binary string with pointer arithmetic, and was trying to prevent bad things from happening if I got that wrong (which I did once or twice :). I'll clean this up later.
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;