From a997b0d8a7b720578f40c0f9f7767bac02022e0b Mon Sep 17 00:00:00 2001 From: ro Date: Wed, 2 Nov 2011 10:49:46 +0000 Subject: Move shlib support to toplevel libgcc gcc: PR translation/45116 * Makefile.in (slibdir): Remove, don't export. (SHLIB_NM_FLAGS): Remove. (libgcc.mvars): Don't emit SHLIB_LINK, SHLIB_INSTALL, SHLIB_DLLDIR, SHLIB_EXT, SHLIB_MKMAP, SHLIB_MKMAP_OPTS, SHLIB_MAPFILES, SHLIB_NM_FLAGS. (DRIVER_DEFINES): Test SHLIB instead of SHLIB_LINK. (gcc.o): Pass SHLIB instead of SHLIB_LINK. (gccspec.o): Likewise. (installdirs): Don't create $(DESTDIR)$(slibdir). * configure.ac (slibdir): Remove. * configure: Regenerate. * libgcc-libsystem.ver: Move to ../libgcc/config. * mkmap-flat.awk, mkmap-symver.awk: Move to ../libgcc. * config/libgcc-glibc.ver: Move to ../libgcc/config. * config/t-libunwind (SHLIB_LC): Remove. * config/t-linux (SHLIB_MAPFILES): Remove. * config/t-slibgcc-dummy: Rename to config/t-slibgcc. * config/t-slibgcc-elf-ver: Remove. * config/t-slibgcc-libgcc, config/t-slibgcc-nolc-override: Move to ../libgcc/config. * config/alpha/libgcc-alpha-ldbl.ver, config/alpha/t-linux: Move to ../libgcc/config/alpha. * config/alpha/t-vms (shlib_version, SHLIB_EXT, SHLIB_OBJS, SHLIB_NAME, SHLIB_MULTILIB, SHLIB_INSTALL, SHLIB_SYMVEC, SHLIB_SYMVECX2, SHLIB_LINK): Remove. * config/arm/libgcc-bpabi.ver: Move to ../libgcc/config/arm. * config/arm/t-bpabi (SHLIB_MAPFILES): Remove. * config/arm/t-netbsd (SHLIB_EXT, SHLIB_NAME, SHLIB_SONAME, SHLIB_OBJS, SHLIB_LINK, SHLIB_INSTALL): Remove. * config/arm/t-symbian (SHLIB_LC): Remove. * config/bfin/libgcc-bfin.ver: Move to ../libgcc/config/bfin/libgcc-glibc.ver. * config/bfin/t-bfin-linux (SHLIB_MAPFILES): Remove. * config/c6x/libgcc-c6xeabi.ver: Move to ../libgcc/config/c6x/libgcc-eabi.ver. * config/c6x/t-c6x-elf (SHLIB_MAPFILES): Remove. * config/cris/libgcc.ver: Move to ../libgcc/config/cris/libgcc-glibc.ver. * config/cris/t-linux (SHLIB_MAPFILES): Remove. * config/frv/libgcc-frv.ver: Move to ../libgcc/config/frv. * config/frv/t-linux (SHLIB_MAPFILES): Remove. * config/i386/darwin-libgcc.10.4.ver: Move to ../libgcc/config/i386/libgcc-darwin.10.4.ver. * config/i386/darwin-libgcc.10.5.ver: Move to ../libgcc/config/i386/libgcc-darwin.10.5.ver. * config/i386/libgcc-glibc.ver: Move to ../libgcc/config/i386. * config/i386/t-cygming (SHLIB_EXT, SHLIB_IMPLIB, SHLIB_SOVERSION, SHLIB_SONAME, SHLIB_MAP, SHLIB_OBJS, SHLIB_DIR, SHLIB_SLIBDIR_QUAL) SHLIB_PTHREAD_CFLAG, SHLIB_PTHREAD_LDFLAG, SHLIB_LINK, SHLIB_INSTALL, SHLIB_MKMAP, SHLIB_MKMAP_OPTS, SHLIB_MAPFILES): Remove. * config/i386/t-cygwin (SHLIB_LC, SHLIB_EH_EXTENSION, SHLIB_IMPLIB, SHLIB_SONAME, SHLIB_MKMAP_OPTS): Remove. * config/i386/t-dlldir, config/i386/t-dlldir-x: Move to ../libgcc/config/i386. * config/i386/t-dw2-eh, config/i386/t-sjlj-eh: Move to ../libgcc/config/i386. * config/i386/t-linux: Move to ../libgcc/config/i386. * config/i386/t-mingw-pthread: Move to ../libgcc/config/i386. * config/i386/t-mingw-w32 (SHLIB_LC): Remove. * config/i386/t-mingw-w64: Likewise. * config/i386/t-mingw32: Remove. * config/ia64/libgcc-glibc.ver, config/ia64/libgcc-ia64.ver: Move to ../libgcc/config/ia64. * config/ia64/t-glibc: Remove. * config/ia64/t-hpux (SHLIB_EXT, SHLIB_LINK, SHLIB_INSTALL): Remove. * config/ia64/t-ia64 (SHLIB_MAPFILES): Remove. * config/ia64/t-vms (shlib_version, SHLIB_EXT, SHLIB_OBJS, SHLIB_NAME, SHLIB_MULTILIB, SHLIB_INSTALL, SHLIB_LINK): Remove. * config/ia64/vms_symvec_libgcc_s.opt: Remove. * config/m32r/libgcc-glibc.ver: Move to ../libgcc/config/m32r. * config/m32r/t-linux (SHLIB_MAPFILES): Remove. * config/m68k/t-slibgcc-elf-ver: Move to ../libgcc/config/m68k. * config/mips/t-libgcc-mips16 (SHLIB_MAPFILES): Remove. * config/pa/t-hpux-shlib: Move to ../libgcc/config/pa/t-slibgcc-hpux. * config/pa/t-slibgcc-dwarf-ver, config/pa/t-slibgcc-sjsj-ver: Move to ../libgcc/config/pa. * config/rs6000/darwin-libgcc.10.4.ver: Move to ../libgcc/config/rs6000/libgcc-darwin.10.4.ver. * config/rs6000/darwin-libgcc.10.5.ver: Move to ../libgcc/config/rs6000/libgcc-darwin.10.5.ver. * config/rs6000/t-aix43 (SHLIB_EXT, SHLIB_LINK, SHLIB_INSTALL, SHLIB_LIBS, SHLIB_MKMAP, SHLIB_NM_FLAGS, AR_FLAGS_FOR_TARGET): Remove. * config/rs6000/t-aix52: Likewise. * config/sh/libgcc-excl.ver, config/sh/libgcc-glibc.ver: Move to ../libgcc/config/sh. * config/sparc/libgcc-sparc-glibc.ver: Move to ../libgcc/config/sparc/libgcc-glibc.ver. * config/sparc/t-linux: Move to ../libgcc/config/sparc. * config/xtensa/t-linux (SHLIB_MAPFILES): Remove. * config/xtensa/libgcc-xtensa.ver: Move to ../libgcc/config/xtensa/libgcc-glibc.ver. * config.gcc (*-*-freebsd*): Replace t-slibgcc-elf-ver with t-slibgcc in tmake_file. Remove t-slibgcc-nolc-override for *-*-freebsd[34], *-*-freebsd[34].* with pthreads. (*-*-linux*, frv-*-*linux*, *-*-kfreebsd*-gnu, *-*-knetbsd*-gnu, *-*-gnu*, *-*-kopensolaris*-gnu): Replace t-slibgcc-elf-ver with t-slibgcc in tmake_file. (*-*-netbsd*): Likewise. (*-*-solaris2*): Replace t-slibgcc-dummy with t-slibgcc in tmake_file. (*-*-*vms*): Add t-slibgcc to tmake_file. (alpha*-*-linux*): Remove alpha/t-linux from tmake_file. (alpha*-dec-osf5.1*): Replace t-slibgcc-dummy with t-slibgcc in tmake_file. (arm*-*-linux*): Remove t-slibgcc-libgcc from tmake_file for arm*-*-linux-*eabi. (bfin*-linux-uclibc*): Replace t-slibgcc-dummy with t-slibgcc in tmake_file. (crisv32-*-linux*, cris-*-linux*): Likewise. (hppa*-*-linux*): Remove t-slibgcc-libgcc, pa/t-slibgcc-sjlj-ver, pa/t-slibgcc-dwarf-ver from tmake_file. (hppa[12]*-*-hpux10*): Replace pa/t-hpux-shlib with t-slibgcc in tmake_file. Remove pa/t-slibgcc-sjlj-ver, pa/t-slibgcc-dwarf-ver from tmake_file. (hppa*64*-*-hpux11*): Likewise. (hppa[12]*-*-hpux11*): Likewise. (i[34567]86-*-darwin*): Replace t-slibgcc-dummy in t-slibgcc in tmake_file. (x86_64-*-darwin*): Likewise. (i[34567]86-*-cygwin*): Remove tmake_eh_file, tmake_dlldir_file. Add t-slibgcc to tmake_file. (i[34567]86-*-mingw*, x86_64-*-mingw*): Likewise. Remove i386/t-mingw32 from tmake_file unless x86_64-w64-*, i[34567]86-w64-*. Remove i386/t-mingw-pthread from tmake_file. (ia64*-*-linux*): Remove ia64/t-glibc from tmake_file. (ia64*-*-hpux*): Add t-slibgcc to tmake_file. (ia64-hp-*vms*): Likewise. (m32r-*-linux*): Replace t-slibgcc-elf-ver with t-slibgcc in tmake_file. (m32rle-*-linux*): Likewise. (m68k-*-linux*): Remove m68k/t-slibgcc-elf-ver from tmake_file. (microblaze*-linux*): Remove t-slibgcc-elf-ver, t-slibgcc-nolc-override from tmake_file. (mips-sgi-irix6.5*): Replace t-slibgcc-dummy with t-slibgcc in tmake_file. (powerpc-*-darwin*): Likewise. (powerpc64-*-darwin*): Likewise. (powerpc-*-freebsd*): Remove t-slibgcc-libgcc from tmake_file. (powerpc-*-linux*, powerpc64-*-linux*): Likewise. (rs6000-ibm-aix4.[3456789]*, powerpc-ibm-aix4.[3456789]*): Add t-slibgcc to tmake_file. (rs6000-ibm-aix5.1.*, powerpc-ibm-aix5.1.*): Likewise. (rs6000-ibm-aix5.2.*, powerpc-ibm-aix5.2.*): Likewise. (rs6000-ibm-aix5.3.*, powerpc-ibm-aix5.3.*): Likewise. (rs6000-ibm-aix[6789].*, powerpc-ibm-aix[6789].*): Likewise. (sparc-*-linux*): Remove sparc/t-linux from tmake_file. (sparc64-*-linux*): Likewise. (tic6x-*-uclinux): Replace t-slibgcc-elf-ver with t-slibgcc in tmake_file. (i[34567]86-*-linux*, x86_64-*-linux*, i[34567]86-*-kfreebsd*-gnu, x86_64-*-kfreebsd*-gnu, i[34567]86-*-gnu*): Remove i386/t-linux from tmake_file. gcc/cp: * Make-lang.in (g++spec.o): Pass SHLIB instead of SHLIB_LINK. gcc/fortran: * Makef-lang.in (gfortranspec.o): Pass SHLIB instead of SHLIB_LINK. gcc/go: * Make-lang.in (gospec.o): Pass SHLIB instead of SHLIB_LINK. gcc/java: * Make-lang.in (jvspec.o): Pass SHLIB instead of SHLIB_LINK. libgcc: * Makefile.in (SHLIB_NM_FLAGS): Set. * mkmap-flat.awk, mkmap-symver.awk: New files. * configure.ac (libgcc_cv_lib_sjlj_exceptions): Check for SjLj exceptions. * configure: Regenerate. * config/libgcc-glibc.ver: New file. * config/libgcc-libsystem.ver: New file. * config/t-libunwind (SHLIB_LC): Set. * config/t-linux: New file. * config/t-slibgcc (INSTALL_SHLIB): New. (SHLIB_INSTALL): Use it. * config/t-slibgcc-darwin (SHLIB_MKMAP): Use $(srcdir) to refer to mkmap-symver.awk. (SHLIB_MAPFILES): Don't append, adapt pathname. (SHLIB_VERPFX): Set. * config/t-slibgcc-elf-ver (SHLIB_MKMAP): Use $(srcdir) to refer to mkmap-symver.awk. * config/t-slibgcc-gld-nover, config/t-slibgcc-hpux, config/t-slibgcc-libgcc, config/t-slibgcc-vms: New files. * config/alpha/libgcc-alpha-ldbl.ver, config/alpha/t-linux: New files. * config/alpha/t-slibgcc-osf (SHLIB_MKMAP): Use $(srcdir) to refer to mkmap-flat.awk. * config/arm/t-bpabi (SHLIB_MAPFILES): Set. * config/bfin/libgcc-glibc.ver, config/bfin/t-linux: New files. * config/c6x/libgcc-eabi.ver, config/c6x/t-elf: New files. * config/cris/libgcc-glibc.ver, config/cris/t-linux: New files. * config/frv/libgcc-frv.ver, config/frv/t-linux: New files. * config/i386/libgcc-darwin.10.4.ver, config/i386/libgcc-darwin.10.5.ver, config/i386/libgcc-glibc.ver: New files. * config/i386/t-darwin: Remove. * config/i386/t-darwin64: Likewise. * config/i386/t-dw2-eh, config/i386/t-sjlj-eh: New files. * config/i386/t-slibgcc-cygming, config/i386/t-cygwin, config/i386/t-dlldir, config/i386/t-dlldir-x: New files. * config/i386/t-linux: New file. * config/i386/t-mingw32: New file. * config/ia64/libgcc-glibc.ver, config/ia64/libgcc-ia64.ver: New files. * config/ia64/t-glibc: Rename to ... * config/ia64/t-linux: ... this. (SHLIB_MAPFILES): Set. * config/ia64/t-glibc-libunwind: Rename to ... * config/ia64/t-linux-libunwind: ... this. * config/ia64/t-ia64 (SHLIB_MAPFILES): Set. * config/ia64/t-slibgcc-hpux: New file. * config/m32r/libgcc-glibc.ver, config/m32r/t-linux: New files. * config/m68k/t-slibgcc-elf-ver: New file. * config/mips/t-mips16 (SHLIB_MAPFILES): Set. * config/mips/t-slibgcc-irix (SHLIB_MKMAP): Use $(srcdir) to refer to mkmap-flat.awk. * config/pa/t-slibgcc-hpux: New file. * config/pa/t-slibgcc-dwarf-ver, config/pa/t-slibgcc-sjsj-ver: New files. * config/rs6000/libgcc-darwin.10.4.ver, config/rs6000/libgcc-darwin.10.5.ver: New files. * config/rs6000/libgcc-ppc-glibc.ver: Rename to config/rs6000/libgcc-glibc.ver. * config/rs6000/libgcc-ppc64.ver: Rename to config/rs6000/libgcc-ibm-ldouble.ver. * config/rs6000/t-darwin (SHLIB_VERPFX): Remove. * config/rs6000/t-ibm-ldouble (SHLIB_MAPFILES): Adapt filename. * config/rs6000/t-ldbl128: Rename to ... * config/rs6000/t-linux: ... this. (SHLIB_MAPFILES): Adapt filename. * config/rs6000/t-slibgcc-aix: New file. * config/sh/libgcc-excl.ver, config/sh/libgcc-glibc.ver: New files. * config/sh/t-linux (SHLIB_MAPFILES): Use $(srcdir) to refer to libgcc-excl.ver, libgcc-glibc.ver. (SHLIB_LINK, SHLIB_INSTALL): Remove. * config/sparc/libgcc-glibc.ver: New file. * config/sparc/t-linux: New file. * config/xtensa/libgcc-glibc.ver, config/xtensa/t-linux: New files. * config.host (*-*-freebsd*): Add t-slibgcc, t-slibgcc-gld, t-slibgcc-elf-ver to tmake_file. Add t-slibgcc-nolc-override to tmake_file for posix threads on *-*-freebsd[34]. (*-*-linux*, frv-*-*linux*, *-*-kfreebsd*-gnu, *-*-knetbsd*-gnu, *-*-gnu*, *-*-kopensolaris*-gnu): Add t-slibgcc, t-slibgcc-gld, t-slibgcc-elf-ver, t-linux to tmake_file. (*-*-netbsd*): Add t-slibgcc, t-slibgcc-gld, t-slibgcc-elf-ver to tmake_file. (alpha*-*-linux*): Add alpha/t-linux to tmake_file. (alpha64-dec-*vms*): Add t-slibgcc-vms to tmake_file. (alpha*-dec-*vms*): Likewise. (arm*-*-freebsd*): Append to tmake_file. (arm*-*-netbsdelf*): Add t-slibgcc-gld-nover to tmake_file. (arm*-*-linux*): Add t-slibgcc-libgcc to tmake_file for arm*-*-linux-*eabi. (arm*-*-eabi*, arm*-*-symbianelf*): Add t-slibgcc-nolc-override to tmake_file for arm*-*-symbianelf*. (bfin*-linux-uclibc*): Append to tmake_file, add bfin/t-linux. (cris-*-linux*, crisv32-*-linux*): Append to tmake_file, add cris/t-linux. (frv-*-*linux*): Append to tmake_file, add frv/t-linux. (hppa*-*-linux*): Add t-slibgcc-libgcc, pa/t-slibgcc-sjlj-ver, pa/t-slibgcc-dwarf-ver to tmake_file. (hppa[12]*-*-hpux10*): Add t-slibgcc, pa/t-slibgcc-sjlj-ver, pa/t-slibgcc-dwarf-ver, t-slibgcc-hpux, pa/t-slibgcc-hpux to tmake_file. (hppa*64*-*-hpux11*): Likewise. (hppa[12]*-*-hpux11*): Likewise. (x86_64-*-darwin*): Don't override tmake_file, but only keep i386/t-crtpc, i386/t-crtfm. (i[34567]86-*-cygwin*): Set tmake_eh_file, tmake_dlldir_file. Prepend $tmake_eh_file, $tmake_dlldir_file, i386/t-slibgcc-cygming to tmake_file. Add i386/t-cygwin to tmake_file. Prepent i386/t-mingw-pthread to tmake_file for posix threads. (i[34567]86-*-mingw*): Set tmake_eh_file, tmake_dlldir_file. Prepend $tmake_eh_file, $tmake_dlldir_file, i386/t-slibgcc-cygming to tmake_file. Add i386/t-mingw32 to tmake_file. (x86_64-*-mingw*): Likewise. (ia64*-*-freebsd*): Append to tmake_file. (ia64*-*-linux*): Append to tmake_file. Replace ia64/t-glibc by ia64/t-linux. Replace ia64/t-glibc-libunwind by ia64/t-linux-libunwind if using system libunwind. (ia64*-*-hpux*): Add t-slibgcc, ia64/t-slibgcc-hpux, t-slibgcc-hpux to tmake_file. (ia64-hp-*vms*): Add t-slibgcc-vms to tmake_file. (m32r-*-linux*): Append to tmake_file, add m32r/t-linux. (m32rle-*-linux*): Likewise. (m68k-*-linux*)): Add m68k/t-slibgcc-elf-ver to tmake_file unless sjlj exceptions. (microblaze*-linux*): New case. Append to tmake_file, add t-slibgcc-nolc-override. (powerpc-*-freebsd*): Add t-slibgcc-libgcc to tmake_file. (powerpc-*-linux*, powerpc64-*-linux*): Likewise. Replace rs6000/t-ldbl128 by rs6000/t-linux in tmake_file. (rs6000-ibm-aix4.[3456789]*, powerpc-ibm-aix4.[3456789]*): Add rs6000/t-slibgcc-aix to tmake_file. (rs6000-ibm-aix5.1.*, powerpc-ibm-aix5.1.*): Likewise. (rs6000-ibm-aix[56789].*, powerpc-ibm-aix[56789].*): Likewise. (sh-*-elf*, sh[12346l]*-*-elf*, sh-*-linux*) (sh[2346lbe]*-*-linux*, sh-*-netbsdelf*, shl*-*-netbsdelf*) (sh5-*-netbsd*, sh5l*-*-netbsd*, sh64-*-netbsd*) (sh64l*-*-netbsd*): Add t-slibgcc-libgcc to tmake_file for sh*-*-linux*. (sparc-*-linux*): Append to tmake_file for *-leon*. Add sparc/t-linux to tmake_file for non-Leon targets. (sparc64-*-linux*): Add sparc/t-linux to tmake_file. (tic6x-*-uclinux): New case. Add t-slibgcc, t-slibgcc-gld, t-slibgcc-elf-ver to tmake_file. (tic6x-*-*): Add c6x/t-elf to tmake_file. (xtensa*-*-linux*): Append to tmake_file, add xtensa/t-linux. (am33_2.0-*-linux*): Append to tmake_file. (i[34567]86-*-linux*, x86_64-*-linux*, i[34567]86-*-kfreebsd*-gnu) (i[34567]86-*-knetbsd*-gnu, i[34567]86-*-gnu*): Also handle x86_64-*-kfreebsd*-gnu. Add i386/t-linux to tmake_file. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180767 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 4 ++++ gcc/fortran/Make-lang.in | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 40d2a304bd5..ade1906d255 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2011-11-02 Rainer Orth + + * Makef-lang.in (gfortranspec.o): Pass SHLIB instead of SHLIB_LINK. + 2011-10-30 Steven G. Kargl PR fortran/50573 diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in index b766da651a2..2602b157ab8 100644 --- a/gcc/fortran/Make-lang.in +++ b/gcc/fortran/Make-lang.in @@ -79,7 +79,7 @@ fortran: f951$(exeext) gfortranspec.o: $(srcdir)/fortran/gfortranspec.c $(SYSTEM_H) $(TM_H) $(GCC_H) \ $(CONFIG_H) coretypes.h intl.h $(OPTS_H) - (SHLIB_LINK='$(SHLIB_LINK)'; \ + (SHLIB='$(SHLIB)'; \ $(COMPILER) -c $(ALL_COMPILERFLAGS) $(ALL_CPPFLAGS) $(DRIVER_DEFINES) \ $(INCLUDES) $(srcdir)/fortran/gfortranspec.c) -- cgit v1.2.1 From 6370b5e07f646f123b1078a195e483b4fede9cc8 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 20:28:58 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Move array reference initialisation earlier. Factor subsequent array references. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180842 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 33 ++++++++++++++++----------------- 2 files changed, 21 insertions(+), 17 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ade1906d255..cf2222a7a36 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_preloop_setup): Move array reference + initialisation earlier. Factor subsequent array references. + 2011-11-02 Rainer Orth * Makef-lang.in (gfortranspec.o): Pass SHLIB instead of SHLIB_LINK. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 3472804e4c6..4b21476d7d5 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2842,6 +2842,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, gfc_ss_info *info; gfc_ss *ss; gfc_se se; + gfc_array_ref *ar; int i; /* This code will be executed before entering the scalarization loop @@ -2861,6 +2862,18 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (dim >= info->dimen) continue; + if (info->ref) + { + ar = &info->ref->u.ar; + i = loop->order[dim + 1]; + } + else + { + ar = NULL; + i = dim + 1; + } + + if (dim == info->dimen - 1) { /* For the outermost loop calculate the offset due to any @@ -2868,9 +2881,9 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, base offset of the array. */ if (info->ref) { - for (i = 0; i < info->ref->u.ar.dimen; i++) + for (i = 0; i < ar->dimen; i++) { - if (info->ref->u.ar.dimen_type[i] != DIMEN_ELEMENT) + if (ar->dimen_type[i] != DIMEN_ELEMENT) continue; gfc_init_se (&se, NULL); @@ -2878,8 +2891,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, se.expr = info->descriptor; stride = gfc_conv_array_stride (info->descriptor, i); index = gfc_conv_array_index_offset (&se, info, i, -1, - &info->ref->u.ar, - stride); + ar, stride); gfc_add_block_to_block (pblock, &se.pre); info->offset = fold_build2_loc (input_location, PLUS_EXPR, @@ -2903,19 +2915,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, else { /* Add the offset for the previous loop dimension. */ - gfc_array_ref *ar; - - if (info->ref) - { - ar = &info->ref->u.ar; - i = loop->order[dim + 1]; - } - else - { - ar = NULL; - i = dim + 1; - } - gfc_init_se (&se, NULL); se.loop = loop; se.expr = info->descriptor; -- cgit v1.2.1 From 9e38215fde68f82c1a18aed0e76fe7eeee9b676e Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 20:46:00 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Move code earlier. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180843 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 4 ++++ gcc/fortran/trans-array.c | 22 +++++++++++----------- 2 files changed, 15 insertions(+), 11 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cf2222a7a36..fb2123c2558 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_preloop_setup): Move code earlier. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_preloop_setup): Move array reference diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 4b21476d7d5..91359e9c57e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2876,6 +2876,17 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (dim == info->dimen - 1) { + i = loop->order[0]; + /* For the time being, the innermost loop is unconditionally on + the first dimension of the scalarization loop. */ + gcc_assert (i == 0); + stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); + + /* Calculate the stride of the innermost loop. Hopefully this will + allow the backend optimizers to do their stuff more effectively. + */ + info->stride0 = gfc_evaluate_now (stride, pblock); + /* For the outermost loop calculate the offset due to any elemental dimensions. It will have been initialized with the base offset of the array. */ @@ -2900,17 +2911,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, info->offset = gfc_evaluate_now (info->offset, pblock); } } - - i = loop->order[0]; - /* For the time being, the innermost loop is unconditionally on - the first dimension of the scalarization loop. */ - gcc_assert (i == 0); - stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); - - /* Calculate the stride of the innermost loop. Hopefully this will - allow the backend optimizers to do their stuff more effectively. - */ - info->stride0 = gfc_evaluate_now (stride, pblock); } else { -- cgit v1.2.1 From 4d0a8b9d7a3cdf29a03dce0098f74fdcad38e81e Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 20:49:14 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Factor loop index initialization. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180844 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 15 +++++++-------- 2 files changed, 12 insertions(+), 8 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index fb2123c2558..925183392ff 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_preloop_setup): Factor loop index + initialization. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_preloop_setup): Move code earlier. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 91359e9c57e..e3134f5efa9 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2863,16 +2863,15 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, continue; if (info->ref) - { - ar = &info->ref->u.ar; - i = loop->order[dim + 1]; - } + ar = &info->ref->u.ar; else - { - ar = NULL; - i = dim + 1; - } + ar = NULL; + + i = dim + 1; + /* For the time being, there is no loop reordering. */ + gcc_assert (i == loop->order[i]); + i = loop->order[i]; if (dim == info->dimen - 1) { -- cgit v1.2.1 From 71b0aa655e8e16c1a215cce0b98aa1080c503213 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 20:52:14 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Remove redundant assertion. Special case outermost loop. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180846 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 9 ++++----- 2 files changed, 9 insertions(+), 5 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 925183392ff..7c36e109903 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_preloop_setup): Remove redundant assertion. + Special case outermost loop. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_preloop_setup): Factor loop index diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index e3134f5efa9..f5e30ae4e7c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2867,7 +2867,10 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, else ar = NULL; - i = dim + 1; + if (dim == info->dimen - 1) + i = 0; + else + i = dim + 1; /* For the time being, there is no loop reordering. */ gcc_assert (i == loop->order[i]); @@ -2875,10 +2878,6 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (dim == info->dimen - 1) { - i = loop->order[0]; - /* For the time being, the innermost loop is unconditionally on - the first dimension of the scalarization loop. */ - gcc_assert (i == 0); stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); /* Calculate the stride of the innermost loop. Hopefully this will -- cgit v1.2.1 From 14bc1986acab91dac7f14f5e977d88eac3071078 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 20:56:19 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Use loop's dimension instead of array's dimention. Check that it is indeed the same. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180847 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 5 +++-- 2 files changed, 8 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7c36e109903..e800836679c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_preloop_setup): Use loop's dimension instead + of array's dimention. Check that it is indeed the same. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_preloop_setup): Remove redundant assertion. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f5e30ae4e7c..476978e5cce 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2861,13 +2861,14 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (dim >= info->dimen) continue; + gcc_assert (info->dimen == loop->dimen); if (info->ref) ar = &info->ref->u.ar; else ar = NULL; - if (dim == info->dimen - 1) + if (dim == loop->dimen - 1) i = 0; else i = dim + 1; @@ -2876,7 +2877,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, gcc_assert (i == loop->order[i]); i = loop->order[i]; - if (dim == info->dimen - 1) + if (dim == loop->dimen - 1) { stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); -- cgit v1.2.1 From b960d512b24965672f38cb89300e0fad1992ea41 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:00:41 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Move common code... (add_array_offset): ...into that new function. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180848 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 ++++ gcc/fortran/trans-array.c | 59 +++++++++++++++++++++++++---------------------- 2 files changed, 36 insertions(+), 28 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e800836679c..49531070db0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_preloop_setup): Move common code... + (add_array_offset): ...into that new function. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_preloop_setup): Use loop's dimension instead diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 476978e5cce..f615e4e6a10 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2830,6 +2830,34 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym, } +/* Add the offset corresponding to array's ARRAY_DIM dimension and loop's + LOOP_DIM dimension (if any) to array's offset. */ + +static void +add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss, + gfc_array_ref *ar, int array_dim, int loop_dim) +{ + gfc_se se; + gfc_ss_info *info; + tree stride, index; + + info = &ss->data.info; + + gfc_init_se (&se, NULL); + se.loop = loop; + se.expr = info->descriptor; + stride = gfc_conv_array_stride (info->descriptor, array_dim); + index = gfc_conv_array_index_offset (&se, info, array_dim, loop_dim, ar, + stride); + gfc_add_block_to_block (pblock, &se.pre); + + info->offset = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, + info->offset, index); + info->offset = gfc_evaluate_now (info->offset, pblock); +} + + /* Generate the code to be executed immediately before entering a scalarization loop. */ @@ -2837,11 +2865,9 @@ static void gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, stmtblock_t * pblock) { - tree index; tree stride; gfc_ss_info *info; gfc_ss *ss; - gfc_se se; gfc_array_ref *ar; int i; @@ -2896,36 +2922,13 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (ar->dimen_type[i] != DIMEN_ELEMENT) continue; - gfc_init_se (&se, NULL); - se.loop = loop; - se.expr = info->descriptor; - stride = gfc_conv_array_stride (info->descriptor, i); - index = gfc_conv_array_index_offset (&se, info, i, -1, - ar, stride); - gfc_add_block_to_block (pblock, &se.pre); - - info->offset = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, - info->offset, index); - info->offset = gfc_evaluate_now (info->offset, pblock); + add_array_offset (pblock, loop, ss, ar, i, /* unused */ -1); } } } else - { - /* Add the offset for the previous loop dimension. */ - gfc_init_se (&se, NULL); - se.loop = loop; - se.expr = info->descriptor; - stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); - index = gfc_conv_array_index_offset (&se, info, info->dim[i], i, - ar, stride); - gfc_add_block_to_block (pblock, &se.pre); - info->offset = fold_build2_loc (input_location, PLUS_EXPR, - gfc_array_index_type, info->offset, - index); - info->offset = gfc_evaluate_now (info->offset, pblock); - } + /* Add the offset for the previous loop dimension. */ + add_array_offset (pblock, loop, ss, ar, info->dim[i], i); /* Remember this offset for the second loop. */ if (dim == loop->temp_dim - 1) -- cgit v1.2.1 From fcba1adee07f2256a1c386e44a95b8e02db2dea7 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:03:56 +0000 Subject: * trans-array.c (get_array_ref_dim): Remove redundant condition. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180849 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 4 ++++ gcc/fortran/trans-array.c | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 49531070db0..d7a1ba7d28a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2011-11-03 Mikael Morin + + * trans-array.c (get_array_ref_dim): Remove redundant condition. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_preloop_setup): Move common code... diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f615e4e6a10..c7eaf664b27 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -815,7 +815,7 @@ get_array_ref_dim (gfc_ss_info *info, int loop_dim) array_dim = info->dim[loop_dim]; for (n = 0; n < info->dimen; n++) - if (n != loop_dim && info->dim[n] < array_dim) + if (info->dim[n] < array_dim) array_ref_dim++; return array_ref_dim; -- cgit v1.2.1 From bc0c6a643dbefbee0c0a03e87e95839b2ab316cc Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:08:25 +0000 Subject: * trans-array.c (gfc_walk_array_ref): Skip coarray dimensions. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180850 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 4 ++++ gcc/fortran/trans-array.c | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d7a1ba7d28a..60d97f014d2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_walk_array_ref): Skip coarray dimensions. + 2011-11-03 Mikael Morin * trans-array.c (get_array_ref_dim): Remove redundant condition. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index c7eaf664b27..5500ec46b61 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7637,7 +7637,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) switch (ar->type) { case AR_ELEMENT: - for (n = ar->dimen + ar->codimen - 1; n >= 0; n--) + for (n = ar->dimen - 1; n >= 0; n--) ss = gfc_get_scalar_ss (ss, ar->start[n]); break; -- cgit v1.2.1 From 73ce7954f95f51289691fa2bb4bb9a9f89740d31 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:09:58 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): Assertify one condition. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180851 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 4 ++++ gcc/fortran/trans-array.c | 3 +-- 2 files changed, 5 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 60d97f014d2..a13e8ef3427 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_preloop_setup): Assertify one condition. + 2011-11-03 Mikael Morin * trans-array.c (gfc_walk_array_ref): Skip coarray dimensions. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 5500ec46b61..8359af2d9b2 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2885,8 +2885,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, info = &ss->data.info; - if (dim >= info->dimen) - continue; + gcc_assert (dim < info->dimen); gcc_assert (info->dimen == loop->dimen); if (info->ref) -- cgit v1.2.1 From a82b2774dadbf0821c50a66599694b2b0ac0a2c8 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:12:33 +0000 Subject: * trans-array.c (gfc_conv_ss_startstride): Access array bounds along array dimensions instead of loop dimensions. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180852 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 8 +++++--- 2 files changed, 10 insertions(+), 3 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a13e8ef3427..e9d3f813d32 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_conv_ss_startstride): Access array bounds along + array dimensions instead of loop dimensions. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_preloop_setup): Assertify one condition. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 8359af2d9b2..f4d8a854327 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3347,9 +3347,11 @@ done: case GFC_SS_FUNCTION: for (n = 0; n < ss->data.info.dimen; n++) { - ss->data.info.start[n] = gfc_index_zero_node; - ss->data.info.end[n] = gfc_index_zero_node; - ss->data.info.stride[n] = gfc_index_one_node; + int dim = ss->data.info.dim[n]; + + ss->data.info.start[dim] = gfc_index_zero_node; + ss->data.info.end[dim] = gfc_index_zero_node; + ss->data.info.stride[dim] = gfc_index_one_node; } break; -- cgit v1.2.1 From 39ee9fa924979a477abc1999d062de24aab73583 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:14:19 +0000 Subject: * trans-array.c (gfc_conv_loop_setup): Also skip temporary arrays. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180853 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 4 ++++ gcc/fortran/trans-array.c | 7 ++++++- 2 files changed, 10 insertions(+), 1 deletion(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e9d3f813d32..c0fe2c0bb03 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_conv_loop_setup): Also skip temporary arrays. + 2011-11-03 Mikael Morin * trans-array.c (gfc_conv_ss_startstride): Access array bounds along diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f4d8a854327..cfbe9095c49 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3881,7 +3881,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) loop for this dimension. We try to pick the simplest term. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { - if (ss->type == GFC_SS_SCALAR || ss->type == GFC_SS_REFERENCE) + gfc_ss_type ss_type; + + ss_type = ss->type; + if (ss_type == GFC_SS_SCALAR + || ss_type == GFC_SS_TEMP + || ss_type == GFC_SS_REFERENCE) continue; info = &ss->data.info; -- cgit v1.2.1 From 7f03d4d9fd6f573b413a481adedf1152b592c2fc Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:16:54 +0000 Subject: * trans-array.c (gfc_trans_scalarizing_loops): Stop loop before end marker, not after it. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180855 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c0fe2c0bb03..6949d234625 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_scalarizing_loops): Stop loop before end + marker, not after it. + 2011-11-03 Mikael Morin * trans-array.c (gfc_conv_loop_setup): Also skip temporary arrays. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index cfbe9095c49..f6113020303 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3114,7 +3114,7 @@ gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body) gfc_add_expr_to_block (&loop->pre, tmp); /* Clear all the used flags. */ - for (ss = loop->ss; ss; ss = ss->loop_chain) + for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) ss->useflags = 0; } -- cgit v1.2.1 From b014e22f7a176deb8502813c5f81221f7e04828a Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:19:27 +0000 Subject: * trans-array.c (gfc_trans_constant_array_constructor, trans_constant_array_constructor): Rename the former to the latter. Don't set the rank of the temporary for the loop. Remove then unused loop argument. (gfc_trans_array_constructor): Update call. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180856 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/trans-array.c | 10 +++------- 2 files changed, 11 insertions(+), 7 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6949d234625..2401c186ea3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_constant_array_constructor, + trans_constant_array_constructor): Rename the former to the latter. + Don't set the rank of the temporary for the loop. Remove then unused + loop argument. + (gfc_trans_array_constructor): Update call. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_scalarizing_loops): Stop loop before end diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f6113020303..c39fc9e29b4 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1849,8 +1849,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type) gfc_build_constant_array_constructor. */ static void -gfc_trans_constant_array_constructor (gfc_loopinfo * loop, - gfc_ss * ss, tree type) +trans_constant_array_constructor (gfc_ss * ss, tree type) { gfc_ss_info *info; tree tmp; @@ -1871,14 +1870,11 @@ gfc_trans_constant_array_constructor (gfc_loopinfo * loop, info->end[i] = gfc_index_zero_node; info->stride[i] = gfc_index_one_node; } - - if (info->dimen > loop->temp_dim) - loop->temp_dim = info->dimen; } /* Helper routine of gfc_trans_array_constructor to determine if the bounds of the loop specified by LOOP are constant and simple enough - to use with gfc_trans_constant_array_constructor. Returns the + to use with trans_constant_array_constructor. Returns the iteration count of the loop if suitable, and NULL_TREE otherwise. */ static tree @@ -2033,7 +2029,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) tree size = constant_array_constructor_loop_size (loop); if (size && compare_tree_int (size, nelem) == 0) { - gfc_trans_constant_array_constructor (loop, ss, type); + trans_constant_array_constructor (ss, type); goto finish; } } -- cgit v1.2.1 From aecc03acf6cf9a415e9d66c5dba822a3914620b4 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:21:30 +0000 Subject: * trans-array.c (gfc_trans_array_bound_check, trans_array_bound_check): Rename the former to the latter. Replace descriptor argument with ss argument. Get descriptor from ss. (gfc_conv_array_index_offset, conv_array_index_offset): Rename the former to the latter. Update call to trans_array_bound_check. Replace info argument with ss argument. Get info from ss. (gfc_conv_scalarized_array_ref): Update call to conv_array_index_offset. (add_array_offset): Ditto git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180857 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 11 +++++++++++ gcc/fortran/trans-array.c | 33 ++++++++++++++++++--------------- 2 files changed, 29 insertions(+), 15 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2401c186ea3..f2640956629 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_array_bound_check, + trans_array_bound_check): Rename the former to the latter. + Replace descriptor argument with ss argument. Get descriptor from ss. + (gfc_conv_array_index_offset, conv_array_index_offset): Rename the + former to the latter. Update call to trans_array_bound_check. + Replace info argument with ss argument. Get info from ss. + (gfc_conv_scalarized_array_ref): Update call to conv_array_index_offset. + (add_array_offset): Ditto + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_constant_array_constructor, diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index c39fc9e29b4..45bf6836f5b 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2426,17 +2426,20 @@ gfc_conv_array_ubound (tree descriptor, int dim) /* Generate code to perform an array index bound check. */ static tree -gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n, - locus * where, bool check_upper) +trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n, + locus * where, bool check_upper) { tree fault; tree tmp_lo, tmp_up; + tree descriptor; char *msg; const char * name = NULL; if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) return index; + descriptor = ss->data.info.descriptor; + index = gfc_evaluate_now (index, &se->pre); /* We find a name for the error message. */ @@ -2521,13 +2524,16 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n, DIM is the array dimension, I is the loop dimension. */ static tree -gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i, - gfc_array_ref * ar, tree stride) +conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, + gfc_array_ref * ar, tree stride) { + gfc_ss_info *info; tree index; tree desc; tree data; + info = &ss->data.info; + /* Get the index into the array for this dimension. */ if (ar) { @@ -2544,10 +2550,9 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i, /* We've already translated this value outside the loop. */ index = info->subscript[dim]->data.scalar.expr; - index = gfc_trans_array_bound_check (se, info->descriptor, - index, dim, &ar->where, - ar->as->type != AS_ASSUMED_SIZE - || dim < ar->dimen - 1); + index = trans_array_bound_check (se, ss, index, dim, &ar->where, + ar->as->type != AS_ASSUMED_SIZE + || dim < ar->dimen - 1); break; case DIMEN_VECTOR: @@ -2574,10 +2579,9 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i, index = fold_convert (gfc_array_index_type, index); /* Do any bounds checking on the final info->descriptor index. */ - index = gfc_trans_array_bound_check (se, info->descriptor, - index, dim, &ar->where, - ar->as->type != AS_ASSUMED_SIZE - || dim < ar->dimen - 1); + index = trans_array_bound_check (se, ss, index, dim, &ar->where, + ar->as->type != AS_ASSUMED_SIZE + || dim < ar->dimen - 1); break; case DIMEN_RANGE: @@ -2648,7 +2652,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) else n = 0; - index = gfc_conv_array_index_offset (se, info, info->dim[n], n, ar, + index = conv_array_index_offset (se, se->ss, info->dim[n], n, ar, info->stride0); /* Add the offset for this dimension to the stored offset for all other dimensions. */ @@ -2843,8 +2847,7 @@ add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss, se.loop = loop; se.expr = info->descriptor; stride = gfc_conv_array_stride (info->descriptor, array_dim); - index = gfc_conv_array_index_offset (&se, info, array_dim, loop_dim, ar, - stride); + index = conv_array_index_offset (&se, ss, array_dim, loop_dim, ar, stride); gfc_add_block_to_block (pblock, &se.pre); info->offset = fold_build2_loc (input_location, PLUS_EXPR, -- cgit v1.2.1 From 8451ce2f70e6490314a641483356c5e397074e7a Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:24:24 +0000 Subject: * trans-array.c (gfc_trans_array_bound_check): Use ss argument to get name. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180858 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 24 ++---------------------- 2 files changed, 7 insertions(+), 22 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f2640956629..a7d0680dcf6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_array_bound_check): Use ss argument + to get name. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_array_bound_check, diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 45bf6836f5b..d8f5448ff87 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2443,28 +2443,8 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n, index = gfc_evaluate_now (index, &se->pre); /* We find a name for the error message. */ - if (se->ss) - name = se->ss->expr->symtree->name; - - if (!name && se->loop && se->loop->ss && se->loop->ss->expr - && se->loop->ss->expr->symtree) - name = se->loop->ss->expr->symtree->name; - - if (!name && se->loop && se->loop->ss && se->loop->ss->loop_chain - && se->loop->ss->loop_chain->expr - && se->loop->ss->loop_chain->expr->symtree) - name = se->loop->ss->loop_chain->expr->symtree->name; - - if (!name && se->loop && se->loop->ss && se->loop->ss->expr) - { - if (se->loop->ss->expr->expr_type == EXPR_FUNCTION - && se->loop->ss->expr->value.function.name) - name = se->loop->ss->expr->value.function.name; - else - if (se->loop->ss->type == GFC_SS_CONSTRUCTOR - || se->loop->ss->type == GFC_SS_SCALAR) - name = "unnamed constant"; - } + name = ss->expr->symtree->n.sym->name; + gcc_assert (name != NULL); if (TREE_CODE (descriptor) == VAR_DECL) name = IDENTIFIER_POINTER (DECL_NAME (descriptor)); -- cgit v1.2.1 From 40386751ff4443cecb2d9704efac328b6dec66f1 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:28:26 +0000 Subject: * trans-array.h (gfc_trans_create_temp_array): Replace info argument with ss argument. * trans-array.c (gfc_trans_create_temp_array): Ditto. Get info from ss. (gfc_trans_array_constructor, gfc_conv_loop_setup): Update call to gfc_trans_create_temp_array. * trans-expr.c (gfc_conv_procedure_call): Ditto. * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180859 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 11 +++++++++++ gcc/fortran/trans-array.c | 9 ++++++--- gcc/fortran/trans-array.h | 2 +- gcc/fortran/trans-expr.c | 10 ++++++---- gcc/fortran/trans-intrinsic.c | 2 +- gcc/fortran/trans-stmt.c | 2 +- 6 files changed, 26 insertions(+), 10 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a7d0680dcf6..dec4134d389 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2011-11-03 Mikael Morin + + * trans-array.h (gfc_trans_create_temp_array): Replace info argument + with ss argument. + * trans-array.c (gfc_trans_create_temp_array): Ditto. Get info from ss. + (gfc_trans_array_constructor, gfc_conv_loop_setup): Update call to + gfc_trans_create_temp_array. + * trans-expr.c (gfc_conv_procedure_call): Ditto. + * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto. + * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_array_bound_check): Use ss argument diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d8f5448ff87..0e7c1c14c77 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -838,10 +838,11 @@ get_array_ref_dim (gfc_ss_info *info, int loop_dim) tree gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, - gfc_loopinfo * loop, gfc_ss_info * info, + gfc_loopinfo * loop, gfc_ss * ss, tree eltype, tree initial, bool dynamic, bool dealloc, bool callee_alloc, locus * where) { + gfc_ss_info *info; tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS]; tree type; tree desc; @@ -855,6 +856,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, memset (from, 0, sizeof (from)); memset (to, 0, sizeof (to)); + info = &ss->data.info; + gcc_assert (info->dimen > 0); gcc_assert (loop->dimen == info->dimen); @@ -2038,7 +2041,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) if (TREE_CODE (loop->to[0]) == VAR_DECL) dynamic = true; - gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info, + gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss, type, NULL_TREE, dynamic, true, false, where); desc = ss->data.info.descriptor; @@ -4061,7 +4064,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) loop->temp_ss->data.info.dim[n] = n; gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, - &loop->temp_ss->data.info, tmp, NULL_TREE, + loop->temp_ss, tmp, NULL_TREE, false, true, false, where); } diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 4d737bde94f..57805b6ac5c 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -32,7 +32,7 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *, /* Generate code to create a temporary array. */ tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *, - gfc_ss_info *, tree, tree, bool, bool, bool, + gfc_ss *, tree, tree, bool, bool, bool, locus *); /* Generate function entry code for allocation of compiler allocated array diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 09b98d03faf..b2c1739bdfc 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3602,8 +3602,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, returns a pointer, the temporary will be a shallow copy and mustn't be deallocated. */ callee_alloc = comp->attr.allocatable || comp->attr.pointer; - gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp, - NULL_TREE, false, !comp->attr.pointer, + gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss, + tmp, NULL_TREE, false, + !comp->attr.pointer, callee_alloc, &se->ss->expr->where); /* Pass the temporary as the first argument. */ @@ -3637,8 +3638,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, returns a pointer, the temporary will be a shallow copy and mustn't be deallocated. */ callee_alloc = sym->attr.allocatable || sym->attr.pointer; - gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp, - NULL_TREE, false, !sym->attr.pointer, + gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss, + tmp, NULL_TREE, false, + !sym->attr.pointer, callee_alloc, &se->ss->expr->where); /* Pass the temporary as the first argument. */ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 83fc4fc52ef..95161f8bdd0 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -5502,7 +5502,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) /* Build a destination descriptor, using the pointer, source, as the data field. */ gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, - info, mold_type, NULL_TREE, false, true, false, + se->ss, mold_type, NULL_TREE, false, true, false, &expr->where); /* Cast the pointer to the result. */ diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index c71eeec400f..c7ae36005d2 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -310,7 +310,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, data = gfc_create_var (pvoid_type_node, NULL); gfc_init_block (&temp_post); tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, - &tmp_loop, info, temptype, + &tmp_loop, ss, temptype, initial, false, true, false, &arg->expr->where); -- cgit v1.2.1 From adad4984d0f7a8e555cd6691a2dca987f8217bdf Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:31:12 +0000 Subject: * trans-array.c (gfc_set_vector_loop_bounds, set_vector_loop_bounds): Rename the former to the latter. Change type and name of argument. Get previous argument from the new one. (gfc_add_loop_ss_code): Update call. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180860 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/trans-array.c | 7 +++++-- 2 files changed, 12 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index dec4134d389..57673ba406f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_set_vector_loop_bounds, set_vector_loop_bounds): + Rename the former to the latter. Change type and name of argument. + Get previous argument from the new one. + (gfc_add_loop_ss_code): Update call. + 2011-11-03 Mikael Morin * trans-array.h (gfc_trans_create_temp_array): Replace info argument diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0e7c1c14c77..6af4fd6174c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2094,8 +2094,9 @@ finish: loop bounds. */ static void -gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info) +set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) { + gfc_ss_info *info; gfc_se se; tree tmp; tree desc; @@ -2103,6 +2104,8 @@ gfc_set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss_info * info) int n; int dim; + info = &ss->data.info; + for (n = 0; n < loop->dimen; n++) { dim = info->dim[n]; @@ -2194,7 +2197,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true, where); - gfc_set_vector_loop_bounds (loop, &ss->data.info); + set_vector_loop_bounds (loop, ss); break; case GFC_SS_VECTOR: -- cgit v1.2.1 From 4d0d78fedde4684cac7d935d873903a1ce0bcea2 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:33:28 +0000 Subject: * trans-array.c (get_array_ref_dim): Change argument type and name. Obtain previous argument from the new argument in the body. (gfc_trans_create_temp_arry, gfc_conv_loop_setup): Update calls. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180861 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/trans-array.c | 9 ++++++--- 2 files changed, 12 insertions(+), 3 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 57673ba406f..7bf389415bd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-11-03 Mikael Morin + + * trans-array.c (get_array_ref_dim): Change argument type and name. + Obtain previous argument from the new argument in the body. + (gfc_trans_create_temp_arry, gfc_conv_loop_setup): Update calls. + 2011-11-03 Mikael Morin * trans-array.c (gfc_set_vector_loop_bounds, set_vector_loop_bounds): diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 6af4fd6174c..eeed8bb9ffa 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -807,9 +807,12 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, */ static int -get_array_ref_dim (gfc_ss_info *info, int loop_dim) +get_array_ref_dim (gfc_ss *ss, int loop_dim) { int n, array_dim, array_ref_dim; + gfc_ss_info *info; + + info = &ss->data.info; array_ref_dim = 0; array_dim = info->dim[loop_dim]; @@ -884,7 +887,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, to the n'th dimension of the array. We need to reconstruct loop infos in the right order before using it to set the descriptor bounds. */ - tmp_dim = get_array_ref_dim (info, n); + tmp_dim = get_array_ref_dim (ss, n); from[tmp_dim] = loop->from[n]; to[tmp_dim] = loop->to[n]; @@ -3976,7 +3979,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) && INTEGER_CST_P (info->stride[dim])) { loop->from[n] = info->start[dim]; - mpz_set (i, cshape[get_array_ref_dim (info, n)]); + mpz_set (i, cshape[get_array_ref_dim (loopspec[n], n)]); mpz_sub_ui (i, i, 1); /* To = from + (size - 1) * stride. */ tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind); -- cgit v1.2.1 From 72a55e713ef10b233c16aefb8fcde71097721adc Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:35:35 +0000 Subject: * trans-array.c (dim_ok, transposed_dims): Rename the former to the latter. Change argument type. Invert return value. (gfc_conv_expr_descriptor): Update calls. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180862 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/trans-array.c | 13 ++++++++----- 2 files changed, 14 insertions(+), 5 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7bf389415bd..72cd8720ab2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-11-03 Mikael Morin + + * trans-array.c (dim_ok, transposed_dims): Rename the former to the + latter. Change argument type. Invert return value. + (gfc_conv_expr_descriptor): Update calls. + 2011-11-03 Mikael Morin * trans-array.c (get_array_ref_dim): Change argument type and name. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index eeed8bb9ffa..dc4dccd3fe7 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5659,13 +5659,16 @@ get_array_charlen (gfc_expr *expr, gfc_se *se) /* Helper function to check dimensions. */ static bool -dim_ok (gfc_ss_info *info) +transposed_dims (gfc_ss *ss) { + gfc_ss_info *info; int n; + + info = &ss->data.info; for (n = 0; n < info->dimen; n++) if (info->dim[n] != n) - return false; - return true; + return true; + return false; } /* Convert an array for passing as an actual argument. Expressions and @@ -5752,7 +5755,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) else full = gfc_full_array_ref_p (info->ref, NULL); - if (full && dim_ok (info)) + if (full && !transposed_dims (ss)) { if (se->direct_byref && !se->byref_noassign) { @@ -5949,7 +5952,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) desc = loop.temp_ss->data.info.descriptor; } - else if (expr->expr_type == EXPR_FUNCTION && dim_ok (info)) + else if (expr->expr_type == EXPR_FUNCTION && !transposed_dims (ss)) { desc = info->descriptor; se->string_length = ss->string_length; -- cgit v1.2.1 From ea686fef727b69289f13168df39e10615632faf0 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:39:11 +0000 Subject: * trans.h (struct gfc_ss_info, struct gfc_array_info): Rename the former to the latter. * trans-array.c (gfc_get_array_ss, gfc_trans_allocate_array_storage, get_array_ref_dim, gfc_trans_create_temp_array, gfc_trans_constant_array_constructor, gfc_set_vector_loop_bounds, gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref, add_array_offset, gfc_trans_preloop_setup, gfc_conv_section_startstride, gfc_conv_ss_startstride, gfc_conv_loop_setup, transposed_dims, gfc_conv_expr_descriptor): Update all uses. * trans-expr.c (gfc_conv_subref_array_arg, gfc_conv_procedure_call): Ditto. * trans-intrinsic.c (gfc_conv_intrinsic_transfer, walk_inline_intrinsic_transpose): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies, gfc_trans_pointer_assign_need_temp): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180864 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 18 ++++++++++++++++++ gcc/fortran/trans-array.c | 34 +++++++++++++++++----------------- gcc/fortran/trans-expr.c | 4 ++-- gcc/fortran/trans-intrinsic.c | 4 ++-- gcc/fortran/trans-stmt.c | 4 ++-- gcc/fortran/trans.h | 24 +++++++++++++----------- 6 files changed, 54 insertions(+), 34 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 72cd8720ab2..1d0c67b8bd3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,21 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss_info, struct gfc_array_info): + Rename the former to the latter. + * trans-array.c (gfc_get_array_ss, gfc_trans_allocate_array_storage, + get_array_ref_dim, gfc_trans_create_temp_array, + gfc_trans_constant_array_constructor, gfc_set_vector_loop_bounds, + gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref, + add_array_offset, gfc_trans_preloop_setup, gfc_conv_section_startstride, + gfc_conv_ss_startstride, gfc_conv_loop_setup, transposed_dims, + gfc_conv_expr_descriptor): Update all uses. + * trans-expr.c (gfc_conv_subref_array_arg, gfc_conv_procedure_call): + Ditto. + * trans-intrinsic.c (gfc_conv_intrinsic_transfer, + walk_inline_intrinsic_transpose): Ditto. + * trans-stmt.c (gfc_conv_elemental_dependencies, + gfc_trans_pointer_assign_need_temp): Ditto. + 2011-11-03 Mikael Morin * trans-array.c (dim_ok, transposed_dims): Rename the former to the diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index dc4dccd3fe7..2e1a8d48885 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -517,7 +517,7 @@ gfc_ss * gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) { gfc_ss *ss; - gfc_ss_info *info; + gfc_array_info *info; int i; ss = gfc_get_ss (); @@ -685,7 +685,7 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping, static void gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, - gfc_ss_info * info, tree size, tree nelem, + gfc_array_info * info, tree size, tree nelem, tree initial, bool dynamic, bool dealloc) { tree tmp; @@ -810,7 +810,7 @@ static int get_array_ref_dim (gfc_ss *ss, int loop_dim) { int n, array_dim, array_ref_dim; - gfc_ss_info *info; + gfc_array_info *info; info = &ss->data.info; @@ -845,7 +845,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, tree eltype, tree initial, bool dynamic, bool dealloc, bool callee_alloc, locus * where) { - gfc_ss_info *info; + gfc_array_info *info; tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS]; tree type; tree desc; @@ -1857,7 +1857,7 @@ gfc_build_constant_array_constructor (gfc_expr * expr, tree type) static void trans_constant_array_constructor (gfc_ss * ss, tree type) { - gfc_ss_info *info; + gfc_array_info *info; tree tmp; int i; @@ -2099,7 +2099,7 @@ finish: static void set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) { - gfc_ss_info *info; + gfc_array_info *info; gfc_se se; tree tmp; tree desc; @@ -2516,7 +2516,7 @@ static tree conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, gfc_array_ref * ar, tree stride) { - gfc_ss_info *info; + gfc_array_info *info; tree index; tree desc; tree data; @@ -2629,7 +2629,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, static void gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) { - gfc_ss_info *info; + gfc_array_info *info; tree decl = NULL_TREE; tree index; tree tmp; @@ -2827,7 +2827,7 @@ add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss, gfc_array_ref *ar, int array_dim, int loop_dim) { gfc_se se; - gfc_ss_info *info; + gfc_array_info *info; tree stride, index; info = &ss->data.info; @@ -2854,7 +2854,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, stmtblock_t * pblock) { tree stride; - gfc_ss_info *info; + gfc_array_info *info; gfc_ss *ss; gfc_array_ref *ar; int i; @@ -3205,7 +3205,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim) gfc_expr *stride = NULL; tree desc; gfc_se se; - gfc_ss_info *info; + gfc_array_info *info; gfc_array_ref *ar; gcc_assert (ss->type == GFC_SS_SECTION); @@ -3356,7 +3356,7 @@ done: tree end; tree size[GFC_MAX_DIMENSIONS]; tree stride_pos, stride_neg, non_zerosized, tmp2, tmp3; - gfc_ss_info *info; + gfc_array_info *info; char *msg; int dim; @@ -3851,8 +3851,8 @@ void gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) { int n, dim, spec_dim; - gfc_ss_info *info; - gfc_ss_info *specinfo; + gfc_array_info *info; + gfc_array_info *specinfo; gfc_ss *ss; tree tmp; gfc_ss *loopspec[GFC_MAX_DIMENSIONS]; @@ -4061,7 +4061,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) tmp = loop->temp_ss->data.temp.type; n = loop->temp_ss->data.temp.dimen; - memset (&loop->temp_ss->data.info, 0, sizeof (gfc_ss_info)); + memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); loop->temp_ss->type = GFC_SS_SECTION; loop->temp_ss->data.info.dimen = n; @@ -5661,7 +5661,7 @@ get_array_charlen (gfc_expr *expr, gfc_se *se) static bool transposed_dims (gfc_ss *ss) { - gfc_ss_info *info; + gfc_array_info *info; int n; info = &ss->data.info; @@ -5704,7 +5704,7 @@ void gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) { gfc_loopinfo loop; - gfc_ss_info *info; + gfc_array_info *info; int need_tmp; int n; tree tmp; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b2c1739bdfc..636c0b011ed 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2359,7 +2359,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, gfc_ss *rss; gfc_loopinfo loop; gfc_loopinfo loop2; - gfc_ss_info *info; + gfc_array_info *info; tree offset; tree tmp_index; tree tmp; @@ -2854,7 +2854,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, tree fntype; gfc_se parmse; gfc_ss *argss; - gfc_ss_info *info; + gfc_array_info *info; int byref; int parm_kind; tree type; diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 95161f8bdd0..47313e65698 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -5269,7 +5269,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) gfc_actual_arglist *arg; gfc_se argse; gfc_ss *ss; - gfc_ss_info *info; + gfc_array_info *info; stmtblock_t block; int n; bool scalar_mold; @@ -6757,7 +6757,7 @@ walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr) && tmp_ss->type != GFC_SS_REFERENCE) { int tmp_dim; - gfc_ss_info *info; + gfc_array_info *info; info = &tmp_ss->data.info; gcc_assert (info->dimen == 2); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index c7ae36005d2..aa7591b8d44 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -193,7 +193,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, gfc_loopinfo tmp_loop; gfc_se parmse; gfc_ss *ss; - gfc_ss_info *info; + gfc_array_info *info; gfc_symbol *fsym; gfc_ref *ref; int n; @@ -3306,7 +3306,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, gfc_ss *lss, *rss; gfc_se lse; gfc_se rse; - gfc_ss_info *info; + gfc_array_info *info; gfc_loopinfo loop; tree desc; tree parm; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 535c207fcd4..6f9f6c8a768 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -108,15 +108,10 @@ typedef enum gfc_coarray_type; -/* Scalarization State chain. Created by walking an expression tree before - creating the scalarization loops. Then passed as part of a gfc_se structure - to translate the expression inside the loop. Note that these chains are - terminated by gfc_se_terminator, not NULL. A NULL pointer in a gfc_se - indicates to gfc_conv_* that this is a scalar expression. - Note that some member arrays correspond to scalarizer rank and others - are the variable rank. */ +/* The array-specific scalarization informations. The array members of + this struct are indexed by actual array index, and thus can be sparse. */ -typedef struct gfc_ss_info +typedef struct gfc_array_info { int dimen; /* The ref that holds information on this section. */ @@ -144,7 +139,7 @@ typedef struct gfc_ss_info actual_dim = dim[loop_dim] */ int dim[GFC_MAX_DIMENSIONS]; } -gfc_ss_info; +gfc_array_info; typedef enum { @@ -190,8 +185,15 @@ typedef enum } gfc_ss_type; -/* SS structures can only belong to a single loopinfo. They must be added + +/* Scalarization State chain. Created by walking an expression tree before + creating the scalarization loops. Then passed as part of a gfc_se structure + to translate the expression inside the loop. Note that these chains are + terminated by gfc_ss_terminator, not NULL. A NULL pointer in a gfc_se + indicates to gfc_conv_* that this is a scalar expression. + SS structures can only belong to a single loopinfo. They must be added otherwise they will not get freed. */ + typedef struct gfc_ss { gfc_ss_type type; @@ -217,7 +219,7 @@ typedef struct gfc_ss } temp; /* All other types. */ - gfc_ss_info info; + gfc_array_info info; } data; -- cgit v1.2.1 From 91c546541d44cf6b1de95dc80eb8b365519a4a68 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:44:56 +0000 Subject: * trans.h (struct gfc_array_info): Move dim and dimen fields... (struct gfc_ss): ... here. Remove gfc_ss::data::temp::dimen field. * trans-array.c (gfc_conv_loop_setup): Remove temp_ss dim array initialization. (gfc_get_temp_ss): Initialize dim and dimen. (gfc_free_ss, gfc_get_array_ss, gfc_get_temp_ss, gfc_set_loop_bounds_from_array_spec, get_array_ref_dim, gfc_trans_create_temp_array, gfc_trans_constant_array_constructor, gfc_set_vector_loop_bounds, gfc_conv_scalarized_array_ref, gfc_trans_preloop_setup, gfc_conv_ss_startstride, gfc_conv_resolve_dependencies, gfc_conv_loop_setup, transposed_dims, gfc_conv_expr_descriptor, gfc_alloc_allocatable_for_assignment, gfc_walk_array_ref): Update field references. * trans-expr.c (gfc_conv_subref_array_arg, gfc_conv_procedure_call): Ditto. * trans-intrinsic.c (walk_inline_intrinsic_transpose): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180865 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 20 +++++++ gcc/fortran/trans-array.c | 133 ++++++++++++++++++++---------------------- gcc/fortran/trans-expr.c | 6 +- gcc/fortran/trans-intrinsic.c | 10 ++-- gcc/fortran/trans-stmt.c | 6 +- gcc/fortran/trans.h | 13 ++--- 6 files changed, 99 insertions(+), 89 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1d0c67b8bd3..712882a4c82 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,23 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_array_info): Move dim and dimen fields... + (struct gfc_ss): ... here. Remove gfc_ss::data::temp::dimen field. + * trans-array.c (gfc_conv_loop_setup): Remove temp_ss dim array + initialization. + (gfc_get_temp_ss): Initialize dim and dimen. + (gfc_free_ss, gfc_get_array_ss, gfc_get_temp_ss, + gfc_set_loop_bounds_from_array_spec, get_array_ref_dim, + gfc_trans_create_temp_array, gfc_trans_constant_array_constructor, + gfc_set_vector_loop_bounds, gfc_conv_scalarized_array_ref, + gfc_trans_preloop_setup, gfc_conv_ss_startstride, + gfc_conv_resolve_dependencies, gfc_conv_loop_setup, transposed_dims, + gfc_conv_expr_descriptor, gfc_alloc_allocatable_for_assignment, + gfc_walk_array_ref): Update field references. + * trans-expr.c (gfc_conv_subref_array_arg, gfc_conv_procedure_call): + Ditto. + * trans-intrinsic.c (walk_inline_intrinsic_transpose): Ditto. + * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss_info, struct gfc_array_info): diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 2e1a8d48885..6ff60dcfa99 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -496,10 +496,10 @@ gfc_free_ss (gfc_ss * ss) switch (ss->type) { case GFC_SS_SECTION: - for (n = 0; n < ss->data.info.dimen; n++) + for (n = 0; n < ss->dimen; n++) { - if (ss->data.info.subscript[ss->data.info.dim[n]]) - gfc_free_ss_chain (ss->data.info.subscript[ss->data.info.dim[n]]); + if (ss->data.info.subscript[ss->dim[n]]) + gfc_free_ss_chain (ss->data.info.subscript[ss->dim[n]]); } break; @@ -517,17 +517,15 @@ gfc_ss * gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) { gfc_ss *ss; - gfc_array_info *info; int i; ss = gfc_get_ss (); ss->next = next; ss->type = type; ss->expr = expr; - info = &ss->data.info; - info->dimen = dimen; - for (i = 0; i < info->dimen; i++) - info->dim[i] = i; + ss->dimen = dimen; + for (i = 0; i < ss->dimen; i++) + ss->dim[i] = i; return ss; } @@ -539,13 +537,16 @@ gfc_ss * gfc_get_temp_ss (tree type, tree string_length, int dimen) { gfc_ss *ss; + int i; ss = gfc_get_ss (); ss->next = gfc_ss_terminator; ss->type = GFC_SS_TEMP; ss->string_length = string_length; - ss->data.temp.dimen = dimen; ss->data.temp.type = type; + ss->dimen = dimen; + for (i = 0; i < ss->dimen; i++) + ss->dim[i] = i; return ss; } @@ -642,7 +643,7 @@ gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping, if (as && as->type == AS_EXPLICIT) for (n = 0; n < se->loop->dimen; n++) { - dim = se->ss->data.info.dim[n]; + dim = se->ss->dim[n]; gcc_assert (dim < as->rank); gcc_assert (se->loop->dimen == as->rank); if (se->loop->to[n] == NULL_TREE) @@ -810,15 +811,12 @@ static int get_array_ref_dim (gfc_ss *ss, int loop_dim) { int n, array_dim, array_ref_dim; - gfc_array_info *info; - - info = &ss->data.info; array_ref_dim = 0; - array_dim = info->dim[loop_dim]; + array_dim = ss->dim[loop_dim]; - for (n = 0; n < info->dimen; n++) - if (info->dim[n] < array_dim) + for (n = 0; n < ss->dimen; n++) + if (ss->dim[n] < array_dim) array_ref_dim++; return array_ref_dim; @@ -861,8 +859,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, info = &ss->data.info; - gcc_assert (info->dimen > 0); - gcc_assert (loop->dimen == info->dimen); + gcc_assert (ss->dimen > 0); + gcc_assert (loop->dimen == ss->dimen); if (gfc_option.warn_array_temp && where) gfc_warning ("Creating array temporary at %L", where); @@ -870,7 +868,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, /* Set the lower bound to zero. */ for (n = 0; n < loop->dimen; n++) { - dim = info->dim[n]; + dim = ss->dim[n]; /* Callee allocated arrays may not have a known bound yet. */ if (loop->to[n]) @@ -899,7 +897,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, /* Initialize the descriptor. */ type = - gfc_get_array_type_bounds (eltype, info->dimen, 0, from, to, 1, + gfc_get_array_type_bounds (eltype, ss->dimen, 0, from, to, 1, GFC_ARRAY_UNKNOWN, true); desc = gfc_create_var (type, "atmp"); GFC_DECL_PACKED_ARRAY (desc) = 1; @@ -937,7 +935,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, for (n = 0; n < loop->dimen; n++) { - dim = info->dim[n]; + dim = ss->dim[n]; if (size == NULL_TREE) { @@ -1003,8 +1001,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial, dynamic, dealloc); - if (info->dimen > loop->temp_dim) - loop->temp_dim = info->dimen; + if (ss->dimen > loop->temp_dim) + loop->temp_dim = ss->dimen; return size; } @@ -1869,7 +1867,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type) info->data = gfc_build_addr_expr (NULL_TREE, tmp); info->offset = gfc_index_zero_node; - for (i = 0; i < info->dimen; i++) + for (i = 0; i < ss->dimen; i++) { info->delta[i] = gfc_index_zero_node; info->start[i] = gfc_index_zero_node; @@ -1950,7 +1948,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) first_len = true; } - gcc_assert (ss->data.info.dimen == loop->dimen); + gcc_assert (ss->dimen == loop->dimen); c = ss->expr->value.constructor; if (ss->expr->ts.type == BT_CHARACTER) @@ -2111,7 +2109,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) for (n = 0; n < loop->dimen; n++) { - dim = info->dim[n]; + dim = ss->dim[n]; if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR && loop->to[n] == NULL) { @@ -2633,16 +2631,17 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) tree decl = NULL_TREE; tree index; tree tmp; + gfc_ss *ss; int n; - info = &se->ss->data.info; + ss = se->ss; + info = &ss->data.info; if (ar) n = se->loop->order[0]; else n = 0; - index = conv_array_index_offset (se, se->ss, info->dim[n], n, ar, - info->stride0); + index = conv_array_index_offset (se, ss, ss->dim[n], n, ar, info->stride0); /* Add the offset for this dimension to the stored offset for all other dimensions. */ if (!integer_zerop (info->offset)) @@ -2873,8 +2872,8 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, info = &ss->data.info; - gcc_assert (dim < info->dimen); - gcc_assert (info->dimen == loop->dimen); + gcc_assert (dim < ss->dimen); + gcc_assert (ss->dimen == loop->dimen); if (info->ref) ar = &info->ref->u.ar; @@ -2892,7 +2891,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if (dim == loop->dimen - 1) { - stride = gfc_conv_array_stride (info->descriptor, info->dim[i]); + stride = gfc_conv_array_stride (info->descriptor, ss->dim[i]); /* Calculate the stride of the innermost loop. Hopefully this will allow the backend optimizers to do their stuff more effectively. @@ -2915,7 +2914,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, } else /* Add the offset for the previous loop dimension. */ - add_array_offset (pblock, loop, ss, ar, info->dim[i], i); + add_array_offset (pblock, loop, ss, ar, ss->dim[i], i); /* Remember this offset for the second loop. */ if (dim == loop->temp_dim - 1) @@ -3271,7 +3270,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) case GFC_SS_CONSTRUCTOR: case GFC_SS_FUNCTION: case GFC_SS_COMPONENT: - loop->dimen = ss->data.info.dimen; + loop->dimen = ss->dimen; goto done; /* As usual, lbound and ubound are exceptions!. */ @@ -3283,7 +3282,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) case GFC_ISYM_LCOBOUND: case GFC_ISYM_UCOBOUND: case GFC_ISYM_THIS_IMAGE: - loop->dimen = ss->data.info.dimen; + loop->dimen = ss->dimen; goto done; default: @@ -3312,8 +3311,8 @@ done: /* Get the descriptor for the array. */ gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter); - for (n = 0; n < ss->data.info.dimen; n++) - gfc_conv_section_startstride (loop, ss, ss->data.info.dim[n]); + for (n = 0; n < ss->dimen; n++) + gfc_conv_section_startstride (loop, ss, ss->dim[n]); break; case GFC_SS_INTRINSIC: @@ -3333,9 +3332,9 @@ done: case GFC_SS_CONSTRUCTOR: case GFC_SS_FUNCTION: - for (n = 0; n < ss->data.info.dimen; n++) + for (n = 0; n < ss->dimen; n++) { - int dim = ss->data.info.dim[n]; + int dim = ss->dim[n]; ss->data.info.start[dim] = gfc_index_zero_node; ss->data.info.end[dim] = gfc_index_zero_node; @@ -3387,7 +3386,7 @@ done: { bool check_upper; - dim = info->dim[n]; + dim = ss->dim[n]; if (info->ref->u.ar.dimen_type[dim] != DIMEN_RANGE) continue; @@ -3776,10 +3775,10 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, if (nDepend == 1) break; - for (i = 0; i < dest->data.info.dimen; i++) - for (j = 0; j < ss->data.info.dimen; j++) + for (i = 0; i < dest->dimen; i++) + for (j = 0; j < ss->dimen; j++) if (i != j - && dest->data.info.dim[i] == ss->data.info.dim[j]) + && dest->dim[i] == ss->dim[j]) { /* If we don't access array elements in the same order, there is a dependency. */ @@ -3853,7 +3852,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) int n, dim, spec_dim; gfc_array_info *info; gfc_array_info *specinfo; - gfc_ss *ss; + gfc_ss *ss, *tmp_ss; tree tmp; gfc_ss *loopspec[GFC_MAX_DIMENSIONS]; bool dynamic[GFC_MAX_DIMENSIONS]; @@ -3878,12 +3877,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) continue; info = &ss->data.info; - dim = info->dim[n]; + dim = ss->dim[n]; if (loopspec[n] != NULL) { specinfo = &loopspec[n]->data.info; - spec_dim = specinfo->dim[n]; + spec_dim = loopspec[n]->dim[n]; } else { @@ -3971,7 +3970,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) gcc_assert (loopspec[n]); info = &loopspec[n]->data.info; - dim = info->dim[n]; + dim = loopspec[n]->dim[n]; /* Set the extents of this range. */ cshape = loopspec[n]->shape; @@ -4047,8 +4046,9 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) allocating the temporary. */ gfc_add_loop_ss_code (loop, loop->ss, false, where); + tmp_ss = loop->temp_ss; /* If we want a temporary then create it. */ - if (loop->temp_ss != NULL) + if (tmp_ss != NULL) { gcc_assert (loop->temp_ss->type == GFC_SS_TEMP); @@ -4060,17 +4060,13 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) loop->temp_ss->string_length); tmp = loop->temp_ss->data.temp.type; - n = loop->temp_ss->data.temp.dimen; memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); loop->temp_ss->type = GFC_SS_SECTION; - loop->temp_ss->data.info.dimen = n; - gcc_assert (loop->temp_ss->data.info.dimen != 0); - for (n = 0; n < loop->temp_ss->data.info.dimen; n++) - loop->temp_ss->data.info.dim[n] = n; + gcc_assert (tmp_ss->dimen != 0); gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, - loop->temp_ss, tmp, NULL_TREE, + tmp_ss, tmp, NULL_TREE, false, true, false, where); } @@ -4094,12 +4090,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) info = &ss->data.info; - for (n = 0; n < info->dimen; n++) + for (n = 0; n < ss->dimen; n++) { /* If we are specifying the range the delta is already set. */ if (loopspec[n] != ss) { - dim = ss->data.info.dim[n]; + dim = ss->dim[n]; /* Calculate the offset relative to the loop variable. First multiply by the stride. */ @@ -5657,16 +5653,15 @@ get_array_charlen (gfc_expr *expr, gfc_se *se) } } + /* Helper function to check dimensions. */ static bool transposed_dims (gfc_ss *ss) { - gfc_array_info *info; int n; - info = &ss->data.info; - for (n = 0; n < info->dimen; n++) - if (info->dim[n] != n) + for (n = 0; n < ss->dimen; n++) + if (ss->dim[n] != n) return true; return false; } @@ -5899,7 +5894,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) loop.dimen); se->string_length = loop.temp_ss->string_length; - gcc_assert (loop.temp_ss->data.temp.dimen == loop.dimen); + gcc_assert (loop.temp_ss->dimen == loop.dimen); gfc_add_ss_to_loop (&loop, loop.temp_ss); } @@ -5972,7 +5967,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) tree to; tree base; - ndim = info->ref ? info->ref->u.ar.dimen : info->dimen; + ndim = info->ref ? info->ref->u.ar.dimen : ss->dimen; if (se->want_coarray) { @@ -6087,7 +6082,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) /* look for the corresponding scalarizer dimension: dim. */ for (dim = 0; dim < ndim; dim++) - if (info->dim[dim] == n) + if (ss->dim[dim] == n) break; /* loop exited early: the DIM being looked for has been found. */ @@ -7376,7 +7371,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, for (n = 0; n < expr1->rank; n++) { tmp = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]); - dim = lss->data.info.dim[n]; + dim = lss->dim[n]; tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, tmp, loop->from[dim]); @@ -7678,8 +7673,8 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) case DIMEN_RANGE: /* We don't add anything for sections, just remember this dimension for later. */ - newss->data.info.dim[newss->data.info.dimen] = n; - newss->data.info.dimen++; + newss->dim[newss->dimen] = n; + newss->dimen++; break; case DIMEN_VECTOR: @@ -7689,8 +7684,8 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) 1, GFC_SS_VECTOR); indexss->loop_chain = gfc_ss_terminator; newss->data.info.subscript[n] = indexss; - newss->data.info.dim[newss->data.info.dimen] = n; - newss->data.info.dimen++; + newss->dim[newss->dimen] = n; + newss->dimen++; break; default: @@ -7700,7 +7695,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) } /* We should have at least one non-elemental dimension, unless we are creating a descriptor for a (scalar) coarray. */ - gcc_assert (newss->data.info.dimen > 0 + gcc_assert (newss->dimen > 0 || newss->data.info.ref->u.ar.as->corank > 0); ss = newss; break; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 636c0b011ed..84222f52969 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2489,7 +2489,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, outside the innermost loop, so the overall transfer could be optimized further. */ info = &rse.ss->data.info; - dimen = info->dimen; + dimen = rse.ss->dimen; tmp_index = gfc_index_zero_node; for (n = dimen - 1; n > 0; n--) @@ -3582,7 +3582,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Set the type of the array. */ tmp = gfc_typenode_for_spec (&comp->ts); - gcc_assert (info->dimen == se->loop->dimen); + gcc_assert (se->ss->dimen == se->loop->dimen); /* Evaluate the bounds of the result, if known. */ gfc_set_loop_bounds_from_array_spec (&mapping, se, comp->as); @@ -3618,7 +3618,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, /* Set the type of the array. */ tmp = gfc_typenode_for_spec (&ts); - gcc_assert (info->dimen == se->loop->dimen); + gcc_assert (se->ss->dimen == se->loop->dimen); /* Evaluate the bounds of the result, if known. */ gfc_set_loop_bounds_from_array_spec (&mapping, se, sym->result->as); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 47313e65698..3f8d51451fb 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -6757,15 +6757,13 @@ walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr) && tmp_ss->type != GFC_SS_REFERENCE) { int tmp_dim; - gfc_array_info *info; - info = &tmp_ss->data.info; - gcc_assert (info->dimen == 2); + gcc_assert (tmp_ss->dimen == 2); /* We just invert dimensions. */ - tmp_dim = info->dim[0]; - info->dim[0] = info->dim[1]; - info->dim[1] = tmp_dim; + tmp_dim = tmp_ss->dim[0]; + tmp_ss->dim[0] = tmp_ss->dim[1]; + tmp_ss->dim[1] = tmp_dim; } /* Stop when tmp_ss points to the last valid element of the chain... */ diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index aa7591b8d44..c66d6b54499 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -241,8 +241,8 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, /* Make a local loopinfo for the temporary creation, so that none of the other ss->info's have to be renormalized. */ gfc_init_loopinfo (&tmp_loop); - tmp_loop.dimen = info->dimen; - for (n = 0; n < info->dimen; n++) + tmp_loop.dimen = ss->dimen; + for (n = 0; n < ss->dimen; n++) { tmp_loop.to[n] = loopse->loop->to[n]; tmp_loop.from[n] = loopse->loop->from[n]; @@ -320,7 +320,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, /* Calculate the offset for the temporary. */ offset = gfc_index_zero_node; - for (n = 0; n < info->dimen; n++) + for (n = 0; n < ss->dimen; n++) { tmp = gfc_conv_descriptor_stride_get (info->descriptor, gfc_rank_cst[n]); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 6f9f6c8a768..5acab12ad5a 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -113,7 +113,6 @@ gfc_coarray_type; typedef struct gfc_array_info { - int dimen; /* The ref that holds information on this section. */ gfc_ref *ref; /* The descriptor of this array. */ @@ -134,10 +133,6 @@ typedef struct gfc_array_info tree end[GFC_MAX_DIMENSIONS]; tree stride[GFC_MAX_DIMENSIONS]; tree delta[GFC_MAX_DIMENSIONS]; - - /* Translation from loop dimensions to actual dimensions. - actual_dim = dim[loop_dim] */ - int dim[GFC_MAX_DIMENSIONS]; } gfc_array_info; @@ -212,9 +207,6 @@ typedef struct gfc_ss /* GFC_SS_TEMP. */ struct { - /* The rank of the temporary. May be less than the rank of the - assigned expression. */ - int dimen; tree type; } temp; @@ -223,6 +215,11 @@ typedef struct gfc_ss } data; + int dimen; + /* Translation from loop dimensions to actual array dimensions. + actual_dim = dim[loop_dim] */ + int dim[GFC_MAX_DIMENSIONS]; + /* All the SS in a loop and linked through loop_chain. The SS for an expression are linked by the next pointer. */ struct gfc_ss *loop_chain; -- cgit v1.2.1 From f6b46ebcc27964a832aa2bf59be164269b7c9fee Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:47:49 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_array_info): Move shape field from the former struct to the latter. * trans-array.c (gfc_conv_ss_startstride, gfc_conv_loop_setup): Update field references. * trans-expr.c (gfc_trans_subarray_assign): Update field references and factor common reference chains. * trans-io.c (transfer_array_component): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180866 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 ++++++++++ gcc/fortran/trans-array.c | 16 ++++++++++------ gcc/fortran/trans-expr.c | 24 +++++++++++++----------- gcc/fortran/trans-io.c | 24 +++++++++++++----------- gcc/fortran/trans.h | 3 ++- 5 files changed, 48 insertions(+), 29 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 712882a4c82..ff8f4d83c91 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss, struct gfc_array_info): Move shape field + from the former struct to the latter. + * trans-array.c (gfc_conv_ss_startstride, gfc_conv_loop_setup): + Update field references. + * trans-expr.c (gfc_trans_subarray_assign): Update field references + and factor common reference chains. + * trans-io.c (transfer_array_component): Ditto. + 2011-11-03 Mikael Morin * trans.h (struct gfc_array_info): Move dim and dimen fields... diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 6ff60dcfa99..277a49e79e9 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3302,8 +3302,12 @@ done: /* Loop over all the SS in the chain. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { - if (ss->expr && ss->expr->shape && !ss->shape) - ss->shape = ss->expr->shape; + gfc_array_info *info; + + info = &ss->data.info; + + if (ss->expr && ss->expr->shape && !info->shape) + info->shape = ss->expr->shape; switch (ss->type) { @@ -3891,12 +3895,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) spec_dim = 0; } - if (ss->shape) + if (info->shape) { - gcc_assert (ss->shape[dim]); + gcc_assert (info->shape[dim]); /* The frontend has worked out the size for us. */ if (!loopspec[n] - || !loopspec[n]->shape + || !specinfo->shape || !integer_zerop (specinfo->start[spec_dim])) /* Prefer zero-based descriptors if possible. */ loopspec[n] = ss; @@ -3973,7 +3977,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) dim = loopspec[n]->dim[n]; /* Set the extents of this range. */ - cshape = loopspec[n]->shape; + cshape = info->shape; if (cshape && INTEGER_CST_P (info->start[dim]) && INTEGER_CST_P (info->stride[dim])) { diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 84222f52969..6bc336b0027 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4344,6 +4344,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) gfc_se lse; gfc_ss *rss; gfc_ss *lss; + gfc_array_info *lss_array; stmtblock_t body; stmtblock_t block; gfc_loopinfo loop; @@ -4367,19 +4368,20 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) /* Create a SS for the destination. */ lss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank, GFC_SS_COMPONENT); - lss->shape = gfc_get_shape (cm->as->rank); - lss->data.info.descriptor = dest; - lss->data.info.data = gfc_conv_array_data (dest); - lss->data.info.offset = gfc_conv_array_offset (dest); + lss_array = &lss->data.info; + lss_array->shape = gfc_get_shape (cm->as->rank); + lss_array->descriptor = dest; + lss_array->data = gfc_conv_array_data (dest); + lss_array->offset = gfc_conv_array_offset (dest); for (n = 0; n < cm->as->rank; n++) { - lss->data.info.start[n] = gfc_conv_array_lbound (dest, n); - lss->data.info.stride[n] = gfc_index_one_node; + lss_array->start[n] = gfc_conv_array_lbound (dest, n); + lss_array->stride[n] = gfc_index_one_node; - mpz_init (lss->shape[n]); - mpz_sub (lss->shape[n], cm->as->upper[n]->value.integer, + mpz_init (lss_array->shape[n]); + mpz_sub (lss_array->shape[n], cm->as->upper[n]->value.integer, cm->as->lower[n]->value.integer); - mpz_add_ui (lss->shape[n], lss->shape[n], 1); + mpz_add_ui (lss_array->shape[n], lss_array->shape[n], 1); } /* Associate the SS with the loop. */ @@ -4422,8 +4424,8 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) gfc_add_block_to_block (&block, &loop.pre); gfc_add_block_to_block (&block, &loop.post); - gcc_assert (lss->shape != NULL); - gfc_free_shape (&lss->shape, cm->as->rank); + gcc_assert (lss_array->shape != NULL); + gfc_free_shape (&lss_array->shape, cm->as->rank); gfc_cleanup_loop (&loop); return gfc_finish_block (&block); diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index bbf5a02eff4..a97691eea0c 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1937,6 +1937,7 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) int n; gfc_ss *ss; gfc_se se; + gfc_array_info *ss_array; gfc_start_block (&block); gfc_init_se (&se, NULL); @@ -1948,19 +1949,20 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) ss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank, GFC_SS_COMPONENT); - ss->shape = gfc_get_shape (cm->as->rank); - ss->data.info.descriptor = expr; - ss->data.info.data = gfc_conv_array_data (expr); - ss->data.info.offset = gfc_conv_array_offset (expr); + ss_array = &ss->data.info; + ss_array->shape = gfc_get_shape (cm->as->rank); + ss_array->descriptor = expr; + ss_array->data = gfc_conv_array_data (expr); + ss_array->offset = gfc_conv_array_offset (expr); for (n = 0; n < cm->as->rank; n++) { - ss->data.info.start[n] = gfc_conv_array_lbound (expr, n); - ss->data.info.stride[n] = gfc_index_one_node; + ss_array->start[n] = gfc_conv_array_lbound (expr, n); + ss_array->stride[n] = gfc_index_one_node; - mpz_init (ss->shape[n]); - mpz_sub (ss->shape[n], cm->as->upper[n]->value.integer, + mpz_init (ss_array->shape[n]); + mpz_sub (ss_array->shape[n], cm->as->upper[n]->value.integer, cm->as->lower[n]->value.integer); - mpz_add_ui (ss->shape[n], ss->shape[n], 1); + mpz_add_ui (ss_array->shape[n], ss_array->shape[n], 1); } /* Once we got ss, we use scalarizer to create the loop. */ @@ -1995,8 +1997,8 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) gfc_add_block_to_block (&block, &loop.pre); gfc_add_block_to_block (&block, &loop.post); - gcc_assert (ss->shape != NULL); - gfc_free_shape (&ss->shape, cm->as->rank); + gcc_assert (ss_array->shape != NULL); + gfc_free_shape (&ss_array->shape, cm->as->rank); gfc_cleanup_loop (&loop); return gfc_finish_block (&block); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 5acab12ad5a..daf24995199 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -113,6 +113,8 @@ gfc_coarray_type; typedef struct gfc_array_info { + mpz_t *shape; + /* The ref that holds information on this section. */ gfc_ref *ref; /* The descriptor of this array. */ @@ -193,7 +195,6 @@ typedef struct gfc_ss { gfc_ss_type type; gfc_expr *expr; - mpz_t *shape; tree string_length; union { -- cgit v1.2.1 From 45f3982640ef8034c09b1f99806122525801e62d Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 21:55:48 +0000 Subject: * trans.h (struct gfc_ss_info): New struct. (gfc_get_ss_info): New macro. (struct gfc_ss): Move type field to struct gfc_ss_info. Add an info field of type gfc_ss_info. * trans-array.c (free_ss_info): New function. (gfc_free_ss): Call free_ss_info. (gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss): Allocate gfc_ss_info field. (gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss, gfc_set_vector_loop_bounds, gfc_add_loop_ss_code, gfc_conv_array_index_offset, gfc_trans_preloop_setup, gfc_trans_scalarized_loop_boundary, gfc_conv_section_startstride, gfc_conv_ss_startstride, gfc_conv_resolve_dependencies, gfc_conv_loop_setup, transposed_dims, gfc_conv_expr_descriptor, gfc_walk_elemental_function_args): Update references to type. * trans-const.c (gfc_conv_constant): Factor common reference chains and update reference to type. * trans-expr.c (gfc_conv_procedure_call, gfc_trans_assignment_1): Update reference to type. (gfc_conv_array_constructor_expr, gfc_conv_expr, gfc_conv_expr_reference): Ditto. Factor common reference chains. * trans-intrinsic.c (walk_inline_intrinsic_transpose): Update references to type * trans-stmt.c (gfc_trans_where_assign): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180867 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 27 ++++++++++ gcc/fortran/trans-array.c | 113 ++++++++++++++++++++++++++++-------------- gcc/fortran/trans-const.c | 9 ++-- gcc/fortran/trans-expr.c | 27 ++++++---- gcc/fortran/trans-intrinsic.c | 4 +- gcc/fortran/trans-stmt.c | 2 +- gcc/fortran/trans.h | 12 ++++- 7 files changed, 141 insertions(+), 53 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ff8f4d83c91..958cc7a22d3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,30 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss_info): New struct. + (gfc_get_ss_info): New macro. + (struct gfc_ss): Move type field to struct gfc_ss_info. + Add an info field of type gfc_ss_info. + * trans-array.c (free_ss_info): New function. + (gfc_free_ss): Call free_ss_info. + (gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss): + Allocate gfc_ss_info field. + (gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss, + gfc_set_vector_loop_bounds, gfc_add_loop_ss_code, + gfc_conv_array_index_offset, gfc_trans_preloop_setup, + gfc_trans_scalarized_loop_boundary, gfc_conv_section_startstride, + gfc_conv_ss_startstride, gfc_conv_resolve_dependencies, + gfc_conv_loop_setup, transposed_dims, gfc_conv_expr_descriptor, + gfc_walk_elemental_function_args): Update references to type. + * trans-const.c (gfc_conv_constant): Factor common reference chains + and update reference to type. + * trans-expr.c (gfc_conv_procedure_call, gfc_trans_assignment_1): + Update reference to type. + (gfc_conv_array_constructor_expr, gfc_conv_expr, + gfc_conv_expr_reference): Ditto. Factor common reference chains. + * trans-intrinsic.c (walk_inline_intrinsic_transpose): Update references + to type + * trans-stmt.c (gfc_trans_where_assign): Ditto. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss, struct gfc_array_info): Move shape field diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 277a49e79e9..80dadf4c4db 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -486,14 +486,24 @@ gfc_free_ss_chain (gfc_ss * ss) } +static void +free_ss_info (gfc_ss_info *ss_info) +{ + free (ss_info); +} + + /* Free a SS. */ static void gfc_free_ss (gfc_ss * ss) { + gfc_ss_info *ss_info; int n; - switch (ss->type) + ss_info = ss->info; + + switch (ss_info->type) { case GFC_SS_SECTION: for (n = 0; n < ss->dimen; n++) @@ -507,6 +517,7 @@ gfc_free_ss (gfc_ss * ss) break; } + free_ss_info (ss_info); free (ss); } @@ -517,11 +528,15 @@ gfc_ss * gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) { gfc_ss *ss; + gfc_ss_info *ss_info; int i; + ss_info = gfc_get_ss_info (); + ss_info->type = type; + ss = gfc_get_ss (); + ss->info = ss_info; ss->next = next; - ss->type = type; ss->expr = expr; ss->dimen = dimen; for (i = 0; i < ss->dimen; i++) @@ -537,11 +552,15 @@ gfc_ss * gfc_get_temp_ss (tree type, tree string_length, int dimen) { gfc_ss *ss; + gfc_ss_info *ss_info; int i; + ss_info = gfc_get_ss_info (); + ss_info->type = GFC_SS_TEMP; + ss = gfc_get_ss (); + ss->info = ss_info; ss->next = gfc_ss_terminator; - ss->type = GFC_SS_TEMP; ss->string_length = string_length; ss->data.temp.type = type; ss->dimen = dimen; @@ -558,10 +577,14 @@ gfc_ss * gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr) { gfc_ss *ss; + gfc_ss_info *ss_info; + + ss_info = gfc_get_ss_info (); + ss_info->type = GFC_SS_SCALAR; ss = gfc_get_ss (); + ss->info = ss_info; ss->next = next; - ss->type = GFC_SS_SCALAR; ss->expr = expr; return ss; @@ -2118,7 +2141,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) difference between the vector's upper and lower bounds. */ gcc_assert (loop->from[n] == gfc_index_zero_node); gcc_assert (info->subscript[dim] - && info->subscript[dim]->type == GFC_SS_VECTOR); + && info->subscript[dim]->info->type == GFC_SS_VECTOR); gfc_init_se (&se, NULL); desc = info->subscript[dim]->data.info.descriptor; @@ -2153,7 +2176,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, { gcc_assert (ss); - switch (ss->type) + switch (ss->info->type) { case GFC_SS_SCALAR: /* Scalar expression. Evaluate this now. This includes elemental @@ -2533,7 +2556,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, case DIMEN_ELEMENT: /* Elemental dimension. */ gcc_assert (info->subscript[dim] - && info->subscript[dim]->type == GFC_SS_SCALAR); + && info->subscript[dim]->info->type == GFC_SS_SCALAR); /* We've already translated this value outside the loop. */ index = info->subscript[dim]->data.scalar.expr; @@ -2545,7 +2568,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, case DIMEN_VECTOR: gcc_assert (info && se->loop); gcc_assert (info->subscript[dim] - && info->subscript[dim]->type == GFC_SS_VECTOR); + && info->subscript[dim]->info->type == GFC_SS_VECTOR); desc = info->subscript[dim]->data.info.descriptor; /* Get a zero-based index into the vector. */ @@ -2600,7 +2623,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, /* Pointer functions can have stride[0] different from unity. Use the stride returned by the function call and stored in the descriptor for the temporary. */ - if (se->ss && se->ss->type == GFC_SS_FUNCTION + if (se->ss && se->ss->info->type == GFC_SS_FUNCTION && se->ss->expr && se->ss->expr->symtree && se->ss->expr->symtree->n.sym->result @@ -2854,6 +2877,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, { tree stride; gfc_array_info *info; + gfc_ss_type ss_type; gfc_ss *ss; gfc_array_ref *ar; int i; @@ -2865,9 +2889,11 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, if ((ss->useflags & flag) == 0) continue; - if (ss->type != GFC_SS_SECTION - && ss->type != GFC_SS_FUNCTION && ss->type != GFC_SS_CONSTRUCTOR - && ss->type != GFC_SS_COMPONENT) + ss_type = ss->info->type; + if (ss_type != GFC_SS_SECTION + && ss_type != GFC_SS_FUNCTION + && ss_type != GFC_SS_CONSTRUCTOR + && ss_type != GFC_SS_COMPONENT) continue; info = &ss->data.info; @@ -3134,12 +3160,16 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body) /* Restore the initial offsets. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { + gfc_ss_type ss_type; + if ((ss->useflags & 2) == 0) continue; - if (ss->type != GFC_SS_SECTION - && ss->type != GFC_SS_FUNCTION && ss->type != GFC_SS_CONSTRUCTOR - && ss->type != GFC_SS_COMPONENT) + ss_type = ss->info->type; + if (ss_type != GFC_SS_SECTION + && ss_type != GFC_SS_FUNCTION + && ss_type != GFC_SS_CONSTRUCTOR + && ss_type != GFC_SS_COMPONENT) continue; ss->data.info.offset = ss->data.info.saved_offset; @@ -3207,7 +3237,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim) gfc_array_info *info; gfc_array_ref *ar; - gcc_assert (ss->type == GFC_SS_SECTION); + gcc_assert (ss->info->type == GFC_SS_SECTION); info = &ss->data.info; ar = &info->ref->u.ar; @@ -3264,7 +3294,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) /* Determine the rank of the loop. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { - switch (ss->type) + switch (ss->info->type) { case GFC_SS_SECTION: case GFC_SS_CONSTRUCTOR: @@ -3309,7 +3339,7 @@ done: if (ss->expr && ss->expr->shape && !info->shape) info->shape = ss->expr->shape; - switch (ss->type) + switch (ss->info->type) { case GFC_SS_SECTION: /* Get the descriptor for the array. */ @@ -3372,7 +3402,7 @@ done: { stmtblock_t inner; - if (ss->type != GFC_SS_SECTION) + if (ss->info->type != GFC_SS_SECTION) continue; /* Catch allocatable lhs in f2003. */ @@ -3757,7 +3787,7 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, for (ss = rss; ss != gfc_ss_terminator; ss = ss->next) { - if (ss->type != GFC_SS_SECTION) + if (ss->info->type != GFC_SS_SECTION) continue; if (dest->expr->symtree->n.sym != ss->expr->symtree->n.sym) @@ -3874,7 +3904,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) { gfc_ss_type ss_type; - ss_type = ss->type; + ss_type = ss->info->type; if (ss_type == GFC_SS_SCALAR || ss_type == GFC_SS_TEMP || ss_type == GFC_SS_REFERENCE) @@ -3907,7 +3937,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) continue; } - if (ss->type == GFC_SS_CONSTRUCTOR) + if (ss_type == GFC_SS_CONSTRUCTOR) { gfc_constructor_base base; /* An unknown size constructor will always be rank one. @@ -3928,7 +3958,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) /* TODO: Pick the best bound if we have a choice between a function and something else. */ - if (ss->type == GFC_SS_FUNCTION) + if (ss_type == GFC_SS_FUNCTION) { loopspec[n] = ss; continue; @@ -3939,7 +3969,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) if (loopspec[n] && ss->is_alloc_lhs) continue; - if (ss->type != GFC_SS_SECTION) + if (ss_type != GFC_SS_SECTION) continue; if (!loopspec[n]) @@ -3951,7 +3981,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) known lower bound known upper bound */ - else if ((loopspec[n]->type == GFC_SS_CONSTRUCTOR && dynamic[n]) + else if ((loopspec[n]->info->type == GFC_SS_CONSTRUCTOR && dynamic[n]) || n >= loop->dimen) loopspec[n] = ss; else if (integer_onep (info->stride[dim]) @@ -3997,7 +4027,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) else { loop->from[n] = info->start[dim]; - switch (loopspec[n]->type) + switch (loopspec[n]->info->type) { case GFC_SS_CONSTRUCTOR: /* The upper bound is calculated when we expand the @@ -4054,7 +4084,10 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) /* If we want a temporary then create it. */ if (tmp_ss != NULL) { - gcc_assert (loop->temp_ss->type == GFC_SS_TEMP); + gfc_ss_info *tmp_ss_info; + + tmp_ss_info = tmp_ss->info; + gcc_assert (tmp_ss_info->type == GFC_SS_TEMP); /* Make absolutely sure that this is a complete type. */ if (loop->temp_ss->string_length) @@ -4065,7 +4098,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) tmp = loop->temp_ss->data.temp.type; memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); - loop->temp_ss->type = GFC_SS_SECTION; + tmp_ss_info->type = GFC_SS_SECTION; gcc_assert (tmp_ss->dimen != 0); @@ -4087,9 +4120,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) /* Calculate the translation from loop variables to array indices. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { - if (ss->type != GFC_SS_SECTION && ss->type != GFC_SS_COMPONENT - && ss->type != GFC_SS_CONSTRUCTOR) + gfc_ss_type ss_type; + ss_type = ss->info->type; + if (ss_type != GFC_SS_SECTION + && ss_type != GFC_SS_COMPONENT + && ss_type != GFC_SS_CONSTRUCTOR) continue; info = &ss->data.info; @@ -5702,6 +5738,7 @@ transposed_dims (gfc_ss *ss) void gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) { + gfc_ss_type ss_type; gfc_loopinfo loop; gfc_array_info *info; int need_tmp; @@ -5718,6 +5755,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) gcc_assert (ss != NULL); gcc_assert (ss != gfc_ss_terminator); + ss_type = ss->info->type; + /* Special case things we know we can pass easily. */ switch (expr->expr_type) { @@ -5725,7 +5764,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) /* If we have a linear array section, we can pass it directly. Otherwise we need to copy it into a temporary. */ - gcc_assert (ss->type == GFC_SS_SECTION); + gcc_assert (ss_type == GFC_SS_SECTION); gcc_assert (ss->expr == expr); info = &ss->data.info; @@ -5804,7 +5843,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) if (se->direct_byref) { - gcc_assert (ss->type == GFC_SS_FUNCTION && ss->expr == expr); + gcc_assert (ss_type == GFC_SS_FUNCTION && ss->expr == expr); /* For pointer assignments pass the descriptor directly. */ if (se->ss == NULL) @@ -5816,7 +5855,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) return; } - if (ss->expr != expr || ss->type != GFC_SS_FUNCTION) + if (ss->expr != expr || ss_type != GFC_SS_FUNCTION) { if (ss->expr != expr) /* Elemental function. */ @@ -5825,7 +5864,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) || (expr->value.function.isym != NULL && expr->value.function.isym->elemental)); else - gcc_assert (ss->type == GFC_SS_INTRINSIC); + gcc_assert (ss_type == GFC_SS_INTRINSIC); need_tmp = 1; if (expr->ts.type == BT_CHARACTER @@ -5844,7 +5883,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) case EXPR_ARRAY: /* Constant array constructors don't need a temporary. */ - if (ss->type == GFC_SS_CONSTRUCTOR + if (ss_type == GFC_SS_CONSTRUCTOR && expr->ts.type != BT_CHARACTER && gfc_constant_array_constructor_p (expr->value.constructor)) { @@ -6055,7 +6094,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) && info->ref->u.ar.dimen_type[n] == DIMEN_ELEMENT) { gcc_assert (info->subscript[n] - && info->subscript[n]->type == GFC_SS_SCALAR); + && info->subscript[n]->info->type == GFC_SS_SCALAR); start = info->subscript[n]->data.scalar.expr; } else @@ -7811,7 +7850,7 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, /* Scalar argument. */ gcc_assert (type == GFC_SS_SCALAR || type == GFC_SS_REFERENCE); newss = gfc_get_scalar_ss (head, arg->expr); - newss->type = type; + newss->info->type = type; } else scalar = 0; diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 5fbe765c493..84a83391097 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -358,6 +358,8 @@ gfc_conv_constant_to_tree (gfc_expr * expr) void gfc_conv_constant (gfc_se * se, gfc_expr * expr) { + gfc_ss *ss; + /* We may be receiving an expression for C_NULL_PTR or C_NULL_FUNPTR. If so, the expr_type will not yet be an EXPR_CONSTANT. We need to make it so here. */ @@ -380,10 +382,11 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr) return; } - if (se->ss != NULL) + ss = se->ss; + if (ss != NULL) { - gcc_assert (se->ss != gfc_ss_terminator); - gcc_assert (se->ss->type == GFC_SS_SCALAR); + gcc_assert (ss != gfc_ss_terminator); + gcc_assert (ss->info->type == GFC_SS_SCALAR); gcc_assert (se->ss->expr == expr); se->expr = se->ss->data.scalar.expr; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 6bc336b0027..5a946154818 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2893,7 +2893,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { if (!sym->attr.elemental) { - gcc_assert (se->ss->type == GFC_SS_FUNCTION); + gcc_assert (se->ss->info->type == GFC_SS_FUNCTION); if (se->ss->useflags) { gcc_assert ((!comp && gfc_return_by_reference (sym) @@ -4239,8 +4239,11 @@ is_zero_initializer_p (gfc_expr * expr) static void gfc_conv_array_constructor_expr (gfc_se * se, gfc_expr * expr) { - gcc_assert (se->ss != NULL && se->ss != gfc_ss_terminator); - gcc_assert (se->ss->expr == expr && se->ss->type == GFC_SS_CONSTRUCTOR); + gfc_ss *ss; + + ss = se->ss; + gcc_assert (ss != NULL && ss != gfc_ss_terminator); + gcc_assert (ss->expr == expr && ss->info->type == GFC_SS_CONSTRUCTOR); gfc_conv_tmp_array_ref (se); } @@ -4821,13 +4824,17 @@ gfc_conv_substring_expr (gfc_se * se, gfc_expr * expr) void gfc_conv_expr (gfc_se * se, gfc_expr * expr) { - if (se->ss && se->ss->expr == expr - && (se->ss->type == GFC_SS_SCALAR || se->ss->type == GFC_SS_REFERENCE)) + gfc_ss *ss; + + ss = se->ss; + if (ss && ss->expr == expr + && (ss->info->type == GFC_SS_SCALAR + || ss->info->type == GFC_SS_REFERENCE)) { /* Substitute a scalar expression evaluated outside the scalarization loop. */ se->expr = se->ss->data.scalar.expr; - if (se->ss->type == GFC_SS_REFERENCE) + if (ss->info->type == GFC_SS_REFERENCE) se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); se->string_length = se->ss->string_length; gfc_advance_se_ss_chain (se); @@ -4946,10 +4953,12 @@ gfc_conv_expr_type (gfc_se * se, gfc_expr * expr, tree type) void gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr) { + gfc_ss *ss; tree var; - if (se->ss && se->ss->expr == expr - && se->ss->type == GFC_SS_REFERENCE) + ss = se->ss; + if (ss && ss->expr == expr + && ss->info->type == GFC_SS_REFERENCE) { /* Returns a reference to the scalar evaluated outside the loop for this case. */ @@ -6154,7 +6163,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, /* Find a non-scalar SS from the lhs. */ while (lss_section != gfc_ss_terminator - && lss_section->type != GFC_SS_SECTION) + && lss_section->info->type != GFC_SS_SECTION) lss_section = lss_section->next; gcc_assert (lss_section != gfc_ss_terminator); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 3f8d51451fb..dff16dc7af3 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -6753,8 +6753,8 @@ walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr) for (tmp_ss = arg_ss; ; tmp_ss = tmp_ss->next) { - if (tmp_ss->type != GFC_SS_SCALAR - && tmp_ss->type != GFC_SS_REFERENCE) + if (tmp_ss->info->type != GFC_SS_SCALAR + && tmp_ss->info->type != GFC_SS_REFERENCE) { int tmp_dim; diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index c66d6b54499..c89419a9728 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -4048,7 +4048,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, /* Find a non-scalar SS from the lhs. */ while (lss_section != gfc_ss_terminator - && lss_section->type != GFC_SS_SECTION) + && lss_section->info->type != GFC_SS_SECTION) lss_section = lss_section->next; gcc_assert (lss_section != gfc_ss_terminator); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index daf24995199..13d4c580e9a 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -183,6 +183,15 @@ typedef enum gfc_ss_type; +typedef struct gfc_ss_info +{ + gfc_ss_type type; +} +gfc_ss_info; + +#define gfc_get_ss_info() XCNEW (gfc_ss_info) + + /* Scalarization State chain. Created by walking an expression tree before creating the scalarization loops. Then passed as part of a gfc_se structure to translate the expression inside the loop. Note that these chains are @@ -193,7 +202,8 @@ gfc_ss_type; typedef struct gfc_ss { - gfc_ss_type type; + gfc_ss_info *info; + gfc_expr *expr; tree string_length; union -- cgit v1.2.1 From bfa437805588fe031de39fef8eed00cc0a244a41 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:01:46 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move field expr from the former struct to the latter. * trans-array.c (gfc_get_array_ss, gfc_get_scalar_ss, gfc_trans_constant_array_constructor, gfc_trans_array_constructor, gfc_add_loop_ss_code, gfc_conv_ss_descriptor, gfc_trans_array_bound_check, gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref, gfc_conv_ss_startstride, gfc_could_be_alias, gfc_conv_resolve_dependencies, gfc_conv_loop_setup, gfc_conv_expr_descriptor, gfc_alloc_allocatable_for_assignment): Update references to expr and factor common reference chains where possible. * trans-const.c (gfc_conv_constant): Ditto. * trans-expr.c (gfc_conv_variable, gfc_conv_procedure_call, gfc_conv_array_constructor_expr, gfc_conv_expr, gfc_conv_expr_reference): Ditto. * trans-intrinsic.c (trans_this_image, gfc_conv_intrinsic_bound, gfc_conv_intrinsic_cobound, gfc_conv_intrinsic_funcall, gfc_add_intrinsic_ss_code): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180868 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 23 +++++ gcc/fortran/trans-array.c | 203 +++++++++++++++++++++++++----------------- gcc/fortran/trans-const.c | 7 +- gcc/fortran/trans-expr.c | 22 ++--- gcc/fortran/trans-intrinsic.c | 10 +-- gcc/fortran/trans-stmt.c | 2 +- gcc/fortran/trans.h | 2 +- 7 files changed, 167 insertions(+), 102 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 958cc7a22d3..c16bc6d690d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,26 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss, struct gfc_ss_info): Move field expr from + the former struct to the latter. + * trans-array.c + (gfc_get_array_ss, gfc_get_scalar_ss, + gfc_trans_constant_array_constructor, gfc_trans_array_constructor, + gfc_add_loop_ss_code, gfc_conv_ss_descriptor, + gfc_trans_array_bound_check, gfc_conv_array_index_offset, + gfc_conv_scalarized_array_ref, gfc_conv_ss_startstride, + gfc_could_be_alias, gfc_conv_resolve_dependencies, + gfc_conv_loop_setup, gfc_conv_expr_descriptor, + gfc_alloc_allocatable_for_assignment): Update references to expr and + factor common reference chains where possible. + * trans-const.c (gfc_conv_constant): Ditto. + * trans-expr.c (gfc_conv_variable, gfc_conv_procedure_call, + gfc_conv_array_constructor_expr, gfc_conv_expr, + gfc_conv_expr_reference): Ditto. + * trans-intrinsic.c (trans_this_image, gfc_conv_intrinsic_bound, + gfc_conv_intrinsic_cobound, gfc_conv_intrinsic_funcall, + gfc_add_intrinsic_ss_code): Ditto. + * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss_info): New struct. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 80dadf4c4db..65f7aded2d6 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -533,11 +533,11 @@ gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) ss_info = gfc_get_ss_info (); ss_info->type = type; + ss_info->expr = expr; ss = gfc_get_ss (); ss->info = ss_info; ss->next = next; - ss->expr = expr; ss->dimen = dimen; for (i = 0; i < ss->dimen; i++) ss->dim[i] = i; @@ -581,11 +581,11 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr) ss_info = gfc_get_ss_info (); ss_info->type = GFC_SS_SCALAR; + ss_info->expr = expr; ss = gfc_get_ss (); ss->info = ss_info; ss->next = next; - ss->expr = expr; return ss; } @@ -1882,7 +1882,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type) tree tmp; int i; - tmp = gfc_build_constant_array_constructor (ss->expr, type); + tmp = gfc_build_constant_array_constructor (ss->info->expr, type); info = &ss->data.info; @@ -1953,19 +1953,22 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) bool dynamic; bool old_first_len, old_typespec_chararray_ctor; tree old_first_len_val; + gfc_expr *expr; /* Save the old values for nested checking. */ old_first_len = first_len; old_first_len_val = first_len_val; old_typespec_chararray_ctor = typespec_chararray_ctor; + expr = ss->info->expr; + /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no typespec was given for the array constructor. */ - typespec_chararray_ctor = (ss->expr->ts.u.cl - && ss->expr->ts.u.cl->length_from_typespec); + typespec_chararray_ctor = (expr->ts.u.cl + && expr->ts.u.cl->length_from_typespec); if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) - && ss->expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor) + && expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor) { first_len_val = gfc_create_var (gfc_charlen_type_node, "len"); first_len = true; @@ -1973,22 +1976,22 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) gcc_assert (ss->dimen == loop->dimen); - c = ss->expr->value.constructor; - if (ss->expr->ts.type == BT_CHARACTER) + c = expr->value.constructor; + if (expr->ts.type == BT_CHARACTER) { bool const_string; /* get_array_ctor_strlen walks the elements of the constructor, if a typespec was given, we already know the string length and want the one specified there. */ - if (typespec_chararray_ctor && ss->expr->ts.u.cl->length - && ss->expr->ts.u.cl->length->expr_type != EXPR_CONSTANT) + if (typespec_chararray_ctor && expr->ts.u.cl->length + && expr->ts.u.cl->length->expr_type != EXPR_CONSTANT) { gfc_se length_se; const_string = false; gfc_init_se (&length_se, NULL); - gfc_conv_expr_type (&length_se, ss->expr->ts.u.cl->length, + gfc_conv_expr_type (&length_se, expr->ts.u.cl->length, gfc_charlen_type_node); ss->string_length = length_se.expr; gfc_add_block_to_block (&loop->pre, &length_se.pre); @@ -2002,26 +2005,26 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) and not end up here. */ gcc_assert (ss->string_length); - ss->expr->ts.u.cl->backend_decl = ss->string_length; + expr->ts.u.cl->backend_decl = ss->string_length; - type = gfc_get_character_type_len (ss->expr->ts.kind, ss->string_length); + type = gfc_get_character_type_len (expr->ts.kind, ss->string_length); if (const_string) type = build_pointer_type (type); } else - type = gfc_typenode_for_spec (&ss->expr->ts); + type = gfc_typenode_for_spec (&expr->ts); /* See if the constructor determines the loop bounds. */ dynamic = false; - if (ss->expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE) + if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE) { /* We have a multidimensional parameter. */ int n; - for (n = 0; n < ss->expr->rank; n++) + for (n = 0; n < expr->rank; n++) { loop->from[n] = gfc_index_zero_node; - loop->to[n] = gfc_conv_mpz_to_tree (ss->expr->shape [n], + loop->to[n] = gfc_conv_mpz_to_tree (expr->shape [n], gfc_index_integer_kind); loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, @@ -2166,6 +2169,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, locus * where) { gfc_se se; + gfc_ss_info *ss_info; + gfc_expr *expr; int n; /* TODO: This can generate bad code if there are ordering dependencies, @@ -2176,16 +2181,19 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, { gcc_assert (ss); - switch (ss->info->type) + ss_info = ss->info; + expr = ss_info->expr; + + switch (ss_info->type) { case GFC_SS_SCALAR: /* Scalar expression. Evaluate this now. This includes elemental dimension indices, but not array section bounds. */ gfc_init_se (&se, NULL); - gfc_conv_expr (&se, ss->expr); + gfc_conv_expr (&se, expr); gfc_add_block_to_block (&loop->pre, &se.pre); - if (ss->expr->ts.type != BT_CHARACTER) + if (expr->ts.type != BT_CHARACTER) { /* Move the evaluation of scalar expressions outside the scalarization loop, except for WHERE assignments. */ @@ -2206,7 +2214,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, /* Scalar argument to elemental procedure. Evaluate this now. */ gfc_init_se (&se, NULL); - gfc_conv_expr (&se, ss->expr); + gfc_conv_expr (&se, expr); gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); @@ -2227,7 +2235,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, case GFC_SS_VECTOR: /* Get the vector's descriptor and store it in SS. */ gfc_init_se (&se, NULL); - gfc_conv_expr_descriptor (&se, ss->expr, gfc_walk_expr (ss->expr)); + gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr)); gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); ss->data.info.descriptor = se.expr; @@ -2243,20 +2251,20 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_init_se (&se, NULL); se.loop = loop; se.ss = ss; - gfc_conv_expr (&se, ss->expr); + gfc_conv_expr (&se, expr); gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); ss->string_length = se.string_length; break; case GFC_SS_CONSTRUCTOR: - if (ss->expr->ts.type == BT_CHARACTER - && ss->string_length == NULL - && ss->expr->ts.u.cl - && ss->expr->ts.u.cl->length) + if (expr->ts.type == BT_CHARACTER + && ss->string_length == NULL + && expr->ts.u.cl + && expr->ts.u.cl->length) { gfc_init_se (&se, NULL); - gfc_conv_expr_type (&se, ss->expr->ts.u.cl->length, + gfc_conv_expr_type (&se, expr->ts.u.cl->length, gfc_charlen_type_node); ss->string_length = se.expr; gfc_add_block_to_block (&loop->pre, &se.pre); @@ -2284,13 +2292,16 @@ static void gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) { gfc_se se; + gfc_ss_info *ss_info; tree tmp; + ss_info = ss->info; + /* Get the descriptor for the array to be scalarized. */ - gcc_assert (ss->expr->expr_type == EXPR_VARIABLE); + gcc_assert (ss_info->expr->expr_type == EXPR_VARIABLE); gfc_init_se (&se, NULL); se.descriptor_only = 1; - gfc_conv_expr_lhs (&se, ss->expr); + gfc_conv_expr_lhs (&se, ss_info->expr); gfc_add_block_to_block (block, &se.pre); ss->data.info.descriptor = se.expr; ss->string_length = se.string_length; @@ -2473,7 +2484,7 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n, index = gfc_evaluate_now (index, &se->pre); /* We find a name for the error message. */ - name = ss->expr->symtree->n.sym->name; + name = ss->info->expr->symtree->n.sym->name; gcc_assert (name != NULL); if (TREE_CODE (descriptor) == VAR_DECL) @@ -2624,10 +2635,10 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, Use the stride returned by the function call and stored in the descriptor for the temporary. */ if (se->ss && se->ss->info->type == GFC_SS_FUNCTION - && se->ss->expr - && se->ss->expr->symtree - && se->ss->expr->symtree->n.sym->result - && se->ss->expr->symtree->n.sym->result->attr.pointer) + && se->ss->info->expr + && se->ss->info->expr->symtree + && se->ss->info->expr->symtree->n.sym->result + && se->ss->info->expr->symtree->n.sym->result->attr.pointer) stride = gfc_conv_descriptor_stride_get (info->descriptor, gfc_rank_cst[dim]); @@ -2655,9 +2666,11 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) tree index; tree tmp; gfc_ss *ss; + gfc_expr *expr; int n; ss = se->ss; + expr = ss->info->expr; info = &ss->data.info; if (ar) n = se->loop->order[0]; @@ -2671,11 +2684,10 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) index = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, index, info->offset); - if (se->ss->expr && is_subref_array (se->ss->expr)) - decl = se->ss->expr->symtree->n.sym->backend_decl; + if (expr && is_subref_array (expr)) + decl = expr->symtree->n.sym->backend_decl; - tmp = build_fold_indirect_ref_loc (input_location, - info->data); + tmp = build_fold_indirect_ref_loc (input_location, info->data); se->expr = gfc_build_array_ref (tmp, index, decl); } @@ -3305,7 +3317,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop) /* As usual, lbound and ubound are exceptions!. */ case GFC_SS_INTRINSIC: - switch (ss->expr->value.function.isym->id) + switch (ss->info->expr->value.function.isym->id) { case GFC_ISYM_LBOUND: case GFC_ISYM_UBOUND: @@ -3332,14 +3344,18 @@ done: /* Loop over all the SS in the chain. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { + gfc_ss_info *ss_info; gfc_array_info *info; + gfc_expr *expr; + ss_info = ss->info; + expr = ss_info->expr; info = &ss->data.info; - if (ss->expr && ss->expr->shape && !info->shape) - info->shape = ss->expr->shape; + if (expr && expr->shape && !info->shape) + info->shape = expr->shape; - switch (ss->info->type) + switch (ss_info->type) { case GFC_SS_SECTION: /* Get the descriptor for the array. */ @@ -3350,7 +3366,7 @@ done: break; case GFC_SS_INTRINSIC: - switch (ss->expr->value.function.isym->id) + switch (expr->value.function.isym->id) { /* Fall through to supply start and stride. */ case GFC_ISYM_LBOUND: @@ -3401,14 +3417,23 @@ done: for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { stmtblock_t inner; + gfc_ss_info *ss_info; + gfc_expr *expr; + locus *expr_loc; + const char *expr_name; - if (ss->info->type != GFC_SS_SECTION) + ss_info = ss->info; + if (ss_info->type != GFC_SS_SECTION) continue; /* Catch allocatable lhs in f2003. */ if (gfc_option.flag_realloc_lhs && ss->is_alloc_lhs) continue; + expr = ss_info->expr; + expr_loc = &expr->where; + expr_name = expr->symtree->name; + gfc_start_block (&inner); /* TODO: range checking for mapped dimensions. */ @@ -3434,9 +3459,9 @@ done: tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, info->stride[dim], gfc_index_zero_node); asprintf (&msg, "Zero stride is not allowed, for dimension %d " - "of array '%s'", dim + 1, ss->expr->symtree->name); + "of array '%s'", dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp, &inner, - &ss->expr->where, msg); + expr_loc, msg); free (msg); desc = ss->data.info.descriptor; @@ -3493,14 +3518,14 @@ done: non_zerosized, tmp2); asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " "outside of expected range (%%ld:%%ld)", - dim + 1, ss->expr->symtree->name); + dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, info->start[dim]), fold_convert (long_integer_type_node, lbound), fold_convert (long_integer_type_node, ubound)); gfc_trans_runtime_check (true, false, tmp2, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, info->start[dim]), fold_convert (long_integer_type_node, lbound), fold_convert (long_integer_type_node, ubound)); @@ -3515,9 +3540,9 @@ done: boolean_type_node, non_zerosized, tmp); asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " "below lower bound of %%ld", - dim + 1, ss->expr->symtree->name); + dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, info->start[dim]), fold_convert (long_integer_type_node, lbound)); free (msg); @@ -3547,14 +3572,14 @@ done: boolean_type_node, non_zerosized, tmp3); asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " "outside of expected range (%%ld:%%ld)", - dim + 1, ss->expr->symtree->name); + dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp2, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, tmp), fold_convert (long_integer_type_node, ubound), fold_convert (long_integer_type_node, lbound)); gfc_trans_runtime_check (true, false, tmp3, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, tmp), fold_convert (long_integer_type_node, ubound), fold_convert (long_integer_type_node, lbound)); @@ -3564,9 +3589,9 @@ done: { asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' " "below lower bound of %%ld", - dim + 1, ss->expr->symtree->name); + dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp2, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, tmp), fold_convert (long_integer_type_node, lbound)); free (msg); @@ -3593,10 +3618,10 @@ done: boolean_type_node, tmp, size[n]); asprintf (&msg, "Array bound mismatch for dimension %d " "of array '%s' (%%ld/%%ld)", - dim + 1, ss->expr->symtree->name); + dim + 1, expr_name); gfc_trans_runtime_check (true, false, tmp3, &inner, - &ss->expr->where, msg, + expr_loc, msg, fold_convert (long_integer_type_node, tmp), fold_convert (long_integer_type_node, size[n])); @@ -3610,10 +3635,10 @@ done: /* For optional arguments, only check bounds if the argument is present. */ - if (ss->expr->symtree->n.sym->attr.optional - || ss->expr->symtree->n.sym->attr.not_always_present) + if (expr->symtree->n.sym->attr.optional + || expr->symtree->n.sym->attr.not_always_present) tmp = build3_v (COND_EXPR, - gfc_conv_expr_present (ss->expr->symtree->n.sym), + gfc_conv_expr_present (expr->symtree->n.sym), tmp, build_empty_stmt (input_location)); gfc_add_expr_to_block (&block, tmp); @@ -3666,12 +3691,16 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) { gfc_ref *lref; gfc_ref *rref; + gfc_expr *lexpr, *rexpr; gfc_symbol *lsym; gfc_symbol *rsym; bool lsym_pointer, lsym_target, rsym_pointer, rsym_target; - lsym = lss->expr->symtree->n.sym; - rsym = rss->expr->symtree->n.sym; + lexpr = lss->info->expr; + rexpr = rss->info->expr; + + lsym = lexpr->symtree->n.sym; + rsym = rexpr->symtree->n.sym; lsym_pointer = lsym->attr.pointer; lsym_target = lsym->attr.target; @@ -3689,7 +3718,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) /* For derived types we must check all the component types. We can ignore array references as these will have the same base type as the previous component ref. */ - for (lref = lss->expr->ref; lref != lss->data.info.ref; lref = lref->next) + for (lref = lexpr->ref; lref != lss->data.info.ref; lref = lref->next) { if (lref->type != REF_COMPONENT) continue; @@ -3709,7 +3738,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) return 1; } - for (rref = rss->expr->ref; rref != rss->data.info.ref; + for (rref = rexpr->ref; rref != rss->data.info.ref; rref = rref->next) { if (rref->type != REF_COMPONENT) @@ -3744,7 +3773,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) lsym_pointer = lsym->attr.pointer; lsym_target = lsym->attr.target; - for (rref = rss->expr->ref; rref != rss->data.info.ref; rref = rref->next) + for (rref = rexpr->ref; rref != rss->data.info.ref; rref = rref->next) { if (rref->type != REF_COMPONENT) break; @@ -3780,20 +3809,25 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, gfc_ss *ss; gfc_ref *lref; gfc_ref *rref; + gfc_expr *dest_expr; + gfc_expr *ss_expr; int nDepend = 0; int i, j; loop->temp_ss = NULL; + dest_expr = dest->info->expr; for (ss = rss; ss != gfc_ss_terminator; ss = ss->next) { if (ss->info->type != GFC_SS_SECTION) continue; - if (dest->expr->symtree->n.sym != ss->expr->symtree->n.sym) + ss_expr = ss->info->expr; + + if (dest_expr->symtree->n.sym != ss_expr->symtree->n.sym) { if (gfc_could_be_alias (dest, ss) - || gfc_are_equivalenced_arrays (dest->expr, ss->expr)) + || gfc_are_equivalenced_arrays (dest_expr, ss_expr)) { nDepend = 1; break; @@ -3801,8 +3835,8 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, } else { - lref = dest->expr->ref; - rref = ss->expr->ref; + lref = dest_expr->ref; + rref = ss_expr->ref; nDepend = gfc_dep_resolver (lref, rref, &loop->reverse[0]); @@ -3861,7 +3895,7 @@ temporary: if (nDepend == 1) { - tree base_type = gfc_typenode_for_spec (&dest->expr->ts); + tree base_type = gfc_typenode_for_spec (&dest_expr->ts); if (GFC_ARRAY_TYPE_P (base_type) || GFC_DESCRIPTOR_TYPE_P (base_type)) base_type = gfc_get_element_type (base_type); @@ -3949,7 +3983,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) can be determined at compile time. Prefer not to otherwise, since the general case involves realloc, and it's better to avoid that overhead if possible. */ - base = ss->expr->value.constructor; + base = ss->info->expr->value.constructor; dynamic[n] = gfc_get_array_constructor_size (&i, base); if (!dynamic[n] || !loopspec[n]) loopspec[n] = ss; @@ -5739,6 +5773,7 @@ void gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) { gfc_ss_type ss_type; + gfc_ss_info *ss_info; gfc_loopinfo loop; gfc_array_info *info; int need_tmp; @@ -5750,12 +5785,14 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) tree offset; int full; bool subref_array_target = false; - gfc_expr *arg; + gfc_expr *arg, *ss_expr; gcc_assert (ss != NULL); gcc_assert (ss != gfc_ss_terminator); - ss_type = ss->info->type; + ss_info = ss->info; + ss_type = ss_info->type; + ss_expr = ss_info->expr; /* Special case things we know we can pass easily. */ switch (expr->expr_type) @@ -5765,7 +5802,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) Otherwise we need to copy it into a temporary. */ gcc_assert (ss_type == GFC_SS_SECTION); - gcc_assert (ss->expr == expr); + gcc_assert (ss_expr == expr); info = &ss->data.info; /* Get the descriptor for the array. */ @@ -5843,7 +5880,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) if (se->direct_byref) { - gcc_assert (ss_type == GFC_SS_FUNCTION && ss->expr == expr); + gcc_assert (ss_type == GFC_SS_FUNCTION && ss_expr == expr); /* For pointer assignments pass the descriptor directly. */ if (se->ss == NULL) @@ -5855,9 +5892,9 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) return; } - if (ss->expr != expr || ss_type != GFC_SS_FUNCTION) + if (ss_expr != expr || ss_type != GFC_SS_FUNCTION) { - if (ss->expr != expr) + if (ss_expr != expr) /* Elemental function. */ gcc_assert ((expr->value.function.esym != NULL && expr->value.function.esym->attr.elemental) @@ -7211,11 +7248,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Find the ss for the lhs. */ lss = loop->ss; for (; lss && lss != gfc_ss_terminator; lss = lss->loop_chain) - if (lss->expr && lss->expr->expr_type == EXPR_VARIABLE) + if (lss->info->expr && lss->info->expr->expr_type == EXPR_VARIABLE) break; if (lss == gfc_ss_terminator) return NULL_TREE; - expr1 = lss->expr; + expr1 = lss->info->expr; } /* Bail out if this is not a valid allocate on assignment. */ @@ -7226,7 +7263,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Find the ss for the lhs. */ lss = loop->ss; for (; lss && lss != gfc_ss_terminator; lss = lss->loop_chain) - if (lss->expr == expr1) + if (lss->info->expr == expr1) break; if (lss == gfc_ss_terminator) @@ -7236,7 +7273,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, ss's for the operands. Any one of these will do. */ rss = loop->ss; for (; rss && rss != gfc_ss_terminator; rss = rss->loop_chain) - if (rss->expr != expr1 && rss != loop->temp_ss) + if (rss->info->expr != expr1 && rss != loop->temp_ss) break; if (expr2 && rss == gfc_ss_terminator) diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 84a83391097..0cf27190d95 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -385,9 +385,12 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr) ss = se->ss; if (ss != NULL) { + gfc_ss_info *ss_info; + + ss_info = ss->info; gcc_assert (ss != gfc_ss_terminator); - gcc_assert (ss->info->type == GFC_SS_SCALAR); - gcc_assert (se->ss->expr == expr); + gcc_assert (ss_info->type == GFC_SS_SCALAR); + gcc_assert (ss_info->expr == expr); se->expr = se->ss->data.scalar.expr; se->string_length = se->ss->string_length; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 5a946154818..2e620adc787 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -613,6 +613,7 @@ conv_parent_component_references (gfc_se * se, gfc_ref * ref) static void gfc_conv_variable (gfc_se * se, gfc_expr * expr) { + gfc_ss *ss; gfc_ref *ref; gfc_symbol *sym; tree parent_decl = NULL_TREE; @@ -622,11 +623,12 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) bool entry_master; sym = expr->symtree->n.sym; - if (se->ss != NULL) + ss = se->ss; + if (ss != NULL) { /* Check that something hasn't gone horribly wrong. */ - gcc_assert (se->ss != gfc_ss_terminator); - gcc_assert (se->ss->expr == expr); + gcc_assert (ss != gfc_ss_terminator); + gcc_assert (ss->info->expr == expr); /* A scalarized term. We already know the descriptor. */ se->expr = se->ss->data.info.descriptor; @@ -3604,8 +3606,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, callee_alloc = comp->attr.allocatable || comp->attr.pointer; gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss, tmp, NULL_TREE, false, - !comp->attr.pointer, - callee_alloc, &se->ss->expr->where); + !comp->attr.pointer, callee_alloc, + &se->ss->info->expr->where); /* Pass the temporary as the first argument. */ result = info->descriptor; @@ -3640,8 +3642,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, callee_alloc = sym->attr.allocatable || sym->attr.pointer; gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss, tmp, NULL_TREE, false, - !sym->attr.pointer, - callee_alloc, &se->ss->expr->where); + !sym->attr.pointer, callee_alloc, + &se->ss->info->expr->where); /* Pass the temporary as the first argument. */ result = info->descriptor; @@ -4243,7 +4245,7 @@ gfc_conv_array_constructor_expr (gfc_se * se, gfc_expr * expr) ss = se->ss; gcc_assert (ss != NULL && ss != gfc_ss_terminator); - gcc_assert (ss->expr == expr && ss->info->type == GFC_SS_CONSTRUCTOR); + gcc_assert (ss->info->expr == expr && ss->info->type == GFC_SS_CONSTRUCTOR); gfc_conv_tmp_array_ref (se); } @@ -4827,7 +4829,7 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr) gfc_ss *ss; ss = se->ss; - if (ss && ss->expr == expr + if (ss && ss->info->expr == expr && (ss->info->type == GFC_SS_SCALAR || ss->info->type == GFC_SS_REFERENCE)) { @@ -4957,7 +4959,7 @@ gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr) tree var; ss = se->ss; - if (ss && ss->expr == expr + if (ss && ss->info->expr == expr && ss->info->type == GFC_SS_REFERENCE) { /* Returns a reference to the scalar evaluated outside the loop diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index dff16dc7af3..ef9360b2fba 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -1004,7 +1004,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr) gcc_assert (!expr->value.function.actual->next->expr); gcc_assert (corank > 0); gcc_assert (se->loop->dimen == 1); - gcc_assert (se->ss->expr == expr); + gcc_assert (se->ss->info->expr == expr); dim_arg = se->loop->loopvar[0]; dim_arg = fold_build2_loc (input_location, PLUS_EXPR, @@ -1321,7 +1321,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper) /* Create an implicit second parameter from the loop variable. */ gcc_assert (!arg2->expr); gcc_assert (se->loop->dimen == 1); - gcc_assert (se->ss->expr == expr); + gcc_assert (se->ss->info->expr == expr); gfc_advance_se_ss_chain (se); bound = se->loop->loopvar[0]; bound = fold_build2_loc (input_location, MINUS_EXPR, @@ -1515,7 +1515,7 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr) gcc_assert (!arg2->expr); gcc_assert (corank > 0); gcc_assert (se->loop->dimen == 1); - gcc_assert (se->ss->expr == expr); + gcc_assert (se->ss->info->expr == expr); bound = se->loop->loopvar[0]; bound = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, @@ -2323,7 +2323,7 @@ gfc_conv_intrinsic_funcall (gfc_se * se, gfc_expr * expr) gfc_symbol *sym; VEC(tree,gc) *append_args; - gcc_assert (!se->ss || se->ss->expr == expr); + gcc_assert (!se->ss || se->ss->info->expr == expr); if (se->ss) gcc_assert (expr->rank > 0); @@ -6800,7 +6800,7 @@ walk_inline_intrinsic_function (gfc_ss * ss, gfc_expr * expr) void gfc_add_intrinsic_ss_code (gfc_loopinfo * loop ATTRIBUTE_UNUSED, gfc_ss * ss) { - switch (ss->expr->value.function.isym->id) + switch (ss->info->expr->value.function.isym->id) { case GFC_ISYM_UBOUND: case GFC_ISYM_LBOUND: diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index c89419a9728..936a4ee64f2 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -220,7 +220,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, info = NULL; for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next) { - if (ss->expr != e) + if (ss->info->expr != e) continue; info = &ss->data.info; break; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 13d4c580e9a..592236016e6 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -186,6 +186,7 @@ gfc_ss_type; typedef struct gfc_ss_info { gfc_ss_type type; + gfc_expr *expr; } gfc_ss_info; @@ -204,7 +205,6 @@ typedef struct gfc_ss { gfc_ss_info *info; - gfc_expr *expr; tree string_length; union { -- cgit v1.2.1 From 3d653dea0f9e13fd2484d3ee3135800c2c93a0eb Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:04:50 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move field string_length from the former struct to the latter. * trans-array.c (gfc_get_temp_ss, gfc_trans_array_constructor, gfc_add_loop_ss_code, gfc_conv_ss_descriptor, gfc_conv_scalarized_array_ref, gfc_conv_resolve_dependencies, gfc_conv_loop_setup, gfc_conv_expr_descriptor): Update references to string_length and factor common reference chains where possible. * trans-const.c (gfc_conv_constant): Ditto. * trans-expr.c (gfc_conv_variable, gfc_conv_subref_array_arg, gfc_conv_expr): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180869 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 14 ++++++++++++++ gcc/fortran/trans-array.c | 40 +++++++++++++++++++++------------------- gcc/fortran/trans-const.c | 2 +- gcc/fortran/trans-expr.c | 15 ++++++++++----- gcc/fortran/trans.h | 2 +- 5 files changed, 47 insertions(+), 26 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c16bc6d690d..3f1339f36e2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss, struct gfc_ss_info): Move field + string_length from the former struct to the latter. + * trans-array.c + (gfc_get_temp_ss, gfc_trans_array_constructor, gfc_add_loop_ss_code, + gfc_conv_ss_descriptor, gfc_conv_scalarized_array_ref, + gfc_conv_resolve_dependencies, gfc_conv_loop_setup, + gfc_conv_expr_descriptor): Update references to string_length and + factor common reference chains where possible. + * trans-const.c (gfc_conv_constant): Ditto. + * trans-expr.c (gfc_conv_variable, gfc_conv_subref_array_arg, + gfc_conv_expr): Ditto. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss, struct gfc_ss_info): Move field expr from diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 65f7aded2d6..827d13d3946 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -557,11 +557,11 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen) ss_info = gfc_get_ss_info (); ss_info->type = GFC_SS_TEMP; + ss_info->string_length = string_length; ss = gfc_get_ss (); ss->info = ss_info; ss->next = gfc_ss_terminator; - ss->string_length = string_length; ss->data.temp.type = type; ss->dimen = dimen; for (i = 0; i < ss->dimen; i++) @@ -1953,6 +1953,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) bool dynamic; bool old_first_len, old_typespec_chararray_ctor; tree old_first_len_val; + gfc_ss_info *ss_info; gfc_expr *expr; /* Save the old values for nested checking. */ @@ -1960,7 +1961,8 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) old_first_len_val = first_len_val; old_typespec_chararray_ctor = typespec_chararray_ctor; - expr = ss->info->expr; + ss_info = ss->info; + expr = ss_info->expr; /* Do bounds-checking here and in gfc_trans_array_ctor_element only if no typespec was given for the array constructor. */ @@ -1993,21 +1995,21 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) gfc_init_se (&length_se, NULL); gfc_conv_expr_type (&length_se, expr->ts.u.cl->length, gfc_charlen_type_node); - ss->string_length = length_se.expr; + ss_info->string_length = length_se.expr; gfc_add_block_to_block (&loop->pre, &length_se.pre); gfc_add_block_to_block (&loop->post, &length_se.post); } else const_string = get_array_ctor_strlen (&loop->pre, c, - &ss->string_length); + &ss_info->string_length); /* Complex character array constructors should have been taken care of and not end up here. */ - gcc_assert (ss->string_length); + gcc_assert (ss_info->string_length); - expr->ts.u.cl->backend_decl = ss->string_length; + expr->ts.u.cl->backend_decl = ss_info->string_length; - type = gfc_get_character_type_len (expr->ts.kind, ss->string_length); + type = gfc_get_character_type_len (expr->ts.kind, ss_info->string_length); if (const_string) type = build_pointer_type (type); } @@ -2207,7 +2209,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_add_block_to_block (&loop->post, &se.post); ss->data.scalar.expr = se.expr; - ss->string_length = se.string_length; + ss_info->string_length = se.string_length; break; case GFC_SS_REFERENCE: @@ -2219,7 +2221,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_add_block_to_block (&loop->post, &se.post); ss->data.scalar.expr = gfc_evaluate_now (se.expr, &loop->pre); - ss->string_length = se.string_length; + ss_info->string_length = se.string_length; break; case GFC_SS_SECTION: @@ -2254,19 +2256,19 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_conv_expr (&se, expr); gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); - ss->string_length = se.string_length; + ss_info->string_length = se.string_length; break; case GFC_SS_CONSTRUCTOR: if (expr->ts.type == BT_CHARACTER - && ss->string_length == NULL + && ss_info->string_length == NULL && expr->ts.u.cl && expr->ts.u.cl->length) { gfc_init_se (&se, NULL); gfc_conv_expr_type (&se, expr->ts.u.cl->length, gfc_charlen_type_node); - ss->string_length = se.expr; + ss_info->string_length = se.expr; gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); } @@ -2304,7 +2306,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) gfc_conv_expr_lhs (&se, ss_info->expr); gfc_add_block_to_block (block, &se.pre); ss->data.info.descriptor = se.expr; - ss->string_length = se.string_length; + ss_info->string_length = se.string_length; if (base) { @@ -2697,7 +2699,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) void gfc_conv_tmp_array_ref (gfc_se * se) { - se->string_length = se->ss->string_length; + se->string_length = se->ss->info->string_length; gfc_conv_scalarized_array_ref (se, NULL); gfc_advance_se_ss_chain (se); } @@ -3899,7 +3901,7 @@ temporary: if (GFC_ARRAY_TYPE_P (base_type) || GFC_DESCRIPTOR_TYPE_P (base_type)) base_type = gfc_get_element_type (base_type); - loop->temp_ss = gfc_get_temp_ss (base_type, dest->string_length, + loop->temp_ss = gfc_get_temp_ss (base_type, dest->info->string_length, loop->dimen); gfc_add_ss_to_loop (loop, loop->temp_ss); } @@ -4124,11 +4126,11 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) gcc_assert (tmp_ss_info->type == GFC_SS_TEMP); /* Make absolutely sure that this is a complete type. */ - if (loop->temp_ss->string_length) + if (tmp_ss_info->string_length) loop->temp_ss->data.temp.type = gfc_get_character_type_len_for_eltype (TREE_TYPE (loop->temp_ss->data.temp.type), - loop->temp_ss->string_length); + tmp_ss_info->string_length); tmp = loop->temp_ss->data.temp.type; memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); @@ -5973,7 +5975,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) : NULL), loop.dimen); - se->string_length = loop.temp_ss->string_length; + se->string_length = loop.temp_ss->info->string_length; gcc_assert (loop.temp_ss->dimen == loop.dimen); gfc_add_ss_to_loop (&loop, loop.temp_ss); } @@ -6030,7 +6032,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) else if (expr->expr_type == EXPR_FUNCTION && !transposed_dims (ss)) { desc = info->descriptor; - se->string_length = ss->string_length; + se->string_length = ss_info->string_length; } else { diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 0cf27190d95..35a5e687d53 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -393,7 +393,7 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr) gcc_assert (ss_info->expr == expr); se->expr = se->ss->data.scalar.expr; - se->string_length = se->ss->string_length; + se->string_length = ss_info->string_length; gfc_advance_se_ss_chain (se); return; } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 2e620adc787..87734f17984 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -626,13 +626,15 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) ss = se->ss; if (ss != NULL) { + gfc_ss_info *ss_info = ss->info; + /* Check that something hasn't gone horribly wrong. */ gcc_assert (ss != gfc_ss_terminator); - gcc_assert (ss->info->expr == expr); + gcc_assert (ss_info->expr == expr); /* A scalarized term. We already know the descriptor. */ se->expr = se->ss->data.info.descriptor; - se->string_length = se->ss->string_length; + se->string_length = ss_info->string_length; for (ref = se->ss->data.info.ref; ref; ref = ref->next) if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) break; @@ -2402,7 +2404,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, : NULL), loop.dimen); - parmse->string_length = loop.temp_ss->string_length; + parmse->string_length = loop.temp_ss->info->string_length; /* Associate the SS with the loop. */ gfc_add_ss_to_loop (&loop, loop.temp_ss); @@ -4833,12 +4835,15 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr) && (ss->info->type == GFC_SS_SCALAR || ss->info->type == GFC_SS_REFERENCE)) { + gfc_ss_info *ss_info; + + ss_info = ss->info; /* Substitute a scalar expression evaluated outside the scalarization loop. */ se->expr = se->ss->data.scalar.expr; - if (ss->info->type == GFC_SS_REFERENCE) + if (ss_info->type == GFC_SS_REFERENCE) se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); - se->string_length = se->ss->string_length; + se->string_length = ss_info->string_length; gfc_advance_se_ss_chain (se); return; } diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 592236016e6..f1b109a80e8 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -187,6 +187,7 @@ typedef struct gfc_ss_info { gfc_ss_type type; gfc_expr *expr; + tree string_length; } gfc_ss_info; @@ -205,7 +206,6 @@ typedef struct gfc_ss { gfc_ss_info *info; - tree string_length; union { /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */ -- cgit v1.2.1 From aaaf75f7383104e9da85f377bf647e21f79049dd Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:10:25 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move member struct gfc_ss::data::scalar into newly created union gfc_ss_info::data, and rename subfield expr to value. * trans-array.c (gfc_add_loop_ss_code, gfc_conv_array_index_offset, gfc_conv_expr_descriptor): Update reference chains. * trans-const.c (gfc_conv_constant): Ditto. * trans-expr.c (gfc_conv_expr): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180870 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 ++++++++++ gcc/fortran/trans-array.c | 8 ++++---- gcc/fortran/trans-const.c | 2 +- gcc/fortran/trans-expr.c | 2 +- gcc/fortran/trans.h | 18 +++++++++++------- 5 files changed, 27 insertions(+), 13 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3f1339f36e2..f10419a6b62 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss, struct gfc_ss_info): Move member struct + gfc_ss::data::scalar into newly created union gfc_ss_info::data, + and rename subfield expr to value. + * trans-array.c (gfc_add_loop_ss_code, gfc_conv_array_index_offset, + gfc_conv_expr_descriptor): Update reference chains. + * trans-const.c (gfc_conv_constant): Ditto. + * trans-expr.c (gfc_conv_expr): Ditto. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss, struct gfc_ss_info): Move field diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 827d13d3946..eef0f097f2a 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2208,7 +2208,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, else gfc_add_block_to_block (&loop->post, &se.post); - ss->data.scalar.expr = se.expr; + ss_info->data.scalar.value = se.expr; ss_info->string_length = se.string_length; break; @@ -2220,7 +2220,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); - ss->data.scalar.expr = gfc_evaluate_now (se.expr, &loop->pre); + ss_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre); ss_info->string_length = se.string_length; break; @@ -2571,7 +2571,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, gcc_assert (info->subscript[dim] && info->subscript[dim]->info->type == GFC_SS_SCALAR); /* We've already translated this value outside the loop. */ - index = info->subscript[dim]->data.scalar.expr; + index = info->subscript[dim]->info->data.scalar.value; index = trans_array_bound_check (se, ss, index, dim, &ar->where, ar->as->type != AS_ASSUMED_SIZE @@ -6134,7 +6134,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) { gcc_assert (info->subscript[n] && info->subscript[n]->info->type == GFC_SS_SCALAR); - start = info->subscript[n]->data.scalar.expr; + start = info->subscript[n]->info->data.scalar.value; } else { diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c index 35a5e687d53..fa820ef10de 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.c @@ -392,7 +392,7 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr) gcc_assert (ss_info->type == GFC_SS_SCALAR); gcc_assert (ss_info->expr == expr); - se->expr = se->ss->data.scalar.expr; + se->expr = ss_info->data.scalar.value; se->string_length = ss_info->string_length; gfc_advance_se_ss_chain (se); return; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 87734f17984..55853f19d2b 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -4840,7 +4840,7 @@ gfc_conv_expr (gfc_se * se, gfc_expr * expr) ss_info = ss->info; /* Substitute a scalar expression evaluated outside the scalarization loop. */ - se->expr = se->ss->data.scalar.expr; + se->expr = ss_info->data.scalar.value; if (ss_info->type == GFC_SS_REFERENCE) se->expr = gfc_build_addr_expr (NULL_TREE, se->expr); se->string_length = ss_info->string_length; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index f1b109a80e8..567e5a343f1 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -188,6 +188,17 @@ typedef struct gfc_ss_info gfc_ss_type type; gfc_expr *expr; tree string_length; + + union + { + /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */ + struct + { + tree value; + } + scalar; + } + data; } gfc_ss_info; @@ -208,13 +219,6 @@ typedef struct gfc_ss union { - /* If type is GFC_SS_SCALAR or GFC_SS_REFERENCE. */ - struct - { - tree expr; - } - scalar; - /* GFC_SS_TEMP. */ struct { -- cgit v1.2.1 From 0a9ca5de5663f6e84b301bd4b08f6590de0c8c5d Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:16:29 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move member struct gfc_ss::data::temp into gfc_ss_info::data. * trans-array.c (gfc_get_temp_ss, gfc_conv_loop_setup): Update reference chains. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180872 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/trans-array.c | 8 ++++---- gcc/fortran/trans.h | 13 +++++++------ 3 files changed, 18 insertions(+), 10 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f10419a6b62..c8d5e7fe8db 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss, struct gfc_ss_info): Move member struct + gfc_ss::data::temp into gfc_ss_info::data. + * trans-array.c (gfc_get_temp_ss, gfc_conv_loop_setup): Update reference + chains. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss, struct gfc_ss_info): Move member struct diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index eef0f097f2a..173e52b299e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -558,11 +558,11 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen) ss_info = gfc_get_ss_info (); ss_info->type = GFC_SS_TEMP; ss_info->string_length = string_length; + ss_info->data.temp.type = type; ss = gfc_get_ss (); ss->info = ss_info; ss->next = gfc_ss_terminator; - ss->data.temp.type = type; ss->dimen = dimen; for (i = 0; i < ss->dimen; i++) ss->dim[i] = i; @@ -4127,12 +4127,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) /* Make absolutely sure that this is a complete type. */ if (tmp_ss_info->string_length) - loop->temp_ss->data.temp.type + tmp_ss_info->data.temp.type = gfc_get_character_type_len_for_eltype - (TREE_TYPE (loop->temp_ss->data.temp.type), + (TREE_TYPE (tmp_ss_info->data.temp.type), tmp_ss_info->string_length); - tmp = loop->temp_ss->data.temp.type; + tmp = tmp_ss_info->data.temp.type; memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); tmp_ss_info->type = GFC_SS_SECTION; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 567e5a343f1..60708e937a9 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -197,6 +197,13 @@ typedef struct gfc_ss_info tree value; } scalar; + + /* GFC_SS_TEMP. */ + struct + { + tree type; + } + temp; } data; } @@ -219,12 +226,6 @@ typedef struct gfc_ss union { - /* GFC_SS_TEMP. */ - struct - { - tree type; - } - temp; /* All other types. */ gfc_array_info info; } -- cgit v1.2.1 From b8f3834798a7071af579131273d8beefa4db1bdb Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:21:36 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move field gfc_ss::data::info into gfc_ss_info::data and remove empty union gfc_ss::data. * trans-array.c (gfc_free_ss, gfc_trans_create_temp_array, gfc_trans_constant_array_constructor, gfc_trans_array_constructor, gfc_set_vector_loop_bounds, gfc_add_loop_ss_code, gfc_conv_ss_descriptor, gfc_trans_array_bound_check, gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref, add_array_offset, gfc_trans_preloop_setup, gfc_trans_scalarized_boundary, gfc_conv_section_startstride, gfc_conv_ss_startstride, gfc_could_be_alias, gfc_conv_loop_setup, gfc_conv_expr_descriptor, gfc_alloc_allocatable_for_assignment, gfc_walk_array_ref): Update reference chains and factor them where possible. * trans-expr.c (gfc_conv_variable, gfc_conv_subref_array_arg, gfc_conv_procedure_call, gfc_trans_subarray_assign): Updata reference chains. * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto. * trans-io.c (transfer_array_component): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies, gfc_trans_pointer_assign_need_temp): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180873 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 24 ++++++++ gcc/fortran/trans-array.c | 130 +++++++++++++++++++++++------------------- gcc/fortran/trans-expr.c | 12 ++-- gcc/fortran/trans-intrinsic.c | 2 +- gcc/fortran/trans-io.c | 2 +- gcc/fortran/trans-stmt.c | 4 +- gcc/fortran/trans.h | 10 +--- 7 files changed, 108 insertions(+), 76 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c8d5e7fe8db..2767e32c32a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,27 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss, struct gfc_ss_info): Move field + gfc_ss::data::info into gfc_ss_info::data and remove empty union + gfc_ss::data. + * trans-array.c (gfc_free_ss, gfc_trans_create_temp_array, + gfc_trans_constant_array_constructor, gfc_trans_array_constructor, + gfc_set_vector_loop_bounds, gfc_add_loop_ss_code, + gfc_conv_ss_descriptor, gfc_trans_array_bound_check, + gfc_conv_array_index_offset, gfc_conv_scalarized_array_ref, + add_array_offset, gfc_trans_preloop_setup, + gfc_trans_scalarized_boundary, gfc_conv_section_startstride, + gfc_conv_ss_startstride, gfc_could_be_alias, + gfc_conv_loop_setup, gfc_conv_expr_descriptor, + gfc_alloc_allocatable_for_assignment, gfc_walk_array_ref): + Update reference chains and factor them where possible. + * trans-expr.c (gfc_conv_variable, gfc_conv_subref_array_arg, + gfc_conv_procedure_call, gfc_trans_subarray_assign): Updata reference + chains. + * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto. + * trans-io.c (transfer_array_component): Ditto. + * trans-stmt.c (gfc_conv_elemental_dependencies, + gfc_trans_pointer_assign_need_temp): Ditto. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss, struct gfc_ss_info): Move member struct diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 173e52b299e..78e1443fecf 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -508,8 +508,8 @@ gfc_free_ss (gfc_ss * ss) case GFC_SS_SECTION: for (n = 0; n < ss->dimen; n++) { - if (ss->data.info.subscript[ss->dim[n]]) - gfc_free_ss_chain (ss->data.info.subscript[ss->dim[n]]); + if (ss_info->data.array.subscript[ss->dim[n]]) + gfc_free_ss_chain (ss_info->data.array.subscript[ss->dim[n]]); } break; @@ -880,7 +880,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, memset (from, 0, sizeof (from)); memset (to, 0, sizeof (to)); - info = &ss->data.info; + info = &ss->info->data.array; gcc_assert (ss->dimen > 0); gcc_assert (loop->dimen == ss->dimen); @@ -1884,7 +1884,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type) tmp = gfc_build_constant_array_constructor (ss->info->expr, type); - info = &ss->data.info; + info = &ss->info->data.array; info->descriptor = tmp; info->data = gfc_build_addr_expr (NULL_TREE, tmp); @@ -2073,7 +2073,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss, type, NULL_TREE, dynamic, true, false, where); - desc = ss->data.info.descriptor; + desc = ss_info->data.array.descriptor; offset = gfc_index_zero_node; offsetvar = gfc_create_var_np (gfc_array_index_type, "offset"); TREE_NO_WARNING (offsetvar) = 1; @@ -2133,7 +2133,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) int n; int dim; - info = &ss->data.info; + info = &ss->info->data.array; for (n = 0; n < loop->dimen; n++) { @@ -2149,7 +2149,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) && info->subscript[dim]->info->type == GFC_SS_VECTOR); gfc_init_se (&se, NULL); - desc = info->subscript[dim]->data.info.descriptor; + desc = info->subscript[dim]->info->data.array.descriptor; zero = gfc_rank_cst[0]; tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, @@ -2172,6 +2172,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, { gfc_se se; gfc_ss_info *ss_info; + gfc_array_info *info; gfc_expr *expr; int n; @@ -2185,6 +2186,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, ss_info = ss->info; expr = ss_info->expr; + info = &ss_info->data.array; switch (ss_info->type) { @@ -2227,9 +2229,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, case GFC_SS_SECTION: /* Add the expressions for scalar and vector subscripts. */ for (n = 0; n < GFC_MAX_DIMENSIONS; n++) - if (ss->data.info.subscript[n]) - gfc_add_loop_ss_code (loop, ss->data.info.subscript[n], true, - where); + if (info->subscript[n]) + gfc_add_loop_ss_code (loop, info->subscript[n], true, where); set_vector_loop_bounds (loop, ss); break; @@ -2240,7 +2241,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr)); gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); - ss->data.info.descriptor = se.expr; + info->descriptor = se.expr; break; case GFC_SS_INTRINSIC: @@ -2295,9 +2296,11 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) { gfc_se se; gfc_ss_info *ss_info; + gfc_array_info *info; tree tmp; ss_info = ss->info; + info = &ss_info->data.array; /* Get the descriptor for the array to be scalarized. */ gcc_assert (ss_info->expr->expr_type == EXPR_VARIABLE); @@ -2305,7 +2308,7 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) se.descriptor_only = 1; gfc_conv_expr_lhs (&se, ss_info->expr); gfc_add_block_to_block (block, &se.pre); - ss->data.info.descriptor = se.expr; + info->descriptor = se.expr; ss_info->string_length = se.string_length; if (base) @@ -2320,15 +2323,15 @@ gfc_conv_ss_descriptor (stmtblock_t * block, gfc_ss * ss, int base) || (TREE_CODE (tmp) == ADDR_EXPR && DECL_P (TREE_OPERAND (tmp, 0))))) tmp = gfc_evaluate_now (tmp, block); - ss->data.info.data = tmp; + info->data = tmp; tmp = gfc_conv_array_offset (se.expr); - ss->data.info.offset = gfc_evaluate_now (tmp, block); + info->offset = gfc_evaluate_now (tmp, block); /* Make absolutely sure that the saved_offset is indeed saved so that the variable is still accessible after the loops are translated. */ - ss->data.info.saved_offset = ss->data.info.offset; + info->saved_offset = info->offset; } } @@ -2481,7 +2484,7 @@ trans_array_bound_check (gfc_se * se, gfc_ss *ss, tree index, int n, if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)) return index; - descriptor = ss->data.info.descriptor; + descriptor = ss->info->data.array.descriptor; index = gfc_evaluate_now (index, &se->pre); @@ -2555,7 +2558,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, tree desc; tree data; - info = &ss->data.info; + info = &ss->info->data.array; /* Get the index into the array for this dimension. */ if (ar) @@ -2582,7 +2585,7 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i, gcc_assert (info && se->loop); gcc_assert (info->subscript[dim] && info->subscript[dim]->info->type == GFC_SS_VECTOR); - desc = info->subscript[dim]->data.info.descriptor; + desc = info->subscript[dim]->info->data.array.descriptor; /* Get a zero-based index into the vector. */ index = fold_build2_loc (input_location, MINUS_EXPR, @@ -2673,7 +2676,7 @@ gfc_conv_scalarized_array_ref (gfc_se * se, gfc_array_ref * ar) ss = se->ss; expr = ss->info->expr; - info = &ss->data.info; + info = &ss->info->data.array; if (ar) n = se->loop->order[0]; else @@ -2866,7 +2869,7 @@ add_array_offset (stmtblock_t *pblock, gfc_loopinfo *loop, gfc_ss *ss, gfc_array_info *info; tree stride, index; - info = &ss->data.info; + info = &ss->info->data.array; gfc_init_se (&se, NULL); se.loop = loop; @@ -2890,6 +2893,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, stmtblock_t * pblock) { tree stride; + gfc_ss_info *ss_info; gfc_array_info *info; gfc_ss_type ss_type; gfc_ss *ss; @@ -2900,17 +2904,19 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, for this dimension. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { + ss_info = ss->info; + if ((ss->useflags & flag) == 0) continue; - ss_type = ss->info->type; + ss_type = ss_info->type; if (ss_type != GFC_SS_SECTION && ss_type != GFC_SS_FUNCTION && ss_type != GFC_SS_CONSTRUCTOR && ss_type != GFC_SS_COMPONENT) continue; - info = &ss->data.info; + info = &ss_info->data.array; gcc_assert (dim < ss->dimen); gcc_assert (ss->dimen == loop->dimen); @@ -3175,18 +3181,21 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body) for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { gfc_ss_type ss_type; + gfc_ss_info *ss_info; + + ss_info = ss->info; if ((ss->useflags & 2) == 0) continue; - ss_type = ss->info->type; + ss_type = ss_info->type; if (ss_type != GFC_SS_SECTION && ss_type != GFC_SS_FUNCTION && ss_type != GFC_SS_CONSTRUCTOR && ss_type != GFC_SS_COMPONENT) continue; - ss->data.info.offset = ss->data.info.saved_offset; + ss_info->data.array.offset = ss_info->data.array.saved_offset; } /* Restart all the inner loops we just finished. */ @@ -3253,7 +3262,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int dim) gcc_assert (ss->info->type == GFC_SS_SECTION); - info = &ss->data.info; + info = &ss->info->data.array; ar = &info->ref->u.ar; if (ar->dimen_type[dim] == DIMEN_VECTOR) @@ -3352,7 +3361,7 @@ done: ss_info = ss->info; expr = ss_info->expr; - info = &ss->data.info; + info = &ss_info->data.array; if (expr && expr->shape && !info->shape) info->shape = expr->shape; @@ -3388,9 +3397,9 @@ done: { int dim = ss->dim[n]; - ss->data.info.start[dim] = gfc_index_zero_node; - ss->data.info.end[dim] = gfc_index_zero_node; - ss->data.info.stride[dim] = gfc_index_one_node; + info->start[dim] = gfc_index_zero_node; + info->end[dim] = gfc_index_zero_node; + info->stride[dim] = gfc_index_one_node; } break; @@ -3439,7 +3448,7 @@ done: gfc_start_block (&inner); /* TODO: range checking for mapped dimensions. */ - info = &ss->data.info; + info = &ss_info->data.array; /* This code only checks ranges. Elemental and vector dimensions are checked later. */ @@ -3466,7 +3475,7 @@ done: expr_loc, msg); free (msg); - desc = ss->data.info.descriptor; + desc = info->descriptor; /* This is the run-time equivalent of resolve.c's check_dimension(). The logical is more readable there @@ -3720,7 +3729,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) /* For derived types we must check all the component types. We can ignore array references as these will have the same base type as the previous component ref. */ - for (lref = lexpr->ref; lref != lss->data.info.ref; lref = lref->next) + for (lref = lexpr->ref; lref != lss->info->data.array.ref; lref = lref->next) { if (lref->type != REF_COMPONENT) continue; @@ -3740,7 +3749,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) return 1; } - for (rref = rexpr->ref; rref != rss->data.info.ref; + for (rref = rexpr->ref; rref != rss->info->data.array.ref; rref = rref->next) { if (rref->type != REF_COMPONENT) @@ -3775,7 +3784,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) lsym_pointer = lsym->attr.pointer; lsym_target = lsym->attr.target; - for (rref = rexpr->ref; rref != rss->data.info.ref; rref = rref->next) + for (rref = rexpr->ref; rref != rss->info->data.array.ref; rref = rref->next) { if (rref->type != REF_COMPONENT) break; @@ -3946,12 +3955,12 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) || ss_type == GFC_SS_REFERENCE) continue; - info = &ss->data.info; + info = &ss->info->data.array; dim = ss->dim[n]; if (loopspec[n] != NULL) { - specinfo = &loopspec[n]->data.info; + specinfo = &loopspec[n]->info->data.array; spec_dim = loopspec[n]->dim[n]; } else @@ -4039,7 +4048,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) that's bad news. */ gcc_assert (loopspec[n]); - info = &loopspec[n]->data.info; + info = &loopspec[n]->info->data.array; dim = loopspec[n]->dim[n]; /* Set the extents of this range. */ @@ -4133,7 +4142,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) tmp_ss_info->string_length); tmp = tmp_ss_info->data.temp.type; - memset (&loop->temp_ss->data.info, 0, sizeof (gfc_array_info)); + memset (&tmp_ss_info->data.array, 0, sizeof (gfc_array_info)); tmp_ss_info->type = GFC_SS_SECTION; gcc_assert (tmp_ss->dimen != 0); @@ -4164,7 +4173,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) && ss_type != GFC_SS_CONSTRUCTOR) continue; - info = &ss->data.info; + info = &ss->info->data.array; for (n = 0; n < ss->dimen; n++) { @@ -5805,7 +5814,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) gcc_assert (ss_type == GFC_SS_SECTION); gcc_assert (ss_expr == expr); - info = &ss->data.info; + info = &ss_info->data.array; /* Get the descriptor for the array. */ gfc_conv_ss_descriptor (&se->pre, ss, 0); @@ -5915,7 +5924,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) else { /* Transformational function. */ - info = &ss->data.info; + info = &ss_info->data.array; need_tmp = 0; } break; @@ -5927,7 +5936,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) && gfc_constant_array_constructor_p (expr->value.constructor)) { need_tmp = 0; - info = &ss->data.info; + info = &ss_info->data.array; } else { @@ -6027,7 +6036,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) /* Finish the copying loops. */ gfc_trans_scalarizing_loops (&loop, &block); - desc = loop.temp_ss->data.info.descriptor; + desc = loop.temp_ss->info->data.array.descriptor; } else if (expr->expr_type == EXPR_FUNCTION && !transposed_dims (ss)) { @@ -7220,6 +7229,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, stmtblock_t fblock; gfc_ss *rss; gfc_ss *lss; + gfc_array_info *linfo; tree realloc_expr; tree alloc_expr; tree size1; @@ -7271,6 +7281,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, if (lss == gfc_ss_terminator) return NULL_TREE; + linfo = &lss->info->data.array; + /* Find an ss for the rhs. For operator expressions, we see the ss's for the operands. Any one of these will do. */ rss = loop->ss; @@ -7285,7 +7297,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Since the lhs is allocatable, this must be a descriptor type. Get the data and array size. */ - desc = lss->data.info.descriptor; + desc = linfo->descriptor; gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))); array1 = gfc_conv_descriptor_data_get (desc); @@ -7355,7 +7367,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, /* Get the rhs size. Fix both sizes. */ if (expr2) - desc2 = rss->data.info.descriptor; + desc2 = rss->info->data.array.descriptor; else desc2 = NULL_TREE; size2 = gfc_index_one_node; @@ -7445,9 +7457,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, running offset. Use the saved_offset instead. */ tmp = gfc_conv_descriptor_offset (desc); gfc_add_modify (&fblock, tmp, offset); - if (lss->data.info.saved_offset - && TREE_CODE (lss->data.info.saved_offset) == VAR_DECL) - gfc_add_modify (&fblock, lss->data.info.saved_offset, tmp); + if (linfo->saved_offset + && TREE_CODE (linfo->saved_offset) == VAR_DECL) + gfc_add_modify (&fblock, linfo->saved_offset, tmp); /* Now set the deltas for the lhs. */ for (n = 0; n < expr1->rank; n++) @@ -7457,9 +7469,9 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, tmp, loop->from[dim]); - if (lss->data.info.delta[dim] - && TREE_CODE (lss->data.info.delta[dim]) == VAR_DECL) - gfc_add_modify (&fblock, lss->data.info.delta[dim], tmp); + if (linfo->delta[dim] + && TREE_CODE (linfo->delta[dim]) == VAR_DECL) + gfc_add_modify (&fblock, linfo->delta[dim], tmp); } /* Get the new lhs size in bytes. */ @@ -7523,11 +7535,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop, gfc_add_expr_to_block (&fblock, tmp); /* Make sure that the scalarizer data pointer is updated. */ - if (lss->data.info.data - && TREE_CODE (lss->data.info.data) == VAR_DECL) + if (linfo->data + && TREE_CODE (linfo->data) == VAR_DECL) { tmp = gfc_conv_descriptor_data_get (desc); - gfc_add_modify (&fblock, lss->data.info.data, tmp); + gfc_add_modify (&fblock, linfo->data, tmp); } /* Add the exit label. */ @@ -7717,7 +7729,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) case AR_FULL: newss = gfc_get_array_ss (ss, expr, ar->as->rank, GFC_SS_SECTION); - newss->data.info.ref = ref; + newss->info->data.array.ref = ref; /* Make sure array is the same as array(:,:), this way we don't need to special case all the time. */ @@ -7735,7 +7747,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) case AR_SECTION: newss = gfc_get_array_ss (ss, expr, 0, GFC_SS_SECTION); - newss->data.info.ref = ref; + newss->info->data.array.ref = ref; /* We add SS chains for all the subscripts in the section. */ for (n = 0; n < ar->dimen; n++) @@ -7749,7 +7761,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) gcc_assert (ar->start[n]); indexss = gfc_get_scalar_ss (gfc_ss_terminator, ar->start[n]); indexss->loop_chain = gfc_ss_terminator; - newss->data.info.subscript[n] = indexss; + newss->info->data.array.subscript[n] = indexss; break; case DIMEN_RANGE: @@ -7765,7 +7777,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) indexss = gfc_get_array_ss (gfc_ss_terminator, ar->start[n], 1, GFC_SS_VECTOR); indexss->loop_chain = gfc_ss_terminator; - newss->data.info.subscript[n] = indexss; + newss->info->data.array.subscript[n] = indexss; newss->dim[newss->dimen] = n; newss->dimen++; break; @@ -7778,7 +7790,7 @@ gfc_walk_array_ref (gfc_ss * ss, gfc_expr * expr, gfc_ref * ref) /* We should have at least one non-elemental dimension, unless we are creating a descriptor for a (scalar) coarray. */ gcc_assert (newss->dimen > 0 - || newss->data.info.ref->u.ar.as->corank > 0); + || newss->info->data.array.ref->u.ar.as->corank > 0); ss = newss; break; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 55853f19d2b..b175b62c49f 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -633,9 +633,9 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr) gcc_assert (ss_info->expr == expr); /* A scalarized term. We already know the descriptor. */ - se->expr = se->ss->data.info.descriptor; + se->expr = ss_info->data.array.descriptor; se->string_length = ss_info->string_length; - for (ref = se->ss->data.info.ref; ref; ref = ref->next) + for (ref = ss_info->data.array.ref; ref; ref = ref->next) if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT) break; } @@ -2413,7 +2413,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, gfc_conv_loop_setup (&loop, &expr->where); /* Pass the temporary descriptor back to the caller. */ - info = &loop.temp_ss->data.info; + info = &loop.temp_ss->info->data.array; parmse->expr = info->descriptor; /* Setup the gfc_se structures. */ @@ -2492,7 +2492,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr, int g77, dimensions, so this is very simple. The offset is only computed outside the innermost loop, so the overall transfer could be optimized further. */ - info = &rse.ss->data.info; + info = &rse.ss->info->data.array; dimen = rse.ss->dimen; tmp_index = gfc_index_zero_node; @@ -2910,7 +2910,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, return 0; } } - info = &se->ss->data.info; + info = &se->ss->info->data.array; } else info = NULL; @@ -4375,7 +4375,7 @@ gfc_trans_subarray_assign (tree dest, gfc_component * cm, gfc_expr * expr) /* Create a SS for the destination. */ lss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank, GFC_SS_COMPONENT); - lss_array = &lss->data.info; + lss_array = &lss->info->data.array; lss_array->shape = gfc_get_shape (cm->as->rank); lss_array->descriptor = dest; lss_array->data = gfc_conv_array_data (dest); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index ef9360b2fba..a3b73832c35 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -5276,7 +5276,7 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) info = NULL; if (se->loop) - info = &se->ss->data.info; + info = &se->ss->info->data.array; /* Convert SOURCE. The output from this stage is:- source_bytes = length of the source in bytes diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index a97691eea0c..12dfcf82333 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1949,7 +1949,7 @@ transfer_array_component (tree expr, gfc_component * cm, locus * where) ss = gfc_get_array_ss (gfc_ss_terminator, NULL, cm->as->rank, GFC_SS_COMPONENT); - ss_array = &ss->data.info; + ss_array = &ss->info->data.array; ss_array->shape = gfc_get_shape (cm->as->rank); ss_array->descriptor = expr; ss_array->data = gfc_conv_array_data (expr); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 936a4ee64f2..101a6513ed9 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -222,7 +222,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, { if (ss->info->expr != e) continue; - info = &ss->data.info; + info = &ss->info->data.array; break; } @@ -3388,7 +3388,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, gfc_conv_loop_setup (&loop, &expr2->where); - info = &rss->data.info; + info = &rss->info->data.array; desc = info->descriptor; /* Make a new descriptor. */ diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 60708e937a9..e74da4139ad 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -204,6 +204,9 @@ typedef struct gfc_ss_info tree type; } temp; + + /* All other types. */ + gfc_array_info array; } data; } @@ -224,13 +227,6 @@ typedef struct gfc_ss { gfc_ss_info *info; - union - { - /* All other types. */ - gfc_array_info info; - } - data; - int dimen; /* Translation from loop dimensions to actual array dimensions. actual_dim = dim[loop_dim] */ -- cgit v1.2.1 From 1b3fff24b46c1fbc5686b62512a1bc496524cf15 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:24:37 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move field gfc_ss::useflags into gfc_ss_info. * trans-array.c (gfc_mark_ss_chain_used, gfc_trans_preloop_setup, gfc_trans_scalarizing_loops, gfc_trans_scalarized_boundary): Update reference chains. * trans-expr.c (gfc_conv_procedure_call): Ditto. * trans-intrinsic.c (gfc_conv_intrinsic_function): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180875 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 ++++++++++ gcc/fortran/trans-array.c | 8 ++++---- gcc/fortran/trans-expr.c | 4 ++-- gcc/fortran/trans-intrinsic.c | 2 +- gcc/fortran/trans.h | 13 ++++++++----- 5 files changed, 25 insertions(+), 12 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2767e32c32a..baa20a9de82 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss, struct gfc_ss_info): Move field + gfc_ss::useflags into gfc_ss_info. + * trans-array.c (gfc_mark_ss_chain_used, gfc_trans_preloop_setup, + gfc_trans_scalarizing_loops, gfc_trans_scalarized_boundary): + Update reference chains. + * trans-expr.c (gfc_conv_procedure_call): Ditto. + * trans-intrinsic.c (gfc_conv_intrinsic_function): Ditto. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss, struct gfc_ss_info): Move field diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 78e1443fecf..427bb7b53d1 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -463,7 +463,7 @@ void gfc_mark_ss_chain_used (gfc_ss * ss, unsigned flags) { for (; ss != gfc_ss_terminator; ss = ss->next) - ss->useflags = flags; + ss->info->useflags = flags; } static void gfc_free_ss (gfc_ss *); @@ -2906,7 +2906,7 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, { ss_info = ss->info; - if ((ss->useflags & flag) == 0) + if ((ss_info->useflags & flag) == 0) continue; ss_type = ss_info->type; @@ -3148,7 +3148,7 @@ gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body) /* Clear all the used flags. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) - ss->useflags = 0; + ss->info->useflags = 0; } @@ -3185,7 +3185,7 @@ gfc_trans_scalarized_loop_boundary (gfc_loopinfo * loop, stmtblock_t * body) ss_info = ss->info; - if ((ss->useflags & 2) == 0) + if ((ss_info->useflags & 2) == 0) continue; ss_type = ss_info->type; diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b175b62c49f..01d4ca3885f 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2898,7 +2898,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (!sym->attr.elemental) { gcc_assert (se->ss->info->type == GFC_SS_FUNCTION); - if (se->ss->useflags) + if (se->ss->info->useflags) { gcc_assert ((!comp && gfc_return_by_reference (sym) && sym->result->attr.dimension) @@ -2983,7 +2983,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, gfc_init_se (&parmse, se); gfc_conv_derived_to_class (&parmse, e, fsym->ts); } - else if (se->ss && se->ss->useflags) + else if (se->ss && se->ss->info->useflags) { /* An elemental function inside a scalarized loop. */ gfc_init_se (&parmse, se); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index a3b73832c35..fcc59d7086a 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -6634,7 +6634,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) break; case GFC_ISYM_TRANSFER: - if (se->ss && se->ss->useflags) + if (se->ss && se->ss->info->useflags) /* Access the previously obtained result. */ gfc_conv_tmp_array_ref (se); else diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index e74da4139ad..907c2713958 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -209,6 +209,11 @@ typedef struct gfc_ss_info gfc_array_info array; } data; + + /* This is used by assignments requiring temporaries. The bits specify which + loops the terms appear in. This will be 1 for the RHS expressions, + 2 for the LHS expressions, and 3(=1|2) for the temporary. */ + unsigned useflags:2; } gfc_ss_info; @@ -237,11 +242,9 @@ typedef struct gfc_ss struct gfc_ss *loop_chain; struct gfc_ss *next; - /* This is used by assignments requiring temporaries. The bits specify which - loops the terms appear in. This will be 1 for the RHS expressions, - 2 for the LHS expressions, and 3(=1|2) for the temporary. The bit - 'where' suppresses precalculation of scalars in WHERE assignments. */ - unsigned useflags:2, where:1, is_alloc_lhs:1; + /* The bit 'where' suppresses precalculation of scalars in WHERE assignments. + */ + unsigned where:1, is_alloc_lhs:1; } gfc_ss; #define gfc_get_ss() XCNEW (gfc_ss) -- cgit v1.2.1 From 77e80024c9a3ed5a229e1cb4a5afe6b639eebf47 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:29:25 +0000 Subject: * trans.h (struct gfc_ss, struct gfc_ss_info): Move field gfc_ss::where into gfc_ss_info. * trans-array.c (gfc_add_loop_ss_code): Update reference chains. * trans-stmt.c (gfc_trans_where_assign, gfc_trans_where_3): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180877 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/trans-array.c | 2 +- gcc/fortran/trans-stmt.c | 6 +++--- gcc/fortran/trans.h | 7 ++++--- 4 files changed, 16 insertions(+), 7 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index baa20a9de82..802c2ff4ba8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss, struct gfc_ss_info): Move field + gfc_ss::where into gfc_ss_info. + * trans-array.c (gfc_add_loop_ss_code): + Update reference chains. + * trans-stmt.c (gfc_trans_where_assign, gfc_trans_where_3): Ditto. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss, struct gfc_ss_info): Move field diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 427bb7b53d1..045c426cab1 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2203,7 +2203,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, scalarization loop, except for WHERE assignments. */ if (subscript) se.expr = convert(gfc_array_index_type, se.expr); - if (!ss->where) + if (!ss_info->where) se.expr = gfc_evaluate_now (se.expr, &loop->pre); gfc_add_block_to_block (&loop->pre, &se.post); } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 101a6513ed9..86a56e8c19a 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -4062,7 +4062,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, { /* The rhs is scalar. Add a ss for the expression. */ rss = gfc_get_scalar_ss (gfc_ss_terminator, expr2); - rss->where = 1; + rss->info->where = 1; } /* Associate the SS with the loop. */ @@ -4501,7 +4501,7 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock) if (tsss == gfc_ss_terminator) { tsss = gfc_get_scalar_ss (gfc_ss_terminator, tsrc); - tsss->where = 1; + tsss->info->where = 1; } gfc_add_ss_to_loop (&loop, tdss); gfc_add_ss_to_loop (&loop, tsss); @@ -4516,7 +4516,7 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock) if (esss == gfc_ss_terminator) { esss = gfc_get_scalar_ss (gfc_ss_terminator, esrc); - esss->where = 1; + esss->info->where = 1; } gfc_add_ss_to_loop (&loop, edss); gfc_add_ss_to_loop (&loop, esss); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 907c2713958..c35b1ae0fda 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -214,6 +214,9 @@ typedef struct gfc_ss_info loops the terms appear in. This will be 1 for the RHS expressions, 2 for the LHS expressions, and 3(=1|2) for the temporary. */ unsigned useflags:2; + + /* Suppresses precalculation of scalars in WHERE assignments. */ + unsigned where:1; } gfc_ss_info; @@ -242,9 +245,7 @@ typedef struct gfc_ss struct gfc_ss *loop_chain; struct gfc_ss *next; - /* The bit 'where' suppresses precalculation of scalars in WHERE assignments. - */ - unsigned where:1, is_alloc_lhs:1; + unsigned is_alloc_lhs:1; } gfc_ss; #define gfc_get_ss() XCNEW (gfc_ss) -- cgit v1.2.1 From 7415cfe42b4bbd3568e7acd72c888d2b9048daba Mon Sep 17 00:00:00 2001 From: burnus Date: Thu, 3 Nov 2011 22:32:37 +0000 Subject: 2011-11-03 Tobias Burnus PR fortran/50960 * trans-decl.c (gfc_finish_var_decl): Mark PARAMETER as * TREE_READONLY. 2011-11-03 Tobias Burnus PR fortran/50960 * gfortran.dg/module_parameter_array_refs_2.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180878 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-decl.c | 4 ++++ 2 files changed, 9 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 802c2ff4ba8..f29eab08abd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Tobias Burnus + + PR fortran/50960 + * trans-decl.c (gfc_finish_var_decl): Mark PARAMETER as TREE_READONLY. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss, struct gfc_ss_info): Move field diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index b7460b779e2..b90b0ab25b6 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -517,6 +517,10 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) /* If it wasn't used we wouldn't be getting it. */ TREE_USED (decl) = 1; + if (sym->attr.flavor == FL_PARAMETER + && (sym->attr.dimension || sym->ts.type == BT_DERIVED)) + TREE_READONLY (decl) = 1; + /* Chain this decl to the pending declarations. Don't do pushdecl() because this would add them to the current scope rather than the function scope. */ -- cgit v1.2.1 From 796e80e841195c7bef691554a45c6716330eb519 Mon Sep 17 00:00:00 2001 From: burnus Date: Thu, 3 Nov 2011 22:36:11 +0000 Subject: 2011-11-03 Tobias Burnus PR fortran/50933 * interface.c (gfc_compare_derived_types): Fix check for * BIND(C). 2011-11-03 Tobias Burnus PR fortran/50933 * gfortran.dg/bind_c_dts_5.f90: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180879 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/interface.c | 5 +++-- 2 files changed, 8 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f29eab08abd..ac6e29ba2ae 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Tobias Burnus + + PR fortran/50933 + * interface.c (gfc_compare_derived_types): Fix check for BIND(C). + 2011-11-03 Tobias Burnus PR fortran/50960 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 5308513b774..19ede06cf55 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -405,7 +405,7 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) return 1; /* Compare type via the rules of the standard. Both types must have - the SEQUENCE attribute to be equal. */ + the SEQUENCE or BIND(C) attribute to be equal. */ if (strcmp (derived1->name, derived2->name)) return 0; @@ -414,7 +414,8 @@ gfc_compare_derived_types (gfc_symbol *derived1, gfc_symbol *derived2) || derived2->component_access == ACCESS_PRIVATE) return 0; - if (derived1->attr.sequence == 0 || derived2->attr.sequence == 0) + if (!(derived1->attr.sequence && derived2->attr.sequence) + && !(derived1->attr.is_bind_c && derived2->attr.is_bind_c)) return 0; dt1 = derived1->components; -- cgit v1.2.1 From 899cad3ef7f3eaa60ddcf9072d54c381a44812bb Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:40:55 +0000 Subject: * trans-array.c (set_loop_bounds): Separate the beginning of gfc_conv_loop_setup into a function of its own. (set_delta): Separate the end of gfc_conv_loop_setup into a function of its own. (gfc_conv_loop_setup): Call set_loop_bounds and set delta. (set_loop_bounds, set_delta, gfc_conv_loop_setup): Make loopspec a pointer to the specloop field from the loop struct. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180880 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 ++++++++ gcc/fortran/trans-array.c | 60 +++++++++++++++++++++++++++++++++++++---------- 2 files changed, 58 insertions(+), 12 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ac6e29ba2ae..0d0e730b9cb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2011-11-03 Mikael Morin + + * trans-array.c (set_loop_bounds): Separate the beginning of + gfc_conv_loop_setup into a function of its own. + (set_delta): Separate the end of gfc_conv_loop_setup into a function + of its own. + (gfc_conv_loop_setup): Call set_loop_bounds and set delta. + (set_loop_bounds, set_delta, gfc_conv_loop_setup): Make loopspec a + pointer to the specloop field from the loop struct. + 2011-11-03 Tobias Burnus PR fortran/50933 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 045c426cab1..302f937989c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3919,25 +3919,25 @@ temporary: } -/* Initialize the scalarization loop. Creates the loop variables. Determines - the range of the loop variables. Creates a temporary if required. - Calculates how to transform from loop variables to array indices for each - expression. Also generates code for scalar expressions which have been - moved outside the loop. */ +/* Browse through each array's information from the scalarizer and set the loop + bounds according to the "best" one (per dimension), i.e. the one which + provides the most information (constant bounds, shape, etc). */ -void -gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) +static void +set_loop_bounds (gfc_loopinfo *loop) { int n, dim, spec_dim; gfc_array_info *info; gfc_array_info *specinfo; - gfc_ss *ss, *tmp_ss; + gfc_ss *ss; tree tmp; - gfc_ss *loopspec[GFC_MAX_DIMENSIONS]; + gfc_ss **loopspec; bool dynamic[GFC_MAX_DIMENSIONS]; mpz_t *cshape; mpz_t i; + loopspec = loop->specloop; + mpz_init (i); for (n = 0; n < loop->dimen; n++) { @@ -4119,6 +4119,26 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) loop->from[n] = gfc_index_zero_node; } } + mpz_clear (i); +} + + +static void set_delta (gfc_loopinfo *loop); + + +/* Initialize the scalarization loop. Creates the loop variables. Determines + the range of the loop variables. Creates a temporary if required. + Also generates code for scalar expressions which have been + moved outside the loop. */ + +void +gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) +{ + gfc_ss *tmp_ss; + tree tmp; + int n; + + set_loop_bounds (loop); /* Add all the scalar code that can be taken out of the loops. This may include calculating the loop bounds, so do it before @@ -4153,15 +4173,31 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) } for (n = 0; n < loop->temp_dim; n++) - loopspec[loop->order[n]] = NULL; - - mpz_clear (i); + loop->specloop[loop->order[n]] = NULL; /* For array parameters we don't have loop variables, so don't calculate the translations. */ if (loop->array_parameter) return; + set_delta (loop); +} + + +/* Calculates how to transform from loop variables to array indices for each + array: once loop bounds are chosen, sets the difference (DELTA field) between + loop bounds and array reference bounds, for each array info. */ + +static void +set_delta (gfc_loopinfo *loop) +{ + gfc_ss *ss, **loopspec; + gfc_array_info *info; + tree tmp; + int n, dim; + + loopspec = loop->specloop; + /* Calculate the translation from loop variables to array indices. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) { -- cgit v1.2.1 From 8a598e134238d6bd3420e50eb04355bdd139cbfa Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:42:58 +0000 Subject: * trans-array.c (gfc_conv_loop_setup, gfc_trans_create_temp_array): Move specloop arrays clearing from the former to the latter. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180881 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 9 +++++---- 2 files changed, 10 insertions(+), 4 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0d0e730b9cb..af37e211ca0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_conv_loop_setup, gfc_trans_create_temp_array): + Move specloop arrays clearing from the former to the latter. + 2011-11-03 Mikael Morin * trans-array.c (set_loop_bounds): Separate the beginning of diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 302f937989c..545f2fb21a9 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -902,6 +902,11 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, pre); loop->from[n] = gfc_index_zero_node; + /* We have just changed the loop bounds, we must clear the + corresponding specloop, so that delta calculation is not skipped + later in set_delta. */ + loop->specloop[n] = NULL; + /* We are constructing the temporary's descriptor based on the loop dimensions. As the dimensions may be accessed in arbitrary order (think of transpose) the size taken from the n'th loop may not map @@ -4136,7 +4141,6 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) { gfc_ss *tmp_ss; tree tmp; - int n; set_loop_bounds (loop); @@ -4172,9 +4176,6 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) false, true, false, where); } - for (n = 0; n < loop->temp_dim; n++) - loop->specloop[loop->order[n]] = NULL; - /* For array parameters we don't have loop variables, so don't calculate the translations. */ if (loop->array_parameter) -- cgit v1.2.1 From 04d28f1f9e5a1d1f5b4e4a0b8e40f98b71528750 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:45:41 +0000 Subject: * trans-array.c (gfc_trans_create_temp_array): Move invariant condition out of the containing loop. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180882 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 57 +++++++++++++++++++++++++---------------------- 2 files changed, 35 insertions(+), 27 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index af37e211ca0..9b07f76723f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_create_temp_array): Move invariant condition + out of the containing loop. + 2011-11-03 Mikael Morin * trans-array.c (gfc_conv_loop_setup, gfc_trans_create_temp_array): diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 545f2fb21a9..663d12e6e69 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -961,12 +961,12 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, break; } - for (n = 0; n < loop->dimen; n++) + if (size == NULL_TREE) { - dim = ss->dim[n]; - - if (size == NULL_TREE) + for (n = 0; n < loop->dimen; n++) { + dim = ss->dim[n]; + /* For a callee allocated array express the loop bounds in terms of the descriptor fields. */ tmp = fold_build2_loc (input_location, @@ -974,39 +974,42 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]), gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim])); loop->to[n] = tmp; - continue; } - - /* Store the stride and bound components in the descriptor. */ - gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size); + } + else + { + for (n = 0; n < loop->dimen; n++) + { + /* Store the stride and bound components in the descriptor. */ + gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size); - gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n], - gfc_index_zero_node); + gfc_conv_descriptor_lbound_set (pre, desc, gfc_rank_cst[n], + gfc_index_zero_node); - gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], - to[n]); + gfc_conv_descriptor_ubound_set (pre, desc, gfc_rank_cst[n], to[n]); - tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - to[n], gfc_index_one_node); + tmp = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, + to[n], gfc_index_one_node); - /* Check whether the size for this dimension is negative. */ - cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, tmp, - gfc_index_zero_node); - cond = gfc_evaluate_now (cond, pre); + /* Check whether the size for this dimension is negative. */ + cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, + tmp, gfc_index_zero_node); + cond = gfc_evaluate_now (cond, pre); - if (n == 0) - or_expr = cond; - else - or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR, - boolean_type_node, or_expr, cond); + if (n == 0) + or_expr = cond; + else + or_expr = fold_build2_loc (input_location, TRUTH_OR_EXPR, + boolean_type_node, or_expr, cond); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, tmp); - size = gfc_evaluate_now (size, pre); + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, tmp); + size = gfc_evaluate_now (size, pre); + } } /* Get the size of the array. */ - if (size && !callee_alloc) { /* If or_expr is true, then the extent in at least one -- cgit v1.2.1 From 2092de0642f48458576e6f34c5f48f55a378c58f Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:50:06 +0000 Subject: * trans.h (struct gfc_ss_info): New field refcount. * trans-array.c (free_ss_info): Decrement refcount. Return early if still non-zero. (gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss): Increment refcount. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180883 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/trans-array.c | 8 ++++++++ gcc/fortran/trans.h | 1 + 3 files changed, 17 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9b07f76723f..d014b9d97db 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss_info): New field refcount. + * trans-array.c (free_ss_info): Decrement refcount. Return early if + still non-zero. + (gfc_get_array_ss, gfc_get_temp_ss, gfc_get_scalar_ss): Increment + refcount. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_create_temp_array): Move invariant condition diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 663d12e6e69..abb6db2a97f 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -489,6 +489,11 @@ gfc_free_ss_chain (gfc_ss * ss) static void free_ss_info (gfc_ss_info *ss_info) { + ss_info->refcount--; + if (ss_info->refcount > 0) + return; + + gcc_assert (ss_info->refcount == 0); free (ss_info); } @@ -532,6 +537,7 @@ gfc_get_array_ss (gfc_ss *next, gfc_expr *expr, int dimen, gfc_ss_type type) int i; ss_info = gfc_get_ss_info (); + ss_info->refcount++; ss_info->type = type; ss_info->expr = expr; @@ -556,6 +562,7 @@ gfc_get_temp_ss (tree type, tree string_length, int dimen) int i; ss_info = gfc_get_ss_info (); + ss_info->refcount++; ss_info->type = GFC_SS_TEMP; ss_info->string_length = string_length; ss_info->data.temp.type = type; @@ -580,6 +587,7 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr) gfc_ss_info *ss_info; ss_info = gfc_get_ss_info (); + ss_info->refcount++; ss_info->type = GFC_SS_SCALAR; ss_info->expr = expr; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index c35b1ae0fda..02f2b422f07 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -185,6 +185,7 @@ gfc_ss_type; typedef struct gfc_ss_info { + int refcount; gfc_ss_type type; gfc_expr *expr; tree string_length; -- cgit v1.2.1 From 5e3e355bb34e3261542c1198e46e835c4d91fb68 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:54:37 +0000 Subject: * trans.h (struct gfc_ss): New field loop. * trans-array.c (set_ss_loop): New function. (gfc_add_ss_to_loop): Call set_ss_loop. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180884 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/trans-array.c | 23 +++++++++++++++++++++++ gcc/fortran/trans.h | 3 +++ 3 files changed, 32 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index d014b9d97db..57d62be36c1 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss): New field loop. + * trans-array.c (set_ss_loop): New function. + (gfc_add_ss_to_loop): Call set_ss_loop. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss_info): New field refcount. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index abb6db2a97f..e64767a2010 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -618,6 +618,27 @@ gfc_cleanup_loop (gfc_loopinfo * loop) } +static void +set_ss_loop (gfc_ss *ss, gfc_loopinfo *loop) +{ + int n; + + for (; ss != gfc_ss_terminator; ss = ss->next) + { + ss->loop = loop; + + if (ss->info->type == GFC_SS_SCALAR + || ss->info->type == GFC_SS_REFERENCE + || ss->info->type == GFC_SS_TEMP) + continue; + + for (n = 0; n < GFC_MAX_DIMENSIONS; n++) + if (ss->info->data.array.subscript[n] != NULL) + set_ss_loop (ss->info->data.array.subscript[n], loop); + } +} + + /* Associate a SS chain with a loop. */ void @@ -628,6 +649,8 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head) if (head == gfc_ss_terminator) return; + set_ss_loop (head, loop); + ss = head; for (; ss && ss != gfc_ss_terminator; ss = ss->next) { diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 02f2b422f07..62bcc643fb5 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -246,6 +246,9 @@ typedef struct gfc_ss struct gfc_ss *loop_chain; struct gfc_ss *next; + /* The loop this gfc_ss is in. */ + struct gfc_loopinfo *loop; + unsigned is_alloc_lhs:1; } gfc_ss; -- cgit v1.2.1 From 1c26be96ff66f2911fb4650c83deea91a9f54e33 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:56:12 +0000 Subject: * trans-array.c (gfc_set_vector_loop_bounds): Get loop from ss. Remove loop argument. (gfc_add_loop_ss_code): Update call. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180885 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/trans-array.c | 6 ++++-- 2 files changed, 10 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 57d62be36c1..1a435053349 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_set_vector_loop_bounds): Get loop from ss. + Remove loop argument. + (gfc_add_loop_ss_code): Update call. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss): New field loop. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index e64767a2010..a305ac38cff 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2162,8 +2162,9 @@ finish: loop bounds. */ static void -set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) +set_vector_loop_bounds (gfc_ss * ss) { + gfc_loopinfo *loop; gfc_array_info *info; gfc_se se; tree tmp; @@ -2173,6 +2174,7 @@ set_vector_loop_bounds (gfc_loopinfo * loop, gfc_ss * ss) int dim; info = &ss->info->data.array; + loop = ss->loop; for (n = 0; n < loop->dimen; n++) { @@ -2271,7 +2273,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, if (info->subscript[n]) gfc_add_loop_ss_code (loop, info->subscript[n], true, where); - set_vector_loop_bounds (loop, ss); + set_vector_loop_bounds (ss); break; case GFC_SS_VECTOR: -- cgit v1.2.1 From b219b10831f574eb14f52b2285310481237bf65e Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 22:59:29 +0000 Subject: * trans-array.c (gfc_trans_array_constructor, trans_array_constructor): Rename the former to the later. Get loop from ss. Remove loop argument. (gfc_add_loop_ss_code): Update call. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180886 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/trans-array.c | 6 ++++-- 2 files changed, 11 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1a435053349..7ec20cbf3ab 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_array_constructor, trans_array_constructor): + Rename the former to the later. Get loop from ss. + Remove loop argument. + (gfc_add_loop_ss_code): Update call. + 2011-11-03 Mikael Morin * trans-array.c (gfc_set_vector_loop_bounds): Get loop from ss. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index a305ac38cff..01a411a0508 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1981,7 +1981,7 @@ constant_array_constructor_loop_size (gfc_loopinfo * loop) simplest method. */ static void -gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) +trans_array_constructor (gfc_ss * ss, locus * where) { gfc_constructor_base c; tree offset; @@ -1992,6 +1992,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) bool dynamic; bool old_first_len, old_typespec_chararray_ctor; tree old_first_len_val; + gfc_loopinfo *loop; gfc_ss_info *ss_info; gfc_expr *expr; @@ -2000,6 +2001,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where) old_first_len_val = first_len_val; old_typespec_chararray_ctor = typespec_chararray_ctor; + loop = ss->loop; ss_info = ss->info; expr = ss_info->expr; @@ -2314,7 +2316,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_add_block_to_block (&loop->pre, &se.pre); gfc_add_block_to_block (&loop->post, &se.post); } - gfc_trans_array_constructor (loop, ss, where); + trans_array_constructor (ss, where); break; case GFC_SS_TEMP: -- cgit v1.2.1 From b310f6ff18798f156ca4d5606237324f87467bed Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:02:03 +0000 Subject: * trans-array.c (gfc_trans_create_temp_array): New variable total_dim. Set total_dim to loop's rank. Replace usages of loop's rank. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180887 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 10 ++++++---- 2 files changed, 11 insertions(+), 4 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7ec20cbf3ab..338fca6849f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_create_temp_array): New variable total_dim. + Set total_dim to loop's rank. Replace usages of loop's rank. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_array_constructor, trans_array_constructor): diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 01a411a0508..b2388c12f24 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -907,6 +907,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, tree cond; tree or_expr; int n, dim, tmp_dim; + int total_dim = 0; memset (from, 0, sizeof (from)); memset (to, 0, sizeof (to)); @@ -919,6 +920,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, if (gfc_option.warn_array_temp && where) gfc_warning ("Creating array temporary at %L", where); + total_dim = loop->dimen; /* Set the lower bound to zero. */ for (n = 0; n < loop->dimen; n++) { @@ -956,7 +958,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, /* Initialize the descriptor. */ type = - gfc_get_array_type_bounds (eltype, ss->dimen, 0, from, to, 1, + gfc_get_array_type_bounds (eltype, total_dim, 0, from, to, 1, GFC_ARRAY_UNKNOWN, true); desc = gfc_create_var (type, "atmp"); GFC_DECL_PACKED_ARRAY (desc) = 1; @@ -985,8 +987,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, /* If there is at least one null loop->to[n], it is a callee allocated array. */ - for (n = 0; n < loop->dimen; n++) - if (loop->to[n] == NULL_TREE) + for (n = 0; n < total_dim; n++) + if (to[n] == NULL_TREE) { size = NULL_TREE; break; @@ -1009,7 +1011,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, } else { - for (n = 0; n < loop->dimen; n++) + for (n = 0; n < total_dim; n++) { /* Store the stride and bound components in the descriptor. */ gfc_conv_descriptor_stride_set (pre, desc, gfc_rank_cst[n], size); -- cgit v1.2.1 From fc09773a52dc0ffe8235e4d6608a1469eaa39158 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:06:22 +0000 Subject: * trans-array.h (gfc_trans_create_temp_array): Remove loop argument. * trans-array.c (gfc_trans_create_temp_array): Ditto. Get loop from ss. Update reference to loop. Remove loop argument. (gfc_trans_array_constructor, gfc_conv_loop_setup): Update calls to gfc_trans_create_temp_array. * trans-expr.c (gfc_conv_procedure_call): Ditto. * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto. * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. Set loop before calling gfc_trans_create_temp_array. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180888 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 12 ++++++++++++ gcc/fortran/trans-array.c | 23 +++++++++++------------ gcc/fortran/trans-array.h | 5 ++--- gcc/fortran/trans-expr.c | 4 ++-- gcc/fortran/trans-intrinsic.c | 5 ++--- gcc/fortran/trans-stmt.c | 9 ++++----- 6 files changed, 33 insertions(+), 25 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 338fca6849f..ce4e619b778 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2011-11-03 Mikael Morin + + * trans-array.h (gfc_trans_create_temp_array): Remove loop argument. + * trans-array.c (gfc_trans_create_temp_array): Ditto. Get loop from ss. + Update reference to loop. Remove loop argument. + (gfc_trans_array_constructor, gfc_conv_loop_setup): Update calls to + gfc_trans_create_temp_array. + * trans-expr.c (gfc_conv_procedure_call): Ditto. + * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Ditto. + * trans-stmt.c (gfc_conv_elemental_dependencies): Ditto. + Set loop before calling gfc_trans_create_temp_array. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_create_temp_array): New variable total_dim. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index b2388c12f24..d386a228a0e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -888,15 +888,14 @@ get_array_ref_dim (gfc_ss *ss, int loop_dim) callee allocated array. PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for - gfc_trans_allocate_array_storage. - */ + gfc_trans_allocate_array_storage. */ tree -gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, - gfc_loopinfo * loop, gfc_ss * ss, +gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, tree eltype, tree initial, bool dynamic, bool dealloc, bool callee_alloc, locus * where) { + gfc_loopinfo *loop; gfc_array_info *info; tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS]; tree type; @@ -915,11 +914,12 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, info = &ss->info->data.array; gcc_assert (ss->dimen > 0); - gcc_assert (loop->dimen == ss->dimen); + gcc_assert (ss->loop->dimen == ss->dimen); if (gfc_option.warn_array_temp && where) gfc_warning ("Creating array temporary at %L", where); + loop = ss->loop; total_dim = loop->dimen; /* Set the lower bound to zero. */ for (n = 0; n < loop->dimen; n++) @@ -1065,8 +1065,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial, dynamic, dealloc); - if (ss->dimen > loop->temp_dim) - loop->temp_dim = ss->dimen; + if (ss->dimen > ss->loop->temp_dim) + ss->loop->temp_dim = ss->dimen; return size; } @@ -2113,8 +2113,8 @@ trans_array_constructor (gfc_ss * ss, locus * where) if (TREE_CODE (loop->to[0]) == VAR_DECL) dynamic = true; - gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, ss, - type, NULL_TREE, dynamic, true, false, where); + gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE, + dynamic, true, false, where); desc = ss_info->data.array.descriptor; offset = gfc_index_zero_node; @@ -4211,9 +4211,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) gcc_assert (tmp_ss->dimen != 0); - gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, - tmp_ss, tmp, NULL_TREE, - false, true, false, where); + gfc_trans_create_temp_array (&loop->pre, &loop->post, tmp_ss, tmp, + NULL_TREE, false, true, false, where); } /* For array parameters we don't have loop variables, so don't calculate the diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 57805b6ac5c..aad8c47b6f1 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -31,9 +31,8 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *, gfc_se *, gfc_array_spec *); /* Generate code to create a temporary array. */ -tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *, - gfc_ss *, tree, tree, bool, bool, bool, - locus *); +tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_ss *, + tree, tree, bool, bool, bool, locus *); /* Generate function entry code for allocation of compiler allocated array variables. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 01d4ca3885f..e091c89d696 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -3606,7 +3606,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, returns a pointer, the temporary will be a shallow copy and mustn't be deallocated. */ callee_alloc = comp->attr.allocatable || comp->attr.pointer; - gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss, + gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, tmp, NULL_TREE, false, !comp->attr.pointer, callee_alloc, &se->ss->info->expr->where); @@ -3642,7 +3642,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, returns a pointer, the temporary will be a shallow copy and mustn't be deallocated. */ callee_alloc = sym->attr.allocatable || sym->attr.pointer; - gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, se->ss, + gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, tmp, NULL_TREE, false, !sym->attr.pointer, callee_alloc, &se->ss->info->expr->where); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index fcc59d7086a..c3a414b789b 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -5501,9 +5501,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) /* Build a destination descriptor, using the pointer, source, as the data field. */ - gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, - se->ss, mold_type, NULL_TREE, false, true, false, - &expr->where); + gfc_trans_create_temp_array (&se->pre, &se->post, se->ss, mold_type, + NULL_TREE, false, true, false, &expr->where); /* Cast the pointer to the result. */ tmp = gfc_conv_descriptor_data_get (info->descriptor); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 86a56e8c19a..2e023207e0e 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -309,11 +309,10 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, size = gfc_create_var (gfc_array_index_type, NULL); data = gfc_create_var (pvoid_type_node, NULL); gfc_init_block (&temp_post); - tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, - &tmp_loop, ss, temptype, - initial, - false, true, false, - &arg->expr->where); + ss->loop = &tmp_loop; + tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, ss, + temptype, initial, false, true, + false, &arg->expr->where); gfc_add_modify (&se->pre, size, tmp); tmp = fold_convert (pvoid_type_node, info->data); gfc_add_modify (&se->pre, data, tmp); -- cgit v1.2.1 From 7a516fb346b6fccae85af8e3068068bfead8e845 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:17:08 +0000 Subject: * trans.h (struct gfc_ss): New field parent. * trans-array.c (gfc_trans_scalarizing_loops): Skip clearing if a parent exists. * trans-expr.c (gfc_advance_se_ss_chain): Move to parent ss at the end of the chain. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180889 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/trans-array.c | 3 ++- gcc/fortran/trans-expr.c | 11 ++++++++++- gcc/fortran/trans.h | 3 +++ 4 files changed, 23 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ce4e619b778..a552beade86 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss): New field parent. + * trans-array.c (gfc_trans_scalarizing_loops): Skip clearing if a + parent exists. + * trans-expr.c (gfc_advance_se_ss_chain): Move to parent ss at the + end of the chain. + 2011-11-03 Mikael Morin * trans-array.h (gfc_trans_create_temp_array): Remove loop argument. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d386a228a0e..abff8b5dc73 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3193,7 +3193,8 @@ gfc_trans_scalarizing_loops (gfc_loopinfo * loop, stmtblock_t * body) /* Clear all the used flags. */ for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain) - ss->info->useflags = 0; + if (ss->parent == NULL) + ss->info->useflags = 0; } diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index e091c89d696..72d35f8de89 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -83,6 +83,7 @@ void gfc_advance_se_ss_chain (gfc_se * se) { gfc_se *p; + gfc_ss *ss; gcc_assert (se != NULL && se->ss != NULL && se->ss != gfc_ss_terminator); @@ -93,7 +94,15 @@ gfc_advance_se_ss_chain (gfc_se * se) /* Simple consistency check. */ gcc_assert (p->parent == NULL || p->parent->ss == p->ss); - p->ss = p->ss->next; + /* If we were in a nested loop, the next scalarized expression can be + on the parent ss' next pointer. Thus we should not take the next + pointer blindly, but rather go up one nest level as long as next + is the end of chain. */ + ss = p->ss; + while (ss->next == gfc_ss_terminator && ss->parent != NULL) + ss = ss->parent; + + p->ss = ss->next; p = p->parent; } diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 62bcc643fb5..53c5ce25fa4 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -246,6 +246,9 @@ typedef struct gfc_ss struct gfc_ss *loop_chain; struct gfc_ss *next; + /* Non-null if the ss is part of a nested loop. */ + struct gfc_ss *parent; + /* The loop this gfc_ss is in. */ struct gfc_loopinfo *loop; -- cgit v1.2.1 From 5bbc46bd13bb278329e01231711642416dc92c06 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:22:13 +0000 Subject: * trans-array.c (gfc_set_loop_bounds_from_array_spec): Loop over the parents. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180890 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 ++++ gcc/fortran/trans-array.c | 73 ++++++++++++++++++++++++++++------------------- 2 files changed, 48 insertions(+), 30 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a552beade86..7595d359a8e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_set_loop_bounds_from_array_spec): Loop over the + parents. + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss): New field parent. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index abff8b5dc73..83542f66811 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -688,41 +688,54 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping * mapping, gfc_se * se, gfc_array_spec * as) { - int n, dim; + int n, dim, total_dim; gfc_se tmpse; + gfc_ss *ss; tree lower; tree upper; tree tmp; - if (as && as->type == AS_EXPLICIT) - for (n = 0; n < se->loop->dimen; n++) - { - dim = se->ss->dim[n]; - gcc_assert (dim < as->rank); - gcc_assert (se->loop->dimen == as->rank); - if (se->loop->to[n] == NULL_TREE) - { - /* Evaluate the lower bound. */ - gfc_init_se (&tmpse, NULL); - gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]); - gfc_add_block_to_block (&se->pre, &tmpse.pre); - gfc_add_block_to_block (&se->post, &tmpse.post); - lower = fold_convert (gfc_array_index_type, tmpse.expr); - - /* ...and the upper bound. */ - gfc_init_se (&tmpse, NULL); - gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]); - gfc_add_block_to_block (&se->pre, &tmpse.pre); - gfc_add_block_to_block (&se->post, &tmpse.post); - upper = fold_convert (gfc_array_index_type, tmpse.expr); - - /* Set the upper bound of the loop to UPPER - LOWER. */ - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, upper, lower); - tmp = gfc_evaluate_now (tmp, &se->pre); - se->loop->to[n] = tmp; - } - } + total_dim = 0; + + if (!as || as->type != AS_EXPLICIT) + return; + + for (ss = se->ss; ss; ss = ss->parent) + { + total_dim += ss->loop->dimen; + for (n = 0; n < ss->loop->dimen; n++) + { + /* The bound is known, nothing to do. */ + if (ss->loop->to[n] != NULL_TREE) + continue; + + dim = ss->dim[n]; + gcc_assert (dim < as->rank); + gcc_assert (ss->loop->dimen <= as->rank); + + /* Evaluate the lower bound. */ + gfc_init_se (&tmpse, NULL); + gfc_apply_interface_mapping (mapping, &tmpse, as->lower[dim]); + gfc_add_block_to_block (&se->pre, &tmpse.pre); + gfc_add_block_to_block (&se->post, &tmpse.post); + lower = fold_convert (gfc_array_index_type, tmpse.expr); + + /* ...and the upper bound. */ + gfc_init_se (&tmpse, NULL); + gfc_apply_interface_mapping (mapping, &tmpse, as->upper[dim]); + gfc_add_block_to_block (&se->pre, &tmpse.pre); + gfc_add_block_to_block (&se->post, &tmpse.post); + upper = fold_convert (gfc_array_index_type, tmpse.expr); + + /* Set the upper bound of the loop to UPPER - LOWER. */ + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, upper, lower); + tmp = gfc_evaluate_now (tmp, &se->pre); + ss->loop->to[n] = tmp; + } + } + + gcc_assert (total_dim == as->rank); } -- cgit v1.2.1 From a9a5a41415bca8c0bc6c6e13dd9f7f2279fb4edf Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:25:34 +0000 Subject: * trans-array.c (gfc_trans_array_constructor): Loop over the parents. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180891 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 4 ++++ gcc/fortran/trans-array.c | 26 ++++++++++++++++---------- 2 files changed, 20 insertions(+), 10 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7595d359a8e..196f3dae126 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_array_constructor): Loop over the parents. + 2011-11-03 Mikael Morin * trans-array.c (gfc_set_loop_bounds_from_array_spec): Loop over the diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 83542f66811..463a0a2cf6f 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1953,6 +1953,7 @@ trans_constant_array_constructor (gfc_ss * ss, tree type) } } + /* Helper routine of gfc_trans_array_constructor to determine if the bounds of the loop specified by LOOP are constant and simple enough to use with trans_constant_array_constructor. Returns the @@ -2010,6 +2011,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) gfc_loopinfo *loop; gfc_ss_info *ss_info; gfc_expr *expr; + gfc_ss *s; /* Save the old values for nested checking. */ old_first_len = first_len; @@ -2078,16 +2080,20 @@ trans_array_constructor (gfc_ss * ss, locus * where) if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE) { /* We have a multidimensional parameter. */ - int n; - for (n = 0; n < expr->rank; n++) - { - loop->from[n] = gfc_index_zero_node; - loop->to[n] = gfc_conv_mpz_to_tree (expr->shape [n], - gfc_index_integer_kind); - loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - loop->to[n], gfc_index_one_node); - } + for (s = ss; s; s = s->parent) + { + int n; + for (n = 0; n < s->loop->dimen; n++) + { + s->loop->from[n] = gfc_index_zero_node; + s->loop->to[n] = gfc_conv_mpz_to_tree (expr->shape[s->dim[n]], + gfc_index_integer_kind); + s->loop->to[n] = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + s->loop->to[n], + gfc_index_one_node); + } + } } if (loop->to[0] == NULL_TREE) -- cgit v1.2.1 From 13d8bc14db87f1f59ee25ad7e39a40c464cb43df Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:28:25 +0000 Subject: * trans-array.c (set_vector_loop_bounds): Loop over the parents. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180892 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 4 ++++ gcc/fortran/trans-array.c | 14 +++++++++----- 2 files changed, 13 insertions(+), 5 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 196f3dae126..47c4938f8e0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2011-11-03 Mikael Morin + + * trans-array.c (set_vector_loop_bounds): Loop over the parents. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_array_constructor): Loop over the parents. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 463a0a2cf6f..25d9a37675c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2197,14 +2197,18 @@ set_vector_loop_bounds (gfc_ss * ss) int dim; info = &ss->info->data.array; - loop = ss->loop; - for (n = 0; n < loop->dimen; n++) + for (; ss; ss = ss->parent) { - dim = ss->dim[n]; - if (info->ref->u.ar.dimen_type[dim] == DIMEN_VECTOR - && loop->to[n] == NULL) + loop = ss->loop; + + for (n = 0; n < loop->dimen; n++) { + dim = ss->dim[n]; + if (info->ref->u.ar.dimen_type[dim] != DIMEN_VECTOR + || loop->to[n] != NULL) + continue; + /* Loop variable N indexes vector dimension DIM, and we don't yet know the upper bound of loop variable N. Set it to the difference between the vector's upper and lower bounds. */ -- cgit v1.2.1 From f53dc1beca14933ff21b68564c9ff4f93eb882ac Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:31:32 +0000 Subject: * trans.h (struct gfc_ss): New field nested_ss. * trans-expr.c (gfc_advance_se_ss_chain): Update assertion. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180893 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-expr.c | 3 ++- gcc/fortran/trans.h | 5 +++++ 3 files changed, 12 insertions(+), 1 deletion(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 47c4938f8e0..92be1535b9e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_ss): New field nested_ss. + * trans-expr.c (gfc_advance_se_ss_chain): Update assertion. + 2011-11-03 Mikael Morin * trans-array.c (set_vector_loop_bounds): Loop over the parents. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 72d35f8de89..4cfdc3e0906 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -92,7 +92,8 @@ gfc_advance_se_ss_chain (gfc_se * se) while (p != NULL) { /* Simple consistency check. */ - gcc_assert (p->parent == NULL || p->parent->ss == p->ss); + gcc_assert (p->parent == NULL || p->parent->ss == p->ss + || p->parent->ss->nested_ss == p->ss); /* If we were in a nested loop, the next scalarized expression can be on the parent ss' next pointer. Thus we should not take the next diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 53c5ce25fa4..06088797f64 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -249,6 +249,11 @@ typedef struct gfc_ss /* Non-null if the ss is part of a nested loop. */ struct gfc_ss *parent; + /* If the evaluation of an expression requires a nested loop (for example + if the sum intrinsic is evaluated inline), this points to the nested + loop's gfc_ss. */ + struct gfc_ss *nested_ss; + /* The loop this gfc_ss is in. */ struct gfc_loopinfo *loop; -- cgit v1.2.1 From 7e7e695867898829e5026279ef986271a18a66c7 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:34:53 +0000 Subject: * trans-array.c (get_array_ref_dim, get_scalarizer_dim_for_array_dim): Rename the former to the latter and loop over the parents. (innermost_ss): New function. (get_array_ref_dim_for_loop_dim): New function. (gfc_trans_create_temp_array): Use get_scalarizer_dim_for_array_dim. (set_loop_bounds): Use get_array_dim_for_loop_dim). git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180894 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 9 +++++++ gcc/fortran/trans-array.c | 62 ++++++++++++++++++++++++++++++++++++----------- 2 files changed, 57 insertions(+), 14 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 92be1535b9e..e802754b18c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2011-11-03 Mikael Morin + + * trans-array.c (get_array_ref_dim, get_scalarizer_dim_for_array_dim): + Rename the former to the latter and loop over the parents. + (innermost_ss): New function. + (get_array_ref_dim_for_loop_dim): New function. + (gfc_trans_create_temp_array): Use get_scalarizer_dim_for_array_dim. + (set_loop_bounds): Use get_array_dim_for_loop_dim). + 2011-11-03 Mikael Morin * trans.h (struct gfc_ss): New field nested_ss. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 25d9a37675c..d918fa82009 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -868,28 +868,62 @@ gfc_trans_allocate_array_storage (stmtblock_t * pre, stmtblock_t * post, } -/* Get the array reference dimension corresponding to the given loop dimension. - It is different from the true array dimension given by the dim array in - the case of a partial array reference - It is different from the loop dimension in the case of a transposed array. - */ +/* Get the scalarizer array dimension corresponding to actual array dimension + given by ARRAY_DIM. + + For example, if SS represents the array ref a(1,:,:,1), it is a + bidimensional scalarizer array, and the result would be 0 for ARRAY_DIM=1, + and 1 for ARRAY_DIM=2. + If SS represents transpose(a(:,1,1,:)), it is again a bidimensional + scalarizer array, and the result would be 1 for ARRAY_DIM=0 and 0 for + ARRAY_DIM=3. + If SS represents sum(a(:,:,:,1), dim=1), it is a 2+1-dimensional scalarizer + array. If called on the inner ss, the result would be respectively 0,1,2 for + ARRAY_DIM=0,1,2. If called on the outer ss, the result would be 0,1 + for ARRAY_DIM=1,2. */ static int -get_array_ref_dim (gfc_ss *ss, int loop_dim) +get_scalarizer_dim_for_array_dim (gfc_ss *ss, int array_dim) { - int n, array_dim, array_ref_dim; + int array_ref_dim; + int n; array_ref_dim = 0; - array_dim = ss->dim[loop_dim]; - for (n = 0; n < ss->dimen; n++) - if (ss->dim[n] < array_dim) - array_ref_dim++; + for (; ss; ss = ss->parent) + for (n = 0; n < ss->dimen; n++) + if (ss->dim[n] < array_dim) + array_ref_dim++; return array_ref_dim; } +static gfc_ss * +innermost_ss (gfc_ss *ss) +{ + while (ss->nested_ss != NULL) + ss = ss->nested_ss; + + return ss; +} + + + +/* Get the array reference dimension corresponding to the given loop dimension. + It is different from the true array dimension given by the dim array in + the case of a partial array reference (i.e. a(:,:,1,:) for example) + It is different from the loop dimension in the case of a transposed array. + */ + +static int +get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim) +{ + return get_scalarizer_dim_for_array_dim (innermost_ss (ss), + ss->dim[loop_dim]); +} + + /* Generate code to create and initialize the descriptor for a temporary array. This is used for both temporaries needed by the scalarizer, and functions returning arrays. Adjusts the loop variables to be @@ -959,7 +993,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, to the n'th dimension of the array. We need to reconstruct loop infos in the right order before using it to set the descriptor bounds. */ - tmp_dim = get_array_ref_dim (ss, n); + tmp_dim = get_scalarizer_dim_for_array_dim (ss, dim); from[tmp_dim] = loop->from[n]; to[tmp_dim] = loop->to[n]; @@ -1011,7 +1045,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, { for (n = 0; n < loop->dimen; n++) { - dim = ss->dim[n]; + dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]); /* For a callee allocated array express the loop bounds in terms of the descriptor fields. */ @@ -4126,7 +4160,7 @@ set_loop_bounds (gfc_loopinfo *loop) && INTEGER_CST_P (info->stride[dim])) { loop->from[n] = info->start[dim]; - mpz_set (i, cshape[get_array_ref_dim (loopspec[n], n)]); + mpz_set (i, cshape[get_array_ref_dim_for_loop_dim (loopspec[n], n)]); mpz_sub_ui (i, i, 1); /* To = from + (size - 1) * stride. */ tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind); -- cgit v1.2.1 From 478de4e6ba8d020b3448153bdb91685a6a3d4d3b Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:37:24 +0000 Subject: * trans-array.c (gfc_trans_create_temp_array): Loop over the parents. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180895 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 4 +++ gcc/fortran/trans-array.c | 71 ++++++++++++++++++++++++++--------------------- 2 files changed, 43 insertions(+), 32 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e802754b18c..e973d487553 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_create_temp_array): Loop over the parents. + 2011-11-03 Mikael Morin * trans-array.c (get_array_ref_dim, get_scalarizer_dim_for_array_dim): diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d918fa82009..1a86ae66c59 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -943,6 +943,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, bool dealloc, bool callee_alloc, locus * where) { gfc_loopinfo *loop; + gfc_ss *s; gfc_array_info *info; tree from[GFC_MAX_DIMENSIONS], to[GFC_MAX_DIMENSIONS]; tree type; @@ -966,41 +967,45 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, if (gfc_option.warn_array_temp && where) gfc_warning ("Creating array temporary at %L", where); - loop = ss->loop; - total_dim = loop->dimen; /* Set the lower bound to zero. */ - for (n = 0; n < loop->dimen; n++) + for (s = ss; s; s = s->parent) { - dim = ss->dim[n]; + loop = s->loop; + + total_dim += loop->dimen; + for (n = 0; n < loop->dimen; n++) + { + dim = s->dim[n]; - /* Callee allocated arrays may not have a known bound yet. */ - if (loop->to[n]) - loop->to[n] = gfc_evaluate_now ( + /* Callee allocated arrays may not have a known bound yet. */ + if (loop->to[n]) + loop->to[n] = gfc_evaluate_now ( fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, loop->to[n], loop->from[n]), pre); - loop->from[n] = gfc_index_zero_node; - - /* We have just changed the loop bounds, we must clear the - corresponding specloop, so that delta calculation is not skipped - later in set_delta. */ - loop->specloop[n] = NULL; - - /* We are constructing the temporary's descriptor based on the loop - dimensions. As the dimensions may be accessed in arbitrary order - (think of transpose) the size taken from the n'th loop may not map - to the n'th dimension of the array. We need to reconstruct loop infos - in the right order before using it to set the descriptor - bounds. */ - tmp_dim = get_scalarizer_dim_for_array_dim (ss, dim); - from[tmp_dim] = loop->from[n]; - to[tmp_dim] = loop->to[n]; - - info->delta[dim] = gfc_index_zero_node; - info->start[dim] = gfc_index_zero_node; - info->end[dim] = gfc_index_zero_node; - info->stride[dim] = gfc_index_one_node; + loop->from[n] = gfc_index_zero_node; + + /* We have just changed the loop bounds, we must clear the + corresponding specloop, so that delta calculation is not skipped + later in set_delta. */ + loop->specloop[n] = NULL; + + /* We are constructing the temporary's descriptor based on the loop + dimensions. As the dimensions may be accessed in arbitrary order + (think of transpose) the size taken from the n'th loop may not map + to the n'th dimension of the array. We need to reconstruct loop + infos in the right order before using it to set the descriptor + bounds. */ + tmp_dim = get_scalarizer_dim_for_array_dim (ss, dim); + from[tmp_dim] = loop->from[n]; + to[tmp_dim] = loop->to[n]; + + info->delta[dim] = gfc_index_zero_node; + info->start[dim] = gfc_index_zero_node; + info->end[dim] = gfc_index_zero_node; + info->stride[dim] = gfc_index_one_node; + } } /* Initialize the descriptor. */ @@ -1042,8 +1047,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, } if (size == NULL_TREE) - { - for (n = 0; n < loop->dimen; n++) + for (s = ss; s; s = s->parent) + for (n = 0; n < s->loop->dimen; n++) { dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]); @@ -1053,9 +1058,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, MINUS_EXPR, gfc_array_index_type, gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]), gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim])); - loop->to[n] = tmp; + s->loop->to[n] = tmp; } - } else { for (n = 0; n < total_dim; n++) @@ -1112,6 +1116,9 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, gfc_trans_allocate_array_storage (pre, post, info, size, nelem, initial, dynamic, dealloc); + while (ss->parent) + ss = ss->parent; + if (ss->dimen > ss->loop->temp_dim) ss->loop->temp_dim = ss->dimen; -- cgit v1.2.1 From e390313110b6f6d77d0adc77e82b830bc8b15d39 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:39:11 +0000 Subject: * trans.h (struct gfc_loopinfo): New fields nested and next. * trans-array.c (gfc_add_ss_to_loop): Update list of nested list if ss has non-null nested_ss field. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180897 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/trans-array.c | 16 ++++++++++++++++ gcc/fortran/trans.h | 3 +++ 3 files changed, 25 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e973d487553..a8d38424326 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_loopinfo): New fields nested and next. + * trans-array.c (gfc_add_ss_to_loop): Update list of nested list if + ss has non-null nested_ss field. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_create_temp_array): Loop over the parents. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 1a86ae66c59..0c1dc895d0d 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -645,6 +645,7 @@ void gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head) { gfc_ss *ss; + gfc_loopinfo *nested_loop; if (head == gfc_ss_terminator) return; @@ -654,6 +655,21 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head) ss = head; for (; ss && ss != gfc_ss_terminator; ss = ss->next) { + if (ss->nested_ss) + { + nested_loop = ss->nested_ss->loop; + + /* More than one ss can belong to the same loop. Hence, we add the + loop to the chain only if it is different from the previously + added one, to avoid duplicate nested loops. */ + if (nested_loop != loop->nested) + { + gcc_assert (nested_loop->next == NULL); + nested_loop->next = loop->nested; + loop->nested = nested_loop; + } + } + if (ss->next == gfc_ss_terminator) ss->loop_chain = loop->ss; else diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 06088797f64..0549aa79301 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -279,6 +279,9 @@ typedef struct gfc_loopinfo /* The SS describing the temporary used in an assignment. */ gfc_ss *temp_ss; + /* Chain of nested loops. */ + struct gfc_loopinfo *nested, *next; + /* The scalarization loop index variables. */ tree loopvar[GFC_MAX_DIMENSIONS]; -- cgit v1.2.1 From dded49d253260180d3a2253d75f152100a2db695 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:41:28 +0000 Subject: * trans-array.c (gfc_add_loop_ss_code): Skip non-nestedmost ss. Call recursively gfc_add_loop_ss_code for all the nested loops. (gfc_conv_ss_startstride): Only get the descriptor for the outermost ss. Call recursively gfc_conv_ss_startstride for all the nested loops. (set_loop_bounds): Call recursively for all the nested loops. (set_delta): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180898 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 9 +++++++++ gcc/fortran/trans-array.c | 33 ++++++++++++++++++++++++++++++--- 2 files changed, 39 insertions(+), 3 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a8d38424326..653b262b81d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_add_loop_ss_code): Skip non-nestedmost ss. + Call recursively gfc_add_loop_ss_code for all the nested loops. + (gfc_conv_ss_startstride): Only get the descriptor for the outermost + ss. Call recursively gfc_conv_ss_startstride for all the nested loops. + (set_loop_bounds): Call recursively for all the nested loops. + (set_delta): Ditto. + 2011-11-03 Mikael Morin * trans.h (struct gfc_loopinfo): New fields nested and next. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0c1dc895d0d..27356a1a1d3 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2295,10 +2295,12 @@ static void gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, locus * where) { + gfc_loopinfo *nested_loop; gfc_se se; gfc_ss_info *ss_info; gfc_array_info *info; gfc_expr *expr; + bool skip_nested = false; int n; /* TODO: This can generate bad code if there are ordering dependencies, @@ -2309,6 +2311,10 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, { gcc_assert (ss); + /* Cross loop arrays are handled from within the most nested loop. */ + if (ss->nested_ss != NULL) + continue; + ss_info = ss->info; expr = ss_info->expr; info = &ss_info->data.array; @@ -2355,7 +2361,12 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, /* Add the expressions for scalar and vector subscripts. */ for (n = 0; n < GFC_MAX_DIMENSIONS; n++) if (info->subscript[n]) - gfc_add_loop_ss_code (loop, info->subscript[n], true, where); + { + gfc_add_loop_ss_code (loop, info->subscript[n], true, where); + /* The recursive call will have taken care of the nested loops. + No need to do it twice. */ + skip_nested = true; + } set_vector_loop_bounds (ss); break; @@ -2410,6 +2421,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gcc_unreachable (); } } + + if (!skip_nested) + for (nested_loop = loop->nested; nested_loop; + nested_loop = nested_loop->next) + gfc_add_loop_ss_code (nested_loop, nested_loop->ss, subscript, where); } @@ -3495,8 +3511,10 @@ done: switch (ss_info->type) { case GFC_SS_SECTION: - /* Get the descriptor for the array. */ - gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter); + /* Get the descriptor for the array. If it is a cross loops array, + we got the descriptor already in the outermost loop. */ + if (ss->parent == NULL) + gfc_conv_ss_descriptor (&loop->pre, ss, !loop->array_parameter); for (n = 0; n < ss->dimen; n++) gfc_conv_section_startstride (loop, ss, ss->dim[n]); @@ -3785,6 +3803,9 @@ done: tmp = gfc_finish_block (&block); gfc_add_expr_to_block (&loop->pre, tmp); } + + for (loop = loop->nested; loop; loop = loop->next) + gfc_conv_ss_startstride (loop); } /* Return true if both symbols could refer to the same data object. Does @@ -4246,6 +4267,9 @@ set_loop_bounds (gfc_loopinfo *loop) } } mpz_clear (i); + + for (loop = loop->nested; loop; loop = loop->next) + set_loop_bounds (loop); } @@ -4356,6 +4380,9 @@ set_delta (gfc_loopinfo *loop) } } } + + for (loop = loop->nested; loop; loop = loop->next) + set_delta (loop); } -- cgit v1.2.1 From 9de941c0b8cd7c36f63ecd6681b89f2a962055b0 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:45:19 +0000 Subject: * trans.h (struct gfc_loopinfo): New field parent. * trans-array.c (gfc_cleanup_loop): Free nested loops. (gfc_add_ss_to_loop): Set nested_loop's parent loop. (gfc_trans_array_constructor): Update assertion. (gfc_conv_loop_setup): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180899 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/trans-array.c | 25 +++++++++++++++++++++++++ gcc/fortran/trans.h | 3 +++ 3 files changed, 36 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 653b262b81d..89ba5847fde 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-11-03 Mikael Morin + + * trans.h (struct gfc_loopinfo): New field parent. + * trans-array.c (gfc_cleanup_loop): Free nested loops. + (gfc_add_ss_to_loop): Set nested_loop's parent loop. + (gfc_trans_array_constructor): Update assertion. + (gfc_conv_loop_setup): Ditto. + 2011-11-03 Mikael Morin * trans-array.c (gfc_add_loop_ss_code): Skip non-nestedmost ss. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 27356a1a1d3..5659b70846e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -604,6 +604,7 @@ gfc_get_scalar_ss (gfc_ss *next, gfc_expr *expr) void gfc_cleanup_loop (gfc_loopinfo * loop) { + gfc_loopinfo *loop_next, **ploop; gfc_ss *ss; gfc_ss *next; @@ -615,6 +616,23 @@ gfc_cleanup_loop (gfc_loopinfo * loop) gfc_free_ss (ss); ss = next; } + + /* Remove reference to self in the parent loop. */ + if (loop->parent) + for (ploop = &loop->parent->nested; *ploop; ploop = &(*ploop)->next) + if (*ploop == loop) + { + *ploop = loop->next; + break; + } + + /* Free non-freed nested loops. */ + for (loop = loop->nested; loop; loop = loop_next) + { + loop_next = loop->next; + gfc_cleanup_loop (loop); + free (loop); + } } @@ -664,10 +682,15 @@ gfc_add_ss_to_loop (gfc_loopinfo * loop, gfc_ss * head) added one, to avoid duplicate nested loops. */ if (nested_loop != loop->nested) { + gcc_assert (nested_loop->parent == NULL); + nested_loop->parent = loop; + gcc_assert (nested_loop->next == NULL); nested_loop->next = loop->nested; loop->nested = nested_loop; } + else + gcc_assert (nested_loop->parent == loop); } if (ss->next == gfc_ss_terminator) @@ -2158,6 +2181,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) mpz_t size; /* We should have a 1-dimensional, zero-based loop. */ + gcc_assert (loop->parent == NULL && loop->nested == NULL); gcc_assert (loop->dimen == 1); gcc_assert (integer_zerop (loop->from[0])); @@ -4302,6 +4326,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) tmp_ss_info = tmp_ss->info; gcc_assert (tmp_ss_info->type == GFC_SS_TEMP); + gcc_assert (loop->parent == NULL); /* Make absolutely sure that this is a complete type. */ if (tmp_ss_info->string_length) diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 0549aa79301..4d745f144ce 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -279,6 +279,9 @@ typedef struct gfc_loopinfo /* The SS describing the temporary used in an assignment. */ gfc_ss *temp_ss; + /* Non-null if this loop is nested in another one. */ + struct gfc_loopinfo *parent; + /* Chain of nested loops. */ struct gfc_loopinfo *nested, *next; -- cgit v1.2.1 From 705974ff25145107542123005f7c2947ad25f11e Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:48:29 +0000 Subject: * trans-array.c (get_rank, get_loop_upper_bound_for_array): New functions. (gfc_trans_array_constructor): Handle multiple loops. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180900 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/trans-array.c | 47 ++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 46 insertions(+), 7 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 89ba5847fde..091ae6e273e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-11-03 Mikael Morin + + * trans-array.c (get_rank, get_loop_upper_bound_for_array): + New functions. + (gfc_trans_array_constructor): Handle multiple loops. + 2011-11-03 Mikael Morin * trans.h (struct gfc_loopinfo): New field parent. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 5659b70846e..083ce5c77ee 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2034,6 +2034,19 @@ trans_constant_array_constructor (gfc_ss * ss, tree type) } +static int +get_rank (gfc_loopinfo *loop) +{ + int rank; + + rank = 0; + for (; loop; loop = loop->parent) + rank += loop->dimen; + + return rank; +} + + /* Helper routine of gfc_trans_array_constructor to determine if the bounds of the loop specified by LOOP are constant and simple enough to use with trans_constant_array_constructor. Returns the @@ -2072,6 +2085,23 @@ constant_array_constructor_loop_size (gfc_loopinfo * loop) } +static tree * +get_loop_upper_bound_for_array (gfc_ss *array, int array_dim) +{ + gfc_ss *ss; + int n; + + gcc_assert (array->nested_ss == NULL); + + for (ss = array; ss; ss = ss->parent) + for (n = 0; n < ss->loop->dimen; n++) + if (array_dim == get_array_ref_dim_for_loop_dim (ss, n)) + return &(ss->loop->to[n]); + + gcc_unreachable (); +} + + /* Array constructors are handled by constructing a temporary, then using that within the scalarization loop. This is not optimal, but seems by far the simplest method. */ @@ -2085,6 +2115,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) tree desc; tree type; tree tmp; + tree *loop_ubound0; bool dynamic; bool old_first_len, old_typespec_chararray_ctor; tree old_first_len_val; @@ -2114,7 +2145,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) first_len = true; } - gcc_assert (ss->dimen == loop->dimen); + gcc_assert (ss->dimen == ss->loop->dimen); c = expr->value.constructor; if (expr->ts.type == BT_CHARACTER) @@ -2157,7 +2188,9 @@ trans_array_constructor (gfc_ss * ss, locus * where) /* See if the constructor determines the loop bounds. */ dynamic = false; - if (expr->shape && loop->dimen > 1 && loop->to[0] == NULL_TREE) + loop_ubound0 = get_loop_upper_bound_for_array (ss, 0); + + if (expr->shape && get_rank (loop) > 1 && *loop_ubound0 == NULL_TREE) { /* We have a multidimensional parameter. */ for (s = ss; s; s = s->parent) @@ -2176,7 +2209,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) } } - if (loop->to[0] == NULL_TREE) + if (*loop_ubound0 == NULL_TREE) { mpz_t size; @@ -2210,7 +2243,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) } } - if (TREE_CODE (loop->to[0]) == VAR_DECL) + if (TREE_CODE (*loop_ubound0) == VAR_DECL) dynamic = true; gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE, @@ -2233,10 +2266,10 @@ trans_array_constructor (gfc_ss * ss, locus * where) offsetvar, gfc_index_one_node); tmp = gfc_evaluate_now (tmp, &loop->pre); gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp); - if (loop->to[0] && TREE_CODE (loop->to[0]) == VAR_DECL) - gfc_add_modify (&loop->pre, loop->to[0], tmp); + if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL) + gfc_add_modify (&loop->pre, *loop_ubound0, tmp); else - loop->to[0] = tmp; + *loop_ubound0 = tmp; } if (TREE_USED (offsetvar)) -- cgit v1.2.1 From 2a0320a7dedb6f5c9b47813321836d826aec60f5 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:51:04 +0000 Subject: * trans-array.c (constant_array_constructor_loop_size): Handle multiple loops. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180901 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 42 ++++++++++++++++++++++++------------------ 2 files changed, 29 insertions(+), 18 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 091ae6e273e..e359eca5f07 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (constant_array_constructor_loop_size): + Handle multiple loops. + 2011-11-03 Mikael Morin * trans-array.c (get_rank, get_loop_upper_bound_for_array): diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 083ce5c77ee..299bd807564 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2053,32 +2053,38 @@ get_rank (gfc_loopinfo *loop) iteration count of the loop if suitable, and NULL_TREE otherwise. */ static tree -constant_array_constructor_loop_size (gfc_loopinfo * loop) +constant_array_constructor_loop_size (gfc_loopinfo * l) { + gfc_loopinfo *loop; tree size = gfc_index_one_node; tree tmp; - int i; + int i, total_dim; + + total_dim = get_rank (l); - for (i = 0; i < loop->dimen; i++) + for (loop = l; loop; loop = loop->parent) { - /* If the bounds aren't constant, return NULL_TREE. */ - if (!INTEGER_CST_P (loop->from[i]) || !INTEGER_CST_P (loop->to[i])) - return NULL_TREE; - if (!integer_zerop (loop->from[i])) + for (i = 0; i < loop->dimen; i++) { - /* Only allow nonzero "from" in one-dimensional arrays. */ - if (loop->dimen != 1) + /* If the bounds aren't constant, return NULL_TREE. */ + if (!INTEGER_CST_P (loop->from[i]) || !INTEGER_CST_P (loop->to[i])) return NULL_TREE; - tmp = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, - loop->to[i], loop->from[i]); + if (!integer_zerop (loop->from[i])) + { + /* Only allow nonzero "from" in one-dimensional arrays. */ + if (total_dim != 1) + return NULL_TREE; + tmp = fold_build2_loc (input_location, MINUS_EXPR, + gfc_array_index_type, + loop->to[i], loop->from[i]); + } + else + tmp = loop->to[i]; + tmp = fold_build2_loc (input_location, PLUS_EXPR, + gfc_array_index_type, tmp, gfc_index_one_node); + size = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, size, tmp); } - else - tmp = loop->to[i]; - tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type, - tmp, gfc_index_one_node); - size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, - size, tmp); } return size; -- cgit v1.2.1 From 7e10f24355cf3115066a3825f8ca44ebc271bdbe Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:53:42 +0000 Subject: * trans-array.c (outermost_loop): New function. (gfc_trans_array_constructor, gfc_set_vector_loop_bounds, gfc_add_loop_ss_code): Put generated code out of the outermost loop. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180902 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 +++++ gcc/fortran/trans-array.c | 66 +++++++++++++++++++++++++++++------------------ 2 files changed, 47 insertions(+), 25 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e359eca5f07..e073ddf916a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2011-11-03 Mikael Morin + + * trans-array.c (outermost_loop): New function. + (gfc_trans_array_constructor, gfc_set_vector_loop_bounds, + gfc_add_loop_ss_code): Put generated code out of the outermost loop. + 2011-11-03 Mikael Morin * trans-array.c (constant_array_constructor_loop_size): diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 299bd807564..0f3d1718521 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2108,6 +2108,16 @@ get_loop_upper_bound_for_array (gfc_ss *array, int array_dim) } +static gfc_loopinfo * +outermost_loop (gfc_loopinfo * loop) +{ + while (loop->parent != NULL) + loop = loop->parent; + + return loop; +} + + /* Array constructors are handled by constructing a temporary, then using that within the scalarization loop. This is not optimal, but seems by far the simplest method. */ @@ -2125,7 +2135,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) bool dynamic; bool old_first_len, old_typespec_chararray_ctor; tree old_first_len_val; - gfc_loopinfo *loop; + gfc_loopinfo *loop, *outer_loop; gfc_ss_info *ss_info; gfc_expr *expr; gfc_ss *s; @@ -2136,6 +2146,7 @@ trans_array_constructor (gfc_ss * ss, locus * where) old_typespec_chararray_ctor = typespec_chararray_ctor; loop = ss->loop; + outer_loop = outermost_loop (loop); ss_info = ss->info; expr = ss_info->expr; @@ -2171,11 +2182,11 @@ trans_array_constructor (gfc_ss * ss, locus * where) gfc_conv_expr_type (&length_se, expr->ts.u.cl->length, gfc_charlen_type_node); ss_info->string_length = length_se.expr; - gfc_add_block_to_block (&loop->pre, &length_se.pre); - gfc_add_block_to_block (&loop->post, &length_se.post); + gfc_add_block_to_block (&outer_loop->pre, &length_se.pre); + gfc_add_block_to_block (&outer_loop->post, &length_se.post); } else - const_string = get_array_ctor_strlen (&loop->pre, c, + const_string = get_array_ctor_strlen (&outer_loop->pre, c, &ss_info->string_length); /* Complex character array constructors should have been taken care of @@ -2252,15 +2263,15 @@ trans_array_constructor (gfc_ss * ss, locus * where) if (TREE_CODE (*loop_ubound0) == VAR_DECL) dynamic = true; - gfc_trans_create_temp_array (&loop->pre, &loop->post, ss, type, NULL_TREE, - dynamic, true, false, where); + gfc_trans_create_temp_array (&outer_loop->pre, &outer_loop->post, ss, type, + NULL_TREE, dynamic, true, false, where); desc = ss_info->data.array.descriptor; offset = gfc_index_zero_node; offsetvar = gfc_create_var_np (gfc_array_index_type, "offset"); TREE_NO_WARNING (offsetvar) = 1; TREE_USED (offsetvar) = 0; - gfc_trans_array_constructor_value (&loop->pre, type, desc, c, + gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c, &offset, &offsetvar, dynamic); /* If the array grows dynamically, the upper bound of the loop variable @@ -2270,10 +2281,10 @@ trans_array_constructor (gfc_ss * ss, locus * where) tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, offsetvar, gfc_index_one_node); - tmp = gfc_evaluate_now (tmp, &loop->pre); + tmp = gfc_evaluate_now (tmp, &outer_loop->pre); gfc_conv_descriptor_ubound_set (&loop->pre, desc, gfc_rank_cst[0], tmp); if (*loop_ubound0 && TREE_CODE (*loop_ubound0) == VAR_DECL) - gfc_add_modify (&loop->pre, *loop_ubound0, tmp); + gfc_add_modify (&outer_loop->pre, *loop_ubound0, tmp); else *loop_ubound0 = tmp; } @@ -2307,7 +2318,7 @@ finish: static void set_vector_loop_bounds (gfc_ss * ss) { - gfc_loopinfo *loop; + gfc_loopinfo *loop, *outer_loop; gfc_array_info *info; gfc_se se; tree tmp; @@ -2316,6 +2327,8 @@ set_vector_loop_bounds (gfc_ss * ss) int n; int dim; + outer_loop = outermost_loop (ss->loop); + info = &ss->info->data.array; for (; ss; ss = ss->parent) @@ -2343,7 +2356,7 @@ set_vector_loop_bounds (gfc_ss * ss) gfc_array_index_type, gfc_conv_descriptor_ubound_get (desc, zero), gfc_conv_descriptor_lbound_get (desc, zero)); - tmp = gfc_evaluate_now (tmp, &loop->pre); + tmp = gfc_evaluate_now (tmp, &outer_loop->pre); loop->to[n] = tmp; } } @@ -2358,7 +2371,7 @@ static void gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, locus * where) { - gfc_loopinfo *nested_loop; + gfc_loopinfo *nested_loop, *outer_loop; gfc_se se; gfc_ss_info *ss_info; gfc_array_info *info; @@ -2366,6 +2379,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, bool skip_nested = false; int n; + outer_loop = outermost_loop (loop); + /* TODO: This can generate bad code if there are ordering dependencies, e.g., a callee allocated function and an unknown size constructor. */ gcc_assert (ss != NULL); @@ -2389,7 +2404,7 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, dimension indices, but not array section bounds. */ gfc_init_se (&se, NULL); gfc_conv_expr (&se, expr); - gfc_add_block_to_block (&loop->pre, &se.pre); + gfc_add_block_to_block (&outer_loop->pre, &se.pre); if (expr->ts.type != BT_CHARACTER) { @@ -2398,11 +2413,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, if (subscript) se.expr = convert(gfc_array_index_type, se.expr); if (!ss_info->where) - se.expr = gfc_evaluate_now (se.expr, &loop->pre); - gfc_add_block_to_block (&loop->pre, &se.post); + se.expr = gfc_evaluate_now (se.expr, &outer_loop->pre); + gfc_add_block_to_block (&outer_loop->pre, &se.post); } else - gfc_add_block_to_block (&loop->post, &se.post); + gfc_add_block_to_block (&outer_loop->post, &se.post); ss_info->data.scalar.value = se.expr; ss_info->string_length = se.string_length; @@ -2413,10 +2428,11 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, now. */ gfc_init_se (&se, NULL); gfc_conv_expr (&se, expr); - gfc_add_block_to_block (&loop->pre, &se.pre); - gfc_add_block_to_block (&loop->post, &se.post); + gfc_add_block_to_block (&outer_loop->pre, &se.pre); + gfc_add_block_to_block (&outer_loop->post, &se.post); - ss_info->data.scalar.value = gfc_evaluate_now (se.expr, &loop->pre); + ss_info->data.scalar.value = gfc_evaluate_now (se.expr, + &outer_loop->pre); ss_info->string_length = se.string_length; break; @@ -2438,8 +2454,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, /* Get the vector's descriptor and store it in SS. */ gfc_init_se (&se, NULL); gfc_conv_expr_descriptor (&se, expr, gfc_walk_expr (expr)); - gfc_add_block_to_block (&loop->pre, &se.pre); - gfc_add_block_to_block (&loop->post, &se.post); + gfc_add_block_to_block (&outer_loop->pre, &se.pre); + gfc_add_block_to_block (&outer_loop->post, &se.post); info->descriptor = se.expr; break; @@ -2454,8 +2470,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, se.loop = loop; se.ss = ss; gfc_conv_expr (&se, expr); - gfc_add_block_to_block (&loop->pre, &se.pre); - gfc_add_block_to_block (&loop->post, &se.post); + gfc_add_block_to_block (&outer_loop->pre, &se.pre); + gfc_add_block_to_block (&outer_loop->post, &se.post); ss_info->string_length = se.string_length; break; @@ -2469,8 +2485,8 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript, gfc_conv_expr_type (&se, expr->ts.u.cl->length, gfc_charlen_type_node); ss_info->string_length = se.expr; - gfc_add_block_to_block (&loop->pre, &se.pre); - gfc_add_block_to_block (&loop->post, &se.post); + gfc_add_block_to_block (&outer_loop->pre, &se.pre); + gfc_add_block_to_block (&outer_loop->post, &se.post); } trans_array_constructor (ss, where); break; -- cgit v1.2.1 From 5e8f57eb418d5e7f43d7dfc23a0edfeb461fdf93 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:56:20 +0000 Subject: * trans-array.c (gfc_trans_preloop_setup): New pointers to outer dimension's ss and loop. Use them. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180903 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-array.c | 34 +++++++++++++++++++++++++++------- 2 files changed, 32 insertions(+), 7 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e073ddf916a..f8a83669c98 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-03 Mikael Morin + + * trans-array.c (gfc_trans_preloop_setup): New pointers to outer + dimension's ss and loop. Use them. + 2011-11-03 Mikael Morin * trans-array.c (outermost_loop): New function. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0f3d1718521..3c0c1103807 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3116,7 +3116,8 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, gfc_ss_info *ss_info; gfc_array_info *info; gfc_ss_type ss_type; - gfc_ss *ss; + gfc_ss *ss, *pss; + gfc_loopinfo *ploop; gfc_array_ref *ar; int i; @@ -3146,18 +3147,37 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, else ar = NULL; + if (dim == loop->dimen - 1 && loop->parent != NULL) + { + /* If we are in the outermost dimension of this loop, the previous + dimension shall be in the parent loop. */ + gcc_assert (ss->parent != NULL); + + pss = ss->parent; + ploop = loop->parent; + + /* ss and ss->parent are about the same array. */ + gcc_assert (ss_info == pss->info); + } + else + { + ploop = loop; + pss = ss; + } + if (dim == loop->dimen - 1) i = 0; else i = dim + 1; /* For the time being, there is no loop reordering. */ - gcc_assert (i == loop->order[i]); - i = loop->order[i]; + gcc_assert (i == ploop->order[i]); + i = ploop->order[i]; - if (dim == loop->dimen - 1) + if (dim == loop->dimen - 1 && loop->parent == NULL) { - stride = gfc_conv_array_stride (info->descriptor, ss->dim[i]); + stride = gfc_conv_array_stride (info->descriptor, + innermost_ss (ss)->dim[i]); /* Calculate the stride of the innermost loop. Hopefully this will allow the backend optimizers to do their stuff more effectively. @@ -3180,10 +3200,10 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, } else /* Add the offset for the previous loop dimension. */ - add_array_offset (pblock, loop, ss, ar, ss->dim[i], i); + add_array_offset (pblock, ploop, ss, ar, pss->dim[i], i); /* Remember this offset for the second loop. */ - if (dim == loop->temp_dim - 1) + if (dim == loop->temp_dim - 1 && loop->parent == NULL) info->saved_offset = info->offset; } } -- cgit v1.2.1 From efeb2b164fbfa123b7dee536ecab9edff0621e5d Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 3 Nov 2011 23:58:20 +0000 Subject: * trans.h (gfc_inline_intrinsic_function_p): Move prototype... * gfortran.h (gfc_inline_intrinsic_function_p): ... here. * dependency.c (gfc_check_argument_var_dependency): Check dependencies of inline intrinsics' arguments. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180904 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/dependency.c | 11 +++++++++++ gcc/fortran/gfortran.h | 3 +++ gcc/fortran/trans.h | 3 --- 4 files changed, 21 insertions(+), 3 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f8a83669c98..a1faa78c0f2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-11-03 Mikael Morin + + * trans.h (gfc_inline_intrinsic_function_p): Move prototype... + * gfortran.h (gfc_inline_intrinsic_function_p): ... here. + * dependency.c (gfc_check_argument_var_dependency): Check dependencies + of inline intrinsics' arguments. + 2011-11-03 Mikael Morin * trans-array.c (gfc_trans_preloop_setup): New pointers to outer diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index c43af00c727..fd7fa734426 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -713,6 +713,17 @@ gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent, return gfc_check_fncall_dependency (var, intent, NULL, expr->value.function.actual, ELEM_CHECK_VARIABLE); + + if (gfc_inline_intrinsic_function_p (expr)) + { + /* The TRANSPOSE case should have been caught in the + noncopying intrinsic case above. */ + gcc_assert (expr->value.function.isym->id != GFC_ISYM_TRANSPOSE); + + return gfc_check_fncall_dependency (var, intent, NULL, + expr->value.function.actual, + ELEM_CHECK_VARIABLE); + } } return 0; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index da3477d7a0b..b869ca353de 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2880,6 +2880,9 @@ void gfc_generate_code (gfc_namespace *); void gfc_generate_module_code (gfc_namespace *); void gfc_init_coarray_decl (bool); +/* trans-intrinsic.c */ +bool gfc_inline_intrinsic_function_p (gfc_expr *); + /* bbt.c */ typedef int (*compare_fn) (void *, void *); void gfc_insert_bbt (void *, void *, compare_fn); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 4d745f144ce..5757865b3a1 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -396,9 +396,6 @@ tree gfc_builtin_decl_for_float_kind (enum built_in_function, int); tree gfc_conv_intrinsic_subroutine (gfc_code *); void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *); -/* Is the intrinsic expanded inline. */ -bool gfc_inline_intrinsic_function_p (gfc_expr *); - /* Does an intrinsic map directly to an external library call This is true for array-returning intrinsics, unless gfc_inline_intrinsic_function_p returns true. */ -- cgit v1.2.1 From 6e7db166fd97d22395e0022879d43c19234697a1 Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:00:23 +0000 Subject: * trans-array.h (gfc_free_ss, gfc_set_delta): New prototypes. * trans-array.c (gfc_free_ss): Remove forward declaration. Make non-static. (set_delta, gfc_set_delta): Remove forward declaration. Make non-static and rename the former to the later. Update uses. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180905 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 ++++++++ gcc/fortran/trans-array.c | 21 +++++++-------------- gcc/fortran/trans-array.h | 4 ++++ 3 files changed, 19 insertions(+), 14 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a1faa78c0f2..9a8fee0504b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-11-04 Mikael Morin + + * trans-array.h (gfc_free_ss, gfc_set_delta): New prototypes. + * trans-array.c (gfc_free_ss): Remove forward declaration. + Make non-static. + (set_delta, gfc_set_delta): Remove forward declaration. + Make non-static and rename the former to the later. Update uses. + 2011-11-03 Mikael Morin * trans.h (gfc_inline_intrinsic_function_p): Move prototype... diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 3c0c1103807..acd9aec18fe 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -466,8 +466,6 @@ gfc_mark_ss_chain_used (gfc_ss * ss, unsigned flags) ss->info->useflags = flags; } -static void gfc_free_ss (gfc_ss *); - /* Free a gfc_ss chain. */ @@ -500,7 +498,7 @@ free_ss_info (gfc_ss_info *ss_info) /* Free a SS. */ -static void +void gfc_free_ss (gfc_ss * ss) { gfc_ss_info *ss_info; @@ -1027,7 +1025,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, /* We have just changed the loop bounds, we must clear the corresponding specloop, so that delta calculation is not skipped - later in set_delta. */ + later in gfc_set_delta. */ loop->specloop[n] = NULL; /* We are constructing the temporary's descriptor based on the loop @@ -4372,9 +4370,6 @@ set_loop_bounds (gfc_loopinfo *loop) } -static void set_delta (gfc_loopinfo *loop); - - /* Initialize the scalarization loop. Creates the loop variables. Determines the range of the loop variables. Creates a temporary if required. Also generates code for scalar expressions which have been @@ -4422,10 +4417,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) /* For array parameters we don't have loop variables, so don't calculate the translations. */ - if (loop->array_parameter) - return; - - set_delta (loop); + if (!loop->array_parameter) + gfc_set_delta (loop); } @@ -4433,8 +4426,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where) array: once loop bounds are chosen, sets the difference (DELTA field) between loop bounds and array reference bounds, for each array info. */ -static void -set_delta (gfc_loopinfo *loop) +void +gfc_set_delta (gfc_loopinfo *loop) { gfc_ss *ss, **loopspec; gfc_array_info *info; @@ -4482,7 +4475,7 @@ set_delta (gfc_loopinfo *loop) } for (loop = loop->nested; loop; loop = loop->next) - set_delta (loop); + gfc_set_delta (loop); } diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index aad8c47b6f1..bd593bdb487 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -88,6 +88,8 @@ void gfc_add_ss_to_loop (gfc_loopinfo *, gfc_ss *); void gfc_mark_ss_chain_used (gfc_ss *, unsigned); /* Free a gfc_ss chain. */ void gfc_free_ss_chain (gfc_ss *); +/* Free a single gfc_ss element. */ +void gfc_free_ss (gfc_ss *); /* Allocate a new array type ss. */ gfc_ss *gfc_get_array_ss (gfc_ss *, gfc_expr *, int, gfc_ss_type); /* Allocate a new temporary type ss. */ @@ -111,6 +113,8 @@ void gfc_trans_scalarizing_loops (gfc_loopinfo *, stmtblock_t *); void gfc_trans_scalarized_loop_boundary (gfc_loopinfo *, stmtblock_t *); /* Initialize the scalarization loop parameters. */ void gfc_conv_loop_setup (gfc_loopinfo *, locus *); +/* Set each array's delta. */ +void gfc_set_delta (gfc_loopinfo *); /* Resolve array assignment dependencies. */ void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *); /* Build a null array descriptor constructor. */ -- cgit v1.2.1 From 38adfa471c5125c67cf712e91f01635f22d547cf Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:04:27 +0000 Subject: * trans-expr.c (gfc_conv_procedure_call): Handle temporaries for arguments to elemental calls. * trans-stmt.c (replace_ss): New function. (gfc_conv_elemental_dependencies): Remove temporary loop handling. Create a new ss for the temporary and replace the original one with it. Remove fake array references. Recalculate all offsets. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180906 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 9 ++++ gcc/fortran/trans-expr.c | 13 +++++- gcc/fortran/trans-stmt.c | 112 +++++++++++++++++++---------------------------- 3 files changed, 67 insertions(+), 67 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9a8fee0504b..0cebe5fee67 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2011-11-04 Mikael Morin + + * trans-expr.c (gfc_conv_procedure_call): Handle temporaries for + arguments to elemental calls. + * trans-stmt.c (replace_ss): New function. + (gfc_conv_elemental_dependencies): Remove temporary loop handling. + Create a new ss for the temporary and replace the original one with it. + Remove fake array references. Recalculate all offsets. + 2011-11-04 Mikael Morin * trans-array.h (gfc_free_ss, gfc_set_delta): New prototypes. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 4cfdc3e0906..cf9f0f7cdb9 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2997,8 +2997,19 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { /* An elemental function inside a scalarized loop. */ gfc_init_se (&parmse, se); - gfc_conv_expr_reference (&parmse, e); parm_kind = ELEMENTAL; + + if (se->ss->dimen > 0 + && se->ss->info->data.array.ref == NULL) + { + gfc_conv_tmp_array_ref (&parmse); + if (e->ts.type == BT_CHARACTER) + gfc_conv_string_parameter (&parmse); + else + parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr); + } + else + gfc_conv_expr_reference (&parmse, e); } else { diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 2e023207e0e..0d793f96858 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -178,6 +178,41 @@ gfc_trans_entry (gfc_code * code) } +/* Replace a gfc_ss structure by another both in the gfc_se struct + and the gfc_loopinfo struct. This is used in gfc_conv_elemental_dependencies + to replace a variable ss by the corresponding temporary. */ + +static void +replace_ss (gfc_se *se, gfc_ss *old_ss, gfc_ss *new_ss) +{ + gfc_ss **sess, **loopss; + + /* The old_ss is a ss for a single variable. */ + gcc_assert (old_ss->info->type == GFC_SS_SECTION); + + for (sess = &(se->ss); *sess != gfc_ss_terminator; sess = &((*sess)->next)) + if (*sess == old_ss) + break; + gcc_assert (*sess != gfc_ss_terminator); + + *sess = new_ss; + new_ss->next = old_ss->next; + + + for (loopss = &(se->loop->ss); *loopss != gfc_ss_terminator; + loopss = &((*loopss)->loop_chain)) + if (*loopss == old_ss) + break; + gcc_assert (*loopss != gfc_ss_terminator); + + *loopss = new_ss; + new_ss->loop_chain = old_ss->loop_chain; + new_ss->loop = old_ss->loop; + + gfc_free_ss (old_ss); +} + + /* Check for dependencies between INTENT(IN) and INTENT(OUT) arguments of elemental subroutines. Make temporaries for output arguments if any such dependencies are found. Output arguments are chosen because internal_unpack @@ -190,15 +225,10 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, gfc_actual_arglist *arg0; gfc_expr *e; gfc_formal_arglist *formal; - gfc_loopinfo tmp_loop; gfc_se parmse; gfc_ss *ss; - gfc_array_info *info; gfc_symbol *fsym; - gfc_ref *ref; - int n; tree data; - tree offset; tree size; tree tmp; @@ -217,14 +247,9 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, continue; /* Obtain the info structure for the current argument. */ - info = NULL; for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next) - { - if (ss->info->expr != e) - continue; - info = &ss->info->data.array; + if (ss->info->expr == e) break; - } /* If there is a dependency, create a temporary and use it instead of the variable. */ @@ -237,49 +262,17 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, { tree initial, temptype; stmtblock_t temp_post; + gfc_ss *tmp_ss; - /* Make a local loopinfo for the temporary creation, so that - none of the other ss->info's have to be renormalized. */ - gfc_init_loopinfo (&tmp_loop); - tmp_loop.dimen = ss->dimen; - for (n = 0; n < ss->dimen; n++) - { - tmp_loop.to[n] = loopse->loop->to[n]; - tmp_loop.from[n] = loopse->loop->from[n]; - tmp_loop.order[n] = loopse->loop->order[n]; - } + tmp_ss = gfc_get_array_ss (gfc_ss_terminator, NULL, ss->dimen, + GFC_SS_SECTION); + gfc_mark_ss_chain_used (tmp_ss, 1); + tmp_ss->info->expr = ss->info->expr; + replace_ss (loopse, ss, tmp_ss); /* Obtain the argument descriptor for unpacking. */ gfc_init_se (&parmse, NULL); parmse.want_pointer = 1; - - /* The scalarizer introduces some specific peculiarities when - handling elemental subroutines; the stride can be needed up to - the dim_array - 1, rather than dim_loop - 1 to calculate - offsets outside the loop. For this reason, we make sure that - the descriptor has the dimensionality of the array by converting - trailing elements into ranges with end = start. */ - for (ref = e->ref; ref; ref = ref->next) - if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION) - break; - - if (ref) - { - bool seen_range = false; - for (n = 0; n < ref->u.ar.dimen; n++) - { - if (ref->u.ar.dimen_type[n] == DIMEN_RANGE) - seen_range = true; - - if (!seen_range - || ref->u.ar.dimen_type[n] != DIMEN_ELEMENT) - continue; - - ref->u.ar.end[n] = gfc_copy_expr (ref->u.ar.start[n]); - ref->u.ar.dimen_type[n] = DIMEN_RANGE; - } - } - gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e)); gfc_add_block_to_block (&se->pre, &parmse.pre); @@ -309,28 +302,15 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, size = gfc_create_var (gfc_array_index_type, NULL); data = gfc_create_var (pvoid_type_node, NULL); gfc_init_block (&temp_post); - ss->loop = &tmp_loop; - tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, ss, + tmp = gfc_trans_create_temp_array (&se->pre, &temp_post, tmp_ss, temptype, initial, false, true, false, &arg->expr->where); gfc_add_modify (&se->pre, size, tmp); - tmp = fold_convert (pvoid_type_node, info->data); + tmp = fold_convert (pvoid_type_node, tmp_ss->info->data.array.data); gfc_add_modify (&se->pre, data, tmp); - /* Calculate the offset for the temporary. */ - offset = gfc_index_zero_node; - for (n = 0; n < ss->dimen; n++) - { - tmp = gfc_conv_descriptor_stride_get (info->descriptor, - gfc_rank_cst[n]); - tmp = fold_build2_loc (input_location, MULT_EXPR, - gfc_array_index_type, - loopse->loop->from[n], tmp); - offset = fold_build2_loc (input_location, MINUS_EXPR, - gfc_array_index_type, offset, tmp); - } - info->offset = gfc_create_var (gfc_array_index_type, NULL); - gfc_add_modify (&se->pre, info->offset, offset); + /* Update other ss' delta. */ + gfc_set_delta (loopse->loop); /* Copy the result back using unpack. */ tmp = build_call_expr_loc (input_location, -- cgit v1.2.1 From e816ed35675a709b33257df7e1ff7f0da7a85060 Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:05:51 +0000 Subject: * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Don't calculate offset twice in generated code. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180907 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-intrinsic.c | 28 ++++++++-------------------- 2 files changed, 13 insertions(+), 20 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0cebe5fee67..07eff72a87d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-04 Mikael Morin + + * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Don't calculate + offset twice in generated code. + 2011-11-04 Mikael Morin * trans-expr.c (gfc_conv_procedure_call): Handle temporaries for diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index c3a414b789b..ee162eac6e5 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -3090,6 +3090,14 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) TREE_USED (lab2) = 1; } + /* An offset must be added to the loop + counter to obtain the required position. */ + gcc_assert (loop.from[0]); + + tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, + gfc_index_one_node, loop.from[0]); + gfc_add_modify (&loop.pre, offset, tmp); + gfc_mark_ss_chain_used (arrayss, 1); if (maskss) gfc_mark_ss_chain_used (maskss, 1); @@ -3123,16 +3131,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) /* Assign the value to the limit... */ gfc_add_modify (&ifblock, limit, arrayse.expr); - /* Remember where we are. An offset must be added to the loop - counter to obtain the required position. */ - if (loop.from[0]) - tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - gfc_index_one_node, loop.from[0]); - else - tmp = gfc_index_one_node; - - gfc_add_modify (&block, offset, tmp); - if (nonempty == NULL && HONOR_NANS (DECL_MODE (limit))) { stmtblock_t ifblock2; @@ -3232,16 +3230,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) /* Assign the value to the limit... */ gfc_add_modify (&ifblock, limit, arrayse.expr); - /* Remember where we are. An offset must be added to the loop - counter to obtain the required position. */ - if (loop.from[0]) - tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type, - gfc_index_one_node, loop.from[0]); - else - tmp = gfc_index_one_node; - - gfc_add_modify (&block, offset, tmp); - tmp = fold_build2_loc (input_location, PLUS_EXPR, TREE_TYPE (pos), loop.loopvar[0], offset); gfc_add_modify (&ifblock, pos, tmp); -- cgit v1.2.1 From 30eabb0d057ebf3719e3d0ef389ade5bcc64c0a4 Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:09:27 +0000 Subject: * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Set loop's temporary rank to the loop rank. Mark ss chains for multiple loop if necessary. Use gfc_trans_scalarized_loop_boundary to end one loop and start another. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180908 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/trans-intrinsic.c | 24 ++++++++++++++++++++---- 2 files changed, 27 insertions(+), 4 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 07eff72a87d..9b518595fbd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-11-04 Mikael Morin + + * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Set loop's + temporary rank to the loop rank. Mark ss chains for multiple loop + if necessary. Use gfc_trans_scalarized_loop_boundary to end one loop + and start another. + 2011-11-04 Mikael Morin * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Don't calculate diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index ee162eac6e5..506cdf22b80 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -3061,6 +3061,23 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); + + /* The code generated can have more than one loop in sequence (see the + comment at the function header). This doesn't work well with the + scalarizer, which changes arrays' offset when the scalarization loops + are generated (see gfc_trans_preloop_setup). Fortunately, {min,max}loc + are currently inlined in the scalar case only (for which loop is of rank + one). As there is no dependency to care about in that case, there is no + temporary, so that we can use the scalarizer temporary code to handle + multiple loops. Thus, we set temp_dim here, we call gfc_mark_ss_chain_used + with flag=3 later, and we use gfc_trans_scalarized_loop_boundary even later + to restore offset. + TODO: this prevents inlining of rank > 0 minmaxloc calls, so this + should eventually go away. We could either create two loops properly, + or find another way to save/restore the array offsets between the two + loops (without conflicting with temporary management), or use a single + loop minmaxloc implementation. See PR 31067. */ + loop.temp_dim = loop.dimen; gfc_conv_loop_setup (&loop, &expr->where); gcc_assert (loop.dimen == 1); @@ -3098,9 +3115,9 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) gfc_index_one_node, loop.from[0]); gfc_add_modify (&loop.pre, offset, tmp); - gfc_mark_ss_chain_used (arrayss, 1); + gfc_mark_ss_chain_used (arrayss, lab1 ? 3 : 1); if (maskss) - gfc_mark_ss_chain_used (maskss, 1); + gfc_mark_ss_chain_used (maskss, lab1 ? 3 : 1); /* Generate the loop body. */ gfc_start_scalarized_body (&loop, &body); @@ -3186,7 +3203,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) if (lab1) { - gfc_trans_scalarized_loop_end (&loop, 0, &body); + gfc_trans_scalarized_loop_boundary (&loop, &body); if (HONOR_NANS (DECL_MODE (limit))) { @@ -3201,7 +3218,6 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) gfc_add_expr_to_block (&loop.code[0], build1_v (GOTO_EXPR, lab2)); gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab1)); - gfc_start_block (&body); /* If we have a mask, only check this element if the mask is set. */ if (maskss) -- cgit v1.2.1 From 469bafde49ccc25bad4b9666e3b2d85f5373b6e6 Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:11:39 +0000 Subject: * trans-intrinsic.c (gfc_conv_intrinsic_minmaxval): Set loop's temporary rank to the loop rank. Mark ss chains for multiple loop if necessary. Use gfc_trans_scalarized_loop_boundary to end one loop and start another. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180909 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/trans-intrinsic.c | 24 +++++++++++++++++++----- 2 files changed, 26 insertions(+), 5 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9b518595fbd..86551b71b8a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-11-04 Mikael Morin + + * trans-intrinsic.c (gfc_conv_intrinsic_minmaxval): Set loop's + temporary rank to the loop rank. Mark ss chains for multiple loop + if necessary. Use gfc_trans_scalarized_loop_boundary to end one loop + and start another. + 2011-11-04 Mikael Morin * trans-intrinsic.c (gfc_conv_intrinsic_minmaxloc): Set loop's diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 506cdf22b80..3cdc1e0970a 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -3522,6 +3522,22 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) /* Initialize the loop. */ gfc_conv_ss_startstride (&loop); + + /* The code generated can have more than one loop in sequence (see the + comment at the function header). This doesn't work well with the + scalarizer, which changes arrays' offset when the scalarization loops + are generated (see gfc_trans_preloop_setup). Fortunately, {min,max}val + are currently inlined in the scalar case only. As there is no dependency + to care about in that case, there is no temporary, so that we can use the + scalarizer temporary code to handle multiple loops. Thus, we set temp_dim + here, we call gfc_mark_ss_chain_used with flag=3 later, and we use + gfc_trans_scalarized_loop_boundary even later to restore offset. + TODO: this prevents inlining of rank > 0 minmaxval calls, so this + should eventually go away. We could either create two loops properly, + or find another way to save/restore the array offsets between the two + loops (without conflicting with temporary management), or use a single + loop minmaxval implementation. See PR 31067. */ + loop.temp_dim = loop.dimen; gfc_conv_loop_setup (&loop, &expr->where); if (nonempty == NULL && maskss == NULL @@ -3553,9 +3569,9 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) } } - gfc_mark_ss_chain_used (arrayss, 1); + gfc_mark_ss_chain_used (arrayss, lab ? 3 : 1); if (maskss) - gfc_mark_ss_chain_used (maskss, 1); + gfc_mark_ss_chain_used (maskss, lab ? 3 : 1); /* Generate the loop body. */ gfc_start_scalarized_body (&loop, &body); @@ -3665,15 +3681,13 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, enum tree_code op) if (lab) { - gfc_trans_scalarized_loop_end (&loop, 0, &body); + gfc_trans_scalarized_loop_boundary (&loop, &body); tmp = fold_build3_loc (input_location, COND_EXPR, type, nonempty, nan_cst, huge_cst); gfc_add_modify (&loop.code[0], limit, tmp); gfc_add_expr_to_block (&loop.code[0], build1_v (LABEL_EXPR, lab)); - gfc_start_block (&body); - /* If we have a mask, only add this element if the mask is set. */ if (maskss) { -- cgit v1.2.1 From d480b22c79d1fb0ee6b6fdef9281446ef6391349 Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:12:54 +0000 Subject: * array.c (match_subscript): Skip whitespaces before setting locus. * matchexp.c (match_level_1): Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180910 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/array.c | 1 + gcc/fortran/matchexp.c | 1 + 3 files changed, 7 insertions(+) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 86551b71b8a..ed6a4dfe267 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-04 Mikael Morin + + * array.c (match_subscript): Skip whitespaces before setting locus. + * matchexp.c (match_level_1): Ditto. + 2011-11-04 Mikael Morin * trans-intrinsic.c (gfc_conv_intrinsic_minmaxval): Set loop's diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index 3e6b9d2591c..a1449fd8c9e 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -70,6 +70,7 @@ match_subscript (gfc_array_ref *ar, int init, bool match_star) i = ar->dimen + ar->codimen; + gfc_gobble_whitespace (); ar->c_where[i] = gfc_current_locus; ar->start[i] = ar->end[i] = ar->stride[i] = NULL; diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c index 8b99ce98692..cd70dc0f758 100644 --- a/gcc/fortran/matchexp.c +++ b/gcc/fortran/matchexp.c @@ -201,6 +201,7 @@ match_level_1 (gfc_expr **result) locus where; match m; + gfc_gobble_whitespace (); where = gfc_current_locus; uop = NULL; m = match_defined_operator (&uop); -- cgit v1.2.1 From 9a1f41f03ac0f7c491aa48bde989a67a2af6359c Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:14:58 +0000 Subject: * frontend-passes.c (cfe_register_funcs): Return early in the case of an inline intrinsic function. (optimize_binop_array_assignment): Skip optimization in the case of an inline intrinsic function. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180911 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/frontend-passes.c | 7 ++++--- 2 files changed, 11 insertions(+), 3 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ed6a4dfe267..6fca42978c2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-11-04 Mikael Morin + + * frontend-passes.c (cfe_register_funcs): Return early in the case + of an inline intrinsic function. + (optimize_binop_array_assignment): Skip optimization in the case of + an inline intrinsic function. + 2011-11-04 Mikael Morin * array.c (match_subscript): Skip whitespaces before setting locus. diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 5b1a644e247..a19f22deac5 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -203,8 +203,8 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, /* Conversions are handled on the fly by the middle end, transpose during trans-* stages and TRANSFER by the middle end. */ if ((*e)->value.function.isym->id == GFC_ISYM_CONVERSION - || (*e)->value.function.isym->id == GFC_ISYM_TRANSPOSE - || (*e)->value.function.isym->id == GFC_ISYM_TRANSFER) + || (*e)->value.function.isym->id == GFC_ISYM_TRANSFER + || gfc_inline_intrinsic_function_p (*e)) return 0; /* Don't create an array temporary for elemental functions, @@ -567,7 +567,8 @@ optimize_binop_array_assignment (gfc_code *c, gfc_expr **rhs, bool seen_op) && ! (e->value.function.isym && (e->value.function.isym->elemental || e->ts.type != c->expr1->ts.type - || e->ts.kind != c->expr1->ts.kind))) + || e->ts.kind != c->expr1->ts.kind)) + && ! gfc_inline_intrinsic_function_p (e)) { gfc_code *n; -- cgit v1.2.1 From 190c9d73cdfbf28d14152d2f9fe55db3e2f0b215 Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:17:07 +0000 Subject: * trans-intrinsic.c (gfc_conv_intrinsic_arith): Update conditions. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180913 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 4 ++++ gcc/fortran/trans-intrinsic.c | 12 ++++++------ 2 files changed, 10 insertions(+), 6 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6fca42978c2..be67d8d0032 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2011-11-04 Mikael Morin + + * trans-intrinsic.c (gfc_conv_intrinsic_arith): Update conditions. + 2011-11-04 Mikael Morin * frontend-passes.c (cfe_register_funcs): Return early in the case diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 3cdc1e0970a..342d2cb4ec4 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2624,7 +2624,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, maskexpr = actual->expr; } - if (maskexpr && maskexpr->rank != 0) + if (maskexpr && maskexpr->rank > 0) { maskss = gfc_walk_expr (maskexpr); gcc_assert (maskss != gfc_ss_terminator); @@ -2635,7 +2635,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, /* Initialize the scalarizer. */ gfc_init_loopinfo (&loop); gfc_add_ss_to_loop (&loop, arrayss); - if (maskss) + if (maskexpr && maskexpr->rank > 0) gfc_add_ss_to_loop (&loop, maskss); /* Initialize the loop. */ @@ -2643,13 +2643,13 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, gfc_conv_loop_setup (&loop, &expr->where); gfc_mark_ss_chain_used (arrayss, 1); - if (maskss) + if (maskexpr && maskexpr->rank > 0) gfc_mark_ss_chain_used (maskss, 1); /* Generate the loop body. */ gfc_start_scalarized_body (&loop, &body); /* If we have a mask, only add this element if the mask is set. */ - if (maskss) + if (maskexpr && maskexpr->rank > 0) { gfc_init_se (&maskse, NULL); gfc_copy_loopinfo_to_se (&maskse, &loop); @@ -2740,7 +2740,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, gfc_add_block_to_block (&block, &arrayse.post); - if (maskss) + if (maskexpr && maskexpr->rank > 0) { /* We enclose the above in if (mask) {...} . */ @@ -2755,7 +2755,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, gfc_trans_scalarizing_loops (&loop, &body); /* For a scalar mask, enclose the loop in an if statement. */ - if (maskexpr && maskss == NULL) + if (maskexpr && maskexpr->rank == 0) { gfc_init_se (&maskse, NULL); gfc_conv_expr_val (&maskse, maskexpr); -- cgit v1.2.1 From dbef28539a4d2bb036dd942eab140580bcda9cae Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:19:11 +0000 Subject: * trans-intrinsic.c (gfc_conv_intrinsic_arith): Small argument handling cleanup. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180917 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-intrinsic.c | 13 +++++++------ 2 files changed, 12 insertions(+), 6 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index be67d8d0032..4d78f77b431 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-04 Mikael Morin + + * trans-intrinsic.c (gfc_conv_intrinsic_arith): Small argument handling + cleanup. + 2011-11-04 Mikael Morin * trans-intrinsic.c (gfc_conv_intrinsic_arith): Update conditions. diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 342d2cb4ec4..b70150228cd 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2569,7 +2569,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, stmtblock_t block; tree tmp; gfc_loopinfo loop; - gfc_actual_arglist *actual; + gfc_actual_arglist *arg_array, *arg_mask; gfc_ss *arrayss; gfc_ss *maskss; gfc_se arrayse; @@ -2608,9 +2608,10 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, gfc_add_modify (&se->pre, resvar, tmp); + arg_array = expr->value.function.actual; + /* Walk the arguments. */ - actual = expr->value.function.actual; - arrayexpr = actual->expr; + arrayexpr = arg_array->expr; arrayss = gfc_walk_expr (arrayexpr); gcc_assert (arrayss != gfc_ss_terminator); @@ -2619,9 +2620,9 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, maskexpr = NULL; else { - actual = actual->next->next; - gcc_assert (actual); - maskexpr = actual->expr; + arg_mask = arg_array->next->next; + gcc_assert (arg_mask != NULL); + maskexpr = arg_mask->expr; } if (maskexpr && maskexpr->rank > 0) -- cgit v1.2.1 From cae7ff32d79ba9f909443a724a93b9bf6eb94932 Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:21:14 +0000 Subject: * trans-intrinsic.c (gfc_conv_intrinsic.c): Introduce current loop pointer. Use it. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180918 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-intrinsic.c | 22 ++++++++++++---------- 2 files changed, 17 insertions(+), 10 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 4d78f77b431..01d43747388 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-04 Mikael Morin + + * trans-intrinsic.c (gfc_conv_intrinsic.c): Introduce current loop + pointer. Use it. + 2011-11-04 Mikael Morin * trans-intrinsic.c (gfc_conv_intrinsic_arith): Small argument handling diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index b70150228cd..f7b10416f98 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2568,7 +2568,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, stmtblock_t body; stmtblock_t block; tree tmp; - gfc_loopinfo loop; + gfc_loopinfo loop, *ploop; gfc_actual_arglist *arg_array, *arg_mask; gfc_ss *arrayss; gfc_ss *maskss; @@ -2646,14 +2646,16 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, gfc_mark_ss_chain_used (arrayss, 1); if (maskexpr && maskexpr->rank > 0) gfc_mark_ss_chain_used (maskss, 1); + + ploop = &loop; /* Generate the loop body. */ - gfc_start_scalarized_body (&loop, &body); + gfc_start_scalarized_body (ploop, &body); /* If we have a mask, only add this element if the mask is set. */ if (maskexpr && maskexpr->rank > 0) { gfc_init_se (&maskse, NULL); - gfc_copy_loopinfo_to_se (&maskse, &loop); + gfc_copy_loopinfo_to_se (&maskse, ploop); maskse.ss = maskss; gfc_conv_expr_val (&maskse, maskexpr); gfc_add_block_to_block (&body, &maskse.pre); @@ -2665,7 +2667,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, /* Do the actual summation/product. */ gfc_init_se (&arrayse, NULL); - gfc_copy_loopinfo_to_se (&arrayse, &loop); + gfc_copy_loopinfo_to_se (&arrayse, ploop); arrayse.ss = arrayss; gfc_conv_expr_val (&arrayse, arrayexpr); gfc_add_block_to_block (&block, &arrayse.pre); @@ -2753,7 +2755,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, tmp = gfc_finish_block (&block); gfc_add_expr_to_block (&body, tmp); - gfc_trans_scalarizing_loops (&loop, &body); + gfc_trans_scalarizing_loops (ploop, &body); /* For a scalar mask, enclose the loop in an if statement. */ if (maskexpr && maskexpr->rank == 0) @@ -2761,8 +2763,8 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, gfc_init_se (&maskse, NULL); gfc_conv_expr_val (&maskse, maskexpr); gfc_init_block (&block); - gfc_add_block_to_block (&block, &loop.pre); - gfc_add_block_to_block (&block, &loop.post); + gfc_add_block_to_block (&block, &ploop->pre); + gfc_add_block_to_block (&block, &ploop->post); tmp = gfc_finish_block (&block); tmp = build3_v (COND_EXPR, maskse.expr, tmp, @@ -2772,11 +2774,11 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, } else { - gfc_add_block_to_block (&se->pre, &loop.pre); - gfc_add_block_to_block (&se->pre, &loop.post); + gfc_add_block_to_block (&se->pre, &ploop->pre); + gfc_add_block_to_block (&se->pre, &ploop->post); } - gfc_cleanup_loop (&loop); + gfc_cleanup_loop (ploop); if (norm2) { -- cgit v1.2.1 From 85b3b7b7f59c24651efc30c7ca4bc1c2e8f13a12 Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:23:14 +0000 Subject: * trans-intrinsic.c (gfc_conv_intrinsic_arith): Introduce parent expression variable. Use it. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180919 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/trans-intrinsic.c | 7 +++++-- 2 files changed, 10 insertions(+), 2 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 01d43747388..f9bd3eb5718 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-04 Mikael Morin + + * trans-intrinsic.c (gfc_conv_intrinsic_arith): Introduce parent + expression variable. Use it. + 2011-11-04 Mikael Morin * trans-intrinsic.c (gfc_conv_intrinsic.c): Introduce current loop diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index f7b10416f98..25c54fb6db9 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2574,6 +2574,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, gfc_ss *maskss; gfc_se arrayse; gfc_se maskse; + gfc_se *parent_se; gfc_expr *arrayexpr; gfc_expr *maskexpr; @@ -2582,6 +2583,8 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, gfc_conv_intrinsic_funcall (se, expr); return; } + else + parent_se = NULL; type = gfc_typenode_for_spec (&expr->ts); /* Initialize the result. */ @@ -2654,7 +2657,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, /* If we have a mask, only add this element if the mask is set. */ if (maskexpr && maskexpr->rank > 0) { - gfc_init_se (&maskse, NULL); + gfc_init_se (&maskse, parent_se); gfc_copy_loopinfo_to_se (&maskse, ploop); maskse.ss = maskss; gfc_conv_expr_val (&maskse, maskexpr); @@ -2666,7 +2669,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, gfc_init_block (&block); /* Do the actual summation/product. */ - gfc_init_se (&arrayse, NULL); + gfc_init_se (&arrayse, parent_se); gfc_copy_loopinfo_to_se (&arrayse, ploop); arrayse.ss = arrayss; gfc_conv_expr_val (&arrayse, arrayexpr); -- cgit v1.2.1 From 88df5e2fe380ded681c7058f6b1ab1db7ceb10a6 Mon Sep 17 00:00:00 2001 From: mikael Date: Fri, 4 Nov 2011 00:31:19 +0000 Subject: PR fortran/43829 * trans-array.c (gfc_conv_expr_descriptor): Accept the inline intrinsic case in the assertion. * trans-intrinsic (enter_nested_loop): New function. (gfc_conv_intrinsic_arith): Support non-scalar cases. (nest_loop_dimension, walk_inline_intrinsic_arith): New functions. (walk_inline_intrinsic_function): Handle sum and product. (gfc_inline_intrinsic_function_p): Ditto. * trans.h (gfc_get_loopinfo): New macro. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@180920 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 12 +++ gcc/fortran/trans-array.c | 3 +- gcc/fortran/trans-intrinsic.c | 235 ++++++++++++++++++++++++++++++++++++------ gcc/fortran/trans.h | 1 + 4 files changed, 217 insertions(+), 34 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index f9bd3eb5718..5b1d41071e9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2011-11-04 Mikael Morin + + PR fortran/43829 + * trans-array.c (gfc_conv_expr_descriptor): Accept the inline intrinsic + case in the assertion. + * trans-intrinsic (enter_nested_loop): New function. + (gfc_conv_intrinsic_arith): Support non-scalar cases. + (nest_loop_dimension, walk_inline_intrinsic_arith): New functions. + (walk_inline_intrinsic_function): Handle sum and product. + (gfc_inline_intrinsic_function_p): Ditto. + * trans.h (gfc_get_loopinfo): New macro. + 2011-11-04 Mikael Morin * trans-intrinsic.c (gfc_conv_intrinsic_arith): Introduce parent diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index acd9aec18fe..262743d0d37 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -6187,7 +6187,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss) gcc_assert ((expr->value.function.esym != NULL && expr->value.function.esym->attr.elemental) || (expr->value.function.isym != NULL - && expr->value.function.isym->elemental)); + && expr->value.function.isym->elemental) + || gfc_inline_intrinsic_function_p (expr)); else gcc_assert (ss_type == GFC_SS_INTRINSIC); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 25c54fb6db9..4244570a7e9 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2557,6 +2557,20 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr) se->expr = resvar; } + +/* Update given gfc_se to have ss component pointing to the nested gfc_ss + struct and return the corresponding loopinfo. */ + +static gfc_loopinfo * +enter_nested_loop (gfc_se *se) +{ + se->ss = se->ss->nested_ss; + gcc_assert (se->ss == se->ss->loop->ss); + + return se->ss->loop; +} + + /* Inline implementation of the sum and product intrinsics. */ static void gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, @@ -2570,18 +2584,18 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, tree tmp; gfc_loopinfo loop, *ploop; gfc_actual_arglist *arg_array, *arg_mask; - gfc_ss *arrayss; - gfc_ss *maskss; + gfc_ss *arrayss = NULL; + gfc_ss *maskss = NULL; gfc_se arrayse; gfc_se maskse; gfc_se *parent_se; gfc_expr *arrayexpr; gfc_expr *maskexpr; - if (se->ss) + if (expr->rank > 0) { - gfc_conv_intrinsic_funcall (se, expr); - return; + gcc_assert (gfc_inline_intrinsic_function_p (expr)); + parent_se = se; } else parent_se = NULL; @@ -2613,10 +2627,7 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, arg_array = expr->value.function.actual; - /* Walk the arguments. */ arrayexpr = arg_array->expr; - arrayss = gfc_walk_expr (arrayexpr); - gcc_assert (arrayss != gfc_ss_terminator); if (op == NE_EXPR || norm2) /* PARITY and NORM2. */ @@ -2628,29 +2639,42 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, maskexpr = arg_mask->expr; } - if (maskexpr && maskexpr->rank > 0) + if (expr->rank == 0) { - maskss = gfc_walk_expr (maskexpr); - gcc_assert (maskss != gfc_ss_terminator); - } - else - maskss = NULL; + /* Walk the arguments. */ + arrayss = gfc_walk_expr (arrayexpr); + gcc_assert (arrayss != gfc_ss_terminator); - /* Initialize the scalarizer. */ - gfc_init_loopinfo (&loop); - gfc_add_ss_to_loop (&loop, arrayss); - if (maskexpr && maskexpr->rank > 0) - gfc_add_ss_to_loop (&loop, maskss); + if (maskexpr && maskexpr->rank > 0) + { + maskss = gfc_walk_expr (maskexpr); + gcc_assert (maskss != gfc_ss_terminator); + } + else + maskss = NULL; - /* Initialize the loop. */ - gfc_conv_ss_startstride (&loop); - gfc_conv_loop_setup (&loop, &expr->where); + /* Initialize the scalarizer. */ + gfc_init_loopinfo (&loop); + gfc_add_ss_to_loop (&loop, arrayss); + if (maskexpr && maskexpr->rank > 0) + gfc_add_ss_to_loop (&loop, maskss); - gfc_mark_ss_chain_used (arrayss, 1); - if (maskexpr && maskexpr->rank > 0) - gfc_mark_ss_chain_used (maskss, 1); + /* Initialize the loop. */ + gfc_conv_ss_startstride (&loop); + gfc_conv_loop_setup (&loop, &expr->where); + + gfc_mark_ss_chain_used (arrayss, 1); + if (maskexpr && maskexpr->rank > 0) + gfc_mark_ss_chain_used (maskss, 1); + + ploop = &loop; + } + else + /* All the work has been done in the parent loops. */ + ploop = enter_nested_loop (se); + + gcc_assert (ploop); - ploop = &loop; /* Generate the loop body. */ gfc_start_scalarized_body (ploop, &body); @@ -2659,7 +2683,8 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, { gfc_init_se (&maskse, parent_se); gfc_copy_loopinfo_to_se (&maskse, ploop); - maskse.ss = maskss; + if (expr->rank == 0) + maskse.ss = maskss; gfc_conv_expr_val (&maskse, maskexpr); gfc_add_block_to_block (&body, &maskse.pre); @@ -2671,7 +2696,8 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, /* Do the actual summation/product. */ gfc_init_se (&arrayse, parent_se); gfc_copy_loopinfo_to_se (&arrayse, ploop); - arrayse.ss = arrayss; + if (expr->rank == 0) + arrayse.ss = arrayss; gfc_conv_expr_val (&arrayse, arrayexpr); gfc_add_block_to_block (&block, &arrayse.pre); @@ -2763,17 +2789,29 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, /* For a scalar mask, enclose the loop in an if statement. */ if (maskexpr && maskexpr->rank == 0) { - gfc_init_se (&maskse, NULL); - gfc_conv_expr_val (&maskse, maskexpr); gfc_init_block (&block); gfc_add_block_to_block (&block, &ploop->pre); gfc_add_block_to_block (&block, &ploop->post); tmp = gfc_finish_block (&block); - tmp = build3_v (COND_EXPR, maskse.expr, tmp, - build_empty_stmt (input_location)); + if (expr->rank > 0) + { + tmp = build3_v (COND_EXPR, se->ss->info->data.scalar.value, tmp, + build_empty_stmt (input_location)); + gfc_advance_se_ss_chain (se); + } + else + { + gcc_assert (expr->rank == 0); + gfc_init_se (&maskse, NULL); + gfc_conv_expr_val (&maskse, maskexpr); + tmp = build3_v (COND_EXPR, maskse.expr, tmp, + build_empty_stmt (input_location)); + } + gfc_add_expr_to_block (&block, tmp); gfc_add_block_to_block (&se->pre, &block); + gcc_assert (se->post.head == NULL); } else { @@ -2781,7 +2819,8 @@ gfc_conv_intrinsic_arith (gfc_se * se, gfc_expr * expr, enum tree_code op, gfc_add_block_to_block (&se->pre, &ploop->post); } - gfc_cleanup_loop (ploop); + if (expr->rank == 0) + gfc_cleanup_loop (ploop); if (norm2) { @@ -6801,12 +6840,127 @@ walk_inline_intrinsic_transpose (gfc_ss *ss, gfc_expr *expr) } +/* Move the given dimension of the given gfc_ss list to a nested gfc_ss list. + This has the side effect of reversing the nested list, so there is no + need to call gfc_reverse_ss on it (the given list is assumed not to be + reversed yet). */ + +static gfc_ss * +nest_loop_dimension (gfc_ss *ss, int dim) +{ + int ss_dim, i; + gfc_ss *new_ss, *prev_ss = gfc_ss_terminator; + gfc_loopinfo *new_loop; + + gcc_assert (ss != gfc_ss_terminator); + + for (; ss != gfc_ss_terminator; ss = ss->next) + { + new_ss = gfc_get_ss (); + new_ss->next = prev_ss; + new_ss->parent = ss; + new_ss->info = ss->info; + new_ss->info->refcount++; + if (ss->dimen != 0) + { + gcc_assert (ss->info->type != GFC_SS_SCALAR + && ss->info->type != GFC_SS_REFERENCE); + + new_ss->dimen = 1; + new_ss->dim[0] = ss->dim[dim]; + + gcc_assert (dim < ss->dimen); + + ss_dim = --ss->dimen; + for (i = dim; i < ss_dim; i++) + ss->dim[i] = ss->dim[i + 1]; + + ss->dim[ss_dim] = 0; + } + prev_ss = new_ss; + + if (ss->nested_ss) + { + ss->nested_ss->parent = new_ss; + new_ss->nested_ss = ss->nested_ss; + } + ss->nested_ss = new_ss; + } + + new_loop = gfc_get_loopinfo (); + gfc_init_loopinfo (new_loop); + + gcc_assert (prev_ss != NULL); + gcc_assert (prev_ss != gfc_ss_terminator); + gfc_add_ss_to_loop (new_loop, prev_ss); + return new_ss->parent; +} + + +/* Create the gfc_ss list for the SUM/PRODUCT arguments when the function + is to be inlined. */ + +static gfc_ss * +walk_inline_intrinsic_arith (gfc_ss *ss, gfc_expr *expr) +{ + gfc_ss *tmp_ss, *tail, *array_ss; + gfc_actual_arglist *arg1, *arg2, *arg3; + int sum_dim; + bool scalar_mask = false; + + /* The rank of the result will be determined later. */ + arg1 = expr->value.function.actual; + arg2 = arg1->next; + arg3 = arg2->next; + gcc_assert (arg3 != NULL); + + if (expr->rank == 0) + return ss; + + tmp_ss = gfc_ss_terminator; + + if (arg3->expr) + { + gfc_ss *mask_ss; + + mask_ss = gfc_walk_subexpr (tmp_ss, arg3->expr); + if (mask_ss == tmp_ss) + scalar_mask = 1; + + tmp_ss = mask_ss; + } + + array_ss = gfc_walk_subexpr (tmp_ss, arg1->expr); + gcc_assert (array_ss != tmp_ss); + + /* Odd thing: If the mask is scalar, it is used by the frontend after + the array (to make an if around the nested loop). Thus it shall + be after array_ss once the gfc_ss list is reversed. */ + if (scalar_mask) + tmp_ss = gfc_get_scalar_ss (array_ss, arg3->expr); + else + tmp_ss = array_ss; + + /* "Hide" the dimension on which we will sum in the first arg's scalarization + chain. */ + sum_dim = mpz_get_si (arg2->expr->value.integer) - 1; + tail = nest_loop_dimension (tmp_ss, sum_dim); + tail->next = ss; + + return tmp_ss; +} + + static gfc_ss * walk_inline_intrinsic_function (gfc_ss * ss, gfc_expr * expr) { switch (expr->value.function.isym->id) { + case GFC_ISYM_PRODUCT: + case GFC_ISYM_SUM: + return walk_inline_intrinsic_arith (ss, expr); + case GFC_ISYM_TRANSPOSE: return walk_inline_intrinsic_transpose (ss, expr); @@ -6868,11 +7022,26 @@ gfc_walk_intrinsic_libfunc (gfc_ss * ss, gfc_expr * expr) bool gfc_inline_intrinsic_function_p (gfc_expr *expr) { + gfc_actual_arglist *args; + if (!expr->value.function.isym) return false; switch (expr->value.function.isym->id) { + case GFC_ISYM_PRODUCT: + case GFC_ISYM_SUM: + /* Disable inline expansion if code size matters. */ + if (optimize_size) + return false; + + args = expr->value.function.actual; + /* We need to be able to subset the SUM argument at compile-time. */ + if (args->next->expr && args->next->expr->expr_type != EXPR_CONSTANT) + return false; + + return true; + case GFC_ISYM_TRANSPOSE: return true; diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 5757865b3a1..22033d38d15 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -310,6 +310,7 @@ typedef struct gfc_loopinfo } gfc_loopinfo; +#define gfc_get_loopinfo() XCNEW (gfc_loopinfo) /* Information about a symbol that has been shadowed by a temporary. */ typedef struct -- cgit v1.2.1 From 1cd6e20de6e40ead3795087811f151f00b06e016 Mon Sep 17 00:00:00 2001 From: amacleod Date: Sun, 6 Nov 2011 14:55:48 +0000 Subject: Check in patch/merge from cxx-mem-model Branch git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181031 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 13 ++++++++++++ gcc/fortran/types.def | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 68 insertions(+), 1 deletion(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5b1d41071e9..b5c8bedba28 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2011-11-06 Andrew MacLeod + Aldy Hernandez + + Merged from cxx-mem-model. + + * types.def: (BT_SIZE, BT_CONST_VOLATILE_PTR, BT_FN_VOID_INT, + BT_FN_I{1,2,4,8,16}_CONST_VPTR_INT, BT_FN_VOID_VPTR_INT, + BT_FN_BOOL_VPTR_INT, BT_FN_BOOL_SIZE_CONST_VPTR, + BT_FN_VOID_VPTR_I{1,2,4,8,16}_INT, BT_FN_VOID_SIZE_VPTR_PTR_INT, + BT_FN_VOID_SIZE_CONST_VPTR_PTR_INT, BT_FN_VOID_SIZE_VPTR_PTR_PTR_INT, + BT_FN_BOOL_VPTR_PTR_I{1,2,4,8,16}_BOOL_INT_INT, + BT_FN_I{1,2,4,8,16}_VPTR_I{1,2,4,8,16}_INT): New types. + 2011-11-04 Mikael Morin PR fortran/43829 diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def index 5bcdb5261d9..a2762c6257b 100644 --- a/gcc/fortran/types.def +++ b/gcc/fortran/types.def @@ -57,6 +57,7 @@ DEF_PRIMITIVE_TYPE (BT_UINT, unsigned_type_node) DEF_PRIMITIVE_TYPE (BT_LONG, long_integer_type_node) DEF_PRIMITIVE_TYPE (BT_ULONGLONG, long_long_unsigned_type_node) DEF_PRIMITIVE_TYPE (BT_WORD, (*lang_hooks.types.type_for_mode) (word_mode, 1)) +DEF_PRIMITIVE_TYPE (BT_SIZE, size_type_node) DEF_PRIMITIVE_TYPE (BT_I1, builtin_type_for_size (BITS_PER_UNIT*1, 1)) DEF_PRIMITIVE_TYPE (BT_I2, builtin_type_for_size (BITS_PER_UNIT*2, 1)) @@ -70,7 +71,10 @@ DEF_PRIMITIVE_TYPE (BT_VOLATILE_PTR, build_pointer_type (build_qualified_type (void_type_node, TYPE_QUAL_VOLATILE))) - +DEF_PRIMITIVE_TYPE (BT_CONST_VOLATILE_PTR, + build_pointer_type + (build_qualified_type (void_type_node, + TYPE_QUAL_VOLATILE|TYPE_QUAL_CONST))) DEF_POINTER_TYPE (BT_PTR_LONG, BT_LONG) DEF_POINTER_TYPE (BT_PTR_ULONGLONG, BT_ULONGLONG) DEF_POINTER_TYPE (BT_PTR_PTR, BT_PTR) @@ -85,6 +89,8 @@ DEF_FUNCTION_TYPE_1 (BT_FN_VOID_PTRPTR, BT_VOID, BT_PTR_PTR) DEF_FUNCTION_TYPE_1 (BT_FN_VOID_VPTR, BT_VOID, BT_VOLATILE_PTR) DEF_FUNCTION_TYPE_1 (BT_FN_UINT_UINT, BT_UINT, BT_UINT) DEF_FUNCTION_TYPE_1 (BT_FN_PTR_PTR, BT_PTR, BT_PTR) +DEF_FUNCTION_TYPE_1 (BT_FN_VOID_INT, BT_VOID, BT_INT) + DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR, BT_FN_VOID_PTR) @@ -98,6 +104,21 @@ DEF_FUNCTION_TYPE_2 (BT_FN_I4_VPTR_I4, BT_I4, BT_VOLATILE_PTR, BT_I4) DEF_FUNCTION_TYPE_2 (BT_FN_I8_VPTR_I8, BT_I8, BT_VOLATILE_PTR, BT_I8) DEF_FUNCTION_TYPE_2 (BT_FN_I16_VPTR_I16, BT_I16, BT_VOLATILE_PTR, BT_I16) DEF_FUNCTION_TYPE_2 (BT_FN_VOID_PTR_PTR, BT_VOID, BT_PTR, BT_PTR) +DEF_FUNCTION_TYPE_2 (BT_FN_I1_CONST_VPTR_INT, BT_I1, BT_CONST_VOLATILE_PTR, + BT_INT) +DEF_FUNCTION_TYPE_2 (BT_FN_I2_CONST_VPTR_INT, BT_I2, BT_CONST_VOLATILE_PTR, + BT_INT) +DEF_FUNCTION_TYPE_2 (BT_FN_I4_CONST_VPTR_INT, BT_I4, BT_CONST_VOLATILE_PTR, + BT_INT) +DEF_FUNCTION_TYPE_2 (BT_FN_I8_CONST_VPTR_INT, BT_I8, BT_CONST_VOLATILE_PTR, + BT_INT) +DEF_FUNCTION_TYPE_2 (BT_FN_I16_CONST_VPTR_INT, BT_I16, BT_CONST_VOLATILE_PTR, + BT_INT) +DEF_FUNCTION_TYPE_2 (BT_FN_VOID_VPTR_INT, BT_VOID, BT_VOLATILE_PTR, BT_INT) +DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_VPTR_INT, BT_BOOL, BT_VOLATILE_PTR, BT_INT) +DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_SIZE_CONST_VPTR, BT_BOOL, BT_SIZE, + BT_CONST_VOLATILE_PTR) + DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR_PTR, BT_FN_VOID_PTR_PTR) @@ -119,15 +140,31 @@ DEF_FUNCTION_TYPE_3 (BT_FN_I16_VPTR_I16_I16, BT_I16, BT_VOLATILE_PTR, BT_I16, BT_I16) DEF_FUNCTION_TYPE_3 (BT_FN_VOID_OMPFN_PTR_UINT, BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, BT_UINT) +DEF_FUNCTION_TYPE_3 (BT_FN_I1_VPTR_I1_INT, BT_I1, BT_VOLATILE_PTR, BT_I1, BT_INT) +DEF_FUNCTION_TYPE_3 (BT_FN_I2_VPTR_I2_INT, BT_I2, BT_VOLATILE_PTR, BT_I2, BT_INT) +DEF_FUNCTION_TYPE_3 (BT_FN_I4_VPTR_I4_INT, BT_I4, BT_VOLATILE_PTR, BT_I4, BT_INT) +DEF_FUNCTION_TYPE_3 (BT_FN_I8_VPTR_I8_INT, BT_I8, BT_VOLATILE_PTR, BT_I8, BT_INT) +DEF_FUNCTION_TYPE_3 (BT_FN_I16_VPTR_I16_INT, BT_I16, BT_VOLATILE_PTR, BT_I16, BT_INT) +DEF_FUNCTION_TYPE_3 (BT_FN_VOID_VPTR_I1_INT, BT_VOID, BT_VOLATILE_PTR, BT_I1, BT_INT) +DEF_FUNCTION_TYPE_3 (BT_FN_VOID_VPTR_I2_INT, BT_VOID, BT_VOLATILE_PTR, BT_I2, BT_INT) +DEF_FUNCTION_TYPE_3 (BT_FN_VOID_VPTR_I4_INT, BT_VOID, BT_VOLATILE_PTR, BT_I4, BT_INT) +DEF_FUNCTION_TYPE_3 (BT_FN_VOID_VPTR_I8_INT, BT_VOID, BT_VOLATILE_PTR, BT_I8, BT_INT) +DEF_FUNCTION_TYPE_3 (BT_FN_VOID_VPTR_I16_INT, BT_VOID, BT_VOLATILE_PTR, BT_I16, BT_INT) DEF_FUNCTION_TYPE_4 (BT_FN_VOID_OMPFN_PTR_UINT_UINT, BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, BT_UINT, BT_UINT) DEF_FUNCTION_TYPE_4 (BT_FN_VOID_PTR_WORD_WORD_PTR, BT_VOID, BT_PTR, BT_WORD, BT_WORD, BT_PTR) +DEF_FUNCTION_TYPE_4 (BT_FN_VOID_SIZE_VPTR_PTR_INT, BT_VOID, BT_SIZE, + BT_VOLATILE_PTR, BT_PTR, BT_INT) +DEF_FUNCTION_TYPE_4 (BT_FN_VOID_SIZE_CONST_VPTR_PTR_INT, BT_VOID, BT_SIZE, + BT_CONST_VOLATILE_PTR, BT_PTR, BT_INT) DEF_FUNCTION_TYPE_5 (BT_FN_BOOL_LONG_LONG_LONG_LONGPTR_LONGPTR, BT_BOOL, BT_LONG, BT_LONG, BT_LONG, BT_PTR_LONG, BT_PTR_LONG) +DEF_FUNCTION_TYPE_5 (BT_FN_VOID_SIZE_VPTR_PTR_PTR_INT, BT_VOID, BT_SIZE, + BT_VOLATILE_PTR, BT_PTR, BT_PTR, BT_INT) DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_LONG_LONG_LONG_LONG_LONGPTR_LONGPTR, BT_BOOL, BT_LONG, BT_LONG, BT_LONG, BT_LONG, @@ -138,6 +175,23 @@ DEF_FUNCTION_TYPE_6 (BT_FN_VOID_OMPFN_PTR_UINT_LONG_LONG_LONG, DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_BOOL_ULL_ULL_ULL_ULLPTR_ULLPTR, BT_BOOL, BT_BOOL, BT_ULONGLONG, BT_ULONGLONG, BT_ULONGLONG, BT_PTR_ULONGLONG, BT_PTR_ULONGLONG) +DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_VPTR_PTR_I1_BOOL_INT_INT, + BT_BOOL, BT_VOLATILE_PTR, BT_PTR, BT_I1, BT_BOOL, BT_INT, + BT_INT) +DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_VPTR_PTR_I2_BOOL_INT_INT, + BT_BOOL, BT_VOLATILE_PTR, BT_PTR, BT_I2, BT_BOOL, BT_INT, + BT_INT) +DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_VPTR_PTR_I4_BOOL_INT_INT, + BT_BOOL, BT_VOLATILE_PTR, BT_PTR, BT_I4, BT_BOOL, BT_INT, + BT_INT) +DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_VPTR_PTR_I8_BOOL_INT_INT, + BT_BOOL, BT_VOLATILE_PTR, BT_PTR, BT_I8, BT_BOOL, BT_INT, + BT_INT) +DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_VPTR_PTR_I16_BOOL_INT_INT, + BT_BOOL, BT_VOLATILE_PTR, BT_PTR, BT_I16, BT_BOOL, BT_INT, + BT_INT) +DEF_FUNCTION_TYPE_6 (BT_FN_BOOL_SIZE_VPTR_PTR_PTR_INT_INT, BT_BOOL, BT_SIZE, + BT_VOLATILE_PTR, BT_PTR, BT_PTR, BT_INT, BT_INT) DEF_FUNCTION_TYPE_7 (BT_FN_VOID_OMPFN_PTR_UINT_LONG_LONG_LONG_LONG, BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, BT_UINT, -- cgit v1.2.1 From 63b9ead46280beb816715f4f65d39a62da37d932 Mon Sep 17 00:00:00 2001 From: janus Date: Sun, 6 Nov 2011 21:36:54 +0000 Subject: 2011-11-06 Janus Weil * gfortran.h (gfc_extend_expr): Modified prototype. * interface.c (gfc_extend_expr): Return 'match' instead of 'gfc_try'. Remove argument 'real_error'. * resolve.c (resolve_operator): Modified call to 'gfc_extend_expr'. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181044 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 7 +++++++ gcc/fortran/gfortran.h | 2 +- gcc/fortran/interface.c | 23 +++++++++-------------- gcc/fortran/resolve.c | 7 +++---- 4 files changed, 20 insertions(+), 19 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b5c8bedba28..707611242c6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2011-11-06 Janus Weil + + * gfortran.h (gfc_extend_expr): Modified prototype. + * interface.c (gfc_extend_expr): Return 'match' instead of 'gfc_try'. + Remove argument 'real_error'. + * resolve.c (resolve_operator): Modified call to 'gfc_extend_expr'. + 2011-11-06 Andrew MacLeod Aldy Hernandez diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index b869ca353de..17ebd58e50f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2831,7 +2831,7 @@ void gfc_procedure_use (gfc_symbol *, gfc_actual_arglist **, locus *); void gfc_ppc_use (gfc_component *, gfc_actual_arglist **, locus *); gfc_symbol *gfc_search_interface (gfc_interface *, int, gfc_actual_arglist **); -gfc_try gfc_extend_expr (gfc_expr *, bool *); +match gfc_extend_expr (gfc_expr *); void gfc_free_formal_arglist (gfc_formal_arglist *); gfc_try gfc_extend_assign (gfc_code *, gfc_namespace *); gfc_try gfc_add_interface (gfc_symbol *); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 19ede06cf55..90d98c759dd 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3221,12 +3221,11 @@ build_compcall_for_operator (gfc_expr* e, gfc_actual_arglist* actual, with the operator. This subroutine builds an actual argument list corresponding to the operands, then searches for a compatible interface. If one is found, the expression node is replaced with - the appropriate function call. - real_error is an additional output argument that specifies if FAILURE - is because of some real error and not because no match was found. */ + the appropriate function call. We use the 'match' enum to specify + whether a replacement has been made or not, or if an error occurred. */ -gfc_try -gfc_extend_expr (gfc_expr *e, bool *real_error) +match +gfc_extend_expr (gfc_expr *e) { gfc_actual_arglist *actual; gfc_symbol *sym; @@ -3240,7 +3239,6 @@ gfc_extend_expr (gfc_expr *e, bool *real_error) actual = gfc_get_actual_arglist (); actual->expr = e->value.op.op1; - *real_error = false; gname = NULL; if (e->value.op.op2 != NULL) @@ -3344,16 +3342,16 @@ gfc_extend_expr (gfc_expr *e, bool *real_error) result = gfc_resolve_expr (e); if (result == FAILURE) - *real_error = true; + return MATCH_ERROR; - return result; + return MATCH_YES; } /* Don't use gfc_free_actual_arglist(). */ free (actual->next); free (actual); - return FAILURE; + return MATCH_NO; } /* Change the expression node to a function call. */ @@ -3366,12 +3364,9 @@ gfc_extend_expr (gfc_expr *e, bool *real_error) e->user_operator = 1; if (gfc_resolve_expr (e) == FAILURE) - { - *real_error = true; - return FAILURE; - } + return MATCH_ERROR; - return SUCCESS; + return MATCH_YES; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 30f5f55e214..ab251b57e70 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -4034,11 +4034,10 @@ resolve_operator (gfc_expr *e) bad_op: { - bool real_error; - if (gfc_extend_expr (e, &real_error) == SUCCESS) + match m = gfc_extend_expr (e); + if (m == MATCH_YES) return SUCCESS; - - if (real_error) + if (m == MATCH_ERROR) return FAILURE; } -- cgit v1.2.1 From be960ff72311883b21d520570ddfc4081672c057 Mon Sep 17 00:00:00 2001 From: jb Date: Mon, 7 Nov 2011 15:31:31 +0000 Subject: clock and time are part of the C standard library. 2011-11-07 Janne Blomqvist * intrinsic.texi (MCLOCK, MCLOCK8, TIME, TIME8): Functions clock and time are part of the C standard library. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181087 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 +++++ gcc/fortran/intrinsic.texi | 12 ++++++------ 2 files changed, 11 insertions(+), 6 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 707611242c6..ea828c88f0f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2011-11-07 Janne Blomqvist + + * intrinsic.texi (MCLOCK, MCLOCK8, TIME, TIME8): Functions clock + and time are part of the C standard library. + 2011-11-06 Janus Weil * gfortran.h (gfc_extend_expr): Modified prototype. diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 24af4d5ac7d..f7d5a193e56 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -8639,7 +8639,7 @@ cases, the result is of the same type and kind as @var{ARRAY}. @table @asis @item @emph{Description}: Returns the number of clock ticks since the start of the process, based -on the UNIX function @code{clock(3)}. +on the function @code{clock(3)} in the C standard library. This intrinsic is not fully portable, such as to systems with 32-bit @code{INTEGER} types but supporting times wider than 32 bits. Therefore, @@ -8677,7 +8677,7 @@ the system does not support @code{clock(3)}. @table @asis @item @emph{Description}: Returns the number of clock ticks since the start of the process, based -on the UNIX function @code{clock(3)}. +on the function @code{clock(3)} in the C standard library. @emph{Warning:} this intrinsic does not increase the range of the timing values over that returned by @code{clock(3)}. On a system with a 32-bit @@ -12222,8 +12222,8 @@ END IF @table @asis @item @emph{Description}: Returns the current time encoded as an integer (in the manner of the -UNIX function @code{time(3)}). This value is suitable for passing to -@code{CTIME}, @code{GMTIME}, and @code{LTIME}. +function @code{time(3)} in the C standard library). This value is +suitable for passing to @code{CTIME}, @code{GMTIME}, and @code{LTIME}. This intrinsic is not fully portable, such as to systems with 32-bit @code{INTEGER} types but supporting times wider than 32 bits. Therefore, @@ -12263,8 +12263,8 @@ The return value is a scalar of type @code{INTEGER(4)}. @table @asis @item @emph{Description}: Returns the current time encoded as an integer (in the manner of the -UNIX function @code{time(3)}). This value is suitable for passing to -@code{CTIME}, @code{GMTIME}, and @code{LTIME}. +function @code{time(3)} in the C standard library). This value is +suitable for passing to @code{CTIME}, @code{GMTIME}, and @code{LTIME}. @emph{Warning:} this intrinsic does not increase the range of the timing values over that returned by @code{time(3)}. On a system with a 32-bit -- cgit v1.2.1 From 6df74ab4271c036e5c80aa5b67104c98c0dda1d5 Mon Sep 17 00:00:00 2001 From: janus Date: Mon, 7 Nov 2011 18:41:12 +0000 Subject: 2011-11-07 Janus Weil PR fortran/50919 * class.c (add_proc_comp): Don't add non-overridable procedures to the vtable. * resolve.c (resolve_typebound_function,resolve_typebound_subroutine): Don't generate a dynamic _vptr call for non-overridable procedures. 2011-11-07 Janus Weil PR fortran/50919 * gfortran.dg/typebound_call_21.f03: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181107 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 +++++++ gcc/fortran/class.c | 4 ++++ gcc/fortran/resolve.c | 64 ++++++++++++++++++++++++++++++--------------------- 3 files changed, 50 insertions(+), 26 deletions(-) (limited to 'gcc/fortran') diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ea828c88f0f..1dae389d361 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-11-07 Janus Weil + + PR fortran/50919 + * class.c (add_proc_comp): Don't add non-overridable procedures to the + vtable. + * resolve.c (resolve_typebound_function,resolve_typebound_subroutine): + Don't generate a dynamic _vptr call for non-overridable procedures. + 2011-11-07 Janne Blomqvist * intrinsic.texi (MCLOCK, MCLOCK8, TIME, TIME8): Functions clock diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index f64cc1b2a81..574d22b0b12 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -288,6 +288,10 @@ static void add_proc_comp (gfc_symbol *vtype, const char *name, gfc_typebound_proc *tb) { gfc_component *c; + + if (tb->non_overridable) + return; + c = gfc_find_component (vtype, name, true, true); if (c == NULL) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index ab251b57e70..0e882399902 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5868,11 +5868,13 @@ resolve_typebound_function (gfc_expr* e) const char *name; gfc_typespec ts; gfc_expr *expr; + bool overridable; st = e->symtree; /* Deal with typebound operators for CLASS objects. */ expr = e->value.compcall.base_object; + overridable = !e->value.compcall.tbp->non_overridable; if (expr && expr->ts.type == BT_CLASS && e->value.compcall.name) { /* Since the typebound operators are generic, we have to ensure @@ -5923,22 +5925,26 @@ resolve_typebound_function (gfc_expr* e) return FAILURE; ts = e->ts; - /* Then convert the expression to a procedure pointer component call. */ - e->value.function.esym = NULL; - e->symtree = st; + if (overridable) + { + /* Convert the expression to a procedure pointer component call. */ + e->value.function.esym = NULL; + e->symtree = st; - if (new_ref) - e->ref = new_ref; + if (new_ref) + e->ref = new_ref; - /* '_vptr' points to the vtab, which contains the procedure pointers. */ - gfc_add_vptr_component (e); - gfc_add_component_ref (e, name); + /* '_vptr' points to the vtab, which contains the procedure pointers. */ + gfc_add_vptr_component (e); + gfc_add_component_ref (e, name); + + /* Recover the typespec for the expression. This is really only + necessary for generic procedures, where the additional call + to gfc_add_component_ref seems to throw the collection of the + correct typespec. */ + e->ts = ts; + } - /* Recover the typespec for the expression. This is really only - necessary for generic procedures, where the additional call - to gfc_add_component_ref seems to throw the collection of the - correct typespec. */ - e->ts = ts; return SUCCESS; } @@ -5957,11 +5963,13 @@ resolve_typebound_subroutine (gfc_code *code) const char *name; gfc_typespec ts; gfc_expr *expr; + bool overridable; st = code->expr1->symtree; /* Deal with typebound operators for CLASS objects. */ expr = code->expr1->value.compcall.base_object; + overridable = !code->expr1->value.compcall.tbp->non_overridable; if (expr && expr->ts.type == BT_CLASS && code->expr1->value.compcall.name) { /* Since the typebound operators are generic, we have to ensure @@ -6006,22 +6014,26 @@ resolve_typebound_subroutine (gfc_code *code) return FAILURE; ts = code->expr1->ts; - /* Then convert the expression to a procedure pointer component call. */ - code->expr1->value.function.esym = NULL; - code->expr1->symtree = st; + if (overridable) + { + /* Convert the expression to a procedure pointer component call. */ + code->expr1->value.function.esym = NULL; + code->expr1->symtree = st; + + if (new_ref) + code->expr1->ref = new_ref; - if (new_ref) - code->expr1->ref = new_ref; + /* '_vptr' points to the vtab, which contains the procedure pointers. */ + gfc_add_vptr_component (code->expr1); + gfc_add_component_ref (code->expr1, name); - /* '_vptr' points to the vtab, which contains the procedure pointers. */ - gfc_add_vptr_component (code->expr1); - gfc_add_component_ref (code->expr1, name); + /* Recover the typespec for the expression. This is really only + necessary for generic procedures, where the additional call + to gfc_add_component_ref seems to throw the collection of the + correct typespec. */ + code->expr1->ts = ts; + } - /* Recover the typespec for the expression. This is really only - necessary for generic procedures, where the additional call - to gfc_add_component_ref seems to throw the collection of the - correct typespec. */ - code->expr1->ts = ts; return SUCCESS; } -- cgit v1.2.1