This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [gfortran] Fix PR 17568: Shortcomings in ISHFT constant folder


Tobias Schlüter wrote:
> Patch attached, ChangeLog below.

This statement is correct for this mail. Not the previous one.

- Tobi

> 2004-10-02  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
> 
> 	PR fortran/17568
> 	* simplify.c (twos_complement): New function.
> 	(gfc_simplify_ishft, gfc_simplify_ishftc): Revise.
> 

Index: simplify.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/simplify.c,v
retrieving revision 1.11
diff -c -3 -p -r1.11 simplify.c
*** simplify.c	20 Sep 2004 17:22:50 -0000	1.11
--- simplify.c	2 Oct 2004 19:25:42 -0000
*************** gfc_simplify_ior (gfc_expr * x, gfc_expr
*** 1586,1597 ****
  }
  
  
  gfc_expr *
  gfc_simplify_ishft (gfc_expr * e, gfc_expr * s)
  {
    gfc_expr *result;
!   int shift, ashift, isize, k;
!   long e_int;
  
    if (e->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
      return NULL;
--- 1586,1623 ----
  }
  
  
+ /* Checks if X, which is assumed to represent a two's complement
+    integer of binary width BITSIZE, has the signbit set.  If so, makes 
+    X the corresponding negative number.  */
+ 
+ static void
+ twos_complement (mpz_t x, int bitsize)
+ {
+   mpz_t mask;
+   unsigned long mask_i;
+ 
+   if (mpz_tstbit (x, bitsize - 1) == 1)
+     {
+       mask_i = (bitsize == sizeof(long) * 8) ? ~0 : (1 << bitsize) - 1;
+       mpz_init_set_ui (mask, mask_i);
+ 
+       /* We negate the number by hand, zeroing the high bits, and then
+ 	 have it negated by GMP.  */
+       mpz_com (x, x);
+       mpz_add_ui (x, x, 1);
+       mpz_and (x, x, mask);
+ 
+       mpz_neg (x, x);
+ 
+       mpz_clear (mask);
+     }
+ }
+ 
  gfc_expr *
  gfc_simplify_ishft (gfc_expr * e, gfc_expr * s)
  {
    gfc_expr *result;
!   int shift, ashift, isize, k, *bits, i;
  
    if (e->expr_type != EXPR_CONSTANT || s->expr_type != EXPR_CONSTANT)
      return NULL;
*************** gfc_simplify_ishft (gfc_expr * e, gfc_ex
*** 1619,1628 ****
        return &gfc_bad_expr;
      }
  
-   e_int = mpz_get_si (e->value.integer);
-   if (e_int > INT_MAX || e_int < INT_MIN)
-     gfc_internal_error ("ISHFT: unable to extract integer");
- 
    result = gfc_constant_result (e->ts.type, e->ts.kind, &e->where);
  
    if (shift == 0)
--- 1645,1650 ----
*************** gfc_simplify_ishft (gfc_expr * e, gfc_ex
*** 1630,1642 ****
        mpz_set (result->value.integer, e->value.integer);
        return range_check (result, "ISHFT");
      }
  
    if (shift > 0)
!     mpz_set_si (result->value.integer, e_int << shift);
    else
!     mpz_set_si (result->value.integer, e_int >> ashift);
  
!   return range_check (result, "ISHFT");
  }
  
  
--- 1652,1694 ----
        mpz_set (result->value.integer, e->value.integer);
        return range_check (result, "ISHFT");
      }
+   
+   bits = gfc_getmem (isize * sizeof (int));
+ 
+   for (i = 0; i < isize; i++)
+     bits[i] = mpz_tstbit (e->value.integer, i);
  
    if (shift > 0)
!     {
!       for (i = 0; i < shift; i++)
! 	mpz_clrbit (result->value.integer, i);
! 
!       for (i = 0; i < isize - shift; i++)
! 	{
! 	  if (bits[i] == 0)
! 	    mpz_clrbit (result->value.integer, i + shift);
! 	  else
! 	    mpz_setbit (result->value.integer, i + shift);
! 	}
!     }
    else
!     {
!       for (i = isize - 1; i >= isize - ashift; i--)
! 	mpz_clrbit (result->value.integer, i);
! 
!       for (i = isize - 1; i >= ashift; i--)
! 	{
! 	  if (bits[i] == 0)
! 	    mpz_clrbit (result->value.integer, i - ashift);
! 	  else
! 	    mpz_setbit (result->value.integer, i - ashift);
! 	}
!     }
! 
!   twos_complement (result->value.integer, isize);
  
!   gfc_free (bits);
!   return result;
  }
  
  
*************** gfc_simplify_ishftc (gfc_expr * e, gfc_e
*** 1684,1689 ****
--- 1736,1747 ----
  
    result = gfc_constant_result (e->ts.type, e->ts.kind, &e->where);
  
+   if (shift == 0)
+     {
+       mpz_set (result->value.integer, e->value.integer);
+       return result;
+     }
+ 
    bits = gfc_getmem (isize * sizeof (int));
  
    for (i = 0; i < isize; i++)
*************** gfc_simplify_ishftc (gfc_expr * e, gfc_e
*** 1691,1710 ****
  
    delta = isize - ashift;
  
!   if (shift == 0)
!     {
!       mpz_set (result->value.integer, e->value.integer);
!       gfc_free (bits);
!       return range_check (result, "ISHFTC");
!     }
! 
!   else if (shift > 0)
      {
        for (i = 0; i < delta; i++)
  	{
  	  if (bits[i] == 0)
  	    mpz_clrbit (result->value.integer, i + shift);
! 	  if (bits[i] == 1)
  	    mpz_setbit (result->value.integer, i + shift);
  	}
  
--- 1749,1761 ----
  
    delta = isize - ashift;
  
!   if (shift > 0)
      {
        for (i = 0; i < delta; i++)
  	{
  	  if (bits[i] == 0)
  	    mpz_clrbit (result->value.integer, i + shift);
! 	  else
  	    mpz_setbit (result->value.integer, i + shift);
  	}
  
*************** gfc_simplify_ishftc (gfc_expr * e, gfc_e
*** 1712,1723 ****
  	{
  	  if (bits[i] == 0)
  	    mpz_clrbit (result->value.integer, i - delta);
! 	  if (bits[i] == 1)
  	    mpz_setbit (result->value.integer, i - delta);
  	}
- 
-       gfc_free (bits);
-       return range_check (result, "ISHFTC");
      }
    else
      {
--- 1763,1771 ----
  	{
  	  if (bits[i] == 0)
  	    mpz_clrbit (result->value.integer, i - delta);
! 	  else
  	    mpz_setbit (result->value.integer, i - delta);
  	}
      }
    else
      {
*************** gfc_simplify_ishftc (gfc_expr * e, gfc_e
*** 1725,1731 ****
  	{
  	  if (bits[i] == 0)
  	    mpz_clrbit (result->value.integer, i + delta);
! 	  if (bits[i] == 1)
  	    mpz_setbit (result->value.integer, i + delta);
  	}
  
--- 1773,1779 ----
  	{
  	  if (bits[i] == 0)
  	    mpz_clrbit (result->value.integer, i + delta);
! 	  else
  	    mpz_setbit (result->value.integer, i + delta);
  	}
  
*************** gfc_simplify_ishftc (gfc_expr * e, gfc_e
*** 1733,1745 ****
  	{
  	  if (bits[i] == 0)
  	    mpz_clrbit (result->value.integer, i + shift);
! 	  if (bits[i] == 1)
  	    mpz_setbit (result->value.integer, i + shift);
  	}
- 
-       gfc_free (bits);
-       return range_check (result, "ISHFTC");
      }
  }
  
  
--- 1781,1795 ----
  	{
  	  if (bits[i] == 0)
  	    mpz_clrbit (result->value.integer, i + shift);
! 	  else
  	    mpz_setbit (result->value.integer, i + shift);
  	}
      }
+ 
+   twos_complement (result->value.integer, isize);
+ 
+   gfc_free (bits);
+   return result;
  }
  
  

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]