re PR fortran/26769 (Implement transpose() and reshape() for real instead of using integer)
2006-03-25 Thomas Koenig <Thomas.Koenig@online.de> PR fortran/26769 * iresolve.c (gfc_resolve_reshape): Remove doubling of kind for complex. For real(kind=10), call reshape_r10. (gfc_resolve_transpose): For real(kind=10), call transpose_r10. 2006-03-25 Thomas Koenig <Thomas.Koenig@online.de> PR fortran/26769 * Makefile.am: Add transpose_r10.c and reshape_r10.c. * aclocal.m4: Regenerate using aclocal 1.9.3. * Makefile.in: Regenerate using automake 1.9.3. * m4/iparm.m4 (rtype_ccode): If rtype_letter is `i', evaluate to rtype_kind, otherwise to rtype_code. * generated/transpose_r10.c: Add. * generated/reshape_r10.c: Add. 2006-03-25 Thomas Koenig <Thomas.Koenig@online.de> PR fortran/26769 * gfortran.dg/transpose_reshape_r10.f90: New test case. From-SVN: r112381
This commit is contained in:
Thomas Koenig
Thomas Koenig
parent
fe1f8f442e
commit
9a0fb43ea1
|
|
@ -1,3 +1,11 @@
|
|||
2006-03-25 Thomas Koenig <Thomas.Koenig@online.de>
|
||||
|
||||
PR fortran/26769
|
||||
* iresolve.c (gfc_resolve_reshape): Remove doubling of
|
||||
kind for complex. For real(kind=10), call reshape_r10.
|
||||
(gfc_resolve_transpose): For real(kind=10), call
|
||||
transpose_r10.
|
||||
|
||||
2006-03-25 Roger Sayle <roger@eyesopen.com>
|
||||
|
||||
* dependency.c (gfc_check_dependency): Improve handling of pointers;
|
||||
|
|
|
|||
|
|
@ -1499,9 +1499,6 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
|
|||
switch (source->ts.type)
|
||||
{
|
||||
case BT_COMPLEX:
|
||||
kind = source->ts.kind * 2;
|
||||
break;
|
||||
|
||||
case BT_REAL:
|
||||
case BT_INTEGER:
|
||||
case BT_LOGICAL:
|
||||
|
|
@ -1523,6 +1520,10 @@ gfc_resolve_reshape (gfc_expr * f, gfc_expr * source, gfc_expr * shape,
|
|||
f->value.function.name =
|
||||
gfc_get_string (PREFIX("reshape_%c%d"),
|
||||
gfc_type_letter (BT_COMPLEX), source->ts.kind);
|
||||
else if (source->ts.type == BT_REAL && kind == 10)
|
||||
f->value.function.name =
|
||||
gfc_get_string (PREFIX("reshape_%c%d"),
|
||||
gfc_type_letter (BT_REAL), source->ts.kind);
|
||||
else
|
||||
f->value.function.name =
|
||||
gfc_get_string (PREFIX("reshape_%d"), source->ts.kind);
|
||||
|
|
@ -1987,8 +1988,19 @@ gfc_resolve_transpose (gfc_expr * f, gfc_expr * matrix)
|
|||
gfc_get_string (PREFIX("transpose_c%d"), kind);
|
||||
break;
|
||||
|
||||
case BT_INTEGER:
|
||||
case BT_REAL:
|
||||
/* There is no kind=10 integer type. We need to
|
||||
call the real version. */
|
||||
if (kind == 10)
|
||||
{
|
||||
f->value.function.name =
|
||||
gfc_get_string (PREFIX("transpose_r%d"), kind);
|
||||
break;
|
||||
}
|
||||
|
||||
/* Fall through */
|
||||
|
||||
case BT_INTEGER:
|
||||
case BT_LOGICAL:
|
||||
/* Use the integer routines for real and logical cases. This
|
||||
assumes they all have the same alignment requirements. */
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
2006-03-25 Thomas Koenig <Thomas.Koenig@online.de>
|
||||
|
||||
PR fortran/26769
|
||||
* gfortran.dg/transpose_reshape_r10.f90: New test case.
|
||||
|
||||
2006-03-25 Uros Bizjak <uros@kss-loka.si>
|
||||
|
||||
PR middle-end/26717
|
||||
|
|
|
|||
|
|
@ -0,0 +1,12 @@
|
|||
! { dg-do run }
|
||||
! { dg-require-effective-target fortran_large_real }
|
||||
program main
|
||||
integer,parameter :: k = selected_real_kind (precision (0.0_8) + 1)
|
||||
character(len=90) line
|
||||
real(k) :: a(3,3)
|
||||
real(k) :: b(9)
|
||||
a = 1.0_k
|
||||
a(1,3) = 0.0_k
|
||||
write (line,'(9G10.6)') transpose(a)
|
||||
write (line,'(9G10.6)') reshape(a,shape(b))
|
||||
end
|
||||
|
|
@ -1,3 +1,14 @@
|
|||
2006-03-25 Thomas Koenig <Thomas.Koenig@online.de>
|
||||
|
||||
PR fortran/26769
|
||||
* Makefile.am: Add transpose_r10.c and reshape_r10.c.
|
||||
* aclocal.m4: Regenerate using aclocal 1.9.3.
|
||||
* Makefile.in: Regenerate using automake 1.9.3.
|
||||
* m4/iparm.m4 (rtype_ccode): If rtype_letter is `i',
|
||||
evaluate to rtype_kind, otherwise to rtype_code.
|
||||
* generated/transpose_r10.c: Add.
|
||||
* generated/reshape_r10.c: Add.
|
||||
|
||||
2006-03-22 Thomas Koenig <Thomas.Koenig@online.de>
|
||||
|
||||
PR fortran/19303
|
||||
|
|
|
|||
|
|
@ -312,6 +312,7 @@ i_transpose_c= \
|
|||
generated/transpose_i4.c \
|
||||
generated/transpose_i8.c \
|
||||
generated/transpose_i16.c \
|
||||
generated/transpose_r10.c \
|
||||
generated/transpose_c4.c \
|
||||
generated/transpose_c8.c \
|
||||
generated/transpose_c10.c \
|
||||
|
|
@ -326,6 +327,7 @@ i_reshape_c= \
|
|||
generated/reshape_i4.c \
|
||||
generated/reshape_i8.c \
|
||||
generated/reshape_i16.c \
|
||||
generated/reshape_r10.c \
|
||||
generated/reshape_c4.c \
|
||||
generated/reshape_c8.c \
|
||||
generated/reshape_c10.c \
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
# Makefile.in generated by automake 1.9.6 from Makefile.am.
|
||||
# Makefile.in generated by automake 1.9.3 from Makefile.am.
|
||||
# @configure_input@
|
||||
|
||||
# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
|
||||
# 2003, 2004, 2005 Free Software Foundation, Inc.
|
||||
# 2003, 2004 Free Software Foundation, Inc.
|
||||
# This Makefile.in is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
|
|
@ -14,6 +14,8 @@
|
|||
|
||||
@SET_MAKE@
|
||||
|
||||
SOURCES = $(libgfortran_la_SOURCES) $(libgfortranbegin_la_SOURCES)
|
||||
|
||||
srcdir = @srcdir@
|
||||
top_srcdir = @top_srcdir@
|
||||
VPATH = @srcdir@
|
||||
|
|
@ -45,8 +47,7 @@ DIST_COMMON = $(am__configure_deps) $(srcdir)/../config.guess \
|
|||
$(top_srcdir)/configure ChangeLog
|
||||
subdir = .
|
||||
ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
|
||||
am__aclocal_m4_deps = $(top_srcdir)/../config/lead-dot.m4 \
|
||||
$(top_srcdir)/../config/stdint.m4 $(top_srcdir)/acinclude.m4 \
|
||||
am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \
|
||||
$(top_srcdir)/../config/acx.m4 \
|
||||
$(top_srcdir)/../config/no-executables.m4 \
|
||||
$(top_srcdir)/../libtool.m4 $(top_srcdir)/configure.ac
|
||||
|
|
@ -122,14 +123,15 @@ am__objects_16 = matmul_i4.lo matmul_i8.lo matmul_i16.lo matmul_r4.lo \
|
|||
matmul_c8.lo matmul_c10.lo matmul_c16.lo
|
||||
am__objects_17 = matmul_l4.lo matmul_l8.lo matmul_l16.lo
|
||||
am__objects_18 = transpose_i4.lo transpose_i8.lo transpose_i16.lo \
|
||||
transpose_c4.lo transpose_c8.lo transpose_c10.lo \
|
||||
transpose_c16.lo
|
||||
transpose_r10.lo transpose_c4.lo transpose_c8.lo \
|
||||
transpose_c10.lo transpose_c16.lo
|
||||
am__objects_19 = shape_i4.lo shape_i8.lo shape_i16.lo
|
||||
am__objects_20 = eoshift1_4.lo eoshift1_8.lo eoshift1_16.lo
|
||||
am__objects_21 = eoshift3_4.lo eoshift3_8.lo eoshift3_16.lo
|
||||
am__objects_22 = cshift1_4.lo cshift1_8.lo cshift1_16.lo
|
||||
am__objects_23 = reshape_i4.lo reshape_i8.lo reshape_i16.lo \
|
||||
reshape_c4.lo reshape_c8.lo reshape_c10.lo reshape_c16.lo
|
||||
reshape_r10.lo reshape_c4.lo reshape_c8.lo reshape_c10.lo \
|
||||
reshape_c16.lo
|
||||
am__objects_24 = in_pack_i4.lo in_pack_i8.lo in_pack_i16.lo \
|
||||
in_pack_c4.lo in_pack_c8.lo in_pack_c10.lo in_pack_c16.lo
|
||||
am__objects_25 = in_unpack_i4.lo in_unpack_i8.lo in_unpack_i16.lo \
|
||||
|
|
@ -222,7 +224,7 @@ LTPPFCCOMPILE = $(LIBTOOL) --mode=compile $(FC) $(DEFS) \
|
|||
$(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) \
|
||||
$(AM_FCFLAGS) $(FCFLAGS)
|
||||
FCLD = $(FC)
|
||||
FCLINK = $(LIBTOOL) --mode=link $(FCLD) $(AM_FCFLAGS) $(FCFLAGS) \
|
||||
FCLINK = $(LIBTOOL) --mode=link $(FCLD) $(AM_FFLAGS) $(FCFLAGS) \
|
||||
$(AM_LDFLAGS) $(LDFLAGS) -o $@
|
||||
COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \
|
||||
$(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
|
||||
|
|
@ -658,6 +660,7 @@ i_transpose_c = \
|
|||
generated/transpose_i4.c \
|
||||
generated/transpose_i8.c \
|
||||
generated/transpose_i16.c \
|
||||
generated/transpose_r10.c \
|
||||
generated/transpose_c4.c \
|
||||
generated/transpose_c8.c \
|
||||
generated/transpose_c10.c \
|
||||
|
|
@ -672,6 +675,7 @@ i_reshape_c = \
|
|||
generated/reshape_i4.c \
|
||||
generated/reshape_i8.c \
|
||||
generated/reshape_i16.c \
|
||||
generated/reshape_r10.c \
|
||||
generated/reshape_c4.c \
|
||||
generated/reshape_c8.c \
|
||||
generated/reshape_c10.c \
|
||||
|
|
@ -1928,6 +1932,9 @@ transpose_i8.lo: generated/transpose_i8.c
|
|||
transpose_i16.lo: generated/transpose_i16.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_i16.lo `test -f 'generated/transpose_i16.c' || echo '$(srcdir)/'`generated/transpose_i16.c
|
||||
|
||||
transpose_r10.lo: generated/transpose_r10.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_r10.lo `test -f 'generated/transpose_r10.c' || echo '$(srcdir)/'`generated/transpose_r10.c
|
||||
|
||||
transpose_c4.lo: generated/transpose_c4.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_c4.lo `test -f 'generated/transpose_c4.c' || echo '$(srcdir)/'`generated/transpose_c4.c
|
||||
|
||||
|
|
@ -1985,6 +1992,9 @@ reshape_i8.lo: generated/reshape_i8.c
|
|||
reshape_i16.lo: generated/reshape_i16.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_i16.lo `test -f 'generated/reshape_i16.c' || echo '$(srcdir)/'`generated/reshape_i16.c
|
||||
|
||||
reshape_r10.lo: generated/reshape_r10.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_r10.lo `test -f 'generated/reshape_r10.c' || echo '$(srcdir)/'`generated/reshape_r10.c
|
||||
|
||||
reshape_c4.lo: generated/reshape_c4.c
|
||||
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o reshape_c4.lo `test -f 'generated/reshape_c4.c' || echo '$(srcdir)/'`generated/reshape_c4.c
|
||||
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
# generated automatically by aclocal 1.9.6 -*- Autoconf -*-
|
||||
# generated automatically by aclocal 1.9.3 -*- Autoconf -*-
|
||||
|
||||
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
|
||||
# 2005 Free Software Foundation, Inc.
|
||||
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
|
||||
# Free Software Foundation, Inc.
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
|
|
@ -11,11 +11,23 @@
|
|||
# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
|
||||
# PARTICULAR PURPOSE.
|
||||
|
||||
# Copyright (C) 2002, 2003, 2005 Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
# -*- Autoconf -*-
|
||||
# Copyright (C) 2002, 2003 Free Software Foundation, Inc.
|
||||
# Generated from amversion.in; do not edit by hand.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
|
||||
# AM_AUTOMAKE_VERSION(VERSION)
|
||||
# ----------------------------
|
||||
|
|
@ -28,15 +40,26 @@ AC_DEFUN([AM_AUTOMAKE_VERSION], [am__api_version="1.9"])
|
|||
# Call AM_AUTOMAKE_VERSION so it can be traced.
|
||||
# This function is AC_REQUIREd by AC_INIT_AUTOMAKE.
|
||||
AC_DEFUN([AM_SET_CURRENT_AUTOMAKE_VERSION],
|
||||
[AM_AUTOMAKE_VERSION([1.9.6])])
|
||||
[AM_AUTOMAKE_VERSION([1.9.3])])
|
||||
|
||||
# AM_AUX_DIR_EXPAND -*- Autoconf -*-
|
||||
# AM_AUX_DIR_EXPAND
|
||||
|
||||
# Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
# Copyright (C) 2001, 2003 Free Software Foundation, Inc.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# For projects using AC_CONFIG_AUX_DIR([foo]), Autoconf sets
|
||||
# $ac_aux_dir to `$srcdir/foo'. In other projects, it is set to
|
||||
|
|
@ -83,16 +106,26 @@ AC_PREREQ([2.50])dnl
|
|||
am_aux_dir=`cd $ac_aux_dir && pwd`
|
||||
])
|
||||
|
||||
# AM_CONDITIONAL -*- Autoconf -*-
|
||||
# AM_CONDITIONAL -*- Autoconf -*-
|
||||
|
||||
# Copyright (C) 1997, 2000, 2001, 2003, 2004, 2005
|
||||
# Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
# Copyright (C) 1997, 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
# serial 7
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# serial 6
|
||||
|
||||
# AM_CONDITIONAL(NAME, SHELL-CONDITION)
|
||||
# -------------------------------------
|
||||
|
|
@ -116,20 +149,31 @@ AC_CONFIG_COMMANDS_PRE(
|
|||
Usually this means the macro was only invoked conditionally.]])
|
||||
fi])])
|
||||
|
||||
# Do all the work for Automake. -*- Autoconf -*-
|
||||
# Do all the work for Automake. -*- Autoconf -*-
|
||||
|
||||
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005
|
||||
# Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
|
||||
# serial 12
|
||||
|
||||
# This macro actually does too much. Some checks are only needed if
|
||||
# This macro actually does too much some checks are only needed if
|
||||
# your package does certain things. But this isn't really a big deal.
|
||||
|
||||
# Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
|
||||
# Free Software Foundation, Inc.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# serial 11
|
||||
|
||||
# AM_INIT_AUTOMAKE(PACKAGE, VERSION, [NO-DEFINE])
|
||||
# AM_INIT_AUTOMAKE([OPTIONS])
|
||||
# -----------------------------------------------
|
||||
|
|
@ -230,31 +274,87 @@ for _am_header in $config_headers :; do
|
|||
done
|
||||
echo "timestamp for $1" >`AS_DIRNAME([$1])`/stamp-h[]$_am_stamp_count])
|
||||
|
||||
# Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
|
||||
# AM_PROG_INSTALL_SH
|
||||
# ------------------
|
||||
# Define $install_sh.
|
||||
|
||||
# Copyright (C) 2001, 2003 Free Software Foundation, Inc.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
AC_DEFUN([AM_PROG_INSTALL_SH],
|
||||
[AC_REQUIRE([AM_AUX_DIR_EXPAND])dnl
|
||||
install_sh=${install_sh-"$am_aux_dir/install-sh"}
|
||||
AC_SUBST(install_sh)])
|
||||
|
||||
# Add --enable-maintainer-mode option to configure. -*- Autoconf -*-
|
||||
# -*- Autoconf -*-
|
||||
# Copyright (C) 2003 Free Software Foundation, Inc.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# serial 1
|
||||
|
||||
# Check whether the underlying file-system supports filenames
|
||||
# with a leading dot. For instance MS-DOS doesn't.
|
||||
AC_DEFUN([AM_SET_LEADING_DOT],
|
||||
[rm -rf .tst 2>/dev/null
|
||||
mkdir .tst 2>/dev/null
|
||||
if test -d .tst; then
|
||||
am__leading_dot=.
|
||||
else
|
||||
am__leading_dot=_
|
||||
fi
|
||||
rmdir .tst 2>/dev/null
|
||||
AC_SUBST([am__leading_dot])])
|
||||
|
||||
# Add --enable-maintainer-mode option to configure.
|
||||
# From Jim Meyering
|
||||
|
||||
# Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004, 2005
|
||||
# Copyright (C) 1996, 1998, 2000, 2001, 2002, 2003, 2004
|
||||
# Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
|
||||
# serial 4
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# serial 3
|
||||
|
||||
AC_DEFUN([AM_MAINTAINER_MODE],
|
||||
[AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles])
|
||||
|
|
@ -273,16 +373,27 @@ AC_DEFUN([AM_MAINTAINER_MODE],
|
|||
|
||||
AU_DEFUN([jm_MAINTAINER_MODE], [AM_MAINTAINER_MODE])
|
||||
|
||||
# Fake the existence of programs that GNU maintainers use. -*- Autoconf -*-
|
||||
# -*- Autoconf -*-
|
||||
|
||||
# Copyright (C) 1997, 1999, 2000, 2001, 2003, 2005
|
||||
# Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
|
||||
# serial 4
|
||||
# Copyright (C) 1997, 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# serial 3
|
||||
|
||||
# AM_MISSING_PROG(NAME, PROGRAM)
|
||||
# ------------------------------
|
||||
|
|
@ -308,16 +419,27 @@ else
|
|||
fi
|
||||
])
|
||||
|
||||
# Copyright (C) 2003, 2004, 2005 Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
|
||||
# AM_PROG_MKDIR_P
|
||||
# ---------------
|
||||
# Check whether `mkdir -p' is supported, fallback to mkinstalldirs otherwise.
|
||||
#
|
||||
|
||||
# Copyright (C) 2003, 2004 Free Software Foundation, Inc.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# Automake 1.8 used `mkdir -m 0755 -p --' to ensure that directories
|
||||
# created by `make install' are always world readable, even if the
|
||||
# installer happens to have an overly restrictive umask (e.g. 077).
|
||||
|
|
@ -371,14 +493,25 @@ else
|
|||
fi
|
||||
AC_SUBST([mkdir_p])])
|
||||
|
||||
# Copyright (C) 1998, 1999, 2000, 2001, 2003, 2004, 2005
|
||||
# Copyright (C) 1998, 1999, 2000, 2001, 2003, 2004
|
||||
# Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
|
||||
# serial 5
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# serial 4
|
||||
|
||||
# AM_ENABLE_MULTILIB([MAKEFILE], [REL-TO-TOP-SRCDIR])
|
||||
# ---------------------------------------------------
|
||||
|
|
@ -429,15 +562,26 @@ multi_basedir="$multi_basedir"
|
|||
CONFIG_SHELL=${CONFIG_SHELL-/bin/sh}
|
||||
CC="$CC"])])dnl
|
||||
|
||||
# Helper functions for option handling. -*- Autoconf -*-
|
||||
# Helper functions for option handling. -*- Autoconf -*-
|
||||
|
||||
# Copyright (C) 2001, 2002, 2003, 2005 Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
# Copyright (C) 2001, 2002, 2003 Free Software Foundation, Inc.
|
||||
|
||||
# serial 3
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# serial 2
|
||||
|
||||
# _AM_MANGLE_OPTION(NAME)
|
||||
# -----------------------
|
||||
|
|
@ -462,16 +606,28 @@ AC_DEFUN([_AM_SET_OPTIONS],
|
|||
AC_DEFUN([_AM_IF_OPTION],
|
||||
[m4_ifset(_AM_MANGLE_OPTION([$1]), [$2], [$3])])
|
||||
|
||||
# Check to make sure that the build environment is sane. -*- Autoconf -*-
|
||||
|
||||
# Copyright (C) 1996, 1997, 2000, 2001, 2003, 2005
|
||||
# Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
# Check to make sure that the build environment is sane.
|
||||
#
|
||||
|
||||
# serial 4
|
||||
# Copyright (C) 1996, 1997, 2000, 2001, 2003 Free Software Foundation, Inc.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# serial 3
|
||||
|
||||
# AM_SANITY_CHECK
|
||||
# ---------------
|
||||
|
|
@ -514,14 +670,25 @@ Check your system clock])
|
|||
fi
|
||||
AC_MSG_RESULT(yes)])
|
||||
|
||||
# Copyright (C) 2001, 2003, 2005 Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
|
||||
# AM_PROG_INSTALL_STRIP
|
||||
# ---------------------
|
||||
|
||||
# Copyright (C) 2001, 2003 Free Software Foundation, Inc.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# One issue with vendor `install' (even GNU) is that you can't
|
||||
# specify the program used to strip binaries. This is especially
|
||||
# annoying in cross-compiling environments, where the build's strip
|
||||
|
|
@ -544,13 +711,25 @@ AC_SUBST([INSTALL_STRIP_PROGRAM])])
|
|||
|
||||
# Check how to create a tarball. -*- Autoconf -*-
|
||||
|
||||
# Copyright (C) 2004, 2005 Free Software Foundation, Inc.
|
||||
#
|
||||
# This file is free software; the Free Software Foundation
|
||||
# gives unlimited permission to copy and/or distribute it,
|
||||
# with or without modifications, as long as this notice is preserved.
|
||||
# Copyright (C) 2004 Free Software Foundation, Inc.
|
||||
|
||||
# This program is free software; you can redistribute it and/or modify
|
||||
# it under the terms of the GNU General Public License as published by
|
||||
# the Free Software Foundation; either version 2, or (at your option)
|
||||
# any later version.
|
||||
|
||||
# This program 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 General Public License for more details.
|
||||
|
||||
# You should have received a copy of the GNU General Public License
|
||||
# along with this program; if not, write to the Free Software
|
||||
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
||||
# 02111-1307, USA.
|
||||
|
||||
# serial 1
|
||||
|
||||
# serial 2
|
||||
|
||||
# _AM_PROG_TAR(FORMAT)
|
||||
# --------------------
|
||||
|
|
@ -638,6 +817,4 @@ AC_SUBST([am__tar])
|
|||
AC_SUBST([am__untar])
|
||||
]) # _AM_PROG_TAR
|
||||
|
||||
m4_include([../config/lead-dot.m4])
|
||||
m4_include([../config/stdint.m4])
|
||||
m4_include([acinclude.m4])
|
||||
|
|
|
|||
|
|
@ -0,0 +1,268 @@
|
|||
/* Implementation of the RESHAPE
|
||||
Copyright 2002 Free Software Foundation, Inc.
|
||||
Contributed by Paul Brook <paul@nowt.org>
|
||||
|
||||
This file is part of the GNU Fortran 95 runtime library (libgfortran).
|
||||
|
||||
Libgfortran is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2 of the License, or (at your option) any later version.
|
||||
|
||||
In addition to the permissions in the GNU General Public License, the
|
||||
Free Software Foundation gives you unlimited permission to link the
|
||||
compiled version of this file into combinations with other programs,
|
||||
and to distribute those combinations without any restriction coming
|
||||
from the use of this file. (The General Public License restrictions
|
||||
do apply in other respects; for example, they cover modification of
|
||||
the file, and distribution when not linked into a combine
|
||||
executable.)
|
||||
|
||||
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 General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public
|
||||
License along with libgfortran; see the file COPYING. If not,
|
||||
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
Boston, MA 02110-1301, USA. */
|
||||
|
||||
#include "config.h"
|
||||
#include <stdlib.h>
|
||||
#include <assert.h>
|
||||
#include "libgfortran.h"
|
||||
|
||||
#if defined (HAVE_GFC_REAL_10)
|
||||
|
||||
typedef GFC_ARRAY_DESCRIPTOR(1, index_type) shape_type;
|
||||
|
||||
/* The shape parameter is ignored. We can currently deduce the shape from the
|
||||
return array. */
|
||||
|
||||
extern void reshape_r10 (gfc_array_r10 * const restrict,
|
||||
gfc_array_r10 * const restrict,
|
||||
shape_type * const restrict,
|
||||
gfc_array_r10 * const restrict,
|
||||
shape_type * const restrict);
|
||||
export_proto(reshape_r10);
|
||||
|
||||
void
|
||||
reshape_r10 (gfc_array_r10 * const restrict ret,
|
||||
gfc_array_r10 * const restrict source,
|
||||
shape_type * const restrict shape,
|
||||
gfc_array_r10 * const restrict pad,
|
||||
shape_type * const restrict order)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rcount[GFC_MAX_DIMENSIONS];
|
||||
index_type rextent[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride[GFC_MAX_DIMENSIONS];
|
||||
index_type rstride0;
|
||||
index_type rdim;
|
||||
index_type rsize;
|
||||
index_type rs;
|
||||
index_type rex;
|
||||
GFC_REAL_10 *rptr;
|
||||
/* s.* indicates the source array. */
|
||||
index_type scount[GFC_MAX_DIMENSIONS];
|
||||
index_type sextent[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride[GFC_MAX_DIMENSIONS];
|
||||
index_type sstride0;
|
||||
index_type sdim;
|
||||
index_type ssize;
|
||||
const GFC_REAL_10 *sptr;
|
||||
/* p.* indicates the pad array. */
|
||||
index_type pcount[GFC_MAX_DIMENSIONS];
|
||||
index_type pextent[GFC_MAX_DIMENSIONS];
|
||||
index_type pstride[GFC_MAX_DIMENSIONS];
|
||||
index_type pdim;
|
||||
index_type psize;
|
||||
const GFC_REAL_10 *pptr;
|
||||
|
||||
const GFC_REAL_10 *src;
|
||||
int n;
|
||||
int dim;
|
||||
|
||||
if (source->dim[0].stride == 0)
|
||||
source->dim[0].stride = 1;
|
||||
if (shape->dim[0].stride == 0)
|
||||
shape->dim[0].stride = 1;
|
||||
if (pad && pad->dim[0].stride == 0)
|
||||
pad->dim[0].stride = 1;
|
||||
if (order && order->dim[0].stride == 0)
|
||||
order->dim[0].stride = 1;
|
||||
|
||||
if (ret->data == NULL)
|
||||
{
|
||||
rdim = shape->dim[0].ubound - shape->dim[0].lbound + 1;
|
||||
rs = 1;
|
||||
for (n=0; n < rdim; n++)
|
||||
{
|
||||
ret->dim[n].lbound = 0;
|
||||
rex = shape->data[n * shape->dim[0].stride];
|
||||
ret->dim[n].ubound = rex - 1;
|
||||
ret->dim[n].stride = rs;
|
||||
rs *= rex;
|
||||
}
|
||||
ret->offset = 0;
|
||||
ret->data = internal_malloc_size ( rs * sizeof (GFC_REAL_10));
|
||||
ret->dtype = (source->dtype & ~GFC_DTYPE_RANK_MASK) | rdim;
|
||||
}
|
||||
else
|
||||
{
|
||||
rdim = GFC_DESCRIPTOR_RANK (ret);
|
||||
if (ret->dim[0].stride == 0)
|
||||
ret->dim[0].stride = 1;
|
||||
}
|
||||
|
||||
rsize = 1;
|
||||
for (n = 0; n < rdim; n++)
|
||||
{
|
||||
if (order)
|
||||
dim = order->data[n * order->dim[0].stride] - 1;
|
||||
else
|
||||
dim = n;
|
||||
|
||||
rcount[n] = 0;
|
||||
rstride[n] = ret->dim[dim].stride;
|
||||
rextent[n] = ret->dim[dim].ubound + 1 - ret->dim[dim].lbound;
|
||||
|
||||
if (rextent[n] != shape->data[dim * shape->dim[0].stride])
|
||||
runtime_error ("shape and target do not conform");
|
||||
|
||||
if (rsize == rstride[n])
|
||||
rsize *= rextent[n];
|
||||
else
|
||||
rsize = 0;
|
||||
if (rextent[n] <= 0)
|
||||
return;
|
||||
}
|
||||
|
||||
sdim = GFC_DESCRIPTOR_RANK (source);
|
||||
ssize = 1;
|
||||
for (n = 0; n < sdim; n++)
|
||||
{
|
||||
scount[n] = 0;
|
||||
sstride[n] = source->dim[n].stride;
|
||||
sextent[n] = source->dim[n].ubound + 1 - source->dim[n].lbound;
|
||||
if (sextent[n] <= 0)
|
||||
abort ();
|
||||
|
||||
if (ssize == sstride[n])
|
||||
ssize *= sextent[n];
|
||||
else
|
||||
ssize = 0;
|
||||
}
|
||||
|
||||
if (pad)
|
||||
{
|
||||
pdim = GFC_DESCRIPTOR_RANK (pad);
|
||||
psize = 1;
|
||||
for (n = 0; n < pdim; n++)
|
||||
{
|
||||
pcount[n] = 0;
|
||||
pstride[n] = pad->dim[n].stride;
|
||||
pextent[n] = pad->dim[n].ubound + 1 - pad->dim[n].lbound;
|
||||
if (pextent[n] <= 0)
|
||||
abort ();
|
||||
if (psize == pstride[n])
|
||||
psize *= pextent[n];
|
||||
else
|
||||
psize = 0;
|
||||
}
|
||||
pptr = pad->data;
|
||||
}
|
||||
else
|
||||
{
|
||||
pdim = 0;
|
||||
psize = 1;
|
||||
pptr = NULL;
|
||||
}
|
||||
|
||||
if (rsize != 0 && ssize != 0 && psize != 0)
|
||||
{
|
||||
rsize *= sizeof (GFC_REAL_10);
|
||||
ssize *= sizeof (GFC_REAL_10);
|
||||
psize *= sizeof (GFC_REAL_10);
|
||||
reshape_packed ((char *)ret->data, rsize, (char *)source->data,
|
||||
ssize, pad ? (char *)pad->data : NULL, psize);
|
||||
return;
|
||||
}
|
||||
rptr = ret->data;
|
||||
src = sptr = source->data;
|
||||
rstride0 = rstride[0];
|
||||
sstride0 = sstride[0];
|
||||
|
||||
while (rptr)
|
||||
{
|
||||
/* Select between the source and pad arrays. */
|
||||
*rptr = *src;
|
||||
/* Advance to the next element. */
|
||||
rptr += rstride0;
|
||||
src += sstride0;
|
||||
rcount[0]++;
|
||||
scount[0]++;
|
||||
/* Advance to the next destination element. */
|
||||
n = 0;
|
||||
while (rcount[n] == rextent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
rcount[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so proabably not worth it. */
|
||||
rptr -= rstride[n] * rextent[n];
|
||||
n++;
|
||||
if (n == rdim)
|
||||
{
|
||||
/* Break out of the loop. */
|
||||
rptr = NULL;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
rcount[n]++;
|
||||
rptr += rstride[n];
|
||||
}
|
||||
}
|
||||
/* Advance to the next source element. */
|
||||
n = 0;
|
||||
while (scount[n] == sextent[n])
|
||||
{
|
||||
/* When we get to the end of a dimension, reset it and increment
|
||||
the next dimension. */
|
||||
scount[n] = 0;
|
||||
/* We could precalculate these products, but this is a less
|
||||
frequently used path so proabably not worth it. */
|
||||
src -= sstride[n] * sextent[n];
|
||||
n++;
|
||||
if (n == sdim)
|
||||
{
|
||||
if (sptr && pad)
|
||||
{
|
||||
/* Switch to the pad array. */
|
||||
sptr = NULL;
|
||||
sdim = pdim;
|
||||
for (dim = 0; dim < pdim; dim++)
|
||||
{
|
||||
scount[dim] = pcount[dim];
|
||||
sextent[dim] = pextent[dim];
|
||||
sstride[dim] = pstride[dim];
|
||||
sstride0 = sstride[0];
|
||||
}
|
||||
}
|
||||
/* We now start again from the beginning of the pad array. */
|
||||
src = pptr;
|
||||
break;
|
||||
}
|
||||
else
|
||||
{
|
||||
scount[n]++;
|
||||
src += sstride[n];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -0,0 +1,104 @@
|
|||
/* Implementation of the TRANSPOSE intrinsic
|
||||
Copyright 2003, 2005 Free Software Foundation, Inc.
|
||||
Contributed by Tobias Schlüter
|
||||
|
||||
This file is part of the GNU Fortran 95 runtime library (libgfortran).
|
||||
|
||||
Libgfortran is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public
|
||||
License as published by the Free Software Foundation; either
|
||||
version 2 of the License, or (at your option) any later version.
|
||||
|
||||
In addition to the permissions in the GNU General Public License, the
|
||||
Free Software Foundation gives you unlimited permission to link the
|
||||
compiled version of this file into combinations with other programs,
|
||||
and to distribute those combinations without any restriction coming
|
||||
from the use of this file. (The General Public License restrictions
|
||||
do apply in other respects; for example, they cover modification of
|
||||
the file, and distribution when not linked into a combine
|
||||
executable.)
|
||||
|
||||
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 General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public
|
||||
License along with libgfortran; see the file COPYING. If not,
|
||||
write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
||||
Boston, MA 02110-1301, USA. */
|
||||
|
||||
#include "config.h"
|
||||
#include <assert.h>
|
||||
#include "libgfortran.h"
|
||||
|
||||
#if defined (HAVE_GFC_REAL_10)
|
||||
|
||||
extern void transpose_r10 (gfc_array_r10 * const restrict ret,
|
||||
gfc_array_r10 * const restrict source);
|
||||
export_proto(transpose_r10);
|
||||
|
||||
void
|
||||
transpose_r10 (gfc_array_r10 * const restrict ret,
|
||||
gfc_array_r10 * const restrict source)
|
||||
{
|
||||
/* r.* indicates the return array. */
|
||||
index_type rxstride, rystride;
|
||||
GFC_REAL_10 *rptr;
|
||||
/* s.* indicates the source array. */
|
||||
index_type sxstride, systride;
|
||||
const GFC_REAL_10 *sptr;
|
||||
|
||||
index_type xcount, ycount;
|
||||
index_type x, y;
|
||||
|
||||
assert (GFC_DESCRIPTOR_RANK (source) == 2);
|
||||
|
||||
if (ret->data == NULL)
|
||||
{
|
||||
assert (GFC_DESCRIPTOR_RANK (ret) == 2);
|
||||
assert (ret->dtype == source->dtype);
|
||||
|
||||
ret->dim[0].lbound = 0;
|
||||
ret->dim[0].ubound = source->dim[1].ubound - source->dim[1].lbound;
|
||||
ret->dim[0].stride = 1;
|
||||
|
||||
ret->dim[1].lbound = 0;
|
||||
ret->dim[1].ubound = source->dim[0].ubound - source->dim[0].lbound;
|
||||
ret->dim[1].stride = ret->dim[0].ubound+1;
|
||||
|
||||
ret->data = internal_malloc_size (sizeof (GFC_REAL_10) * size0 ((array_t *) ret));
|
||||
ret->offset = 0;
|
||||
}
|
||||
|
||||
if (ret->dim[0].stride == 0)
|
||||
ret->dim[0].stride = 1;
|
||||
if (source->dim[0].stride == 0)
|
||||
source->dim[0].stride = 1;
|
||||
|
||||
sxstride = source->dim[0].stride;
|
||||
systride = source->dim[1].stride;
|
||||
xcount = source->dim[0].ubound + 1 - source->dim[0].lbound;
|
||||
ycount = source->dim[1].ubound + 1 - source->dim[1].lbound;
|
||||
|
||||
rxstride = ret->dim[0].stride;
|
||||
rystride = ret->dim[1].stride;
|
||||
|
||||
rptr = ret->data;
|
||||
sptr = source->data;
|
||||
|
||||
for (y=0; y < ycount; y++)
|
||||
{
|
||||
for (x=0; x < xcount; x++)
|
||||
{
|
||||
*rptr = *sptr;
|
||||
|
||||
sptr += sxstride;
|
||||
rptr += rystride;
|
||||
}
|
||||
sptr += systride - (sxstride * xcount);
|
||||
rptr += rxstride - (rystride * xcount);
|
||||
}
|
||||
}
|
||||
|
||||
#endif
|
||||
|
|
@ -30,4 +30,4 @@ define(rtype_qual,`_'rtype_kind)dnl
|
|||
define(atype_max, atype_name`_HUGE')dnl
|
||||
define(atype_min, `-'atype_max)dnl
|
||||
define(name, regexp(regexp(file, `[^/]*$', `\&'), `^\([^_]*\)_', `\1'))dnl
|
||||
define(rtype_ccode,ifelse(rtype_letter,`c',rtype_code,rtype_kind))dnl
|
||||
define(rtype_ccode,ifelse(rtype_letter,`i',rtype_kind,rtype_code))dnl
|
||||
|
|
|
|||
Loading…
Reference in New Issue