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]

[libgfortran, patch] Fix complex DOT_PRODUCT error.

From: Feng Wang <wf_cs at yahoo dot com>
To: fortran <fortran at gcc dot gnu dot org>, patch <gcc-patches at gcc dot gnu dot org>
Date: Fri, 6 Feb 2004 21:50:10 +0800 (CST)
Subject: [libgfortran, patch] Fix complex DOT_PRODUCT error.

Hi, all
  This patch fixed an error of dot_product (a, b). If the arguments are of type
complex, the result value should be SUM (CONJ (a) * b). The original
implementation is SUM ( a * b).
  Paul, Please check and apply it. Thank you. But note that this patch also
fixes the spelling in libgfortran/Makefile.am I mentioned in another mail. So
you can leave the mail titled :[libgfortran,patch] Fix spelling in Makefile.am.

  Feng Wang

ChangeLog:
2004-02-06  Feng Wang  <fengwang@nudt.edu.cn>

	* Makefile.am: Add m4/dotprodc.m4. And fix spelling.
	* Makefile.in: Regenerate.
	* m4/dotprodc.m4: New file. Implement complex dot_product.
	* m4/dotprod.m4: Delete the complex implementation.
	* generated/dotprod_*: Update.

testsuite/ChangeLog.tree-ssa
2004-02-06  Feng Wang  <fengwang@nudt.edu.cn>

	* gfortran.fortran-torture/execute/intrinsic_dotprod.f90: Add complex
	test.



_________________________________________________________
Do You Yahoo!? 
完全免费的雅虎电邮，马上注册获赠额外60兆网络存储空间
http://cn.rd.yahoo.com/mail_cn/tag/?http://cn.mail.yahoo.com

diff -cr3p libgfortran/Makefile.am ../gcc/libgfortran/Makefile.am
*** libgfortran/Makefile.am	Fri Feb  6 16:07:48 2004
--- ../gcc/libgfortran/Makefile.am	Fri Feb  6 16:38:23 2004
*************** i_dotprod_c= \
*** 152,165 ****
  generated/dotprod_i4.c \
  generated/dotprod_i8.c \
  generated/dotprod_r4.c \
! generated/dotprod_r8.c \
! generated/dotprod_c4.c \
! generated/dotprod_c8.c
  
  i_dotprodl_c= \
  generated/dotprod_l4.c \
  generated/dotprod_l8.c
  
  i_matmul_c= \
  generated/matmul_i4.c \
  generated/matmul_i8.c \
--- 152,167 ----
  generated/dotprod_i4.c \
  generated/dotprod_i8.c \
  generated/dotprod_r4.c \
! generated/dotprod_r8.c 
  
  i_dotprodl_c= \
  generated/dotprod_l4.c \
  generated/dotprod_l8.c
  
+ i_dotprodc_c= \
+ generated/dotprod_c4.c \
+ generated/dotprod_c8.c
+ 
  i_matmul_c= \
  generated/matmul_i4.c \
  generated/matmul_i8.c \
*************** generated/set_exponent_r8.c
*** 223,229 ****
  m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/types.m4 m4/all.m4 \
      m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
      m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \
!     m4/dotprod.m4 m4/dotprodl.m4 m4/matmul.m4 m4/matmull.m4 \
      m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.m4 \
      m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \
      m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
--- 225,231 ----
  m4_files= m4/iparm.m4 m4/ifunction.m4 m4/iforeach.m4 m4/types.m4 m4/all.m4 \
      m4/any.m4 m4/count.m4 m4/maxloc0.m4 m4/maxloc1.m4 m4/maxval.m4 \
      m4/minloc0.m4 m4/minloc1.m4 m4/minval.m4 m4/product.m4 m4/sum.m4 \
!     m4/dotprod.m4 m4/dotprodl.m4 m4/dotprodc.m4 m4/matmul.m4 m4/matmull.m4 \
      m4/ctrig.m4 m4/cexp.m4 m4/chyp.m4 m4/mtype.m4 \
      m4/specific.m4 m4/specific2.m4 m4/head.m4 m4/shape.m4 m4/reshape.m4 \
      m4/transpose.m4 m4/eoshift1.m4 m4/eoshift3.m4 m4/exponent.m4 \
*************** m4_files= m4/iparm.m4 m4/ifunction.m4 m4
*** 231,238 ****
  
  gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
      $(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
!     $(i_product_c) $(i_sum_c) $(i_dotprod_c) $(i_dotprodl_c) $(i_matmul_c) \
!     $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \
      $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
      $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c)
  
--- 233,240 ----
  
  gfor_built_src= $(i_all_c) $(i_any_c) $(i_count_c) $(i_maxloc0_c) \
      $(i_maxloc1_c) $(i_maxval_c) $(i_minloc0_c) $(i_minloc1_c) $(i_minval_c) \
!     $(i_product_c) $(i_sum_c) $(i_dotprod_c) $(i_dotprodl_c) $(i_dotprodc_c) \
!     $(i_matmul_c) $(i_matmull_c) $(i_transpose_c) $(i_shape_c) $(i_eoshift1_c) \
      $(i_eoshift3_c) $(i_cshift1_c) $(i_reshape_c) $(in_pack_c) $(in_unpack_c) \
      $(i_exponent_c) $(i_fraction_c) $(i_nearest_c) $(i_set_exponent_c)
  
*************** $(i_dotprod_c): m4/dotprod.m4 $(I_M4_DEP
*** 392,397 ****
--- 394,402 ----
  $(i_dotprodl_c): m4/dotprodl.m4 $(I_M4_DEPS)
  	m4 -Dfile=$@ -I$(srcdir)/m4 dotprodl.m4 > $@
  
+ $(i_dotprodc_c): m4/dotprodc.m4 $(I_M4_DEPS)
+ 	m4 -Dfile=$@ -I$(srcdir)/m4 dotprodc.m4 > $@
+ 
  $(i_matmul_c): m4/matmul.m4 $(I_M4_DEPS)
  	m4 -Dfile=$@ -I$(srcdir)/m4 matmul.m4 > $@
  
*************** $(in_pack_c): m4/in_pack.m4 $(I_M4_DEPS)
*** 422,437 ****
  $(in_unpack_c): m4/in_unpack.m4 $(I_M4_DEPS)
  	m4 -Dfile=$@ -I$(srcdir)/m4 in_unpack.m4 > $@
  
! $(in_exponent_c): m4/exponent.m4 m4/mtype.m4
  	m4 -Dfile=$@ -I$(srcdir)/m4 exponent.m4 > $@
  
! $(in_fraction_c): m4/fraction.m4 m4/mtype.m4
  	m4 -Dfile=$@ -I$(srcdir)/m4 fraction.m4 > $@
  
! $(in_nearest_c): m4/nearest.m4 m4/mtype.m4
  	m4 -Dfile=$@ -I$(srcdir)/m4 nearest.m4 > $@
  
! $(in_set_exponent_c): m4/set_exponent.m4 m4/mtype.m4
  	m4 -Dfile=$@ -I$(srcdir)/m4 set_exponent.m4 > $@
  
  $(gfor_math_trig_c): m4/ctrig.m4 m4/mtype.m4
--- 427,442 ----
  $(in_unpack_c): m4/in_unpack.m4 $(I_M4_DEPS)
  	m4 -Dfile=$@ -I$(srcdir)/m4 in_unpack.m4 > $@
  
! $(i_exponent_c): m4/exponent.m4 m4/mtype.m4
  	m4 -Dfile=$@ -I$(srcdir)/m4 exponent.m4 > $@
  
! $(i_fraction_c): m4/fraction.m4 m4/mtype.m4
  	m4 -Dfile=$@ -I$(srcdir)/m4 fraction.m4 > $@
  
! $(i_nearest_c): m4/nearest.m4 m4/mtype.m4
  	m4 -Dfile=$@ -I$(srcdir)/m4 nearest.m4 > $@
  
! $(i_set_exponent_c): m4/set_exponent.m4 m4/mtype.m4
  	m4 -Dfile=$@ -I$(srcdir)/m4 set_exponent.m4 > $@
  
  $(gfor_math_trig_c): m4/ctrig.m4 m4/mtype.m4
diff -cr3p libgfortran/m4/dotprod.m4 ../gcc/libgfortran/m4/dotprod.m4
*** libgfortran/m4/dotprod.m4	Fri Feb  6 16:07:48 2004
--- ../gcc/libgfortran/m4/dotprod.m4	Fri Feb  6 16:32:16 2004
*************** Boston, MA 02111-1307, USA.  */
*** 24,30 ****
  #include <assert.h>
  #include "libgfortran.h"'
  include(types.m4)dnl
! define(rtype_code, regexp(file, `_\([irc][0-9]+\)\.', `\1'))dnl
  define(rtype_letter,substr(rtype_code, 0, 1))dnl
  define(rtype_kind, substr(rtype_code, 1))dnl
  define(rtype,get_arraytype(rtype_letter,rtype_kind))dnl
--- 24,30 ----
  #include <assert.h>
  #include "libgfortran.h"'
  include(types.m4)dnl
! define(rtype_code, regexp(file, `_\([ir][0-9]+\)\.', `\1'))dnl
  define(rtype_letter,substr(rtype_code, 0, 1))dnl
  define(rtype_kind, substr(rtype_code, 1))dnl
  define(rtype,get_arraytype(rtype_letter,rtype_kind))dnl

`/* Implementation of the DOT_PRODUCT intrinsic
   Copyright 2002 Free Software Foundation, Inc.
   Contributed by Paul Brook <paul@nowt.org>
   and Feng Wang <fengwang@nudt.edu.cn>

This file is part of the GNU Fortran 95 runtime library (libgfor).

Libgfortran is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with libgfor; see the file COPYING.LIB.  If not,
write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.  */

#include "config.h"
#include <stdlib.h>
#include <assert.h>
#include "libgfortran.h"'
include(types.m4)dnl
define(rtype_code, regexp(file, `_\([c][0-9]+\)\.', `\1'))dnl
define(rtype_letter,substr(rtype_code, 0, 1))dnl
define(rtype_kind, substr(rtype_code, 1))dnl
define(rtype,get_arraytype(rtype_letter,rtype_kind))dnl
define(rtype_name, get_typename(rtype_letter, rtype_kind))dnl

typedef GFC_ARRAY_DESCRIPTOR(GFC_MAX_DIMENSIONS, char) char_array;

/* Both parameters will already have been converted to the result type.  */
rtype_name
`__dot_product_'rtype_code (rtype * a, rtype * b)
{
  rtype_name *pa;
  rtype_name *pb;
  rtype_name res;
  rtype_name conjga;
  index_type count;
  index_type astride;
  index_type bstride;

  assert (GFC_DESCRIPTOR_RANK (a) == 1
          && GFC_DESCRIPTOR_RANK (b) == 1);

  if (a->dim[0].stride == 0)
    a->dim[0].stride = 1;
  if (b->dim[0].stride == 0)
    b->dim[0].stride = 1;

  astride = a->dim[0].stride;
  bstride = b->dim[0].stride;
  count = a->dim[0].ubound + 1 - a->dim[0].lbound;
  res = 0;
  pa = a->data;
  pb = b->data;
sinclude(`dotprod_asm_'rtype_code`.m4')dnl

  while (count--)
    {
      COMPLEX_ASSIGN(conjga, REALPART (*pa), -IMAGPART (*pa));
      res += conjga * *pb;
      pa += astride;
      pb += bstride;
    }

  return res;
}

*** ../gcc/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_dotprod.f90	Sat Jul 26 08:27:49 2003
--- intrinsic_dotprod.f90	Fri Feb  6 17:39:11 2004
*************** program testforall
*** 5,10 ****
--- 5,13 ----
     integer, dimension (3) :: b
     real, dimension(3) :: c
     real r
+    complex, dimension (2) :: z1
+    complex, dimension (2) :: z2
+    complex z
  
     a = (/1, 2, 3/);
     b = (/4, 5, 6/);
*************** program testforall
*** 14,17 ****
--- 17,25 ----
  
     r = dot_product(a, c)
     if (abs(r - 32.0) .gt. 0.001) call abort
+ 
+    z1 = (/(1.0, 2.0), (2.0, 3.0)/)
+    z2 = (/(3.0, 4.0), (4.0, 5.0)/)
+    z = dot_product (z1, z2)
+    if (abs (z - (34.0, -4.0)) .gt. 0.001) call abort
  end program

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