Re: [PATCH] PR fortran/88227 -- Revenge of the BOZ

classic Classic list List threaded Threaded
4 messages Options
Reply | Threaded
Open this post in threaded view
|

Re: [PATCH] PR fortran/88227 -- Revenge of the BOZ

Steve Kargl
Last call.  T-12.

--
steve

On Thu, Aug 01, 2019 at 02:13:12PM -0700, Steve Kargl 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  <[hidden email]>
> >
> > 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

--
Steve
20170425 https://www.youtube.com/watch?v=VWUpyCsUKR4
20161221 https://www.youtube.com/watch?v=IbCHE-hONow
Reply | Threaded
Open this post in threaded view
|

Re: [PATCH] PR fortran/88227 -- Revenge of the BOZ

Paul Richard Thomas
Hi Steve,

This is OK.

Thanks for working on it.

Paul

On Thu, 1 Aug 2019 at 22:13, Steve Kargl
<[hidden email]> 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  <[hidden email]>
> >
> >       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



--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Reply | Threaded
Open this post in threaded view
|

Re: [PATCH] PR fortran/88227 -- Revenge of the BOZ

Steve Kargl
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.

--
Steve
Reply | Threaded
Open this post in threaded view
|

Re: [PATCH] PR fortran/88227 -- Revenge of the BOZ

Steve Kargl
In reply to this post by Steve Kargl
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 <[hidden email]> 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.

--
Steve