diff mbox series

Fix expand_assignment with complex modes with the same size but different inner mode (PR middle-end/82253)

Message ID 20171122210148.GD14653@tucnak
State New
Headers show
Series Fix expand_assignment with complex modes with the same size but different inner mode (PR middle-end/82253) | expand

Commit Message

Jakub Jelinek Nov. 22, 2017, 9:01 p.m. UTC
Hi!

store_expr which is called if to_rtx is a CONCAT and from has complex mode
covering the whole to_rtx can handle the case when from expands to a CONCAT
or if it has the same complex mode, but if e.g. one mode is CTImode and
the other mode is TCmode and from expands to something other than a CONCAT
(e.g. a MEM, not sure if anything else is possible, perhaps a constant),
then convert_mode can't deal with it.  We already have code to handle the
case when to_rtx is CONCAT and from covers all its bits, so this patch
just uses that code if the complex modes are different.
simplify_gen_subreg doesn't work properly if from would expand as a CONCAT
though, so I'm subregging the individual parts instead in that case.

Bootstrapped/regtested on x86_64-linux and i686-linux, ok for trunk?

2017-11-22  Jakub Jelinek  <jakub@redhat.com>

	PR middle-end/82253
	* expr.c (expand_assignment): For CONCAT to_rtx, complex type from and
	bitpos/bitsize covering the whole destination, use store_expr only if
	the complex mode is the same.  Otherwise, use expand_normal and if
	it returns CONCAT, subreg each part separately instead of trying to
	subreg the whole result.

	* gfortran.dg/pr82253.f90: New test.


	Jakub

Comments

Richard Biener Nov. 23, 2017, 8:51 a.m. UTC | #1
On Wed, 22 Nov 2017, Jakub Jelinek wrote:

> Hi!
> 
> store_expr which is called if to_rtx is a CONCAT and from has complex mode
> covering the whole to_rtx can handle the case when from expands to a CONCAT
> or if it has the same complex mode, but if e.g. one mode is CTImode and
> the other mode is TCmode and from expands to something other than a CONCAT
> (e.g. a MEM, not sure if anything else is possible, perhaps a constant),
> then convert_mode can't deal with it.  We already have code to handle the
> case when to_rtx is CONCAT and from covers all its bits, so this patch
> just uses that code if the complex modes are different.
> simplify_gen_subreg doesn't work properly if from would expand as a CONCAT
> though, so I'm subregging the individual parts instead in that case.
> 
> Bootstrapped/regtested on x86_64-linux and i686-linux, ok for trunk?

LGTM.

Thanks,
Richard.

> 2017-11-22  Jakub Jelinek  <jakub@redhat.com>
> 
> 	PR middle-end/82253
> 	* expr.c (expand_assignment): For CONCAT to_rtx, complex type from and
> 	bitpos/bitsize covering the whole destination, use store_expr only if
> 	the complex mode is the same.  Otherwise, use expand_normal and if
> 	it returns CONCAT, subreg each part separately instead of trying to
> 	subreg the whole result.
> 
> 	* gfortran.dg/pr82253.f90: New test.
> 
> --- gcc/expr.c.jj	2017-11-21 20:23:02.000000000 +0100
> +++ gcc/expr.c	2017-11-22 18:31:57.513726153 +0100
> @@ -5107,7 +5107,8 @@ expand_assignment (tree to, tree from, b
>        else if (GET_CODE (to_rtx) == CONCAT)
>  	{
>  	  unsigned short mode_bitsize = GET_MODE_BITSIZE (GET_MODE (to_rtx));
> -	  if (COMPLEX_MODE_P (TYPE_MODE (TREE_TYPE (from)))
> +	  if (TYPE_MODE (TREE_TYPE (from)) == GET_MODE (to_rtx)
> +	      && COMPLEX_MODE_P (GET_MODE (to_rtx))
>  	      && bitpos == 0
>  	      && bitsize == mode_bitsize)
>  	    result = store_expr (from, to_rtx, false, nontemporal, reversep);
> @@ -5128,14 +5129,30 @@ expand_assignment (tree to, tree from, b
>  				  nontemporal, reversep);
>  	  else if (bitpos == 0 && bitsize == mode_bitsize)
>  	    {
> -	      rtx from_rtx;
>  	      result = expand_normal (from);
> -	      from_rtx = simplify_gen_subreg (GET_MODE (to_rtx), result,
> -					      TYPE_MODE (TREE_TYPE (from)), 0);
> -	      emit_move_insn (XEXP (to_rtx, 0),
> -			      read_complex_part (from_rtx, false));
> -	      emit_move_insn (XEXP (to_rtx, 1),
> -			      read_complex_part (from_rtx, true));
> +	      if (GET_CODE (result) == CONCAT)
> +		{
> +		  machine_mode to_mode = GET_MODE_INNER (GET_MODE (to_rtx));
> +		  machine_mode from_mode = GET_MODE_INNER (GET_MODE (result));
> +		  rtx from_real
> +		    = simplify_gen_subreg (to_mode, XEXP (result, 0),
> +					   from_mode, 0);
> +		  rtx from_imag
> +		    = simplify_gen_subreg (to_mode, XEXP (result, 1),
> +					   from_mode, 1);
> +		  emit_move_insn (XEXP (to_rtx, 0), from_real);
> +		  emit_move_insn (XEXP (to_rtx, 1), from_imag);
> +		}
> +	      else
> +		{
> +		  rtx from_rtx
> +		    = simplify_gen_subreg (GET_MODE (to_rtx), result,
> +					   TYPE_MODE (TREE_TYPE (from)), 0);
> +		  emit_move_insn (XEXP (to_rtx, 0),
> +				  read_complex_part (from_rtx, false));
> +		  emit_move_insn (XEXP (to_rtx, 1),
> +				  read_complex_part (from_rtx, true));
> +		}
>  	    }
>  	  else
>  	    {
> --- gcc/testsuite/gfortran.dg/pr82253.f90.jj	2017-11-22 18:41:33.421850619 +0100
> +++ gcc/testsuite/gfortran.dg/pr82253.f90	2017-11-22 18:41:18.000000000 +0100
> @@ -0,0 +1,40 @@
> +! PR middle-end/82253
> +! { dg-do compile { target fortran_real_16 } }
> +! { dg-options "-Og" }
> +
> +module pr82253
> +  implicit none
> +  private
> +  public :: static_type
> +  type, public :: T
> +    procedure(), nopass, pointer :: testProc => null()
> +  end type
> +  type, public :: S
> +    complex(kind=16), pointer :: ptr
> +  end type
> +  type(T), target :: type_complex32
> +  interface static_type
> +    module procedure foo
> +  end interface
> +  interface
> +    subroutine bar (testProc)
> +      procedure(), optional :: testProc
> +    end subroutine
> +  end interface
> +  contains
> +    function foo (self) result(res)
> +      complex(kind=16) :: self
> +      type(T), pointer :: res
> +      call bar (testProc = baz)
> +    end function
> +    subroutine baz (buffer, status)
> +      character(len=*) :: buffer
> +      integer(kind=4) :: status
> +      complex(kind=16), target :: obj
> +      type(S) :: self
> +      integer(kind=1), parameter :: zero(storage_size(obj)/8) = 0
> +      obj = transfer (zero, obj)
> +      self%ptr => obj
> +      write (buffer, *, iostat=status) self%ptr, '#'
> +    end subroutine
> +end module pr82253
> 
> 	Jakub
> 
>
diff mbox series

Patch

--- gcc/expr.c.jj	2017-11-21 20:23:02.000000000 +0100
+++ gcc/expr.c	2017-11-22 18:31:57.513726153 +0100
@@ -5107,7 +5107,8 @@  expand_assignment (tree to, tree from, b
       else if (GET_CODE (to_rtx) == CONCAT)
 	{
 	  unsigned short mode_bitsize = GET_MODE_BITSIZE (GET_MODE (to_rtx));
-	  if (COMPLEX_MODE_P (TYPE_MODE (TREE_TYPE (from)))
+	  if (TYPE_MODE (TREE_TYPE (from)) == GET_MODE (to_rtx)
+	      && COMPLEX_MODE_P (GET_MODE (to_rtx))
 	      && bitpos == 0
 	      && bitsize == mode_bitsize)
 	    result = store_expr (from, to_rtx, false, nontemporal, reversep);
@@ -5128,14 +5129,30 @@  expand_assignment (tree to, tree from, b
 				  nontemporal, reversep);
 	  else if (bitpos == 0 && bitsize == mode_bitsize)
 	    {
-	      rtx from_rtx;
 	      result = expand_normal (from);
-	      from_rtx = simplify_gen_subreg (GET_MODE (to_rtx), result,
-					      TYPE_MODE (TREE_TYPE (from)), 0);
-	      emit_move_insn (XEXP (to_rtx, 0),
-			      read_complex_part (from_rtx, false));
-	      emit_move_insn (XEXP (to_rtx, 1),
-			      read_complex_part (from_rtx, true));
+	      if (GET_CODE (result) == CONCAT)
+		{
+		  machine_mode to_mode = GET_MODE_INNER (GET_MODE (to_rtx));
+		  machine_mode from_mode = GET_MODE_INNER (GET_MODE (result));
+		  rtx from_real
+		    = simplify_gen_subreg (to_mode, XEXP (result, 0),
+					   from_mode, 0);
+		  rtx from_imag
+		    = simplify_gen_subreg (to_mode, XEXP (result, 1),
+					   from_mode, 1);
+		  emit_move_insn (XEXP (to_rtx, 0), from_real);
+		  emit_move_insn (XEXP (to_rtx, 1), from_imag);
+		}
+	      else
+		{
+		  rtx from_rtx
+		    = simplify_gen_subreg (GET_MODE (to_rtx), result,
+					   TYPE_MODE (TREE_TYPE (from)), 0);
+		  emit_move_insn (XEXP (to_rtx, 0),
+				  read_complex_part (from_rtx, false));
+		  emit_move_insn (XEXP (to_rtx, 1),
+				  read_complex_part (from_rtx, true));
+		}
 	    }
 	  else
 	    {
--- gcc/testsuite/gfortran.dg/pr82253.f90.jj	2017-11-22 18:41:33.421850619 +0100
+++ gcc/testsuite/gfortran.dg/pr82253.f90	2017-11-22 18:41:18.000000000 +0100
@@ -0,0 +1,40 @@ 
+! PR middle-end/82253
+! { dg-do compile { target fortran_real_16 } }
+! { dg-options "-Og" }
+
+module pr82253
+  implicit none
+  private
+  public :: static_type
+  type, public :: T
+    procedure(), nopass, pointer :: testProc => null()
+  end type
+  type, public :: S
+    complex(kind=16), pointer :: ptr
+  end type
+  type(T), target :: type_complex32
+  interface static_type
+    module procedure foo
+  end interface
+  interface
+    subroutine bar (testProc)
+      procedure(), optional :: testProc
+    end subroutine
+  end interface
+  contains
+    function foo (self) result(res)
+      complex(kind=16) :: self
+      type(T), pointer :: res
+      call bar (testProc = baz)
+    end function
+    subroutine baz (buffer, status)
+      character(len=*) :: buffer
+      integer(kind=4) :: status
+      complex(kind=16), target :: obj
+      type(S) :: self
+      integer(kind=1), parameter :: zero(storage_size(obj)/8) = 0
+      obj = transfer (zero, obj)
+      self%ptr => obj
+      write (buffer, *, iostat=status) self%ptr, '#'
+    end subroutine
+end module pr82253