aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/trans-openmp.c
diff options
context:
space:
mode:
authorMartin Liska <mliska@suse.cz>2022-01-14 16:56:44 +0100
committerMartin Liska <mliska@suse.cz>2022-01-17 22:12:04 +0100
commit5c69acb32329d49e58c26fa41ae74229a52b9106 (patch)
treeddb05f9d73afb6f998457d2ac4b720e3b3b60483 /gcc/fortran/trans-openmp.c
parent490e23032baaece71f2ec09fa1805064b150fbc2 (diff)
downloadgcc-5c69acb32329d49e58c26fa41ae74229a52b9106.zip
gcc-5c69acb32329d49e58c26fa41ae74229a52b9106.tar.gz
gcc-5c69acb32329d49e58c26fa41ae74229a52b9106.tar.bz2
Rename .c files to .cc files.
gcc/ada/ChangeLog: * adadecode.c: Moved to... * adadecode.cc: ...here. * affinity.c: Moved to... * affinity.cc: ...here. * argv-lynxos178-raven-cert.c: Moved to... * argv-lynxos178-raven-cert.cc: ...here. * argv.c: Moved to... * argv.cc: ...here. * aux-io.c: Moved to... * aux-io.cc: ...here. * cio.c: Moved to... * cio.cc: ...here. * cstreams.c: Moved to... * cstreams.cc: ...here. * env.c: Moved to... * env.cc: ...here. * exit.c: Moved to... * exit.cc: ...here. * expect.c: Moved to... * expect.cc: ...here. * final.c: Moved to... * final.cc: ...here. * gcc-interface/cuintp.c: Moved to... * gcc-interface/cuintp.cc: ...here. * gcc-interface/decl.c: Moved to... * gcc-interface/decl.cc: ...here. * gcc-interface/misc.c: Moved to... * gcc-interface/misc.cc: ...here. * gcc-interface/targtyps.c: Moved to... * gcc-interface/targtyps.cc: ...here. * gcc-interface/trans.c: Moved to... * gcc-interface/trans.cc: ...here. * gcc-interface/utils.c: Moved to... * gcc-interface/utils.cc: ...here. * gcc-interface/utils2.c: Moved to... * gcc-interface/utils2.cc: ...here. * init.c: Moved to... * init.cc: ...here. * initialize.c: Moved to... * initialize.cc: ...here. * libgnarl/thread.c: Moved to... * libgnarl/thread.cc: ...here. * link.c: Moved to... * link.cc: ...here. * locales.c: Moved to... * locales.cc: ...here. * mkdir.c: Moved to... * mkdir.cc: ...here. * raise.c: Moved to... * raise.cc: ...here. * rtfinal.c: Moved to... * rtfinal.cc: ...here. * rtinit.c: Moved to... * rtinit.cc: ...here. * seh_init.c: Moved to... * seh_init.cc: ...here. * sigtramp-armdroid.c: Moved to... * sigtramp-armdroid.cc: ...here. * sigtramp-ios.c: Moved to... * sigtramp-ios.cc: ...here. * sigtramp-qnx.c: Moved to... * sigtramp-qnx.cc: ...here. * sigtramp-vxworks.c: Moved to... * sigtramp-vxworks.cc: ...here. * socket.c: Moved to... * socket.cc: ...here. * tracebak.c: Moved to... * tracebak.cc: ...here. * version.c: Moved to... * version.cc: ...here. * vx_stack_info.c: Moved to... * vx_stack_info.cc: ...here. gcc/ChangeLog: * adjust-alignment.c: Moved to... * adjust-alignment.cc: ...here. * alias.c: Moved to... * alias.cc: ...here. * alloc-pool.c: Moved to... * alloc-pool.cc: ...here. * asan.c: Moved to... * asan.cc: ...here. * attribs.c: Moved to... * attribs.cc: ...here. * auto-inc-dec.c: Moved to... * auto-inc-dec.cc: ...here. * auto-profile.c: Moved to... * auto-profile.cc: ...here. * bb-reorder.c: Moved to... * bb-reorder.cc: ...here. * bitmap.c: Moved to... * bitmap.cc: ...here. * btfout.c: Moved to... * btfout.cc: ...here. * builtins.c: Moved to... * builtins.cc: ...here. * caller-save.c: Moved to... * caller-save.cc: ...here. * calls.c: Moved to... * calls.cc: ...here. * ccmp.c: Moved to... * ccmp.cc: ...here. * cfg.c: Moved to... * cfg.cc: ...here. * cfganal.c: Moved to... * cfganal.cc: ...here. * cfgbuild.c: Moved to... * cfgbuild.cc: ...here. * cfgcleanup.c: Moved to... * cfgcleanup.cc: ...here. * cfgexpand.c: Moved to... * cfgexpand.cc: ...here. * cfghooks.c: Moved to... * cfghooks.cc: ...here. * cfgloop.c: Moved to... * cfgloop.cc: ...here. * cfgloopanal.c: Moved to... * cfgloopanal.cc: ...here. * cfgloopmanip.c: Moved to... * cfgloopmanip.cc: ...here. * cfgrtl.c: Moved to... * cfgrtl.cc: ...here. * cgraph.c: Moved to... * cgraph.cc: ...here. * cgraphbuild.c: Moved to... * cgraphbuild.cc: ...here. * cgraphclones.c: Moved to... * cgraphclones.cc: ...here. * cgraphunit.c: Moved to... * cgraphunit.cc: ...here. * collect-utils.c: Moved to... * collect-utils.cc: ...here. * collect2-aix.c: Moved to... * collect2-aix.cc: ...here. * collect2.c: Moved to... * collect2.cc: ...here. * combine-stack-adj.c: Moved to... * combine-stack-adj.cc: ...here. * combine.c: Moved to... * combine.cc: ...here. * common/common-targhooks.c: Moved to... * common/common-targhooks.cc: ...here. * common/config/aarch64/aarch64-common.c: Moved to... * common/config/aarch64/aarch64-common.cc: ...here. * common/config/alpha/alpha-common.c: Moved to... * common/config/alpha/alpha-common.cc: ...here. * common/config/arc/arc-common.c: Moved to... * common/config/arc/arc-common.cc: ...here. * common/config/arm/arm-common.c: Moved to... * common/config/arm/arm-common.cc: ...here. * common/config/avr/avr-common.c: Moved to... * common/config/avr/avr-common.cc: ...here. * common/config/bfin/bfin-common.c: Moved to... * common/config/bfin/bfin-common.cc: ...here. * common/config/bpf/bpf-common.c: Moved to... * common/config/bpf/bpf-common.cc: ...here. * common/config/c6x/c6x-common.c: Moved to... * common/config/c6x/c6x-common.cc: ...here. * common/config/cr16/cr16-common.c: Moved to... * common/config/cr16/cr16-common.cc: ...here. * common/config/cris/cris-common.c: Moved to... * common/config/cris/cris-common.cc: ...here. * common/config/csky/csky-common.c: Moved to... * common/config/csky/csky-common.cc: ...here. * common/config/default-common.c: Moved to... * common/config/default-common.cc: ...here. * common/config/epiphany/epiphany-common.c: Moved to... * common/config/epiphany/epiphany-common.cc: ...here. * common/config/fr30/fr30-common.c: Moved to... * common/config/fr30/fr30-common.cc: ...here. * common/config/frv/frv-common.c: Moved to... * common/config/frv/frv-common.cc: ...here. * common/config/gcn/gcn-common.c: Moved to... * common/config/gcn/gcn-common.cc: ...here. * common/config/h8300/h8300-common.c: Moved to... * common/config/h8300/h8300-common.cc: ...here. * common/config/i386/i386-common.c: Moved to... * common/config/i386/i386-common.cc: ...here. * common/config/ia64/ia64-common.c: Moved to... * common/config/ia64/ia64-common.cc: ...here. * common/config/iq2000/iq2000-common.c: Moved to... * common/config/iq2000/iq2000-common.cc: ...here. * common/config/lm32/lm32-common.c: Moved to... * common/config/lm32/lm32-common.cc: ...here. * common/config/m32r/m32r-common.c: Moved to... * common/config/m32r/m32r-common.cc: ...here. * common/config/m68k/m68k-common.c: Moved to... * common/config/m68k/m68k-common.cc: ...here. * common/config/mcore/mcore-common.c: Moved to... * common/config/mcore/mcore-common.cc: ...here. * common/config/microblaze/microblaze-common.c: Moved to... * common/config/microblaze/microblaze-common.cc: ...here. * common/config/mips/mips-common.c: Moved to... * common/config/mips/mips-common.cc: ...here. * common/config/mmix/mmix-common.c: Moved to... * common/config/mmix/mmix-common.cc: ...here. * common/config/mn10300/mn10300-common.c: Moved to... * common/config/mn10300/mn10300-common.cc: ...here. * common/config/msp430/msp430-common.c: Moved to... * common/config/msp430/msp430-common.cc: ...here. * common/config/nds32/nds32-common.c: Moved to... * common/config/nds32/nds32-common.cc: ...here. * common/config/nios2/nios2-common.c: Moved to... * common/config/nios2/nios2-common.cc: ...here. * common/config/nvptx/nvptx-common.c: Moved to... * common/config/nvptx/nvptx-common.cc: ...here. * common/config/or1k/or1k-common.c: Moved to... * common/config/or1k/or1k-common.cc: ...here. * common/config/pa/pa-common.c: Moved to... * common/config/pa/pa-common.cc: ...here. * common/config/pdp11/pdp11-common.c: Moved to... * common/config/pdp11/pdp11-common.cc: ...here. * common/config/pru/pru-common.c: Moved to... * common/config/pru/pru-common.cc: ...here. * common/config/riscv/riscv-common.c: Moved to... * common/config/riscv/riscv-common.cc: ...here. * common/config/rs6000/rs6000-common.c: Moved to... * common/config/rs6000/rs6000-common.cc: ...here. * common/config/rx/rx-common.c: Moved to... * common/config/rx/rx-common.cc: ...here. * common/config/s390/s390-common.c: Moved to... * common/config/s390/s390-common.cc: ...here. * common/config/sh/sh-common.c: Moved to... * common/config/sh/sh-common.cc: ...here. * common/config/sparc/sparc-common.c: Moved to... * common/config/sparc/sparc-common.cc: ...here. * common/config/tilegx/tilegx-common.c: Moved to... * common/config/tilegx/tilegx-common.cc: ...here. * common/config/tilepro/tilepro-common.c: Moved to... * common/config/tilepro/tilepro-common.cc: ...here. * common/config/v850/v850-common.c: Moved to... * common/config/v850/v850-common.cc: ...here. * common/config/vax/vax-common.c: Moved to... * common/config/vax/vax-common.cc: ...here. * common/config/visium/visium-common.c: Moved to... * common/config/visium/visium-common.cc: ...here. * common/config/xstormy16/xstormy16-common.c: Moved to... * common/config/xstormy16/xstormy16-common.cc: ...here. * common/config/xtensa/xtensa-common.c: Moved to... * common/config/xtensa/xtensa-common.cc: ...here. * compare-elim.c: Moved to... * compare-elim.cc: ...here. * config/aarch64/aarch64-bti-insert.c: Moved to... * config/aarch64/aarch64-bti-insert.cc: ...here. * config/aarch64/aarch64-builtins.c: Moved to... * config/aarch64/aarch64-builtins.cc: ...here. * config/aarch64/aarch64-c.c: Moved to... * config/aarch64/aarch64-c.cc: ...here. * config/aarch64/aarch64-d.c: Moved to... * config/aarch64/aarch64-d.cc: ...here. * config/aarch64/aarch64.c: Moved to... * config/aarch64/aarch64.cc: ...here. * config/aarch64/cortex-a57-fma-steering.c: Moved to... * config/aarch64/cortex-a57-fma-steering.cc: ...here. * config/aarch64/driver-aarch64.c: Moved to... * config/aarch64/driver-aarch64.cc: ...here. * config/aarch64/falkor-tag-collision-avoidance.c: Moved to... * config/aarch64/falkor-tag-collision-avoidance.cc: ...here. * config/aarch64/host-aarch64-darwin.c: Moved to... * config/aarch64/host-aarch64-darwin.cc: ...here. * config/alpha/alpha.c: Moved to... * config/alpha/alpha.cc: ...here. * config/alpha/driver-alpha.c: Moved to... * config/alpha/driver-alpha.cc: ...here. * config/arc/arc-c.c: Moved to... * config/arc/arc-c.cc: ...here. * config/arc/arc.c: Moved to... * config/arc/arc.cc: ...here. * config/arc/driver-arc.c: Moved to... * config/arc/driver-arc.cc: ...here. * config/arm/aarch-common.c: Moved to... * config/arm/aarch-common.cc: ...here. * config/arm/arm-builtins.c: Moved to... * config/arm/arm-builtins.cc: ...here. * config/arm/arm-c.c: Moved to... * config/arm/arm-c.cc: ...here. * config/arm/arm-d.c: Moved to... * config/arm/arm-d.cc: ...here. * config/arm/arm.c: Moved to... * config/arm/arm.cc: ...here. * config/arm/driver-arm.c: Moved to... * config/arm/driver-arm.cc: ...here. * config/avr/avr-c.c: Moved to... * config/avr/avr-c.cc: ...here. * config/avr/avr-devices.c: Moved to... * config/avr/avr-devices.cc: ...here. * config/avr/avr-log.c: Moved to... * config/avr/avr-log.cc: ...here. * config/avr/avr.c: Moved to... * config/avr/avr.cc: ...here. * config/avr/driver-avr.c: Moved to... * config/avr/driver-avr.cc: ...here. * config/avr/gen-avr-mmcu-specs.c: Moved to... * config/avr/gen-avr-mmcu-specs.cc: ...here. * config/avr/gen-avr-mmcu-texi.c: Moved to... * config/avr/gen-avr-mmcu-texi.cc: ...here. * config/bfin/bfin.c: Moved to... * config/bfin/bfin.cc: ...here. * config/bpf/bpf.c: Moved to... * config/bpf/bpf.cc: ...here. * config/bpf/coreout.c: Moved to... * config/bpf/coreout.cc: ...here. * config/c6x/c6x.c: Moved to... * config/c6x/c6x.cc: ...here. * config/cr16/cr16.c: Moved to... * config/cr16/cr16.cc: ...here. * config/cris/cris.c: Moved to... * config/cris/cris.cc: ...here. * config/csky/csky.c: Moved to... * config/csky/csky.cc: ...here. * config/darwin-c.c: Moved to... * config/darwin-c.cc: ...here. * config/darwin-d.c: Moved to... * config/darwin-d.cc: ...here. * config/darwin-driver.c: Moved to... * config/darwin-driver.cc: ...here. * config/darwin-f.c: Moved to... * config/darwin-f.cc: ...here. * config/darwin.c: Moved to... * config/darwin.cc: ...here. * config/default-c.c: Moved to... * config/default-c.cc: ...here. * config/default-d.c: Moved to... * config/default-d.cc: ...here. * config/dragonfly-d.c: Moved to... * config/dragonfly-d.cc: ...here. * config/epiphany/epiphany.c: Moved to... * config/epiphany/epiphany.cc: ...here. * config/epiphany/mode-switch-use.c: Moved to... * config/epiphany/mode-switch-use.cc: ...here. * config/epiphany/resolve-sw-modes.c: Moved to... * config/epiphany/resolve-sw-modes.cc: ...here. * config/fr30/fr30.c: Moved to... * config/fr30/fr30.cc: ...here. * config/freebsd-d.c: Moved to... * config/freebsd-d.cc: ...here. * config/frv/frv.c: Moved to... * config/frv/frv.cc: ...here. * config/ft32/ft32.c: Moved to... * config/ft32/ft32.cc: ...here. * config/gcn/driver-gcn.c: Moved to... * config/gcn/driver-gcn.cc: ...here. * config/gcn/gcn-run.c: Moved to... * config/gcn/gcn-run.cc: ...here. * config/gcn/gcn-tree.c: Moved to... * config/gcn/gcn-tree.cc: ...here. * config/gcn/gcn.c: Moved to... * config/gcn/gcn.cc: ...here. * config/gcn/mkoffload.c: Moved to... * config/gcn/mkoffload.cc: ...here. * config/glibc-c.c: Moved to... * config/glibc-c.cc: ...here. * config/glibc-d.c: Moved to... * config/glibc-d.cc: ...here. * config/h8300/h8300.c: Moved to... * config/h8300/h8300.cc: ...here. * config/host-darwin.c: Moved to... * config/host-darwin.cc: ...here. * config/host-hpux.c: Moved to... * config/host-hpux.cc: ...here. * config/host-linux.c: Moved to... * config/host-linux.cc: ...here. * config/host-netbsd.c: Moved to... * config/host-netbsd.cc: ...here. * config/host-openbsd.c: Moved to... * config/host-openbsd.cc: ...here. * config/host-solaris.c: Moved to... * config/host-solaris.cc: ...here. * config/i386/djgpp.c: Moved to... * config/i386/djgpp.cc: ...here. * config/i386/driver-i386.c: Moved to... * config/i386/driver-i386.cc: ...here. * config/i386/driver-mingw32.c: Moved to... * config/i386/driver-mingw32.cc: ...here. * config/i386/gnu-property.c: Moved to... * config/i386/gnu-property.cc: ...here. * config/i386/host-cygwin.c: Moved to... * config/i386/host-cygwin.cc: ...here. * config/i386/host-i386-darwin.c: Moved to... * config/i386/host-i386-darwin.cc: ...here. * config/i386/host-mingw32.c: Moved to... * config/i386/host-mingw32.cc: ...here. * config/i386/i386-builtins.c: Moved to... * config/i386/i386-builtins.cc: ...here. * config/i386/i386-c.c: Moved to... * config/i386/i386-c.cc: ...here. * config/i386/i386-d.c: Moved to... * config/i386/i386-d.cc: ...here. * config/i386/i386-expand.c: Moved to... * config/i386/i386-expand.cc: ...here. * config/i386/i386-features.c: Moved to... * config/i386/i386-features.cc: ...here. * config/i386/i386-options.c: Moved to... * config/i386/i386-options.cc: ...here. * config/i386/i386.c: Moved to... * config/i386/i386.cc: ...here. * config/i386/intelmic-mkoffload.c: Moved to... * config/i386/intelmic-mkoffload.cc: ...here. * config/i386/msformat-c.c: Moved to... * config/i386/msformat-c.cc: ...here. * config/i386/winnt-cxx.c: Moved to... * config/i386/winnt-cxx.cc: ...here. * config/i386/winnt-d.c: Moved to... * config/i386/winnt-d.cc: ...here. * config/i386/winnt-stubs.c: Moved to... * config/i386/winnt-stubs.cc: ...here. * config/i386/winnt.c: Moved to... * config/i386/winnt.cc: ...here. * config/i386/x86-tune-sched-atom.c: Moved to... * config/i386/x86-tune-sched-atom.cc: ...here. * config/i386/x86-tune-sched-bd.c: Moved to... * config/i386/x86-tune-sched-bd.cc: ...here. * config/i386/x86-tune-sched-core.c: Moved to... * config/i386/x86-tune-sched-core.cc: ...here. * config/i386/x86-tune-sched.c: Moved to... * config/i386/x86-tune-sched.cc: ...here. * config/ia64/ia64-c.c: Moved to... * config/ia64/ia64-c.cc: ...here. * config/ia64/ia64.c: Moved to... * config/ia64/ia64.cc: ...here. * config/iq2000/iq2000.c: Moved to... * config/iq2000/iq2000.cc: ...here. * config/linux.c: Moved to... * config/linux.cc: ...here. * config/lm32/lm32.c: Moved to... * config/lm32/lm32.cc: ...here. * config/m32c/m32c-pragma.c: Moved to... * config/m32c/m32c-pragma.cc: ...here. * config/m32c/m32c.c: Moved to... * config/m32c/m32c.cc: ...here. * config/m32r/m32r.c: Moved to... * config/m32r/m32r.cc: ...here. * config/m68k/m68k.c: Moved to... * config/m68k/m68k.cc: ...here. * config/mcore/mcore.c: Moved to... * config/mcore/mcore.cc: ...here. * config/microblaze/microblaze-c.c: Moved to... * config/microblaze/microblaze-c.cc: ...here. * config/microblaze/microblaze.c: Moved to... * config/microblaze/microblaze.cc: ...here. * config/mips/driver-native.c: Moved to... * config/mips/driver-native.cc: ...here. * config/mips/frame-header-opt.c: Moved to... * config/mips/frame-header-opt.cc: ...here. * config/mips/mips-d.c: Moved to... * config/mips/mips-d.cc: ...here. * config/mips/mips.c: Moved to... * config/mips/mips.cc: ...here. * config/mmix/mmix.c: Moved to... * config/mmix/mmix.cc: ...here. * config/mn10300/mn10300.c: Moved to... * config/mn10300/mn10300.cc: ...here. * config/moxie/moxie.c: Moved to... * config/moxie/moxie.cc: ...here. * config/msp430/driver-msp430.c: Moved to... * config/msp430/driver-msp430.cc: ...here. * config/msp430/msp430-c.c: Moved to... * config/msp430/msp430-c.cc: ...here. * config/msp430/msp430-devices.c: Moved to... * config/msp430/msp430-devices.cc: ...here. * config/msp430/msp430.c: Moved to... * config/msp430/msp430.cc: ...here. * config/nds32/nds32-cost.c: Moved to... * config/nds32/nds32-cost.cc: ...here. * config/nds32/nds32-fp-as-gp.c: Moved to... * config/nds32/nds32-fp-as-gp.cc: ...here. * config/nds32/nds32-intrinsic.c: Moved to... * config/nds32/nds32-intrinsic.cc: ...here. * config/nds32/nds32-isr.c: Moved to... * config/nds32/nds32-isr.cc: ...here. * config/nds32/nds32-md-auxiliary.c: Moved to... * config/nds32/nds32-md-auxiliary.cc: ...here. * config/nds32/nds32-memory-manipulation.c: Moved to... * config/nds32/nds32-memory-manipulation.cc: ...here. * config/nds32/nds32-pipelines-auxiliary.c: Moved to... * config/nds32/nds32-pipelines-auxiliary.cc: ...here. * config/nds32/nds32-predicates.c: Moved to... * config/nds32/nds32-predicates.cc: ...here. * config/nds32/nds32-relax-opt.c: Moved to... * config/nds32/nds32-relax-opt.cc: ...here. * config/nds32/nds32-utils.c: Moved to... * config/nds32/nds32-utils.cc: ...here. * config/nds32/nds32.c: Moved to... * config/nds32/nds32.cc: ...here. * config/netbsd-d.c: Moved to... * config/netbsd-d.cc: ...here. * config/netbsd.c: Moved to... * config/netbsd.cc: ...here. * config/nios2/nios2.c: Moved to... * config/nios2/nios2.cc: ...here. * config/nvptx/mkoffload.c: Moved to... * config/nvptx/mkoffload.cc: ...here. * config/nvptx/nvptx-c.c: Moved to... * config/nvptx/nvptx-c.cc: ...here. * config/nvptx/nvptx.c: Moved to... * config/nvptx/nvptx.cc: ...here. * config/openbsd-d.c: Moved to... * config/openbsd-d.cc: ...here. * config/or1k/or1k.c: Moved to... * config/or1k/or1k.cc: ...here. * config/pa/pa-d.c: Moved to... * config/pa/pa-d.cc: ...here. * config/pa/pa.c: Moved to... * config/pa/pa.cc: ...here. * config/pdp11/pdp11.c: Moved to... * config/pdp11/pdp11.cc: ...here. * config/pru/pru-passes.c: Moved to... * config/pru/pru-passes.cc: ...here. * config/pru/pru-pragma.c: Moved to... * config/pru/pru-pragma.cc: ...here. * config/pru/pru.c: Moved to... * config/pru/pru.cc: ...here. * config/riscv/riscv-builtins.c: Moved to... * config/riscv/riscv-builtins.cc: ...here. * config/riscv/riscv-c.c: Moved to... * config/riscv/riscv-c.cc: ...here. * config/riscv/riscv-d.c: Moved to... * config/riscv/riscv-d.cc: ...here. * config/riscv/riscv-shorten-memrefs.c: Moved to... * config/riscv/riscv-shorten-memrefs.cc: ...here. * config/riscv/riscv-sr.c: Moved to... * config/riscv/riscv-sr.cc: ...here. * config/riscv/riscv.c: Moved to... * config/riscv/riscv.cc: ...here. * config/rl78/rl78-c.c: Moved to... * config/rl78/rl78-c.cc: ...here. * config/rl78/rl78.c: Moved to... * config/rl78/rl78.cc: ...here. * config/rs6000/driver-rs6000.c: Moved to... * config/rs6000/driver-rs6000.cc: ...here. * config/rs6000/host-darwin.c: Moved to... * config/rs6000/host-darwin.cc: ...here. * config/rs6000/host-ppc64-darwin.c: Moved to... * config/rs6000/host-ppc64-darwin.cc: ...here. * config/rs6000/rbtree.c: Moved to... * config/rs6000/rbtree.cc: ...here. * config/rs6000/rs6000-c.c: Moved to... * config/rs6000/rs6000-c.cc: ...here. * config/rs6000/rs6000-call.c: Moved to... * config/rs6000/rs6000-call.cc: ...here. * config/rs6000/rs6000-d.c: Moved to... * config/rs6000/rs6000-d.cc: ...here. * config/rs6000/rs6000-gen-builtins.c: Moved to... * config/rs6000/rs6000-gen-builtins.cc: ...here. * config/rs6000/rs6000-linux.c: Moved to... * config/rs6000/rs6000-linux.cc: ...here. * config/rs6000/rs6000-logue.c: Moved to... * config/rs6000/rs6000-logue.cc: ...here. * config/rs6000/rs6000-p8swap.c: Moved to... * config/rs6000/rs6000-p8swap.cc: ...here. * config/rs6000/rs6000-pcrel-opt.c: Moved to... * config/rs6000/rs6000-pcrel-opt.cc: ...here. * config/rs6000/rs6000-string.c: Moved to... * config/rs6000/rs6000-string.cc: ...here. * config/rs6000/rs6000.c: Moved to... * config/rs6000/rs6000.cc: ...here. * config/rx/rx.c: Moved to... * config/rx/rx.cc: ...here. * config/s390/driver-native.c: Moved to... * config/s390/driver-native.cc: ...here. * config/s390/s390-c.c: Moved to... * config/s390/s390-c.cc: ...here. * config/s390/s390-d.c: Moved to... * config/s390/s390-d.cc: ...here. * config/s390/s390.c: Moved to... * config/s390/s390.cc: ...here. * config/sh/divtab-sh4-300.c: Moved to... * config/sh/divtab-sh4-300.cc: ...here. * config/sh/divtab-sh4.c: Moved to... * config/sh/divtab-sh4.cc: ...here. * config/sh/divtab.c: Moved to... * config/sh/divtab.cc: ...here. * config/sh/sh-c.c: Moved to... * config/sh/sh-c.cc: ...here. * config/sh/sh.c: Moved to... * config/sh/sh.cc: ...here. * config/sol2-c.c: Moved to... * config/sol2-c.cc: ...here. * config/sol2-cxx.c: Moved to... * config/sol2-cxx.cc: ...here. * config/sol2-d.c: Moved to... * config/sol2-d.cc: ...here. * config/sol2-stubs.c: Moved to... * config/sol2-stubs.cc: ...here. * config/sol2.c: Moved to... * config/sol2.cc: ...here. * config/sparc/driver-sparc.c: Moved to... * config/sparc/driver-sparc.cc: ...here. * config/sparc/sparc-c.c: Moved to... * config/sparc/sparc-c.cc: ...here. * config/sparc/sparc-d.c: Moved to... * config/sparc/sparc-d.cc: ...here. * config/sparc/sparc.c: Moved to... * config/sparc/sparc.cc: ...here. * config/stormy16/stormy16.c: Moved to... * config/stormy16/stormy16.cc: ...here. * config/tilegx/mul-tables.c: Moved to... * config/tilegx/mul-tables.cc: ...here. * config/tilegx/tilegx-c.c: Moved to... * config/tilegx/tilegx-c.cc: ...here. * config/tilegx/tilegx.c: Moved to... * config/tilegx/tilegx.cc: ...here. * config/tilepro/mul-tables.c: Moved to... * config/tilepro/mul-tables.cc: ...here. * config/tilepro/tilepro-c.c: Moved to... * config/tilepro/tilepro-c.cc: ...here. * config/tilepro/tilepro.c: Moved to... * config/tilepro/tilepro.cc: ...here. * config/v850/v850-c.c: Moved to... * config/v850/v850-c.cc: ...here. * config/v850/v850.c: Moved to... * config/v850/v850.cc: ...here. * config/vax/vax.c: Moved to... * config/vax/vax.cc: ...here. * config/visium/visium.c: Moved to... * config/visium/visium.cc: ...here. * config/vms/vms-c.c: Moved to... * config/vms/vms-c.cc: ...here. * config/vms/vms-f.c: Moved to... * config/vms/vms-f.cc: ...here. * config/vms/vms.c: Moved to... * config/vms/vms.cc: ...here. * config/vxworks-c.c: Moved to... * config/vxworks-c.cc: ...here. * config/vxworks.c: Moved to... * config/vxworks.cc: ...here. * config/winnt-c.c: Moved to... * config/winnt-c.cc: ...here. * config/xtensa/xtensa.c: Moved to... * config/xtensa/xtensa.cc: ...here. * context.c: Moved to... * context.cc: ...here. * convert.c: Moved to... * convert.cc: ...here. * coverage.c: Moved to... * coverage.cc: ...here. * cppbuiltin.c: Moved to... * cppbuiltin.cc: ...here. * cppdefault.c: Moved to... * cppdefault.cc: ...here. * cprop.c: Moved to... * cprop.cc: ...here. * cse.c: Moved to... * cse.cc: ...here. * cselib.c: Moved to... * cselib.cc: ...here. * ctfc.c: Moved to... * ctfc.cc: ...here. * ctfout.c: Moved to... * ctfout.cc: ...here. * data-streamer-in.c: Moved to... * data-streamer-in.cc: ...here. * data-streamer-out.c: Moved to... * data-streamer-out.cc: ...here. * data-streamer.c: Moved to... * data-streamer.cc: ...here. * dbgcnt.c: Moved to... * dbgcnt.cc: ...here. * dbxout.c: Moved to... * dbxout.cc: ...here. * dce.c: Moved to... * dce.cc: ...here. * ddg.c: Moved to... * ddg.cc: ...here. * debug.c: Moved to... * debug.cc: ...here. * df-core.c: Moved to... * df-core.cc: ...here. * df-problems.c: Moved to... * df-problems.cc: ...here. * df-scan.c: Moved to... * df-scan.cc: ...here. * dfp.c: Moved to... * dfp.cc: ...here. * diagnostic-color.c: Moved to... * diagnostic-color.cc: ...here. * diagnostic-show-locus.c: Moved to... * diagnostic-show-locus.cc: ...here. * diagnostic-spec.c: Moved to... * diagnostic-spec.cc: ...here. * diagnostic.c: Moved to... * diagnostic.cc: ...here. * dojump.c: Moved to... * dojump.cc: ...here. * dominance.c: Moved to... * dominance.cc: ...here. * domwalk.c: Moved to... * domwalk.cc: ...here. * double-int.c: Moved to... * double-int.cc: ...here. * dse.c: Moved to... * dse.cc: ...here. * dumpfile.c: Moved to... * dumpfile.cc: ...here. * dwarf2asm.c: Moved to... * dwarf2asm.cc: ...here. * dwarf2cfi.c: Moved to... * dwarf2cfi.cc: ...here. * dwarf2ctf.c: Moved to... * dwarf2ctf.cc: ...here. * dwarf2out.c: Moved to... * dwarf2out.cc: ...here. * early-remat.c: Moved to... * early-remat.cc: ...here. * edit-context.c: Moved to... * edit-context.cc: ...here. * emit-rtl.c: Moved to... * emit-rtl.cc: ...here. * errors.c: Moved to... * errors.cc: ...here. * et-forest.c: Moved to... * et-forest.cc: ...here. * except.c: Moved to... * except.cc: ...here. * explow.c: Moved to... * explow.cc: ...here. * expmed.c: Moved to... * expmed.cc: ...here. * expr.c: Moved to... * expr.cc: ...here. * fibonacci_heap.c: Moved to... * fibonacci_heap.cc: ...here. * file-find.c: Moved to... * file-find.cc: ...here. * file-prefix-map.c: Moved to... * file-prefix-map.cc: ...here. * final.c: Moved to... * final.cc: ...here. * fixed-value.c: Moved to... * fixed-value.cc: ...here. * fold-const-call.c: Moved to... * fold-const-call.cc: ...here. * fold-const.c: Moved to... * fold-const.cc: ...here. * fp-test.c: Moved to... * fp-test.cc: ...here. * function-tests.c: Moved to... * function-tests.cc: ...here. * function.c: Moved to... * function.cc: ...here. * fwprop.c: Moved to... * fwprop.cc: ...here. * gcc-ar.c: Moved to... * gcc-ar.cc: ...here. * gcc-main.c: Moved to... * gcc-main.cc: ...here. * gcc-rich-location.c: Moved to... * gcc-rich-location.cc: ...here. * gcc.c: Moved to... * gcc.cc: ...here. * gcov-dump.c: Moved to... * gcov-dump.cc: ...here. * gcov-io.c: Moved to... * gcov-io.cc: ...here. * gcov-tool.c: Moved to... * gcov-tool.cc: ...here. * gcov.c: Moved to... * gcov.cc: ...here. * gcse-common.c: Moved to... * gcse-common.cc: ...here. * gcse.c: Moved to... * gcse.cc: ...here. * genattr-common.c: Moved to... * genattr-common.cc: ...here. * genattr.c: Moved to... * genattr.cc: ...here. * genattrtab.c: Moved to... * genattrtab.cc: ...here. * genautomata.c: Moved to... * genautomata.cc: ...here. * gencfn-macros.c: Moved to... * gencfn-macros.cc: ...here. * gencheck.c: Moved to... * gencheck.cc: ...here. * genchecksum.c: Moved to... * genchecksum.cc: ...here. * gencodes.c: Moved to... * gencodes.cc: ...here. * genconditions.c: Moved to... * genconditions.cc: ...here. * genconfig.c: Moved to... * genconfig.cc: ...here. * genconstants.c: Moved to... * genconstants.cc: ...here. * genemit.c: Moved to... * genemit.cc: ...here. * genenums.c: Moved to... * genenums.cc: ...here. * generic-match-head.c: Moved to... * generic-match-head.cc: ...here. * genextract.c: Moved to... * genextract.cc: ...here. * genflags.c: Moved to... * genflags.cc: ...here. * gengenrtl.c: Moved to... * gengenrtl.cc: ...here. * gengtype-parse.c: Moved to... * gengtype-parse.cc: ...here. * gengtype-state.c: Moved to... * gengtype-state.cc: ...here. * gengtype.c: Moved to... * gengtype.cc: ...here. * genhooks.c: Moved to... * genhooks.cc: ...here. * genmatch.c: Moved to... * genmatch.cc: ...here. * genmddeps.c: Moved to... * genmddeps.cc: ...here. * genmddump.c: Moved to... * genmddump.cc: ...here. * genmodes.c: Moved to... * genmodes.cc: ...here. * genopinit.c: Moved to... * genopinit.cc: ...here. * genoutput.c: Moved to... * genoutput.cc: ...here. * genpeep.c: Moved to... * genpeep.cc: ...here. * genpreds.c: Moved to... * genpreds.cc: ...here. * genrecog.c: Moved to... * genrecog.cc: ...here. * gensupport.c: Moved to... * gensupport.cc: ...here. * gentarget-def.c: Moved to... * gentarget-def.cc: ...here. * genversion.c: Moved to... * genversion.cc: ...here. * ggc-common.c: Moved to... * ggc-common.cc: ...here. * ggc-none.c: Moved to... * ggc-none.cc: ...here. * ggc-page.c: Moved to... * ggc-page.cc: ...here. * ggc-tests.c: Moved to... * ggc-tests.cc: ...here. * gimple-builder.c: Moved to... * gimple-builder.cc: ...here. * gimple-expr.c: Moved to... * gimple-expr.cc: ...here. * gimple-fold.c: Moved to... * gimple-fold.cc: ...here. * gimple-iterator.c: Moved to... * gimple-iterator.cc: ...here. * gimple-laddress.c: Moved to... * gimple-laddress.cc: ...here. * gimple-loop-jam.c: Moved to... * gimple-loop-jam.cc: ...here. * gimple-low.c: Moved to... * gimple-low.cc: ...here. * gimple-match-head.c: Moved to... * gimple-match-head.cc: ...here. * gimple-pretty-print.c: Moved to... * gimple-pretty-print.cc: ...here. * gimple-ssa-backprop.c: Moved to... * gimple-ssa-backprop.cc: ...here. * gimple-ssa-evrp-analyze.c: Moved to... * gimple-ssa-evrp-analyze.cc: ...here. * gimple-ssa-evrp.c: Moved to... * gimple-ssa-evrp.cc: ...here. * gimple-ssa-isolate-paths.c: Moved to... * gimple-ssa-isolate-paths.cc: ...here. * gimple-ssa-nonnull-compare.c: Moved to... * gimple-ssa-nonnull-compare.cc: ...here. * gimple-ssa-split-paths.c: Moved to... * gimple-ssa-split-paths.cc: ...here. * gimple-ssa-sprintf.c: Moved to... * gimple-ssa-sprintf.cc: ...here. * gimple-ssa-store-merging.c: Moved to... * gimple-ssa-store-merging.cc: ...here. * gimple-ssa-strength-reduction.c: Moved to... * gimple-ssa-strength-reduction.cc: ...here. * gimple-ssa-warn-alloca.c: Moved to... * gimple-ssa-warn-alloca.cc: ...here. * gimple-ssa-warn-restrict.c: Moved to... * gimple-ssa-warn-restrict.cc: ...here. * gimple-streamer-in.c: Moved to... * gimple-streamer-in.cc: ...here. * gimple-streamer-out.c: Moved to... * gimple-streamer-out.cc: ...here. * gimple-walk.c: Moved to... * gimple-walk.cc: ...here. * gimple-warn-recursion.c: Moved to... * gimple-warn-recursion.cc: ...here. * gimple.c: Moved to... * gimple.cc: ...here. * gimplify-me.c: Moved to... * gimplify-me.cc: ...here. * gimplify.c: Moved to... * gimplify.cc: ...here. * godump.c: Moved to... * godump.cc: ...here. * graph.c: Moved to... * graph.cc: ...here. * graphds.c: Moved to... * graphds.cc: ...here. * graphite-dependences.c: Moved to... * graphite-dependences.cc: ...here. * graphite-isl-ast-to-gimple.c: Moved to... * graphite-isl-ast-to-gimple.cc: ...here. * graphite-optimize-isl.c: Moved to... * graphite-optimize-isl.cc: ...here. * graphite-poly.c: Moved to... * graphite-poly.cc: ...here. * graphite-scop-detection.c: Moved to... * graphite-scop-detection.cc: ...here. * graphite-sese-to-poly.c: Moved to... * graphite-sese-to-poly.cc: ...here. * graphite.c: Moved to... * graphite.cc: ...here. * haifa-sched.c: Moved to... * haifa-sched.cc: ...here. * hash-map-tests.c: Moved to... * hash-map-tests.cc: ...here. * hash-set-tests.c: Moved to... * hash-set-tests.cc: ...here. * hash-table.c: Moved to... * hash-table.cc: ...here. * hooks.c: Moved to... * hooks.cc: ...here. * host-default.c: Moved to... * host-default.cc: ...here. * hw-doloop.c: Moved to... * hw-doloop.cc: ...here. * hwint.c: Moved to... * hwint.cc: ...here. * ifcvt.c: Moved to... * ifcvt.cc: ...here. * inchash.c: Moved to... * inchash.cc: ...here. * incpath.c: Moved to... * incpath.cc: ...here. * init-regs.c: Moved to... * init-regs.cc: ...here. * input.c: Moved to... * input.cc: ...here. * internal-fn.c: Moved to... * internal-fn.cc: ...here. * intl.c: Moved to... * intl.cc: ...here. * ipa-comdats.c: Moved to... * ipa-comdats.cc: ...here. * ipa-cp.c: Moved to... * ipa-cp.cc: ...here. * ipa-devirt.c: Moved to... * ipa-devirt.cc: ...here. * ipa-fnsummary.c: Moved to... * ipa-fnsummary.cc: ...here. * ipa-icf-gimple.c: Moved to... * ipa-icf-gimple.cc: ...here. * ipa-icf.c: Moved to... * ipa-icf.cc: ...here. * ipa-inline-analysis.c: Moved to... * ipa-inline-analysis.cc: ...here. * ipa-inline-transform.c: Moved to... * ipa-inline-transform.cc: ...here. * ipa-inline.c: Moved to... * ipa-inline.cc: ...here. * ipa-modref-tree.c: Moved to... * ipa-modref-tree.cc: ...here. * ipa-modref.c: Moved to... * ipa-modref.cc: ...here. * ipa-param-manipulation.c: Moved to... * ipa-param-manipulation.cc: ...here. * ipa-polymorphic-call.c: Moved to... * ipa-polymorphic-call.cc: ...here. * ipa-predicate.c: Moved to... * ipa-predicate.cc: ...here. * ipa-profile.c: Moved to... * ipa-profile.cc: ...here. * ipa-prop.c: Moved to... * ipa-prop.cc: ...here. * ipa-pure-const.c: Moved to... * ipa-pure-const.cc: ...here. * ipa-ref.c: Moved to... * ipa-ref.cc: ...here. * ipa-reference.c: Moved to... * ipa-reference.cc: ...here. * ipa-split.c: Moved to... * ipa-split.cc: ...here. * ipa-sra.c: Moved to... * ipa-sra.cc: ...here. * ipa-utils.c: Moved to... * ipa-utils.cc: ...here. * ipa-visibility.c: Moved to... * ipa-visibility.cc: ...here. * ipa.c: Moved to... * ipa.cc: ...here. * ira-build.c: Moved to... * ira-build.cc: ...here. * ira-color.c: Moved to... * ira-color.cc: ...here. * ira-conflicts.c: Moved to... * ira-conflicts.cc: ...here. * ira-costs.c: Moved to... * ira-costs.cc: ...here. * ira-emit.c: Moved to... * ira-emit.cc: ...here. * ira-lives.c: Moved to... * ira-lives.cc: ...here. * ira.c: Moved to... * ira.cc: ...here. * jump.c: Moved to... * jump.cc: ...here. * langhooks.c: Moved to... * langhooks.cc: ...here. * lcm.c: Moved to... * lcm.cc: ...here. * lists.c: Moved to... * lists.cc: ...here. * loop-doloop.c: Moved to... * loop-doloop.cc: ...here. * loop-init.c: Moved to... * loop-init.cc: ...here. * loop-invariant.c: Moved to... * loop-invariant.cc: ...here. * loop-iv.c: Moved to... * loop-iv.cc: ...here. * loop-unroll.c: Moved to... * loop-unroll.cc: ...here. * lower-subreg.c: Moved to... * lower-subreg.cc: ...here. * lra-assigns.c: Moved to... * lra-assigns.cc: ...here. * lra-coalesce.c: Moved to... * lra-coalesce.cc: ...here. * lra-constraints.c: Moved to... * lra-constraints.cc: ...here. * lra-eliminations.c: Moved to... * lra-eliminations.cc: ...here. * lra-lives.c: Moved to... * lra-lives.cc: ...here. * lra-remat.c: Moved to... * lra-remat.cc: ...here. * lra-spills.c: Moved to... * lra-spills.cc: ...here. * lra.c: Moved to... * lra.cc: ...here. * lto-cgraph.c: Moved to... * lto-cgraph.cc: ...here. * lto-compress.c: Moved to... * lto-compress.cc: ...here. * lto-opts.c: Moved to... * lto-opts.cc: ...here. * lto-section-in.c: Moved to... * lto-section-in.cc: ...here. * lto-section-out.c: Moved to... * lto-section-out.cc: ...here. * lto-streamer-in.c: Moved to... * lto-streamer-in.cc: ...here. * lto-streamer-out.c: Moved to... * lto-streamer-out.cc: ...here. * lto-streamer.c: Moved to... * lto-streamer.cc: ...here. * lto-wrapper.c: Moved to... * lto-wrapper.cc: ...here. * main.c: Moved to... * main.cc: ...here. * mcf.c: Moved to... * mcf.cc: ...here. * mode-switching.c: Moved to... * mode-switching.cc: ...here. * modulo-sched.c: Moved to... * modulo-sched.cc: ...here. * multiple_target.c: Moved to... * multiple_target.cc: ...here. * omp-expand.c: Moved to... * omp-expand.cc: ...here. * omp-general.c: Moved to... * omp-general.cc: ...here. * omp-low.c: Moved to... * omp-low.cc: ...here. * omp-offload.c: Moved to... * omp-offload.cc: ...here. * omp-simd-clone.c: Moved to... * omp-simd-clone.cc: ...here. * opt-suggestions.c: Moved to... * opt-suggestions.cc: ...here. * optabs-libfuncs.c: Moved to... * optabs-libfuncs.cc: ...here. * optabs-query.c: Moved to... * optabs-query.cc: ...here. * optabs-tree.c: Moved to... * optabs-tree.cc: ...here. * optabs.c: Moved to... * optabs.cc: ...here. * opts-common.c: Moved to... * opts-common.cc: ...here. * opts-global.c: Moved to... * opts-global.cc: ...here. * opts.c: Moved to... * opts.cc: ...here. * passes.c: Moved to... * passes.cc: ...here. * plugin.c: Moved to... * plugin.cc: ...here. * postreload-gcse.c: Moved to... * postreload-gcse.cc: ...here. * postreload.c: Moved to... * postreload.cc: ...here. * predict.c: Moved to... * predict.cc: ...here. * prefix.c: Moved to... * prefix.cc: ...here. * pretty-print.c: Moved to... * pretty-print.cc: ...here. * print-rtl-function.c: Moved to... * print-rtl-function.cc: ...here. * print-rtl.c: Moved to... * print-rtl.cc: ...here. * print-tree.c: Moved to... * print-tree.cc: ...here. * profile-count.c: Moved to... * profile-count.cc: ...here. * profile.c: Moved to... * profile.cc: ...here. * read-md.c: Moved to... * read-md.cc: ...here. * read-rtl-function.c: Moved to... * read-rtl-function.cc: ...here. * read-rtl.c: Moved to... * read-rtl.cc: ...here. * real.c: Moved to... * real.cc: ...here. * realmpfr.c: Moved to... * realmpfr.cc: ...here. * recog.c: Moved to... * recog.cc: ...here. * ree.c: Moved to... * ree.cc: ...here. * reg-stack.c: Moved to... * reg-stack.cc: ...here. * regcprop.c: Moved to... * regcprop.cc: ...here. * reginfo.c: Moved to... * reginfo.cc: ...here. * regrename.c: Moved to... * regrename.cc: ...here. * regstat.c: Moved to... * regstat.cc: ...here. * reload.c: Moved to... * reload.cc: ...here. * reload1.c: Moved to... * reload1.cc: ...here. * reorg.c: Moved to... * reorg.cc: ...here. * resource.c: Moved to... * resource.cc: ...here. * rtl-error.c: Moved to... * rtl-error.cc: ...here. * rtl-tests.c: Moved to... * rtl-tests.cc: ...here. * rtl.c: Moved to... * rtl.cc: ...here. * rtlanal.c: Moved to... * rtlanal.cc: ...here. * rtlhash.c: Moved to... * rtlhash.cc: ...here. * rtlhooks.c: Moved to... * rtlhooks.cc: ...here. * rtx-vector-builder.c: Moved to... * rtx-vector-builder.cc: ...here. * run-rtl-passes.c: Moved to... * run-rtl-passes.cc: ...here. * sancov.c: Moved to... * sancov.cc: ...here. * sanopt.c: Moved to... * sanopt.cc: ...here. * sbitmap.c: Moved to... * sbitmap.cc: ...here. * sched-deps.c: Moved to... * sched-deps.cc: ...here. * sched-ebb.c: Moved to... * sched-ebb.cc: ...here. * sched-rgn.c: Moved to... * sched-rgn.cc: ...here. * sel-sched-dump.c: Moved to... * sel-sched-dump.cc: ...here. * sel-sched-ir.c: Moved to... * sel-sched-ir.cc: ...here. * sel-sched.c: Moved to... * sel-sched.cc: ...here. * selftest-diagnostic.c: Moved to... * selftest-diagnostic.cc: ...here. * selftest-rtl.c: Moved to... * selftest-rtl.cc: ...here. * selftest-run-tests.c: Moved to... * selftest-run-tests.cc: ...here. * selftest.c: Moved to... * selftest.cc: ...here. * sese.c: Moved to... * sese.cc: ...here. * shrink-wrap.c: Moved to... * shrink-wrap.cc: ...here. * simplify-rtx.c: Moved to... * simplify-rtx.cc: ...here. * sparseset.c: Moved to... * sparseset.cc: ...here. * spellcheck-tree.c: Moved to... * spellcheck-tree.cc: ...here. * spellcheck.c: Moved to... * spellcheck.cc: ...here. * sreal.c: Moved to... * sreal.cc: ...here. * stack-ptr-mod.c: Moved to... * stack-ptr-mod.cc: ...here. * statistics.c: Moved to... * statistics.cc: ...here. * stmt.c: Moved to... * stmt.cc: ...here. * stor-layout.c: Moved to... * stor-layout.cc: ...here. * store-motion.c: Moved to... * store-motion.cc: ...here. * streamer-hooks.c: Moved to... * streamer-hooks.cc: ...here. * stringpool.c: Moved to... * stringpool.cc: ...here. * substring-locations.c: Moved to... * substring-locations.cc: ...here. * symtab.c: Moved to... * symtab.cc: ...here. * target-globals.c: Moved to... * target-globals.cc: ...here. * targhooks.c: Moved to... * targhooks.cc: ...here. * timevar.c: Moved to... * timevar.cc: ...here. * toplev.c: Moved to... * toplev.cc: ...here. * tracer.c: Moved to... * tracer.cc: ...here. * trans-mem.c: Moved to... * trans-mem.cc: ...here. * tree-affine.c: Moved to... * tree-affine.cc: ...here. * tree-call-cdce.c: Moved to... * tree-call-cdce.cc: ...here. * tree-cfg.c: Moved to... * tree-cfg.cc: ...here. * tree-cfgcleanup.c: Moved to... * tree-cfgcleanup.cc: ...here. * tree-chrec.c: Moved to... * tree-chrec.cc: ...here. * tree-complex.c: Moved to... * tree-complex.cc: ...here. * tree-data-ref.c: Moved to... * tree-data-ref.cc: ...here. * tree-dfa.c: Moved to... * tree-dfa.cc: ...here. * tree-diagnostic.c: Moved to... * tree-diagnostic.cc: ...here. * tree-dump.c: Moved to... * tree-dump.cc: ...here. * tree-eh.c: Moved to... * tree-eh.cc: ...here. * tree-emutls.c: Moved to... * tree-emutls.cc: ...here. * tree-if-conv.c: Moved to... * tree-if-conv.cc: ...here. * tree-inline.c: Moved to... * tree-inline.cc: ...here. * tree-into-ssa.c: Moved to... * tree-into-ssa.cc: ...here. * tree-iterator.c: Moved to... * tree-iterator.cc: ...here. * tree-loop-distribution.c: Moved to... * tree-loop-distribution.cc: ...here. * tree-nested.c: Moved to... * tree-nested.cc: ...here. * tree-nrv.c: Moved to... * tree-nrv.cc: ...here. * tree-object-size.c: Moved to... * tree-object-size.cc: ...here. * tree-outof-ssa.c: Moved to... * tree-outof-ssa.cc: ...here. * tree-parloops.c: Moved to... * tree-parloops.cc: ...here. * tree-phinodes.c: Moved to... * tree-phinodes.cc: ...here. * tree-predcom.c: Moved to... * tree-predcom.cc: ...here. * tree-pretty-print.c: Moved to... * tree-pretty-print.cc: ...here. * tree-profile.c: Moved to... * tree-profile.cc: ...here. * tree-scalar-evolution.c: Moved to... * tree-scalar-evolution.cc: ...here. * tree-sra.c: Moved to... * tree-sra.cc: ...here. * tree-ssa-address.c: Moved to... * tree-ssa-address.cc: ...here. * tree-ssa-alias.c: Moved to... * tree-ssa-alias.cc: ...here. * tree-ssa-ccp.c: Moved to... * tree-ssa-ccp.cc: ...here. * tree-ssa-coalesce.c: Moved to... * tree-ssa-coalesce.cc: ...here. * tree-ssa-copy.c: Moved to... * tree-ssa-copy.cc: ...here. * tree-ssa-dce.c: Moved to... * tree-ssa-dce.cc: ...here. * tree-ssa-dom.c: Moved to... * tree-ssa-dom.cc: ...here. * tree-ssa-dse.c: Moved to... * tree-ssa-dse.cc: ...here. * tree-ssa-forwprop.c: Moved to... * tree-ssa-forwprop.cc: ...here. * tree-ssa-ifcombine.c: Moved to... * tree-ssa-ifcombine.cc: ...here. * tree-ssa-live.c: Moved to... * tree-ssa-live.cc: ...here. * tree-ssa-loop-ch.c: Moved to... * tree-ssa-loop-ch.cc: ...here. * tree-ssa-loop-im.c: Moved to... * tree-ssa-loop-im.cc: ...here. * tree-ssa-loop-ivcanon.c: Moved to... * tree-ssa-loop-ivcanon.cc: ...here. * tree-ssa-loop-ivopts.c: Moved to... * tree-ssa-loop-ivopts.cc: ...here. * tree-ssa-loop-manip.c: Moved to... * tree-ssa-loop-manip.cc: ...here. * tree-ssa-loop-niter.c: Moved to... * tree-ssa-loop-niter.cc: ...here. * tree-ssa-loop-prefetch.c: Moved to... * tree-ssa-loop-prefetch.cc: ...here. * tree-ssa-loop-split.c: Moved to... * tree-ssa-loop-split.cc: ...here. * tree-ssa-loop-unswitch.c: Moved to... * tree-ssa-loop-unswitch.cc: ...here. * tree-ssa-loop.c: Moved to... * tree-ssa-loop.cc: ...here. * tree-ssa-math-opts.c: Moved to... * tree-ssa-math-opts.cc: ...here. * tree-ssa-operands.c: Moved to... * tree-ssa-operands.cc: ...here. * tree-ssa-phiopt.c: Moved to... * tree-ssa-phiopt.cc: ...here. * tree-ssa-phiprop.c: Moved to... * tree-ssa-phiprop.cc: ...here. * tree-ssa-pre.c: Moved to... * tree-ssa-pre.cc: ...here. * tree-ssa-propagate.c: Moved to... * tree-ssa-propagate.cc: ...here. * tree-ssa-reassoc.c: Moved to... * tree-ssa-reassoc.cc: ...here. * tree-ssa-sccvn.c: Moved to... * tree-ssa-sccvn.cc: ...here. * tree-ssa-scopedtables.c: Moved to... * tree-ssa-scopedtables.cc: ...here. * tree-ssa-sink.c: Moved to... * tree-ssa-sink.cc: ...here. * tree-ssa-strlen.c: Moved to... * tree-ssa-strlen.cc: ...here. * tree-ssa-structalias.c: Moved to... * tree-ssa-structalias.cc: ...here. * tree-ssa-tail-merge.c: Moved to... * tree-ssa-tail-merge.cc: ...here. * tree-ssa-ter.c: Moved to... * tree-ssa-ter.cc: ...here. * tree-ssa-threadbackward.c: Moved to... * tree-ssa-threadbackward.cc: ...here. * tree-ssa-threadedge.c: Moved to... * tree-ssa-threadedge.cc: ...here. * tree-ssa-threadupdate.c: Moved to... * tree-ssa-threadupdate.cc: ...here. * tree-ssa-uncprop.c: Moved to... * tree-ssa-uncprop.cc: ...here. * tree-ssa-uninit.c: Moved to... * tree-ssa-uninit.cc: ...here. * tree-ssa.c: Moved to... * tree-ssa.cc: ...here. * tree-ssanames.c: Moved to... * tree-ssanames.cc: ...here. * tree-stdarg.c: Moved to... * tree-stdarg.cc: ...here. * tree-streamer-in.c: Moved to... * tree-streamer-in.cc: ...here. * tree-streamer-out.c: Moved to... * tree-streamer-out.cc: ...here. * tree-streamer.c: Moved to... * tree-streamer.cc: ...here. * tree-switch-conversion.c: Moved to... * tree-switch-conversion.cc: ...here. * tree-tailcall.c: Moved to... * tree-tailcall.cc: ...here. * tree-vect-data-refs.c: Moved to... * tree-vect-data-refs.cc: ...here. * tree-vect-generic.c: Moved to... * tree-vect-generic.cc: ...here. * tree-vect-loop-manip.c: Moved to... * tree-vect-loop-manip.cc: ...here. * tree-vect-loop.c: Moved to... * tree-vect-loop.cc: ...here. * tree-vect-patterns.c: Moved to... * tree-vect-patterns.cc: ...here. * tree-vect-slp-patterns.c: Moved to... * tree-vect-slp-patterns.cc: ...here. * tree-vect-slp.c: Moved to... * tree-vect-slp.cc: ...here. * tree-vect-stmts.c: Moved to... * tree-vect-stmts.cc: ...here. * tree-vector-builder.c: Moved to... * tree-vector-builder.cc: ...here. * tree-vectorizer.c: Moved to... * tree-vectorizer.cc: ...here. * tree-vrp.c: Moved to... * tree-vrp.cc: ...here. * tree.c: Moved to... * tree.cc: ...here. * tsan.c: Moved to... * tsan.cc: ...here. * typed-splay-tree.c: Moved to... * typed-splay-tree.cc: ...here. * ubsan.c: Moved to... * ubsan.cc: ...here. * valtrack.c: Moved to... * valtrack.cc: ...here. * value-prof.c: Moved to... * value-prof.cc: ...here. * var-tracking.c: Moved to... * var-tracking.cc: ...here. * varasm.c: Moved to... * varasm.cc: ...here. * varpool.c: Moved to... * varpool.cc: ...here. * vec-perm-indices.c: Moved to... * vec-perm-indices.cc: ...here. * vec.c: Moved to... * vec.cc: ...here. * vmsdbgout.c: Moved to... * vmsdbgout.cc: ...here. * vr-values.c: Moved to... * vr-values.cc: ...here. * vtable-verify.c: Moved to... * vtable-verify.cc: ...here. * web.c: Moved to... * web.cc: ...here. * xcoffout.c: Moved to... * xcoffout.cc: ...here. gcc/c-family/ChangeLog: * c-ada-spec.c: Moved to... * c-ada-spec.cc: ...here. * c-attribs.c: Moved to... * c-attribs.cc: ...here. * c-common.c: Moved to... * c-common.cc: ...here. * c-cppbuiltin.c: Moved to... * c-cppbuiltin.cc: ...here. * c-dump.c: Moved to... * c-dump.cc: ...here. * c-format.c: Moved to... * c-format.cc: ...here. * c-gimplify.c: Moved to... * c-gimplify.cc: ...here. * c-indentation.c: Moved to... * c-indentation.cc: ...here. * c-lex.c: Moved to... * c-lex.cc: ...here. * c-omp.c: Moved to... * c-omp.cc: ...here. * c-opts.c: Moved to... * c-opts.cc: ...here. * c-pch.c: Moved to... * c-pch.cc: ...here. * c-ppoutput.c: Moved to... * c-ppoutput.cc: ...here. * c-pragma.c: Moved to... * c-pragma.cc: ...here. * c-pretty-print.c: Moved to... * c-pretty-print.cc: ...here. * c-semantics.c: Moved to... * c-semantics.cc: ...here. * c-ubsan.c: Moved to... * c-ubsan.cc: ...here. * c-warn.c: Moved to... * c-warn.cc: ...here. * cppspec.c: Moved to... * cppspec.cc: ...here. * stub-objc.c: Moved to... * stub-objc.cc: ...here. gcc/c/ChangeLog: * c-aux-info.c: Moved to... * c-aux-info.cc: ...here. * c-convert.c: Moved to... * c-convert.cc: ...here. * c-decl.c: Moved to... * c-decl.cc: ...here. * c-errors.c: Moved to... * c-errors.cc: ...here. * c-fold.c: Moved to... * c-fold.cc: ...here. * c-lang.c: Moved to... * c-lang.cc: ...here. * c-objc-common.c: Moved to... * c-objc-common.cc: ...here. * c-parser.c: Moved to... * c-parser.cc: ...here. * c-typeck.c: Moved to... * c-typeck.cc: ...here. * gccspec.c: Moved to... * gccspec.cc: ...here. * gimple-parser.c: Moved to... * gimple-parser.cc: ...here. gcc/cp/ChangeLog: * call.c: Moved to... * call.cc: ...here. * class.c: Moved to... * class.cc: ...here. * constexpr.c: Moved to... * constexpr.cc: ...here. * cp-gimplify.c: Moved to... * cp-gimplify.cc: ...here. * cp-lang.c: Moved to... * cp-lang.cc: ...here. * cp-objcp-common.c: Moved to... * cp-objcp-common.cc: ...here. * cp-ubsan.c: Moved to... * cp-ubsan.cc: ...here. * cvt.c: Moved to... * cvt.cc: ...here. * cxx-pretty-print.c: Moved to... * cxx-pretty-print.cc: ...here. * decl.c: Moved to... * decl.cc: ...here. * decl2.c: Moved to... * decl2.cc: ...here. * dump.c: Moved to... * dump.cc: ...here. * error.c: Moved to... * error.cc: ...here. * except.c: Moved to... * except.cc: ...here. * expr.c: Moved to... * expr.cc: ...here. * friend.c: Moved to... * friend.cc: ...here. * g++spec.c: Moved to... * g++spec.cc: ...here. * init.c: Moved to... * init.cc: ...here. * lambda.c: Moved to... * lambda.cc: ...here. * lex.c: Moved to... * lex.cc: ...here. * mangle.c: Moved to... * mangle.cc: ...here. * method.c: Moved to... * method.cc: ...here. * name-lookup.c: Moved to... * name-lookup.cc: ...here. * optimize.c: Moved to... * optimize.cc: ...here. * parser.c: Moved to... * parser.cc: ...here. * pt.c: Moved to... * pt.cc: ...here. * ptree.c: Moved to... * ptree.cc: ...here. * rtti.c: Moved to... * rtti.cc: ...here. * search.c: Moved to... * search.cc: ...here. * semantics.c: Moved to... * semantics.cc: ...here. * tree.c: Moved to... * tree.cc: ...here. * typeck.c: Moved to... * typeck.cc: ...here. * typeck2.c: Moved to... * typeck2.cc: ...here. * vtable-class-hierarchy.c: Moved to... * vtable-class-hierarchy.cc: ...here. gcc/fortran/ChangeLog: * arith.c: Moved to... * arith.cc: ...here. * array.c: Moved to... * array.cc: ...here. * bbt.c: Moved to... * bbt.cc: ...here. * check.c: Moved to... * check.cc: ...here. * class.c: Moved to... * class.cc: ...here. * constructor.c: Moved to... * constructor.cc: ...here. * convert.c: Moved to... * convert.cc: ...here. * cpp.c: Moved to... * cpp.cc: ...here. * data.c: Moved to... * data.cc: ...here. * decl.c: Moved to... * decl.cc: ...here. * dependency.c: Moved to... * dependency.cc: ...here. * dump-parse-tree.c: Moved to... * dump-parse-tree.cc: ...here. * error.c: Moved to... * error.cc: ...here. * expr.c: Moved to... * expr.cc: ...here. * f95-lang.c: Moved to... * f95-lang.cc: ...here. * frontend-passes.c: Moved to... * frontend-passes.cc: ...here. * gfortranspec.c: Moved to... * gfortranspec.cc: ...here. * interface.c: Moved to... * interface.cc: ...here. * intrinsic.c: Moved to... * intrinsic.cc: ...here. * io.c: Moved to... * io.cc: ...here. * iresolve.c: Moved to... * iresolve.cc: ...here. * match.c: Moved to... * match.cc: ...here. * matchexp.c: Moved to... * matchexp.cc: ...here. * misc.c: Moved to... * misc.cc: ...here. * module.c: Moved to... * module.cc: ...here. * openmp.c: Moved to... * openmp.cc: ...here. * options.c: Moved to... * options.cc: ...here. * parse.c: Moved to... * parse.cc: ...here. * primary.c: Moved to... * primary.cc: ...here. * resolve.c: Moved to... * resolve.cc: ...here. * scanner.c: Moved to... * scanner.cc: ...here. * simplify.c: Moved to... * simplify.cc: ...here. * st.c: Moved to... * st.cc: ...here. * symbol.c: Moved to... * symbol.cc: ...here. * target-memory.c: Moved to... * target-memory.cc: ...here. * trans-array.c: Moved to... * trans-array.cc: ...here. * trans-common.c: Moved to... * trans-common.cc: ...here. * trans-const.c: Moved to... * trans-const.cc: ...here. * trans-decl.c: Moved to... * trans-decl.cc: ...here. * trans-expr.c: Moved to... * trans-expr.cc: ...here. * trans-intrinsic.c: Moved to... * trans-intrinsic.cc: ...here. * trans-io.c: Moved to... * trans-io.cc: ...here. * trans-openmp.c: Moved to... * trans-openmp.cc: ...here. * trans-stmt.c: Moved to... * trans-stmt.cc: ...here. * trans-types.c: Moved to... * trans-types.cc: ...here. * trans.c: Moved to... * trans.cc: ...here. gcc/go/ChangeLog: * go-backend.c: Moved to... * go-backend.cc: ...here. * go-lang.c: Moved to... * go-lang.cc: ...here. * gospec.c: Moved to... * gospec.cc: ...here. gcc/jit/ChangeLog: * dummy-frontend.c: Moved to... * dummy-frontend.cc: ...here. * jit-builtins.c: Moved to... * jit-builtins.cc: ...here. * jit-logging.c: Moved to... * jit-logging.cc: ...here. * jit-playback.c: Moved to... * jit-playback.cc: ...here. * jit-recording.c: Moved to... * jit-recording.cc: ...here. * jit-result.c: Moved to... * jit-result.cc: ...here. * jit-spec.c: Moved to... * jit-spec.cc: ...here. * jit-tempdir.c: Moved to... * jit-tempdir.cc: ...here. * jit-w32.c: Moved to... * jit-w32.cc: ...here. * libgccjit.c: Moved to... * libgccjit.cc: ...here. gcc/lto/ChangeLog: * common.c: Moved to... * common.cc: ...here. * lto-common.c: Moved to... * lto-common.cc: ...here. * lto-dump.c: Moved to... * lto-dump.cc: ...here. * lto-lang.c: Moved to... * lto-lang.cc: ...here. * lto-object.c: Moved to... * lto-object.cc: ...here. * lto-partition.c: Moved to... * lto-partition.cc: ...here. * lto-symtab.c: Moved to... * lto-symtab.cc: ...here. * lto.c: Moved to... * lto.cc: ...here. gcc/objc/ChangeLog: * objc-act.c: Moved to... * objc-act.cc: ...here. * objc-encoding.c: Moved to... * objc-encoding.cc: ...here. * objc-gnu-runtime-abi-01.c: Moved to... * objc-gnu-runtime-abi-01.cc: ...here. * objc-lang.c: Moved to... * objc-lang.cc: ...here. * objc-map.c: Moved to... * objc-map.cc: ...here. * objc-next-runtime-abi-01.c: Moved to... * objc-next-runtime-abi-01.cc: ...here. * objc-next-runtime-abi-02.c: Moved to... * objc-next-runtime-abi-02.cc: ...here. * objc-runtime-shared-support.c: Moved to... * objc-runtime-shared-support.cc: ...here. gcc/objcp/ChangeLog: * objcp-decl.c: Moved to... * objcp-decl.cc: ...here. * objcp-lang.c: Moved to... * objcp-lang.cc: ...here. libcpp/ChangeLog: * charset.c: Moved to... * charset.cc: ...here. * directives.c: Moved to... * directives.cc: ...here. * errors.c: Moved to... * errors.cc: ...here. * expr.c: Moved to... * expr.cc: ...here. * files.c: Moved to... * files.cc: ...here. * identifiers.c: Moved to... * identifiers.cc: ...here. * init.c: Moved to... * init.cc: ...here. * lex.c: Moved to... * lex.cc: ...here. * line-map.c: Moved to... * line-map.cc: ...here. * macro.c: Moved to... * macro.cc: ...here. * makeucnid.c: Moved to... * makeucnid.cc: ...here. * mkdeps.c: Moved to... * mkdeps.cc: ...here. * pch.c: Moved to... * pch.cc: ...here. * symtab.c: Moved to... * symtab.cc: ...here. * traditional.c: Moved to... * traditional.cc: ...here.
Diffstat (limited to 'gcc/fortran/trans-openmp.c')
-rw-r--r--gcc/fortran/trans-openmp.c7701
1 files changed, 0 insertions, 7701 deletions
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
deleted file mode 100644
index d363258..0000000
--- a/gcc/fortran/trans-openmp.c
+++ /dev/null
@@ -1,7701 +0,0 @@
-/* OpenMP directive translation -- generate GCC trees from gfc_code.
- Copyright (C) 2005-2022 Free Software Foundation, Inc.
- Contributed by Jakub Jelinek <jakub@redhat.com>
-
-This file is part of GCC.
-
-GCC is free software; you can redistribute it and/or modify it under
-the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 3, or (at your option) any later
-version.
-
-GCC is distributed in the hope that it will be useful, but WITHOUT ANY
-WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-for more details.
-
-You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING3. If not see
-<http://www.gnu.org/licenses/>. */
-
-
-#include "config.h"
-#include "system.h"
-#include "coretypes.h"
-#include "options.h"
-#include "tree.h"
-#include "gfortran.h"
-#include "gimple-expr.h"
-#include "trans.h"
-#include "stringpool.h"
-#include "fold-const.h"
-#include "gimplify.h" /* For create_tmp_var_raw. */
-#include "trans-stmt.h"
-#include "trans-types.h"
-#include "trans-array.h"
-#include "trans-const.h"
-#include "arith.h"
-#include "constructor.h"
-#include "gomp-constants.h"
-#include "omp-general.h"
-#include "omp-low.h"
-#include "memmodel.h" /* For MEMMODEL_ enums. */
-
-#undef GCC_DIAG_STYLE
-#define GCC_DIAG_STYLE __gcc_tdiag__
-#include "diagnostic-core.h"
-#undef GCC_DIAG_STYLE
-#define GCC_DIAG_STYLE __gcc_gfc__
-#include "attribs.h"
-#include "function.h"
-
-int ompws_flags;
-
-/* True if OpenMP should regard this DECL as being a scalar which has Fortran's
- allocatable or pointer attribute. */
-
-bool
-gfc_omp_is_allocatable_or_ptr (const_tree decl)
-{
- return (DECL_P (decl)
- && (GFC_DECL_GET_SCALAR_POINTER (decl)
- || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)));
-}
-
-/* True if the argument is an optional argument; except that false is also
- returned for arguments with the value attribute (nonpointers) and for
- assumed-shape variables (decl is a local variable containing arg->data).
- Note that for 'procedure(), optional' the value false is used as that's
- always a pointer and no additional indirection is used.
- Note that pvoid_type_node is for 'type(c_ptr), value' (and c_funloc). */
-
-static bool
-gfc_omp_is_optional_argument (const_tree decl)
-{
- /* Note: VAR_DECL can occur with BIND(C) and array descriptors. */
- return ((TREE_CODE (decl) == PARM_DECL || TREE_CODE (decl) == VAR_DECL)
- && DECL_LANG_SPECIFIC (decl)
- && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
- && !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
- && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) != FUNCTION_TYPE
- && GFC_DECL_OPTIONAL_ARGUMENT (decl));
-}
-
-/* Check whether this DECL belongs to a Fortran optional argument.
- With 'for_present_check' set to false, decls which are optional parameters
- themselve are returned as tree - or a NULL_TREE otherwise. Those decls are
- always pointers. With 'for_present_check' set to true, the decl for checking
- whether an argument is present is returned; for arguments with value
- attribute this is the hidden argument and of BOOLEAN_TYPE. If the decl is
- unrelated to optional arguments, NULL_TREE is returned. */
-
-tree
-gfc_omp_check_optional_argument (tree decl, bool for_present_check)
-{
- if (!for_present_check)
- return gfc_omp_is_optional_argument (decl) ? decl : NULL_TREE;
-
- if (!DECL_LANG_SPECIFIC (decl))
- return NULL_TREE;
-
- tree orig_decl = decl;
-
- /* For assumed-shape arrays, a local decl with arg->data is used. */
- if (TREE_CODE (decl) != PARM_DECL
- && (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
- || GFC_ARRAY_TYPE_P (TREE_TYPE (decl))))
- decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
-
- /* Note: With BIND(C), array descriptors are converted to a VAR_DECL. */
- if (decl == NULL_TREE
- || (TREE_CODE (decl) != PARM_DECL && TREE_CODE (decl) != VAR_DECL)
- || !DECL_LANG_SPECIFIC (decl)
- || !GFC_DECL_OPTIONAL_ARGUMENT (decl))
- return NULL_TREE;
-
- /* Scalars with VALUE attribute which are passed by value use a hidden
- argument to denote the present status. They are passed as nonpointer type
- with one exception: 'type(c_ptr), value' as 'void*'. */
- /* Cf. trans-expr.c's gfc_conv_expr_present. */
- if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE
- || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
- {
- char name[GFC_MAX_SYMBOL_LEN + 2];
- tree tree_name;
-
- name[0] = '_';
- strcpy (&name[1], IDENTIFIER_POINTER (DECL_NAME (decl)));
- tree_name = get_identifier (name);
-
- /* Walk function argument list to find the hidden arg. */
- decl = DECL_ARGUMENTS (DECL_CONTEXT (decl));
- for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
- if (DECL_NAME (decl) == tree_name
- && DECL_ARTIFICIAL (decl))
- break;
-
- gcc_assert (decl);
- return decl;
- }
-
- return fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
- orig_decl, null_pointer_node);
-}
-
-
-/* Returns tree with NULL if it is not an array descriptor and with the tree to
- access the 'data' component otherwise. With type_only = true, it returns the
- TREE_TYPE without creating a new tree. */
-
-tree
-gfc_omp_array_data (tree decl, bool type_only)
-{
- tree type = TREE_TYPE (decl);
-
- if (POINTER_TYPE_P (type))
- type = TREE_TYPE (type);
-
- if (!GFC_DESCRIPTOR_TYPE_P (type))
- return NULL_TREE;
-
- if (type_only)
- return GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
-
- if (POINTER_TYPE_P (TREE_TYPE (decl)))
- decl = build_fold_indirect_ref (decl);
-
- decl = gfc_conv_descriptor_data_get (decl);
- STRIP_NOPS (decl);
- return decl;
-}
-
-/* True if OpenMP should privatize what this DECL points to rather
- than the DECL itself. */
-
-bool
-gfc_omp_privatize_by_reference (const_tree decl)
-{
- tree type = TREE_TYPE (decl);
-
- if (TREE_CODE (type) == REFERENCE_TYPE
- && (!DECL_ARTIFICIAL (decl) || TREE_CODE (decl) == PARM_DECL))
- return true;
-
- if (TREE_CODE (type) == POINTER_TYPE
- && gfc_omp_is_optional_argument (decl))
- return true;
-
- if (TREE_CODE (type) == POINTER_TYPE)
- {
- while (TREE_CODE (decl) == COMPONENT_REF)
- decl = TREE_OPERAND (decl, 1);
-
- /* Array POINTER/ALLOCATABLE have aggregate types, all user variables
- that have POINTER_TYPE type and aren't scalar pointers, scalar
- allocatables, Cray pointees or C pointers are supposed to be
- privatized by reference. */
- if (GFC_DECL_GET_SCALAR_POINTER (decl)
- || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
- || GFC_DECL_CRAY_POINTEE (decl)
- || GFC_DECL_ASSOCIATE_VAR_P (decl)
- || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
- return false;
-
- if (!DECL_ARTIFICIAL (decl)
- && TREE_CODE (TREE_TYPE (type)) != FUNCTION_TYPE)
- return true;
-
- /* Some arrays are expanded as DECL_ARTIFICIAL pointers
- by the frontend. */
- if (DECL_LANG_SPECIFIC (decl)
- && GFC_DECL_SAVED_DESCRIPTOR (decl))
- return true;
- }
-
- return false;
-}
-
-/* OMP_CLAUSE_DEFAULT_UNSPECIFIED unless OpenMP sharing attribute
- of DECL is predetermined. */
-
-enum omp_clause_default_kind
-gfc_omp_predetermined_sharing (tree decl)
-{
- /* Associate names preserve the association established during ASSOCIATE.
- As they are implemented either as pointers to the selector or array
- descriptor and shouldn't really change in the ASSOCIATE region,
- this decl can be either shared or firstprivate. If it is a pointer,
- use firstprivate, as it is cheaper that way, otherwise make it shared. */
- if (GFC_DECL_ASSOCIATE_VAR_P (decl))
- {
- if (TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE)
- return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
- else
- return OMP_CLAUSE_DEFAULT_SHARED;
- }
-
- if (DECL_ARTIFICIAL (decl)
- && ! GFC_DECL_RESULT (decl)
- && ! (DECL_LANG_SPECIFIC (decl)
- && GFC_DECL_SAVED_DESCRIPTOR (decl)))
- return OMP_CLAUSE_DEFAULT_SHARED;
-
- /* Cray pointees shouldn't be listed in any clauses and should be
- gimplified to dereference of the corresponding Cray pointer.
- Make them all private, so that they are emitted in the debug
- information. */
- if (GFC_DECL_CRAY_POINTEE (decl))
- return OMP_CLAUSE_DEFAULT_PRIVATE;
-
- /* Assumed-size arrays are predetermined shared. */
- if (TREE_CODE (decl) == PARM_DECL
- && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
- && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN
- && GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (decl),
- GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)) - 1)
- == NULL)
- return OMP_CLAUSE_DEFAULT_SHARED;
-
- /* Dummy procedures aren't considered variables by OpenMP, thus are
- disallowed in OpenMP clauses. They are represented as PARM_DECLs
- in the middle-end, so return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE here
- to avoid complaining about their uses with default(none). */
- if (TREE_CODE (decl) == PARM_DECL
- && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
- && TREE_CODE (TREE_TYPE (TREE_TYPE (decl))) == FUNCTION_TYPE)
- return OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
-
- /* COMMON and EQUIVALENCE decls are shared. They
- are only referenced through DECL_VALUE_EXPR of the variables
- contained in them. If those are privatized, they will not be
- gimplified to the COMMON or EQUIVALENCE decls. */
- if (GFC_DECL_COMMON_OR_EQUIV (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
- return OMP_CLAUSE_DEFAULT_SHARED;
-
- if (GFC_DECL_RESULT (decl) && ! DECL_HAS_VALUE_EXPR_P (decl))
- return OMP_CLAUSE_DEFAULT_SHARED;
-
- /* These are either array or derived parameters, or vtables.
- In the former cases, the OpenMP standard doesn't consider them to be
- variables at all (they can't be redefined), but they can nevertheless appear
- in parallel/task regions and for default(none) purposes treat them as shared.
- For vtables likely the same handling is desirable. */
- if (VAR_P (decl) && TREE_READONLY (decl)
- && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
- return OMP_CLAUSE_DEFAULT_SHARED;
-
- return OMP_CLAUSE_DEFAULT_UNSPECIFIED;
-}
-
-
-/* OMP_CLAUSE_DEFAULTMAP_CATEGORY_UNSPECIFIED unless OpenMP mapping attribute
- of DECL is predetermined. */
-
-enum omp_clause_defaultmap_kind
-gfc_omp_predetermined_mapping (tree decl)
-{
- if (DECL_ARTIFICIAL (decl)
- && ! GFC_DECL_RESULT (decl)
- && ! (DECL_LANG_SPECIFIC (decl)
- && GFC_DECL_SAVED_DESCRIPTOR (decl)))
- return OMP_CLAUSE_DEFAULTMAP_TO;
-
- /* These are either array or derived parameters, or vtables. */
- if (VAR_P (decl) && TREE_READONLY (decl)
- && (TREE_STATIC (decl) || DECL_EXTERNAL (decl)))
- return OMP_CLAUSE_DEFAULTMAP_TO;
-
- return OMP_CLAUSE_DEFAULTMAP_CATEGORY_UNSPECIFIED;
-}
-
-
-/* Return decl that should be used when reporting DEFAULT(NONE)
- diagnostics. */
-
-tree
-gfc_omp_report_decl (tree decl)
-{
- if (DECL_ARTIFICIAL (decl)
- && DECL_LANG_SPECIFIC (decl)
- && GFC_DECL_SAVED_DESCRIPTOR (decl))
- return GFC_DECL_SAVED_DESCRIPTOR (decl);
-
- return decl;
-}
-
-/* Return true if TYPE has any allocatable components. */
-
-static bool
-gfc_has_alloc_comps (tree type, tree decl)
-{
- tree field, ftype;
-
- if (POINTER_TYPE_P (type))
- {
- if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
- type = TREE_TYPE (type);
- else if (GFC_DECL_GET_SCALAR_POINTER (decl))
- return false;
- }
-
- if (GFC_DESCRIPTOR_TYPE_P (type)
- && (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
- || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT))
- return false;
-
- if (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type))
- type = gfc_get_element_type (type);
-
- if (TREE_CODE (type) != RECORD_TYPE)
- return false;
-
- for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
- {
- ftype = TREE_TYPE (field);
- if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
- return true;
- if (GFC_DESCRIPTOR_TYPE_P (ftype)
- && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
- return true;
- if (gfc_has_alloc_comps (ftype, field))
- return true;
- }
- return false;
-}
-
-/* Return true if TYPE is polymorphic but not with pointer attribute. */
-
-static bool
-gfc_is_polymorphic_nonptr (tree type)
-{
- if (POINTER_TYPE_P (type))
- type = TREE_TYPE (type);
- return GFC_CLASS_TYPE_P (type);
-}
-
-/* Return true if TYPE is unlimited polymorphic but not with pointer attribute;
- unlimited means also intrinsic types are handled and _len is used. */
-
-static bool
-gfc_is_unlimited_polymorphic_nonptr (tree type)
-{
- if (POINTER_TYPE_P (type))
- type = TREE_TYPE (type);
- if (!GFC_CLASS_TYPE_P (type))
- return false;
-
- tree field = TYPE_FIELDS (type); /* _data */
- gcc_assert (field);
- field = DECL_CHAIN (field); /* _vptr */
- gcc_assert (field);
- field = DECL_CHAIN (field);
- if (!field)
- return false;
- gcc_assert (strcmp ("_len", IDENTIFIER_POINTER (DECL_NAME (field))) == 0);
- return true;
-}
-
-/* Return true if the DECL is for an allocatable array or scalar. */
-
-bool
-gfc_omp_allocatable_p (tree decl)
-{
- if (!DECL_P (decl))
- return false;
-
- if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
- return true;
-
- tree type = TREE_TYPE (decl);
- if (gfc_omp_privatize_by_reference (decl))
- type = TREE_TYPE (type);
-
- if (GFC_DESCRIPTOR_TYPE_P (type)
- && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
- return true;
-
- return false;
-}
-
-
-/* Return true if DECL in private clause needs
- OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause. */
-bool
-gfc_omp_private_outer_ref (tree decl)
-{
- tree type = TREE_TYPE (decl);
-
- if (gfc_omp_privatize_by_reference (decl))
- type = TREE_TYPE (type);
-
- if (GFC_DESCRIPTOR_TYPE_P (type)
- && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
- return true;
-
- if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
- return true;
-
- if (gfc_has_alloc_comps (type, decl))
- return true;
-
- return false;
-}
-
-/* Callback for gfc_omp_unshare_expr. */
-
-static tree
-gfc_omp_unshare_expr_r (tree *tp, int *walk_subtrees, void *)
-{
- tree t = *tp;
- enum tree_code code = TREE_CODE (t);
-
- /* Stop at types, decls, constants like copy_tree_r. */
- if (TREE_CODE_CLASS (code) == tcc_type
- || TREE_CODE_CLASS (code) == tcc_declaration
- || TREE_CODE_CLASS (code) == tcc_constant
- || code == BLOCK)
- *walk_subtrees = 0;
- else if (handled_component_p (t)
- || TREE_CODE (t) == MEM_REF)
- {
- *tp = unshare_expr (t);
- *walk_subtrees = 0;
- }
-
- return NULL_TREE;
-}
-
-/* Unshare in expr anything that the FE which normally doesn't
- care much about tree sharing (because during gimplification
- everything is unshared) could cause problems with tree sharing
- at omp-low.c time. */
-
-static tree
-gfc_omp_unshare_expr (tree expr)
-{
- walk_tree (&expr, gfc_omp_unshare_expr_r, NULL, NULL);
- return expr;
-}
-
-enum walk_alloc_comps
-{
- WALK_ALLOC_COMPS_DTOR,
- WALK_ALLOC_COMPS_DEFAULT_CTOR,
- WALK_ALLOC_COMPS_COPY_CTOR
-};
-
-/* Handle allocatable components in OpenMP clauses. */
-
-static tree
-gfc_walk_alloc_comps (tree decl, tree dest, tree var,
- enum walk_alloc_comps kind)
-{
- stmtblock_t block, tmpblock;
- tree type = TREE_TYPE (decl), then_b, tem, field;
- gfc_init_block (&block);
-
- if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
- {
- if (GFC_DESCRIPTOR_TYPE_P (type))
- {
- gfc_init_block (&tmpblock);
- tem = gfc_full_array_size (&tmpblock, decl,
- GFC_TYPE_ARRAY_RANK (type));
- then_b = gfc_finish_block (&tmpblock);
- gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (then_b));
- tem = gfc_omp_unshare_expr (tem);
- tem = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, tem,
- gfc_index_one_node);
- }
- else
- {
- bool compute_nelts = false;
- if (!TYPE_DOMAIN (type)
- || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE
- || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node
- || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node)
- compute_nelts = true;
- else if (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
- {
- tree a = DECL_ATTRIBUTES (TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
- if (lookup_attribute ("omp dummy var", a))
- compute_nelts = true;
- }
- if (compute_nelts)
- {
- tem = fold_build2 (EXACT_DIV_EXPR, sizetype,
- TYPE_SIZE_UNIT (type),
- TYPE_SIZE_UNIT (TREE_TYPE (type)));
- tem = size_binop (MINUS_EXPR, tem, size_one_node);
- }
- else
- tem = array_type_nelts (type);
- tem = fold_convert (gfc_array_index_type, tem);
- }
-
- tree nelems = gfc_evaluate_now (tem, &block);
- tree index = gfc_create_var (gfc_array_index_type, "S");
-
- gfc_init_block (&tmpblock);
- tem = gfc_conv_array_data (decl);
- tree declvar = build_fold_indirect_ref_loc (input_location, tem);
- tree declvref = gfc_build_array_ref (declvar, index, NULL);
- tree destvar, destvref = NULL_TREE;
- if (dest)
- {
- tem = gfc_conv_array_data (dest);
- destvar = build_fold_indirect_ref_loc (input_location, tem);
- destvref = gfc_build_array_ref (destvar, index, NULL);
- }
- gfc_add_expr_to_block (&tmpblock,
- gfc_walk_alloc_comps (declvref, destvref,
- var, kind));
-
- gfc_loopinfo loop;
- gfc_init_loopinfo (&loop);
- loop.dimen = 1;
- loop.from[0] = gfc_index_zero_node;
- loop.loopvar[0] = index;
- loop.to[0] = nelems;
- gfc_trans_scalarizing_loops (&loop, &tmpblock);
- gfc_add_block_to_block (&block, &loop.pre);
- return gfc_finish_block (&block);
- }
- else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (var))
- {
- decl = build_fold_indirect_ref_loc (input_location, decl);
- if (dest)
- dest = build_fold_indirect_ref_loc (input_location, dest);
- type = TREE_TYPE (decl);
- }
-
- gcc_assert (TREE_CODE (type) == RECORD_TYPE);
- for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
- {
- tree ftype = TREE_TYPE (field);
- tree declf, destf = NULL_TREE;
- bool has_alloc_comps = gfc_has_alloc_comps (ftype, field);
- if ((!GFC_DESCRIPTOR_TYPE_P (ftype)
- || GFC_TYPE_ARRAY_AKIND (ftype) != GFC_ARRAY_ALLOCATABLE)
- && !GFC_DECL_GET_SCALAR_ALLOCATABLE (field)
- && !has_alloc_comps)
- continue;
- declf = fold_build3_loc (input_location, COMPONENT_REF, ftype,
- decl, field, NULL_TREE);
- if (dest)
- destf = fold_build3_loc (input_location, COMPONENT_REF, ftype,
- dest, field, NULL_TREE);
-
- tem = NULL_TREE;
- switch (kind)
- {
- case WALK_ALLOC_COMPS_DTOR:
- break;
- case WALK_ALLOC_COMPS_DEFAULT_CTOR:
- if (GFC_DESCRIPTOR_TYPE_P (ftype)
- && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
- {
- gfc_add_modify (&block, unshare_expr (destf),
- unshare_expr (declf));
- tem = gfc_duplicate_allocatable_nocopy
- (destf, declf, ftype,
- GFC_TYPE_ARRAY_RANK (ftype));
- }
- else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
- tem = gfc_duplicate_allocatable_nocopy (destf, declf, ftype, 0);
- break;
- case WALK_ALLOC_COMPS_COPY_CTOR:
- if (GFC_DESCRIPTOR_TYPE_P (ftype)
- && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
- tem = gfc_duplicate_allocatable (destf, declf, ftype,
- GFC_TYPE_ARRAY_RANK (ftype),
- NULL_TREE);
- else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
- tem = gfc_duplicate_allocatable (destf, declf, ftype, 0,
- NULL_TREE);
- break;
- }
- if (tem)
- gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
- if (has_alloc_comps)
- {
- gfc_init_block (&tmpblock);
- gfc_add_expr_to_block (&tmpblock,
- gfc_walk_alloc_comps (declf, destf,
- field, kind));
- then_b = gfc_finish_block (&tmpblock);
- if (GFC_DESCRIPTOR_TYPE_P (ftype)
- && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
- tem = gfc_conv_descriptor_data_get (unshare_expr (declf));
- else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
- tem = unshare_expr (declf);
- else
- tem = NULL_TREE;
- if (tem)
- {
- tem = fold_convert (pvoid_type_node, tem);
- tem = fold_build2_loc (input_location, NE_EXPR,
- logical_type_node, tem,
- null_pointer_node);
- then_b = build3_loc (input_location, COND_EXPR, void_type_node,
- tem, then_b,
- build_empty_stmt (input_location));
- }
- gfc_add_expr_to_block (&block, then_b);
- }
- if (kind == WALK_ALLOC_COMPS_DTOR)
- {
- if (GFC_DESCRIPTOR_TYPE_P (ftype)
- && GFC_TYPE_ARRAY_AKIND (ftype) == GFC_ARRAY_ALLOCATABLE)
- {
- tem = gfc_conv_descriptor_data_get (unshare_expr (declf));
- tem = gfc_deallocate_with_status (tem, NULL_TREE, NULL_TREE,
- NULL_TREE, NULL_TREE, true,
- NULL,
- GFC_CAF_COARRAY_NOCOARRAY);
- gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
- }
- else if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field))
- {
- tem = gfc_call_free (unshare_expr (declf));
- gfc_add_expr_to_block (&block, gfc_omp_unshare_expr (tem));
- }
- }
- }
-
- return gfc_finish_block (&block);
-}
-
-/* Return code to initialize DECL with its default constructor, or
- NULL if there's nothing to do. */
-
-tree
-gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
-{
- tree type = TREE_TYPE (decl), size, ptr, cond, then_b, else_b;
- stmtblock_t block, cond_block;
-
- switch (OMP_CLAUSE_CODE (clause))
- {
- case OMP_CLAUSE__LOOPTEMP_:
- case OMP_CLAUSE__REDUCTEMP_:
- case OMP_CLAUSE__CONDTEMP_:
- case OMP_CLAUSE__SCANTEMP_:
- return NULL;
- case OMP_CLAUSE_PRIVATE:
- case OMP_CLAUSE_LASTPRIVATE:
- case OMP_CLAUSE_LINEAR:
- case OMP_CLAUSE_REDUCTION:
- case OMP_CLAUSE_IN_REDUCTION:
- case OMP_CLAUSE_TASK_REDUCTION:
- break;
- default:
- gcc_unreachable ();
- }
-
- if ((! GFC_DESCRIPTOR_TYPE_P (type)
- || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
- && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
- || !POINTER_TYPE_P (type)))
- {
- if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
- {
- gcc_assert (outer);
- gfc_start_block (&block);
- tree tem = gfc_walk_alloc_comps (outer, decl,
- OMP_CLAUSE_DECL (clause),
- WALK_ALLOC_COMPS_DEFAULT_CTOR);
- gfc_add_expr_to_block (&block, tem);
- return gfc_finish_block (&block);
- }
- return NULL_TREE;
- }
-
- gcc_assert (outer != NULL_TREE);
-
- /* Allocatable arrays and scalars in PRIVATE clauses need to be set to
- "not currently allocated" allocation status if outer
- array is "not currently allocated", otherwise should be allocated. */
- gfc_start_block (&block);
-
- gfc_init_block (&cond_block);
-
- if (GFC_DESCRIPTOR_TYPE_P (type))
- {
- gfc_add_modify (&cond_block, decl, outer);
- tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
- size = gfc_conv_descriptor_ubound_get (decl, rank);
- size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- size,
- gfc_conv_descriptor_lbound_get (decl, rank));
- size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- size, gfc_index_one_node);
- if (GFC_TYPE_ARRAY_RANK (type) > 1)
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size,
- gfc_conv_descriptor_stride_get (decl, rank));
- tree esize = fold_convert (gfc_array_index_type,
- TYPE_SIZE_UNIT (gfc_get_element_type (type)));
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, esize);
- size = unshare_expr (size);
- size = gfc_evaluate_now (fold_convert (size_type_node, size),
- &cond_block);
- }
- else
- size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
- ptr = gfc_create_var (pvoid_type_node, NULL);
- gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE);
- if (GFC_DESCRIPTOR_TYPE_P (type))
- gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl), ptr);
- else
- gfc_add_modify (&cond_block, unshare_expr (decl),
- fold_convert (TREE_TYPE (decl), ptr));
- if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
- {
- tree tem = gfc_walk_alloc_comps (outer, decl,
- OMP_CLAUSE_DECL (clause),
- WALK_ALLOC_COMPS_DEFAULT_CTOR);
- gfc_add_expr_to_block (&cond_block, tem);
- }
- then_b = gfc_finish_block (&cond_block);
-
- /* Reduction clause requires allocated ALLOCATABLE. */
- if (OMP_CLAUSE_CODE (clause) != OMP_CLAUSE_REDUCTION
- && OMP_CLAUSE_CODE (clause) != OMP_CLAUSE_IN_REDUCTION
- && OMP_CLAUSE_CODE (clause) != OMP_CLAUSE_TASK_REDUCTION)
- {
- gfc_init_block (&cond_block);
- if (GFC_DESCRIPTOR_TYPE_P (type))
- gfc_conv_descriptor_data_set (&cond_block, unshare_expr (decl),
- null_pointer_node);
- else
- gfc_add_modify (&cond_block, unshare_expr (decl),
- build_zero_cst (TREE_TYPE (decl)));
- else_b = gfc_finish_block (&cond_block);
-
- tree tem = fold_convert (pvoid_type_node,
- GFC_DESCRIPTOR_TYPE_P (type)
- ? gfc_conv_descriptor_data_get (outer) : outer);
- tem = unshare_expr (tem);
- cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
- tem, null_pointer_node);
- gfc_add_expr_to_block (&block,
- build3_loc (input_location, COND_EXPR,
- void_type_node, cond, then_b,
- else_b));
- /* Avoid -W*uninitialized warnings. */
- if (DECL_P (decl))
- suppress_warning (decl, OPT_Wuninitialized);
- }
- else
- gfc_add_expr_to_block (&block, then_b);
-
- return gfc_finish_block (&block);
-}
-
-/* Build and return code for a copy constructor from SRC to DEST. */
-
-tree
-gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
-{
- tree type = TREE_TYPE (dest), ptr, size, call;
- tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause));
- tree cond, then_b, else_b;
- stmtblock_t block, cond_block;
-
- gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
- || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
-
- if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause))
- && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause))
- && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)))
- decl_type
- = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)));
-
- if (gfc_is_polymorphic_nonptr (decl_type))
- {
- if (POINTER_TYPE_P (decl_type))
- decl_type = TREE_TYPE (decl_type);
- decl_type = TREE_TYPE (TYPE_FIELDS (decl_type));
- if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type))
- fatal_error (input_location,
- "Sorry, polymorphic arrays not yet supported for "
- "firstprivate");
- tree src_len;
- tree nelems = build_int_cst (size_type_node, 1); /* Scalar. */
- tree src_data = gfc_class_data_get (unshare_expr (src));
- tree dest_data = gfc_class_data_get (unshare_expr (dest));
- bool unlimited = gfc_is_unlimited_polymorphic_nonptr (type);
-
- gfc_start_block (&block);
- gfc_add_modify (&block, gfc_class_vptr_get (dest),
- gfc_class_vptr_get (src));
- gfc_init_block (&cond_block);
-
- if (unlimited)
- {
- src_len = gfc_class_len_get (src);
- gfc_add_modify (&cond_block, gfc_class_len_get (unshare_expr (dest)), src_len);
- }
-
- /* Use: size = class._vtab._size * (class._len > 0 ? class._len : 1). */
- size = fold_convert (size_type_node, gfc_class_vtab_size_get (src));
- if (unlimited)
- {
- cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
- unshare_expr (src_len),
- build_zero_cst (TREE_TYPE (src_len)));
- cond = build3_loc (input_location, COND_EXPR, size_type_node, cond,
- fold_convert (size_type_node,
- unshare_expr (src_len)),
- build_int_cst (size_type_node, 1));
- size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
- size, cond);
- }
-
- /* Malloc memory + call class->_vpt->_copy. */
- call = builtin_decl_explicit (BUILT_IN_MALLOC);
- call = build_call_expr_loc (input_location, call, 1, size);
- gfc_add_modify (&cond_block, dest_data,
- fold_convert (TREE_TYPE (dest_data), call));
- gfc_add_expr_to_block (&cond_block,
- gfc_copy_class_to_class (src, dest, nelems,
- unlimited));
-
- gcc_assert (TREE_CODE (dest_data) == COMPONENT_REF);
- if (!GFC_DECL_GET_SCALAR_ALLOCATABLE (TREE_OPERAND (dest_data, 1)))
- {
- gfc_add_block_to_block (&block, &cond_block);
- }
- else
- {
- /* Create: if (class._data != 0) <cond_block> else class._data = NULL; */
- cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
- src_data, null_pointer_node);
- gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
- void_type_node, cond,
- gfc_finish_block (&cond_block),
- fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
- unshare_expr (dest_data), null_pointer_node)));
- }
- return gfc_finish_block (&block);
- }
-
- if ((! GFC_DESCRIPTOR_TYPE_P (type)
- || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
- && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
- || !POINTER_TYPE_P (type)))
- {
- if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
- {
- gfc_start_block (&block);
- gfc_add_modify (&block, dest, src);
- tree tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause),
- WALK_ALLOC_COMPS_COPY_CTOR);
- gfc_add_expr_to_block (&block, tem);
- return gfc_finish_block (&block);
- }
- else
- return build2_v (MODIFY_EXPR, dest, src);
- }
-
- /* Allocatable arrays in FIRSTPRIVATE clauses need to be allocated
- and copied from SRC. */
- gfc_start_block (&block);
-
- gfc_init_block (&cond_block);
-
- gfc_add_modify (&cond_block, dest, fold_convert (TREE_TYPE (dest), src));
- if (GFC_DESCRIPTOR_TYPE_P (type))
- {
- tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
- size = gfc_conv_descriptor_ubound_get (dest, rank);
- size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- size,
- gfc_conv_descriptor_lbound_get (dest, rank));
- size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- size, gfc_index_one_node);
- if (GFC_TYPE_ARRAY_RANK (type) > 1)
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size,
- gfc_conv_descriptor_stride_get (dest, rank));
- tree esize = fold_convert (gfc_array_index_type,
- TYPE_SIZE_UNIT (gfc_get_element_type (type)));
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, esize);
- size = unshare_expr (size);
- size = gfc_evaluate_now (fold_convert (size_type_node, size),
- &cond_block);
- }
- else
- size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
- ptr = gfc_create_var (pvoid_type_node, NULL);
- gfc_allocate_using_malloc (&cond_block, ptr, size, NULL_TREE);
- if (GFC_DESCRIPTOR_TYPE_P (type))
- gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest), ptr);
- else
- gfc_add_modify (&cond_block, unshare_expr (dest),
- fold_convert (TREE_TYPE (dest), ptr));
-
- tree srcptr = GFC_DESCRIPTOR_TYPE_P (type)
- ? gfc_conv_descriptor_data_get (src) : src;
- srcptr = unshare_expr (srcptr);
- srcptr = fold_convert (pvoid_type_node, srcptr);
- call = build_call_expr_loc (input_location,
- builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr,
- srcptr, size);
- gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
- if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
- {
- tree tem = gfc_walk_alloc_comps (src, dest,
- OMP_CLAUSE_DECL (clause),
- WALK_ALLOC_COMPS_COPY_CTOR);
- gfc_add_expr_to_block (&cond_block, tem);
- }
- then_b = gfc_finish_block (&cond_block);
-
- gfc_init_block (&cond_block);
- if (GFC_DESCRIPTOR_TYPE_P (type))
- gfc_conv_descriptor_data_set (&cond_block, unshare_expr (dest),
- null_pointer_node);
- else
- gfc_add_modify (&cond_block, unshare_expr (dest),
- build_zero_cst (TREE_TYPE (dest)));
- else_b = gfc_finish_block (&cond_block);
-
- cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
- unshare_expr (srcptr), null_pointer_node);
- gfc_add_expr_to_block (&block,
- build3_loc (input_location, COND_EXPR,
- void_type_node, cond, then_b, else_b));
- /* Avoid -W*uninitialized warnings. */
- if (DECL_P (dest))
- suppress_warning (dest, OPT_Wuninitialized);
-
- return gfc_finish_block (&block);
-}
-
-/* Similarly, except use an intrinsic or pointer assignment operator
- instead. */
-
-tree
-gfc_omp_clause_assign_op (tree clause, tree dest, tree src)
-{
- tree type = TREE_TYPE (dest), ptr, size, call, nonalloc;
- tree cond, then_b, else_b;
- stmtblock_t block, cond_block, cond_block2, inner_block;
-
- if ((! GFC_DESCRIPTOR_TYPE_P (type)
- || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
- && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
- || !POINTER_TYPE_P (type)))
- {
- if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
- {
- gfc_start_block (&block);
- /* First dealloc any allocatable components in DEST. */
- tree tem = gfc_walk_alloc_comps (dest, NULL_TREE,
- OMP_CLAUSE_DECL (clause),
- WALK_ALLOC_COMPS_DTOR);
- gfc_add_expr_to_block (&block, tem);
- /* Then copy over toplevel data. */
- gfc_add_modify (&block, dest, src);
- /* Finally allocate any allocatable components and copy. */
- tem = gfc_walk_alloc_comps (src, dest, OMP_CLAUSE_DECL (clause),
- WALK_ALLOC_COMPS_COPY_CTOR);
- gfc_add_expr_to_block (&block, tem);
- return gfc_finish_block (&block);
- }
- else
- return build2_v (MODIFY_EXPR, dest, src);
- }
-
- gfc_start_block (&block);
-
- if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
- {
- then_b = gfc_walk_alloc_comps (dest, NULL_TREE, OMP_CLAUSE_DECL (clause),
- WALK_ALLOC_COMPS_DTOR);
- tree tem = fold_convert (pvoid_type_node,
- GFC_DESCRIPTOR_TYPE_P (type)
- ? gfc_conv_descriptor_data_get (dest) : dest);
- tem = unshare_expr (tem);
- cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
- tem, null_pointer_node);
- tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
- then_b, build_empty_stmt (input_location));
- gfc_add_expr_to_block (&block, tem);
- }
-
- gfc_init_block (&cond_block);
-
- if (GFC_DESCRIPTOR_TYPE_P (type))
- {
- tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
- size = gfc_conv_descriptor_ubound_get (src, rank);
- size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- size,
- gfc_conv_descriptor_lbound_get (src, rank));
- size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- size, gfc_index_one_node);
- if (GFC_TYPE_ARRAY_RANK (type) > 1)
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size,
- gfc_conv_descriptor_stride_get (src, rank));
- tree esize = fold_convert (gfc_array_index_type,
- TYPE_SIZE_UNIT (gfc_get_element_type (type)));
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size, esize);
- size = unshare_expr (size);
- size = gfc_evaluate_now (fold_convert (size_type_node, size),
- &cond_block);
- }
- else
- size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
- ptr = gfc_create_var (pvoid_type_node, NULL);
-
- tree destptr = GFC_DESCRIPTOR_TYPE_P (type)
- ? gfc_conv_descriptor_data_get (dest) : dest;
- destptr = unshare_expr (destptr);
- destptr = fold_convert (pvoid_type_node, destptr);
- gfc_add_modify (&cond_block, ptr, destptr);
-
- nonalloc = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
- destptr, null_pointer_node);
- cond = nonalloc;
- if (GFC_DESCRIPTOR_TYPE_P (type))
- {
- int i;
- for (i = 0; i < GFC_TYPE_ARRAY_RANK (type); i++)
- {
- tree rank = gfc_rank_cst[i];
- tree tem = gfc_conv_descriptor_ubound_get (src, rank);
- tem = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, tem,
- gfc_conv_descriptor_lbound_get (src, rank));
- tem = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, tem,
- gfc_conv_descriptor_lbound_get (dest, rank));
- tem = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
- tem, gfc_conv_descriptor_ubound_get (dest,
- rank));
- cond = fold_build2_loc (input_location, TRUTH_ORIF_EXPR,
- logical_type_node, cond, tem);
- }
- }
-
- gfc_init_block (&cond_block2);
-
- if (GFC_DESCRIPTOR_TYPE_P (type))
- {
- gfc_init_block (&inner_block);
- gfc_allocate_using_malloc (&inner_block, ptr, size, NULL_TREE);
- then_b = gfc_finish_block (&inner_block);
-
- gfc_init_block (&inner_block);
- gfc_add_modify (&inner_block, ptr,
- gfc_call_realloc (&inner_block, ptr, size));
- else_b = gfc_finish_block (&inner_block);
-
- gfc_add_expr_to_block (&cond_block2,
- build3_loc (input_location, COND_EXPR,
- void_type_node,
- unshare_expr (nonalloc),
- then_b, else_b));
- gfc_add_modify (&cond_block2, dest, src);
- gfc_conv_descriptor_data_set (&cond_block2, unshare_expr (dest), ptr);
- }
- else
- {
- gfc_allocate_using_malloc (&cond_block2, ptr, size, NULL_TREE);
- gfc_add_modify (&cond_block2, unshare_expr (dest),
- fold_convert (type, ptr));
- }
- then_b = gfc_finish_block (&cond_block2);
- else_b = build_empty_stmt (input_location);
-
- gfc_add_expr_to_block (&cond_block,
- build3_loc (input_location, COND_EXPR,
- void_type_node, unshare_expr (cond),
- then_b, else_b));
-
- tree srcptr = GFC_DESCRIPTOR_TYPE_P (type)
- ? gfc_conv_descriptor_data_get (src) : src;
- srcptr = unshare_expr (srcptr);
- srcptr = fold_convert (pvoid_type_node, srcptr);
- call = build_call_expr_loc (input_location,
- builtin_decl_explicit (BUILT_IN_MEMCPY), 3, ptr,
- srcptr, size);
- gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
- if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
- {
- tree tem = gfc_walk_alloc_comps (src, dest,
- OMP_CLAUSE_DECL (clause),
- WALK_ALLOC_COMPS_COPY_CTOR);
- gfc_add_expr_to_block (&cond_block, tem);
- }
- then_b = gfc_finish_block (&cond_block);
-
- if (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_COPYIN)
- {
- gfc_init_block (&cond_block);
- if (GFC_DESCRIPTOR_TYPE_P (type))
- {
- tree tmp = gfc_conv_descriptor_data_get (unshare_expr (dest));
- tmp = gfc_deallocate_with_status (tmp, NULL_TREE, NULL_TREE,
- NULL_TREE, NULL_TREE, true, NULL,
- GFC_CAF_COARRAY_NOCOARRAY);
- gfc_add_expr_to_block (&cond_block, tmp);
- }
- else
- {
- destptr = gfc_evaluate_now (destptr, &cond_block);
- gfc_add_expr_to_block (&cond_block, gfc_call_free (destptr));
- gfc_add_modify (&cond_block, unshare_expr (dest),
- build_zero_cst (TREE_TYPE (dest)));
- }
- else_b = gfc_finish_block (&cond_block);
-
- cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
- unshare_expr (srcptr), null_pointer_node);
- gfc_add_expr_to_block (&block,
- build3_loc (input_location, COND_EXPR,
- void_type_node, cond,
- then_b, else_b));
- }
- else
- gfc_add_expr_to_block (&block, then_b);
-
- return gfc_finish_block (&block);
-}
-
-static void
-gfc_omp_linear_clause_add_loop (stmtblock_t *block, tree dest, tree src,
- tree add, tree nelems)
-{
- stmtblock_t tmpblock;
- tree desta, srca, index = gfc_create_var (gfc_array_index_type, "S");
- nelems = gfc_evaluate_now (nelems, block);
-
- gfc_init_block (&tmpblock);
- if (TREE_CODE (TREE_TYPE (dest)) == ARRAY_TYPE)
- {
- desta = gfc_build_array_ref (dest, index, NULL);
- srca = gfc_build_array_ref (src, index, NULL);
- }
- else
- {
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (dest)));
- tree idx = fold_build2 (MULT_EXPR, sizetype,
- fold_convert (sizetype, index),
- TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dest))));
- desta = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR,
- TREE_TYPE (dest), dest,
- idx));
- srca = build_fold_indirect_ref (fold_build2 (POINTER_PLUS_EXPR,
- TREE_TYPE (src), src,
- idx));
- }
- gfc_add_modify (&tmpblock, desta,
- fold_build2 (PLUS_EXPR, TREE_TYPE (desta),
- srca, add));
-
- gfc_loopinfo loop;
- gfc_init_loopinfo (&loop);
- loop.dimen = 1;
- loop.from[0] = gfc_index_zero_node;
- loop.loopvar[0] = index;
- loop.to[0] = nelems;
- gfc_trans_scalarizing_loops (&loop, &tmpblock);
- gfc_add_block_to_block (block, &loop.pre);
-}
-
-/* Build and return code for a constructor of DEST that initializes
- it to SRC plus ADD (ADD is scalar integer). */
-
-tree
-gfc_omp_clause_linear_ctor (tree clause, tree dest, tree src, tree add)
-{
- tree type = TREE_TYPE (dest), ptr, size, nelems = NULL_TREE;
- stmtblock_t block;
-
- gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
-
- gfc_start_block (&block);
- add = gfc_evaluate_now (add, &block);
-
- if ((! GFC_DESCRIPTOR_TYPE_P (type)
- || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
- && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
- || !POINTER_TYPE_P (type)))
- {
- bool compute_nelts = false;
- gcc_assert (TREE_CODE (type) == ARRAY_TYPE);
- if (!TYPE_DOMAIN (type)
- || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == NULL_TREE
- || TYPE_MIN_VALUE (TYPE_DOMAIN (type)) == error_mark_node
- || TYPE_MAX_VALUE (TYPE_DOMAIN (type)) == error_mark_node)
- compute_nelts = true;
- else if (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
- {
- tree a = DECL_ATTRIBUTES (TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
- if (lookup_attribute ("omp dummy var", a))
- compute_nelts = true;
- }
- if (compute_nelts)
- {
- nelems = fold_build2 (EXACT_DIV_EXPR, sizetype,
- TYPE_SIZE_UNIT (type),
- TYPE_SIZE_UNIT (TREE_TYPE (type)));
- nelems = size_binop (MINUS_EXPR, nelems, size_one_node);
- }
- else
- nelems = array_type_nelts (type);
- nelems = fold_convert (gfc_array_index_type, nelems);
-
- gfc_omp_linear_clause_add_loop (&block, dest, src, add, nelems);
- return gfc_finish_block (&block);
- }
-
- /* Allocatable arrays in LINEAR clauses need to be allocated
- and copied from SRC. */
- gfc_add_modify (&block, dest, src);
- if (GFC_DESCRIPTOR_TYPE_P (type))
- {
- tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
- size = gfc_conv_descriptor_ubound_get (dest, rank);
- size = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
- size,
- gfc_conv_descriptor_lbound_get (dest, rank));
- size = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
- size, gfc_index_one_node);
- if (GFC_TYPE_ARRAY_RANK (type) > 1)
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size,
- gfc_conv_descriptor_stride_get (dest, rank));
- tree esize = fold_convert (gfc_array_index_type,
- TYPE_SIZE_UNIT (gfc_get_element_type (type)));
- nelems = gfc_evaluate_now (unshare_expr (size), &block);
- size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- nelems, unshare_expr (esize));
- size = gfc_evaluate_now (fold_convert (size_type_node, size),
- &block);
- nelems = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, nelems,
- gfc_index_one_node);
- }
- else
- size = fold_convert (size_type_node, TYPE_SIZE_UNIT (TREE_TYPE (type)));
- ptr = gfc_create_var (pvoid_type_node, NULL);
- gfc_allocate_using_malloc (&block, ptr, size, NULL_TREE);
- if (GFC_DESCRIPTOR_TYPE_P (type))
- {
- gfc_conv_descriptor_data_set (&block, unshare_expr (dest), ptr);
- tree etype = gfc_get_element_type (type);
- ptr = fold_convert (build_pointer_type (etype), ptr);
- tree srcptr = gfc_conv_descriptor_data_get (unshare_expr (src));
- srcptr = fold_convert (build_pointer_type (etype), srcptr);
- gfc_omp_linear_clause_add_loop (&block, ptr, srcptr, add, nelems);
- }
- else
- {
- gfc_add_modify (&block, unshare_expr (dest),
- fold_convert (TREE_TYPE (dest), ptr));
- ptr = fold_convert (TREE_TYPE (dest), ptr);
- tree dstm = build_fold_indirect_ref (ptr);
- tree srcm = build_fold_indirect_ref (unshare_expr (src));
- gfc_add_modify (&block, dstm,
- fold_build2 (PLUS_EXPR, TREE_TYPE (add), srcm, add));
- }
- return gfc_finish_block (&block);
-}
-
-/* Build and return code destructing DECL. Return NULL if nothing
- to be done. */
-
-tree
-gfc_omp_clause_dtor (tree clause, tree decl)
-{
- tree type = TREE_TYPE (decl), tem;
- tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause));
-
- if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause))
- && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause))
- && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)))
- decl_type
- = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)));
- if (gfc_is_polymorphic_nonptr (decl_type))
- {
- if (POINTER_TYPE_P (decl_type))
- decl_type = TREE_TYPE (decl_type);
- decl_type = TREE_TYPE (TYPE_FIELDS (decl_type));
- if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type))
- fatal_error (input_location,
- "Sorry, polymorphic arrays not yet supported for "
- "firstprivate");
- stmtblock_t block, cond_block;
- gfc_start_block (&block);
- gfc_init_block (&cond_block);
- tree final = gfc_class_vtab_final_get (decl);
- tree size = fold_convert (size_type_node, gfc_class_vtab_size_get (decl));
- gfc_se se;
- gfc_init_se (&se, NULL);
- symbol_attribute attr = {};
- tree data = gfc_class_data_get (decl);
- tree desc = gfc_conv_scalar_to_descriptor (&se, data, attr);
-
- /* Call class->_vpt->_finalize + free. */
- tree call = build_fold_indirect_ref (final);
- call = build_call_expr_loc (input_location, call, 3,
- gfc_build_addr_expr (NULL, desc),
- size, boolean_false_node);
- gfc_add_block_to_block (&cond_block, &se.pre);
- gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
- gfc_add_block_to_block (&cond_block, &se.post);
- /* Create: if (_vtab && _final) <cond_block> */
- tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
- gfc_class_vptr_get (decl),
- null_pointer_node);
- tree cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
- final, null_pointer_node);
- cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
- boolean_type_node, cond, cond2);
- gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
- void_type_node, cond,
- gfc_finish_block (&cond_block), NULL_TREE));
- call = builtin_decl_explicit (BUILT_IN_FREE);
- call = build_call_expr_loc (input_location, call, 1, data);
- gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
- return gfc_finish_block (&block);
- }
-
- if ((! GFC_DESCRIPTOR_TYPE_P (type)
- || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
- && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
- || !POINTER_TYPE_P (type)))
- {
- if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
- return gfc_walk_alloc_comps (decl, NULL_TREE,
- OMP_CLAUSE_DECL (clause),
- WALK_ALLOC_COMPS_DTOR);
- return NULL_TREE;
- }
-
- if (GFC_DESCRIPTOR_TYPE_P (type))
- {
- /* Allocatable arrays in FIRSTPRIVATE/LASTPRIVATE etc. clauses need
- to be deallocated if they were allocated. */
- tem = gfc_conv_descriptor_data_get (decl);
- tem = gfc_deallocate_with_status (tem, NULL_TREE, NULL_TREE, NULL_TREE,
- NULL_TREE, true, NULL,
- GFC_CAF_COARRAY_NOCOARRAY);
- }
- else
- tem = gfc_call_free (decl);
- tem = gfc_omp_unshare_expr (tem);
-
- if (gfc_has_alloc_comps (type, OMP_CLAUSE_DECL (clause)))
- {
- stmtblock_t block;
- tree then_b;
-
- gfc_init_block (&block);
- gfc_add_expr_to_block (&block,
- gfc_walk_alloc_comps (decl, NULL_TREE,
- OMP_CLAUSE_DECL (clause),
- WALK_ALLOC_COMPS_DTOR));
- gfc_add_expr_to_block (&block, tem);
- then_b = gfc_finish_block (&block);
-
- tem = fold_convert (pvoid_type_node,
- GFC_DESCRIPTOR_TYPE_P (type)
- ? gfc_conv_descriptor_data_get (decl) : decl);
- tem = unshare_expr (tem);
- tree cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
- tem, null_pointer_node);
- tem = build3_loc (input_location, COND_EXPR, void_type_node, cond,
- then_b, build_empty_stmt (input_location));
- }
- return tem;
-}
-
-/* Build a conditional expression in BLOCK. If COND_VAL is not
- null, then the block THEN_B is executed, otherwise ELSE_VAL
- is assigned to VAL. */
-
-static void
-gfc_build_cond_assign (stmtblock_t *block, tree val, tree cond_val,
- tree then_b, tree else_val)
-{
- stmtblock_t cond_block;
- tree else_b = NULL_TREE;
- tree val_ty = TREE_TYPE (val);
-
- if (else_val)
- {
- gfc_init_block (&cond_block);
- gfc_add_modify (&cond_block, val, fold_convert (val_ty, else_val));
- else_b = gfc_finish_block (&cond_block);
- }
- gfc_add_expr_to_block (block,
- build3_loc (input_location, COND_EXPR, void_type_node,
- cond_val, then_b, else_b));
-}
-
-/* Build a conditional expression in BLOCK, returning a temporary
- variable containing the result. If COND_VAL is not null, then
- THEN_VAL will be assigned to the variable, otherwise ELSE_VAL
- is assigned.
- */
-
-static tree
-gfc_build_cond_assign_expr (stmtblock_t *block, tree cond_val,
- tree then_val, tree else_val)
-{
- tree val;
- tree val_ty = TREE_TYPE (then_val);
- stmtblock_t cond_block;
-
- val = create_tmp_var (val_ty);
-
- gfc_init_block (&cond_block);
- gfc_add_modify (&cond_block, val, then_val);
- tree then_b = gfc_finish_block (&cond_block);
-
- gfc_build_cond_assign (block, val, cond_val, then_b, else_val);
-
- return val;
-}
-
-void
-gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
-{
- if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_MAP)
- return;
-
- tree decl = OMP_CLAUSE_DECL (c);
-
- /* Assumed-size arrays can't be mapped implicitly, they have to be
- mapped explicitly using array sections. */
- if (TREE_CODE (decl) == PARM_DECL
- && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))
- && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (decl)) == GFC_ARRAY_UNKNOWN
- && GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (decl),
- GFC_TYPE_ARRAY_RANK (TREE_TYPE (decl)) - 1)
- == NULL)
- {
- error_at (OMP_CLAUSE_LOCATION (c),
- "implicit mapping of assumed size array %qD", decl);
- return;
- }
-
- tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE;
- tree present = gfc_omp_check_optional_argument (decl, true);
- if (POINTER_TYPE_P (TREE_TYPE (decl)))
- {
- if (!gfc_omp_privatize_by_reference (decl)
- && !GFC_DECL_GET_SCALAR_POINTER (decl)
- && !GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
- && !GFC_DECL_CRAY_POINTEE (decl)
- && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
- return;
- tree orig_decl = decl;
-
- c4 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (c4, GOMP_MAP_POINTER);
- OMP_CLAUSE_DECL (c4) = decl;
- OMP_CLAUSE_SIZE (c4) = size_int (0);
- decl = build_fold_indirect_ref (decl);
- if (present
- && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
- || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
- {
- c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_POINTER);
- OMP_CLAUSE_DECL (c2) = decl;
- OMP_CLAUSE_SIZE (c2) = size_int (0);
-
- stmtblock_t block;
- gfc_start_block (&block);
- tree ptr = decl;
- ptr = gfc_build_cond_assign_expr (&block, present, decl,
- null_pointer_node);
- gimplify_and_add (gfc_finish_block (&block), pre_p);
- ptr = build_fold_indirect_ref (ptr);
- OMP_CLAUSE_DECL (c) = ptr;
- OMP_CLAUSE_SIZE (c) = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
- }
- else
- {
- OMP_CLAUSE_DECL (c) = decl;
- OMP_CLAUSE_SIZE (c) = NULL_TREE;
- }
- if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
- && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
- || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
- {
- c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER);
- OMP_CLAUSE_DECL (c3) = unshare_expr (decl);
- OMP_CLAUSE_SIZE (c3) = size_int (0);
- decl = build_fold_indirect_ref (decl);
- OMP_CLAUSE_DECL (c) = decl;
- }
- }
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
- {
- stmtblock_t block;
- gfc_start_block (&block);
- tree type = TREE_TYPE (decl);
- tree ptr = gfc_conv_descriptor_data_get (decl);
-
- /* OpenMP: automatically map pointer targets with the pointer;
- hence, always update the descriptor/pointer itself.
- NOTE: This also remaps the pointer for allocatable arrays with
- 'target' attribute which also don't have the 'restrict' qualifier. */
- bool always_modifier = false;
-
- if (!openacc
- && !(TYPE_QUALS (TREE_TYPE (ptr)) & TYPE_QUAL_RESTRICT))
- always_modifier = true;
-
- if (present)
- ptr = gfc_build_cond_assign_expr (&block, present, ptr,
- null_pointer_node);
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
- ptr = build_fold_indirect_ref (ptr);
- OMP_CLAUSE_DECL (c) = ptr;
- c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_TO_PSET);
- if (present)
- {
- ptr = create_tmp_var (TREE_TYPE (TREE_OPERAND (decl, 0)));
- gfc_add_modify (&block, ptr, TREE_OPERAND (decl, 0));
-
- OMP_CLAUSE_DECL (c2) = build_fold_indirect_ref (ptr);
- }
- else
- OMP_CLAUSE_DECL (c2) = decl;
- OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type);
- c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (c3, always_modifier ? GOMP_MAP_ALWAYS_POINTER
- : GOMP_MAP_POINTER);
- if (present)
- {
- ptr = gfc_conv_descriptor_data_get (decl);
- ptr = gfc_build_addr_expr (NULL, ptr);
- ptr = gfc_build_cond_assign_expr (&block, present,
- ptr, null_pointer_node);
- ptr = build_fold_indirect_ref (ptr);
- OMP_CLAUSE_DECL (c3) = ptr;
- }
- else
- OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl);
- OMP_CLAUSE_SIZE (c3) = size_int (0);
- tree size = create_tmp_var (gfc_array_index_type);
- tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- elemsz = fold_convert (gfc_array_index_type, elemsz);
- if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
- || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)
- {
- stmtblock_t cond_block;
- tree tem, then_b, else_b, zero, cond;
-
- gfc_init_block (&cond_block);
- tem = gfc_full_array_size (&cond_block, decl,
- GFC_TYPE_ARRAY_RANK (type));
- gfc_add_modify (&cond_block, size, tem);
- gfc_add_modify (&cond_block, size,
- fold_build2 (MULT_EXPR, gfc_array_index_type,
- size, elemsz));
- then_b = gfc_finish_block (&cond_block);
- gfc_init_block (&cond_block);
- zero = build_int_cst (gfc_array_index_type, 0);
- gfc_add_modify (&cond_block, size, zero);
- else_b = gfc_finish_block (&cond_block);
- tem = gfc_conv_descriptor_data_get (decl);
- tem = fold_convert (pvoid_type_node, tem);
- cond = fold_build2_loc (input_location, NE_EXPR,
- boolean_type_node, tem, null_pointer_node);
- if (present)
- {
- cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
- boolean_type_node, present, cond);
- }
- gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
- void_type_node, cond,
- then_b, else_b));
- }
- else if (present)
- {
- stmtblock_t cond_block;
- tree then_b;
-
- gfc_init_block (&cond_block);
- gfc_add_modify (&cond_block, size,
- gfc_full_array_size (&cond_block, decl,
- GFC_TYPE_ARRAY_RANK (type)));
- gfc_add_modify (&cond_block, size,
- fold_build2 (MULT_EXPR, gfc_array_index_type,
- size, elemsz));
- then_b = gfc_finish_block (&cond_block);
-
- gfc_build_cond_assign (&block, size, present, then_b,
- build_int_cst (gfc_array_index_type, 0));
- }
- else
- {
- gfc_add_modify (&block, size,
- gfc_full_array_size (&block, decl,
- GFC_TYPE_ARRAY_RANK (type)));
- gfc_add_modify (&block, size,
- fold_build2 (MULT_EXPR, gfc_array_index_type,
- size, elemsz));
- }
- OMP_CLAUSE_SIZE (c) = size;
- tree stmt = gfc_finish_block (&block);
- gimplify_and_add (stmt, pre_p);
- }
- tree last = c;
- if (OMP_CLAUSE_SIZE (c) == NULL_TREE)
- OMP_CLAUSE_SIZE (c)
- = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
- : TYPE_SIZE_UNIT (TREE_TYPE (decl));
- if (gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p,
- NULL, is_gimple_val, fb_rvalue) == GS_ERROR)
- OMP_CLAUSE_SIZE (c) = size_int (0);
- if (c2)
- {
- OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last);
- OMP_CLAUSE_CHAIN (last) = c2;
- last = c2;
- }
- if (c3)
- {
- OMP_CLAUSE_CHAIN (c3) = OMP_CLAUSE_CHAIN (last);
- OMP_CLAUSE_CHAIN (last) = c3;
- last = c3;
- }
- if (c4)
- {
- OMP_CLAUSE_CHAIN (c4) = OMP_CLAUSE_CHAIN (last);
- OMP_CLAUSE_CHAIN (last) = c4;
- }
-}
-
-
-/* Return true if DECL is a scalar variable (for the purpose of
- implicit firstprivatization/mapping). Only if 'ptr_alloc_ok.'
- is true, allocatables and pointers are permitted. */
-
-bool
-gfc_omp_scalar_p (tree decl, bool ptr_alloc_ok)
-{
- tree type = TREE_TYPE (decl);
- if (TREE_CODE (type) == REFERENCE_TYPE)
- type = TREE_TYPE (type);
- if (TREE_CODE (type) == POINTER_TYPE)
- {
- if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
- || GFC_DECL_GET_SCALAR_POINTER (decl))
- {
- if (!ptr_alloc_ok)
- return false;
- type = TREE_TYPE (type);
- }
- if (GFC_ARRAY_TYPE_P (type)
- || GFC_CLASS_TYPE_P (type))
- return false;
- }
- if ((TREE_CODE (type) == ARRAY_TYPE || TREE_CODE (type) == INTEGER_TYPE)
- && TYPE_STRING_FLAG (type))
- return false;
- if (INTEGRAL_TYPE_P (type)
- || SCALAR_FLOAT_TYPE_P (type)
- || COMPLEX_FLOAT_TYPE_P (type))
- return true;
- return false;
-}
-
-
-/* Return true if DECL is a scalar with target attribute but does not have the
- allocatable (or pointer) attribute (for the purpose of implicit mapping). */
-
-bool
-gfc_omp_scalar_target_p (tree decl)
-{
- return (DECL_P (decl) && GFC_DECL_GET_SCALAR_TARGET (decl)
- && gfc_omp_scalar_p (decl, false));
-}
-
-
-/* Return true if DECL's DECL_VALUE_EXPR (if any) should be
- disregarded in OpenMP construct, because it is going to be
- remapped during OpenMP lowering. SHARED is true if DECL
- is going to be shared, false if it is going to be privatized. */
-
-bool
-gfc_omp_disregard_value_expr (tree decl, bool shared)
-{
- if (GFC_DECL_COMMON_OR_EQUIV (decl)
- && DECL_HAS_VALUE_EXPR_P (decl))
- {
- tree value = DECL_VALUE_EXPR (decl);
-
- if (TREE_CODE (value) == COMPONENT_REF
- && VAR_P (TREE_OPERAND (value, 0))
- && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
- {
- /* If variable in COMMON or EQUIVALENCE is privatized, return
- true, as just that variable is supposed to be privatized,
- not the whole COMMON or whole EQUIVALENCE.
- For shared variables in COMMON or EQUIVALENCE, let them be
- gimplified to DECL_VALUE_EXPR, so that for multiple shared vars
- from the same COMMON or EQUIVALENCE just one sharing of the
- whole COMMON or EQUIVALENCE is enough. */
- return ! shared;
- }
- }
-
- if (GFC_DECL_RESULT (decl) && DECL_HAS_VALUE_EXPR_P (decl))
- return ! shared;
-
- return false;
-}
-
-/* Return true if DECL that is shared iff SHARED is true should
- be put into OMP_CLAUSE_PRIVATE with OMP_CLAUSE_PRIVATE_DEBUG
- flag set. */
-
-bool
-gfc_omp_private_debug_clause (tree decl, bool shared)
-{
- if (GFC_DECL_CRAY_POINTEE (decl))
- return true;
-
- if (GFC_DECL_COMMON_OR_EQUIV (decl)
- && DECL_HAS_VALUE_EXPR_P (decl))
- {
- tree value = DECL_VALUE_EXPR (decl);
-
- if (TREE_CODE (value) == COMPONENT_REF
- && VAR_P (TREE_OPERAND (value, 0))
- && GFC_DECL_COMMON_OR_EQUIV (TREE_OPERAND (value, 0)))
- return shared;
- }
-
- return false;
-}
-
-/* Register language specific type size variables as potentially OpenMP
- firstprivate variables. */
-
-void
-gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type)
-{
- if (GFC_ARRAY_TYPE_P (type) || GFC_DESCRIPTOR_TYPE_P (type))
- {
- int r;
-
- gcc_assert (TYPE_LANG_SPECIFIC (type) != NULL);
- for (r = 0; r < GFC_TYPE_ARRAY_RANK (type); r++)
- {
- omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_LBOUND (type, r));
- omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_UBOUND (type, r));
- omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_STRIDE (type, r));
- }
- omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_SIZE (type));
- omp_firstprivatize_variable (ctx, GFC_TYPE_ARRAY_OFFSET (type));
- }
-}
-
-
-static inline tree
-gfc_trans_add_clause (tree node, tree tail)
-{
- OMP_CLAUSE_CHAIN (node) = tail;
- return node;
-}
-
-static tree
-gfc_trans_omp_variable (gfc_symbol *sym, bool declare_simd)
-{
- if (declare_simd)
- {
- int cnt = 0;
- gfc_symbol *proc_sym;
- gfc_formal_arglist *f;
-
- gcc_assert (sym->attr.dummy);
- proc_sym = sym->ns->proc_name;
- if (proc_sym->attr.entry_master)
- ++cnt;
- if (gfc_return_by_reference (proc_sym))
- {
- ++cnt;
- if (proc_sym->ts.type == BT_CHARACTER)
- ++cnt;
- }
- for (f = gfc_sym_get_dummy_args (proc_sym); f; f = f->next)
- if (f->sym == sym)
- break;
- else if (f->sym)
- ++cnt;
- gcc_assert (f);
- return build_int_cst (integer_type_node, cnt);
- }
-
- tree t = gfc_get_symbol_decl (sym);
- tree parent_decl;
- int parent_flag;
- bool return_value;
- bool alternate_entry;
- bool entry_master;
-
- return_value = sym->attr.function && sym->result == sym;
- alternate_entry = sym->attr.function && sym->attr.entry
- && sym->result == sym;
- entry_master = sym->attr.result
- && sym->ns->proc_name->attr.entry_master
- && !gfc_return_by_reference (sym->ns->proc_name);
- parent_decl = current_function_decl
- ? DECL_CONTEXT (current_function_decl) : NULL_TREE;
-
- if ((t == parent_decl && return_value)
- || (sym->ns && sym->ns->proc_name
- && sym->ns->proc_name->backend_decl == parent_decl
- && (alternate_entry || entry_master)))
- parent_flag = 1;
- else
- parent_flag = 0;
-
- /* Special case for assigning the return value of a function.
- Self recursive functions must have an explicit return value. */
- if (return_value && (t == current_function_decl || parent_flag))
- t = gfc_get_fake_result_decl (sym, parent_flag);
-
- /* Similarly for alternate entry points. */
- else if (alternate_entry
- && (sym->ns->proc_name->backend_decl == current_function_decl
- || parent_flag))
- {
- gfc_entry_list *el = NULL;
-
- for (el = sym->ns->entries; el; el = el->next)
- if (sym == el->sym)
- {
- t = gfc_get_fake_result_decl (sym, parent_flag);
- break;
- }
- }
-
- else if (entry_master
- && (sym->ns->proc_name->backend_decl == current_function_decl
- || parent_flag))
- t = gfc_get_fake_result_decl (sym, parent_flag);
-
- return t;
-}
-
-static tree
-gfc_trans_omp_variable_list (enum omp_clause_code code,
- gfc_omp_namelist *namelist, tree list,
- bool declare_simd)
-{
- for (; namelist != NULL; namelist = namelist->next)
- if (namelist->sym->attr.referenced || declare_simd)
- {
- tree t = gfc_trans_omp_variable (namelist->sym, declare_simd);
- if (t != error_mark_node)
- {
- tree node = build_omp_clause (input_location, code);
- OMP_CLAUSE_DECL (node) = t;
- list = gfc_trans_add_clause (node, list);
-
- if (code == OMP_CLAUSE_LASTPRIVATE
- && namelist->u.lastprivate_conditional)
- OMP_CLAUSE_LASTPRIVATE_CONDITIONAL (node) = 1;
- }
- }
- return list;
-}
-
-struct omp_udr_find_orig_data
-{
- gfc_omp_udr *omp_udr;
- bool omp_orig_seen;
-};
-
-static int
-omp_udr_find_orig (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
- void *data)
-{
- struct omp_udr_find_orig_data *cd = (struct omp_udr_find_orig_data *) data;
- if ((*e)->expr_type == EXPR_VARIABLE
- && (*e)->symtree->n.sym == cd->omp_udr->omp_orig)
- cd->omp_orig_seen = true;
-
- return 0;
-}
-
-static void
-gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
-{
- gfc_symbol *sym = n->sym;
- gfc_symtree *root1 = NULL, *root2 = NULL, *root3 = NULL, *root4 = NULL;
- gfc_symtree *symtree1, *symtree2, *symtree3, *symtree4 = NULL;
- gfc_symbol init_val_sym, outer_sym, intrinsic_sym;
- gfc_symbol omp_var_copy[4];
- gfc_expr *e1, *e2, *e3, *e4;
- gfc_ref *ref;
- tree decl, backend_decl, stmt, type, outer_decl;
- locus old_loc = gfc_current_locus;
- const char *iname;
- bool t;
- gfc_omp_udr *udr = n->u2.udr ? n->u2.udr->udr : NULL;
-
- decl = OMP_CLAUSE_DECL (c);
- gfc_current_locus = where;
- type = TREE_TYPE (decl);
- outer_decl = create_tmp_var_raw (type);
- if (TREE_CODE (decl) == PARM_DECL
- && TREE_CODE (type) == REFERENCE_TYPE
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (type))
- && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (type)) == GFC_ARRAY_ALLOCATABLE)
- {
- decl = build_fold_indirect_ref (decl);
- type = TREE_TYPE (type);
- }
-
- /* Create a fake symbol for init value. */
- memset (&init_val_sym, 0, sizeof (init_val_sym));
- init_val_sym.ns = sym->ns;
- init_val_sym.name = sym->name;
- init_val_sym.ts = sym->ts;
- init_val_sym.attr.referenced = 1;
- init_val_sym.declared_at = where;
- init_val_sym.attr.flavor = FL_VARIABLE;
- if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK)
- backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
- else if (udr->initializer_ns)
- backend_decl = NULL;
- else
- switch (sym->ts.type)
- {
- case BT_LOGICAL:
- case BT_INTEGER:
- case BT_REAL:
- case BT_COMPLEX:
- backend_decl = build_zero_cst (gfc_sym_type (&init_val_sym));
- break;
- default:
- backend_decl = NULL_TREE;
- break;
- }
- init_val_sym.backend_decl = backend_decl;
-
- /* Create a fake symbol for the outer array reference. */
- outer_sym = *sym;
- if (sym->as)
- outer_sym.as = gfc_copy_array_spec (sym->as);
- outer_sym.attr.dummy = 0;
- outer_sym.attr.result = 0;
- outer_sym.attr.flavor = FL_VARIABLE;
- outer_sym.backend_decl = outer_decl;
- if (decl != OMP_CLAUSE_DECL (c))
- outer_sym.backend_decl = build_fold_indirect_ref (outer_decl);
-
- /* Create fake symtrees for it. */
- symtree1 = gfc_new_symtree (&root1, sym->name);
- symtree1->n.sym = sym;
- gcc_assert (symtree1 == root1);
-
- symtree2 = gfc_new_symtree (&root2, sym->name);
- symtree2->n.sym = &init_val_sym;
- gcc_assert (symtree2 == root2);
-
- symtree3 = gfc_new_symtree (&root3, sym->name);
- symtree3->n.sym = &outer_sym;
- gcc_assert (symtree3 == root3);
-
- memset (omp_var_copy, 0, sizeof omp_var_copy);
- if (udr)
- {
- omp_var_copy[0] = *udr->omp_out;
- omp_var_copy[1] = *udr->omp_in;
- *udr->omp_out = outer_sym;
- *udr->omp_in = *sym;
- if (udr->initializer_ns)
- {
- omp_var_copy[2] = *udr->omp_priv;
- omp_var_copy[3] = *udr->omp_orig;
- *udr->omp_priv = *sym;
- *udr->omp_orig = outer_sym;
- }
- }
-
- /* Create expressions. */
- e1 = gfc_get_expr ();
- e1->expr_type = EXPR_VARIABLE;
- e1->where = where;
- e1->symtree = symtree1;
- e1->ts = sym->ts;
- if (sym->attr.dimension)
- {
- e1->ref = ref = gfc_get_ref ();
- ref->type = REF_ARRAY;
- ref->u.ar.where = where;
- ref->u.ar.as = sym->as;
- ref->u.ar.type = AR_FULL;
- ref->u.ar.dimen = 0;
- }
- t = gfc_resolve_expr (e1);
- gcc_assert (t);
-
- e2 = NULL;
- if (backend_decl != NULL_TREE)
- {
- e2 = gfc_get_expr ();
- e2->expr_type = EXPR_VARIABLE;
- e2->where = where;
- e2->symtree = symtree2;
- e2->ts = sym->ts;
- t = gfc_resolve_expr (e2);
- gcc_assert (t);
- }
- else if (udr->initializer_ns == NULL)
- {
- gcc_assert (sym->ts.type == BT_DERIVED);
- e2 = gfc_default_initializer (&sym->ts);
- gcc_assert (e2);
- t = gfc_resolve_expr (e2);
- gcc_assert (t);
- }
- else if (n->u2.udr->initializer->op == EXEC_ASSIGN)
- {
- e2 = gfc_copy_expr (n->u2.udr->initializer->expr2);
- t = gfc_resolve_expr (e2);
- gcc_assert (t);
- }
- if (udr && udr->initializer_ns)
- {
- struct omp_udr_find_orig_data cd;
- cd.omp_udr = udr;
- cd.omp_orig_seen = false;
- gfc_code_walker (&n->u2.udr->initializer,
- gfc_dummy_code_callback, omp_udr_find_orig, &cd);
- if (cd.omp_orig_seen)
- OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1;
- }
-
- e3 = gfc_copy_expr (e1);
- e3->symtree = symtree3;
- t = gfc_resolve_expr (e3);
- gcc_assert (t);
-
- iname = NULL;
- e4 = NULL;
- switch (OMP_CLAUSE_REDUCTION_CODE (c))
- {
- case PLUS_EXPR:
- case MINUS_EXPR:
- e4 = gfc_add (e3, e1);
- break;
- case MULT_EXPR:
- e4 = gfc_multiply (e3, e1);
- break;
- case TRUTH_ANDIF_EXPR:
- e4 = gfc_and (e3, e1);
- break;
- case TRUTH_ORIF_EXPR:
- e4 = gfc_or (e3, e1);
- break;
- case EQ_EXPR:
- e4 = gfc_eqv (e3, e1);
- break;
- case NE_EXPR:
- e4 = gfc_neqv (e3, e1);
- break;
- case MIN_EXPR:
- iname = "min";
- break;
- case MAX_EXPR:
- iname = "max";
- break;
- case BIT_AND_EXPR:
- iname = "iand";
- break;
- case BIT_IOR_EXPR:
- iname = "ior";
- break;
- case BIT_XOR_EXPR:
- iname = "ieor";
- break;
- case ERROR_MARK:
- if (n->u2.udr->combiner->op == EXEC_ASSIGN)
- {
- gfc_free_expr (e3);
- e3 = gfc_copy_expr (n->u2.udr->combiner->expr1);
- e4 = gfc_copy_expr (n->u2.udr->combiner->expr2);
- t = gfc_resolve_expr (e3);
- gcc_assert (t);
- t = gfc_resolve_expr (e4);
- gcc_assert (t);
- }
- break;
- default:
- gcc_unreachable ();
- }
- if (iname != NULL)
- {
- memset (&intrinsic_sym, 0, sizeof (intrinsic_sym));
- intrinsic_sym.ns = sym->ns;
- intrinsic_sym.name = iname;
- intrinsic_sym.ts = sym->ts;
- intrinsic_sym.attr.referenced = 1;
- intrinsic_sym.attr.intrinsic = 1;
- intrinsic_sym.attr.function = 1;
- intrinsic_sym.attr.implicit_type = 1;
- intrinsic_sym.result = &intrinsic_sym;
- intrinsic_sym.declared_at = where;
-
- symtree4 = gfc_new_symtree (&root4, iname);
- symtree4->n.sym = &intrinsic_sym;
- gcc_assert (symtree4 == root4);
-
- e4 = gfc_get_expr ();
- e4->expr_type = EXPR_FUNCTION;
- e4->where = where;
- e4->symtree = symtree4;
- e4->value.function.actual = gfc_get_actual_arglist ();
- e4->value.function.actual->expr = e3;
- e4->value.function.actual->next = gfc_get_actual_arglist ();
- e4->value.function.actual->next->expr = e1;
- }
- if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK)
- {
- /* e1 and e3 have been stored as arguments of e4, avoid sharing. */
- e1 = gfc_copy_expr (e1);
- e3 = gfc_copy_expr (e3);
- t = gfc_resolve_expr (e4);
- gcc_assert (t);
- }
-
- /* Create the init statement list. */
- pushlevel ();
- if (e2)
- stmt = gfc_trans_assignment (e1, e2, false, false);
- else
- stmt = gfc_trans_call (n->u2.udr->initializer, false,
- NULL_TREE, NULL_TREE, false);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- OMP_CLAUSE_REDUCTION_INIT (c) = stmt;
-
- /* Create the merge statement list. */
- pushlevel ();
- if (e4)
- stmt = gfc_trans_assignment (e3, e4, false, true);
- else
- stmt = gfc_trans_call (n->u2.udr->combiner, false,
- NULL_TREE, NULL_TREE, false);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- OMP_CLAUSE_REDUCTION_MERGE (c) = stmt;
-
- /* And stick the placeholder VAR_DECL into the clause as well. */
- OMP_CLAUSE_REDUCTION_PLACEHOLDER (c) = outer_decl;
-
- gfc_current_locus = old_loc;
-
- gfc_free_expr (e1);
- if (e2)
- gfc_free_expr (e2);
- gfc_free_expr (e3);
- if (e4)
- gfc_free_expr (e4);
- free (symtree1);
- free (symtree2);
- free (symtree3);
- free (symtree4);
- if (outer_sym.as)
- gfc_free_array_spec (outer_sym.as);
-
- if (udr)
- {
- *udr->omp_out = omp_var_copy[0];
- *udr->omp_in = omp_var_copy[1];
- if (udr->initializer_ns)
- {
- *udr->omp_priv = omp_var_copy[2];
- *udr->omp_orig = omp_var_copy[3];
- }
- }
-}
-
-static tree
-gfc_trans_omp_reduction_list (int kind, gfc_omp_namelist *namelist, tree list,
- locus where, bool mark_addressable)
-{
- omp_clause_code clause = OMP_CLAUSE_REDUCTION;
- switch (kind)
- {
- case OMP_LIST_REDUCTION:
- case OMP_LIST_REDUCTION_INSCAN:
- case OMP_LIST_REDUCTION_TASK:
- break;
- case OMP_LIST_IN_REDUCTION:
- clause = OMP_CLAUSE_IN_REDUCTION;
- break;
- case OMP_LIST_TASK_REDUCTION:
- clause = OMP_CLAUSE_TASK_REDUCTION;
- break;
- default:
- gcc_unreachable ();
- }
- for (; namelist != NULL; namelist = namelist->next)
- if (namelist->sym->attr.referenced)
- {
- tree t = gfc_trans_omp_variable (namelist->sym, false);
- if (t != error_mark_node)
- {
- tree node = build_omp_clause (gfc_get_location (&namelist->where),
- clause);
- OMP_CLAUSE_DECL (node) = t;
- if (mark_addressable)
- TREE_ADDRESSABLE (t) = 1;
- if (kind == OMP_LIST_REDUCTION_INSCAN)
- OMP_CLAUSE_REDUCTION_INSCAN (node) = 1;
- if (kind == OMP_LIST_REDUCTION_TASK)
- OMP_CLAUSE_REDUCTION_TASK (node) = 1;
- switch (namelist->u.reduction_op)
- {
- case OMP_REDUCTION_PLUS:
- OMP_CLAUSE_REDUCTION_CODE (node) = PLUS_EXPR;
- break;
- case OMP_REDUCTION_MINUS:
- OMP_CLAUSE_REDUCTION_CODE (node) = MINUS_EXPR;
- break;
- case OMP_REDUCTION_TIMES:
- OMP_CLAUSE_REDUCTION_CODE (node) = MULT_EXPR;
- break;
- case OMP_REDUCTION_AND:
- OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ANDIF_EXPR;
- break;
- case OMP_REDUCTION_OR:
- OMP_CLAUSE_REDUCTION_CODE (node) = TRUTH_ORIF_EXPR;
- break;
- case OMP_REDUCTION_EQV:
- OMP_CLAUSE_REDUCTION_CODE (node) = EQ_EXPR;
- break;
- case OMP_REDUCTION_NEQV:
- OMP_CLAUSE_REDUCTION_CODE (node) = NE_EXPR;
- break;
- case OMP_REDUCTION_MAX:
- OMP_CLAUSE_REDUCTION_CODE (node) = MAX_EXPR;
- break;
- case OMP_REDUCTION_MIN:
- OMP_CLAUSE_REDUCTION_CODE (node) = MIN_EXPR;
- break;
- case OMP_REDUCTION_IAND:
- OMP_CLAUSE_REDUCTION_CODE (node) = BIT_AND_EXPR;
- break;
- case OMP_REDUCTION_IOR:
- OMP_CLAUSE_REDUCTION_CODE (node) = BIT_IOR_EXPR;
- break;
- case OMP_REDUCTION_IEOR:
- OMP_CLAUSE_REDUCTION_CODE (node) = BIT_XOR_EXPR;
- break;
- case OMP_REDUCTION_USER:
- OMP_CLAUSE_REDUCTION_CODE (node) = ERROR_MARK;
- break;
- default:
- gcc_unreachable ();
- }
- if (namelist->sym->attr.dimension
- || namelist->u.reduction_op == OMP_REDUCTION_USER
- || namelist->sym->attr.allocatable)
- gfc_trans_omp_array_reduction_or_udr (node, namelist, where);
- list = gfc_trans_add_clause (node, list);
- }
- }
- return list;
-}
-
-static inline tree
-gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr)
-{
- gfc_se se;
- tree result;
-
- gfc_init_se (&se, NULL );
- gfc_conv_expr (&se, expr);
- gfc_add_block_to_block (block, &se.pre);
- result = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- return result;
-}
-
-static vec<tree, va_heap, vl_embed> *doacross_steps;
-
-
-/* Translate an array section or array element. */
-
-static void
-gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n,
- tree decl, bool element, gomp_map_kind ptr_kind,
- tree &node, tree &node2, tree &node3, tree &node4)
-{
- gfc_se se;
- tree ptr, ptr2;
- tree elemsz = NULL_TREE;
-
- gfc_init_se (&se, NULL);
-
- if (element)
- {
- gfc_conv_expr_reference (&se, n->expr);
- gfc_add_block_to_block (block, &se.pre);
- ptr = se.expr;
- OMP_CLAUSE_SIZE (node) = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (ptr)));
- elemsz = OMP_CLAUSE_SIZE (node);
- }
- else
- {
- gfc_conv_expr_descriptor (&se, n->expr);
- ptr = gfc_conv_array_data (se.expr);
- tree type = TREE_TYPE (se.expr);
- gfc_add_block_to_block (block, &se.pre);
- OMP_CLAUSE_SIZE (node) = gfc_full_array_size (block, se.expr,
- GFC_TYPE_ARRAY_RANK (type));
- elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- elemsz = fold_convert (gfc_array_index_type, elemsz);
- OMP_CLAUSE_SIZE (node) = fold_build2 (MULT_EXPR, gfc_array_index_type,
- OMP_CLAUSE_SIZE (node), elemsz);
- }
- gcc_assert (se.post.head == NULL_TREE);
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
- OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
- ptr = fold_convert (ptrdiff_type_node, ptr);
-
- if (POINTER_TYPE_P (TREE_TYPE (decl))
- && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
- && ptr_kind == GOMP_MAP_POINTER)
- {
- node4 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
- OMP_CLAUSE_DECL (node4) = decl;
- OMP_CLAUSE_SIZE (node4) = size_int (0);
- decl = build_fold_indirect_ref (decl);
- }
- else if (ptr_kind == GOMP_MAP_ALWAYS_POINTER
- && n->expr->ts.type == BT_CHARACTER
- && n->expr->ts.deferred)
- {
- gomp_map_kind map_kind;
- if (GOMP_MAP_COPY_TO_P (OMP_CLAUSE_MAP_KIND (node)))
- map_kind = GOMP_MAP_TO;
- else if (OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_RELEASE
- || OMP_CLAUSE_MAP_KIND (node) == GOMP_MAP_DELETE)
- map_kind = OMP_CLAUSE_MAP_KIND (node);
- else
- map_kind = GOMP_MAP_ALLOC;
- gcc_assert (se.string_length);
- node4 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node4, map_kind);
- OMP_CLAUSE_DECL (node4) = se.string_length;
- OMP_CLAUSE_SIZE (node4) = TYPE_SIZE_UNIT (gfc_charlen_type_node);
- }
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
- {
- tree desc_node;
- tree type = TREE_TYPE (decl);
- ptr2 = gfc_conv_descriptor_data_get (decl);
- desc_node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
- OMP_CLAUSE_DECL (desc_node) = decl;
- OMP_CLAUSE_SIZE (desc_node) = TYPE_SIZE_UNIT (type);
- if (ptr_kind == GOMP_MAP_ALWAYS_POINTER)
- {
- OMP_CLAUSE_SET_MAP_KIND (desc_node, GOMP_MAP_TO);
- node2 = node;
- node = desc_node; /* Needs to come first. */
- }
- else
- {
- OMP_CLAUSE_SET_MAP_KIND (desc_node, GOMP_MAP_TO_PSET);
- node2 = desc_node;
- }
- node3 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node3, ptr_kind);
- OMP_CLAUSE_DECL (node3)
- = gfc_conv_descriptor_data_get (decl);
- /* This purposely does not include GOMP_MAP_ALWAYS_POINTER. The extra
- cast prevents gimplify.c from recognising it as being part of the
- struct – and adding an 'alloc: for the 'desc.data' pointer, which
- would break as the 'desc' (the descriptor) is also mapped
- (see node4 above). */
- if (ptr_kind == GOMP_MAP_ATTACH_DETACH)
- STRIP_NOPS (OMP_CLAUSE_DECL (node3));
- }
- else
- {
- if (TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
- {
- tree offset;
- ptr2 = build_fold_addr_expr (decl);
- offset = fold_build2 (MINUS_EXPR, ptrdiff_type_node, ptr,
- fold_convert (ptrdiff_type_node, ptr2));
- offset = build2 (TRUNC_DIV_EXPR, ptrdiff_type_node,
- offset, fold_convert (ptrdiff_type_node, elemsz));
- offset = build4_loc (input_location, ARRAY_REF,
- TREE_TYPE (TREE_TYPE (decl)),
- decl, offset, NULL_TREE, NULL_TREE);
- OMP_CLAUSE_DECL (node) = offset;
-
- if (ptr_kind == GOMP_MAP_ALWAYS_POINTER)
- return;
- }
- else
- {
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
- ptr2 = decl;
- }
- node3 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node3, ptr_kind);
- OMP_CLAUSE_DECL (node3) = decl;
- }
- ptr2 = fold_convert (ptrdiff_type_node, ptr2);
- OMP_CLAUSE_SIZE (node3) = fold_build2 (MINUS_EXPR, ptrdiff_type_node,
- ptr, ptr2);
-}
-
-static tree
-handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
-{
- tree list = NULL_TREE;
- for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink)
- {
- gfc_constructor *c;
- gfc_se se;
-
- tree last = make_tree_vec (6);
- tree iter_var = gfc_get_symbol_decl (sym);
- tree type = TREE_TYPE (iter_var);
- TREE_VEC_ELT (last, 0) = iter_var;
- DECL_CHAIN (iter_var) = BLOCK_VARS (block);
- BLOCK_VARS (block) = iter_var;
-
- /* begin */
- c = gfc_constructor_first (sym->value->value.constructor);
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, c->expr);
- gfc_add_block_to_block (iter_block, &se.pre);
- gfc_add_block_to_block (iter_block, &se.post);
- TREE_VEC_ELT (last, 1) = fold_convert (type,
- gfc_evaluate_now (se.expr,
- iter_block));
- /* end */
- c = gfc_constructor_next (c);
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, c->expr);
- gfc_add_block_to_block (iter_block, &se.pre);
- gfc_add_block_to_block (iter_block, &se.post);
- TREE_VEC_ELT (last, 2) = fold_convert (type,
- gfc_evaluate_now (se.expr,
- iter_block));
- /* step */
- c = gfc_constructor_next (c);
- tree step;
- if (c)
- {
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, c->expr);
- gfc_add_block_to_block (iter_block, &se.pre);
- gfc_add_block_to_block (iter_block, &se.post);
- gfc_conv_expr (&se, c->expr);
- step = fold_convert (type,
- gfc_evaluate_now (se.expr,
- iter_block));
- }
- else
- step = build_int_cst (type, 1);
- TREE_VEC_ELT (last, 3) = step;
- /* orig_step */
- TREE_VEC_ELT (last, 4) = save_expr (step);
- TREE_CHAIN (last) = list;
- list = last;
- }
- return list;
-}
-
-static tree
-gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
- locus where, bool declare_simd = false,
- bool openacc = false)
-{
- tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c;
- tree iterator = NULL_TREE;
- tree tree_block = NULL_TREE;
- stmtblock_t iter_block;
- int list, ifc;
- enum omp_clause_code clause_code;
- gfc_omp_namelist *prev = NULL;
- gfc_se se;
-
- if (clauses == NULL)
- return NULL_TREE;
-
- for (list = 0; list < OMP_LIST_NUM; list++)
- {
- gfc_omp_namelist *n = clauses->lists[list];
-
- if (n == NULL)
- continue;
- switch (list)
- {
- case OMP_LIST_REDUCTION:
- case OMP_LIST_REDUCTION_INSCAN:
- case OMP_LIST_REDUCTION_TASK:
- case OMP_LIST_IN_REDUCTION:
- case OMP_LIST_TASK_REDUCTION:
- /* An OpenACC async clause indicates the need to set reduction
- arguments addressable, to allow asynchronous copy-out. */
- omp_clauses = gfc_trans_omp_reduction_list (list, n, omp_clauses,
- where, clauses->async);
- break;
- case OMP_LIST_PRIVATE:
- clause_code = OMP_CLAUSE_PRIVATE;
- goto add_clause;
- case OMP_LIST_SHARED:
- clause_code = OMP_CLAUSE_SHARED;
- goto add_clause;
- case OMP_LIST_FIRSTPRIVATE:
- clause_code = OMP_CLAUSE_FIRSTPRIVATE;
- goto add_clause;
- case OMP_LIST_LASTPRIVATE:
- clause_code = OMP_CLAUSE_LASTPRIVATE;
- goto add_clause;
- case OMP_LIST_COPYIN:
- clause_code = OMP_CLAUSE_COPYIN;
- goto add_clause;
- case OMP_LIST_COPYPRIVATE:
- clause_code = OMP_CLAUSE_COPYPRIVATE;
- goto add_clause;
- case OMP_LIST_UNIFORM:
- clause_code = OMP_CLAUSE_UNIFORM;
- goto add_clause;
- case OMP_LIST_USE_DEVICE:
- case OMP_LIST_USE_DEVICE_PTR:
- clause_code = OMP_CLAUSE_USE_DEVICE_PTR;
- goto add_clause;
- case OMP_LIST_USE_DEVICE_ADDR:
- clause_code = OMP_CLAUSE_USE_DEVICE_ADDR;
- goto add_clause;
- case OMP_LIST_IS_DEVICE_PTR:
- clause_code = OMP_CLAUSE_IS_DEVICE_PTR;
- goto add_clause;
- case OMP_LIST_NONTEMPORAL:
- clause_code = OMP_CLAUSE_NONTEMPORAL;
- goto add_clause;
- case OMP_LIST_SCAN_IN:
- clause_code = OMP_CLAUSE_INCLUSIVE;
- goto add_clause;
- case OMP_LIST_SCAN_EX:
- clause_code = OMP_CLAUSE_EXCLUSIVE;
- goto add_clause;
-
- add_clause:
- omp_clauses
- = gfc_trans_omp_variable_list (clause_code, n, omp_clauses,
- declare_simd);
- break;
- case OMP_LIST_ALIGNED:
- for (; n != NULL; n = n->next)
- if (n->sym->attr.referenced || declare_simd)
- {
- tree t = gfc_trans_omp_variable (n->sym, declare_simd);
- if (t != error_mark_node)
- {
- tree node = build_omp_clause (input_location,
- OMP_CLAUSE_ALIGNED);
- OMP_CLAUSE_DECL (node) = t;
- if (n->expr)
- {
- tree alignment_var;
-
- if (declare_simd)
- alignment_var = gfc_conv_constant_to_tree (n->expr);
- else
- {
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, n->expr);
- gfc_add_block_to_block (block, &se.pre);
- alignment_var = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
- }
- OMP_CLAUSE_ALIGNED_ALIGNMENT (node) = alignment_var;
- }
- omp_clauses = gfc_trans_add_clause (node, omp_clauses);
- }
- }
- break;
- case OMP_LIST_ALLOCATE:
- for (; n != NULL; n = n->next)
- if (n->sym->attr.referenced)
- {
- tree t = gfc_trans_omp_variable (n->sym, false);
- if (t != error_mark_node)
- {
- tree node = build_omp_clause (input_location,
- OMP_CLAUSE_ALLOCATE);
- OMP_CLAUSE_DECL (node) = t;
- if (n->expr)
- {
- tree allocator_;
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, n->expr);
- allocator_ = gfc_evaluate_now (se.expr, block);
- OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
- }
- omp_clauses = gfc_trans_add_clause (node, omp_clauses);
- }
- }
- break;
- case OMP_LIST_LINEAR:
- {
- gfc_expr *last_step_expr = NULL;
- tree last_step = NULL_TREE;
- bool last_step_parm = false;
-
- for (; n != NULL; n = n->next)
- {
- if (n->expr)
- {
- last_step_expr = n->expr;
- last_step = NULL_TREE;
- last_step_parm = false;
- }
- if (n->sym->attr.referenced || declare_simd)
- {
- tree t = gfc_trans_omp_variable (n->sym, declare_simd);
- if (t != error_mark_node)
- {
- tree node = build_omp_clause (input_location,
- OMP_CLAUSE_LINEAR);
- OMP_CLAUSE_DECL (node) = t;
- omp_clause_linear_kind kind;
- switch (n->u.linear_op)
- {
- case OMP_LINEAR_DEFAULT:
- kind = OMP_CLAUSE_LINEAR_DEFAULT;
- break;
- case OMP_LINEAR_REF:
- kind = OMP_CLAUSE_LINEAR_REF;
- break;
- case OMP_LINEAR_VAL:
- kind = OMP_CLAUSE_LINEAR_VAL;
- break;
- case OMP_LINEAR_UVAL:
- kind = OMP_CLAUSE_LINEAR_UVAL;
- break;
- default:
- gcc_unreachable ();
- }
- OMP_CLAUSE_LINEAR_KIND (node) = kind;
- if (last_step_expr && last_step == NULL_TREE)
- {
- if (!declare_simd)
- {
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, last_step_expr);
- gfc_add_block_to_block (block, &se.pre);
- last_step = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
- }
- else if (last_step_expr->expr_type == EXPR_VARIABLE)
- {
- gfc_symbol *s = last_step_expr->symtree->n.sym;
- last_step = gfc_trans_omp_variable (s, true);
- last_step_parm = true;
- }
- else
- last_step
- = gfc_conv_constant_to_tree (last_step_expr);
- }
- if (last_step_parm)
- {
- OMP_CLAUSE_LINEAR_VARIABLE_STRIDE (node) = 1;
- OMP_CLAUSE_LINEAR_STEP (node) = last_step;
- }
- else
- {
- if (kind == OMP_CLAUSE_LINEAR_REF)
- {
- tree type;
- if (n->sym->attr.flavor == FL_PROCEDURE)
- {
- type = gfc_get_function_type (n->sym);
- type = build_pointer_type (type);
- }
- else
- type = gfc_sym_type (n->sym);
- if (POINTER_TYPE_P (type))
- type = TREE_TYPE (type);
- /* Otherwise to be determined what exactly
- should be done. */
- tree t = fold_convert (sizetype, last_step);
- t = size_binop (MULT_EXPR, t,
- TYPE_SIZE_UNIT (type));
- OMP_CLAUSE_LINEAR_STEP (node) = t;
- }
- else
- {
- tree type
- = gfc_typenode_for_spec (&n->sym->ts);
- OMP_CLAUSE_LINEAR_STEP (node)
- = fold_convert (type, last_step);
- }
- }
- if (n->sym->attr.dimension || n->sym->attr.allocatable)
- OMP_CLAUSE_LINEAR_ARRAY (node) = 1;
- omp_clauses = gfc_trans_add_clause (node, omp_clauses);
- }
- }
- }
- }
- break;
- case OMP_LIST_AFFINITY:
- case OMP_LIST_DEPEND:
- iterator = NULL_TREE;
- prev = NULL;
- prev_clauses = omp_clauses;
- for (; n != NULL; n = n->next)
- {
- if (iterator && prev->u2.ns != n->u2.ns)
- {
- BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
- TREE_VEC_ELT (iterator, 5) = tree_block;
- for (tree c = omp_clauses; c != prev_clauses;
- c = OMP_CLAUSE_CHAIN (c))
- OMP_CLAUSE_DECL (c) = build_tree_list (iterator,
- OMP_CLAUSE_DECL (c));
- prev_clauses = omp_clauses;
- iterator = NULL_TREE;
- }
- if (n->u2.ns && (!prev || prev->u2.ns != n->u2.ns))
- {
- gfc_init_block (&iter_block);
- tree_block = make_node (BLOCK);
- TREE_USED (tree_block) = 1;
- BLOCK_VARS (tree_block) = NULL_TREE;
- iterator = handle_iterator (n->u2.ns, block,
- tree_block);
- }
- if (!iterator)
- gfc_init_block (&iter_block);
- prev = n;
- if (list == OMP_LIST_DEPEND
- && n->u.depend_op == OMP_DEPEND_SINK_FIRST)
- {
- tree vec = NULL_TREE;
- unsigned int i;
- for (i = 0; ; i++)
- {
- tree addend = integer_zero_node, t;
- bool neg = false;
- if (n->expr)
- {
- addend = gfc_conv_constant_to_tree (n->expr);
- if (TREE_CODE (addend) == INTEGER_CST
- && tree_int_cst_sgn (addend) == -1)
- {
- neg = true;
- addend = const_unop (NEGATE_EXPR,
- TREE_TYPE (addend), addend);
- }
- }
- t = gfc_trans_omp_variable (n->sym, false);
- if (t != error_mark_node)
- {
- if (i < vec_safe_length (doacross_steps)
- && !integer_zerop (addend)
- && (*doacross_steps)[i])
- {
- tree step = (*doacross_steps)[i];
- addend = fold_convert (TREE_TYPE (step), addend);
- addend = build2 (TRUNC_DIV_EXPR,
- TREE_TYPE (step), addend, step);
- }
- vec = tree_cons (addend, t, vec);
- if (neg)
- OMP_CLAUSE_DEPEND_SINK_NEGATIVE (vec) = 1;
- }
- if (n->next == NULL
- || n->next->u.depend_op != OMP_DEPEND_SINK)
- break;
- n = n->next;
- }
- if (vec == NULL_TREE)
- continue;
-
- tree node = build_omp_clause (input_location,
- OMP_CLAUSE_DEPEND);
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_SINK;
- OMP_CLAUSE_DECL (node) = nreverse (vec);
- omp_clauses = gfc_trans_add_clause (node, omp_clauses);
- continue;
- }
-
- if (!n->sym->attr.referenced)
- continue;
-
- tree node = build_omp_clause (input_location,
- list == OMP_LIST_DEPEND
- ? OMP_CLAUSE_DEPEND
- : OMP_CLAUSE_AFFINITY);
- if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
- {
- tree decl = gfc_trans_omp_variable (n->sym, false);
- if (gfc_omp_privatize_by_reference (decl))
- decl = build_fold_indirect_ref (decl);
- if (n->u.depend_op == OMP_DEPEND_DEPOBJ
- && POINTER_TYPE_P (TREE_TYPE (decl)))
- decl = build_fold_indirect_ref (decl);
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
- {
- decl = gfc_conv_descriptor_data_get (decl);
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl)));
- decl = build_fold_indirect_ref (decl);
- }
- else if (DECL_P (decl))
- TREE_ADDRESSABLE (decl) = 1;
- OMP_CLAUSE_DECL (node) = decl;
- }
- else
- {
- tree ptr;
- gfc_init_se (&se, NULL);
- if (n->expr->ref->u.ar.type == AR_ELEMENT)
- {
- gfc_conv_expr_reference (&se, n->expr);
- ptr = se.expr;
- }
- else
- {
- gfc_conv_expr_descriptor (&se, n->expr);
- ptr = gfc_conv_array_data (se.expr);
- }
- gfc_add_block_to_block (&iter_block, &se.pre);
- gfc_add_block_to_block (&iter_block, &se.post);
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
- OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
- }
- if (list == OMP_LIST_DEPEND)
- switch (n->u.depend_op)
- {
- case OMP_DEPEND_IN:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
- break;
- case OMP_DEPEND_OUT:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT;
- break;
- case OMP_DEPEND_INOUT:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
- break;
- case OMP_DEPEND_MUTEXINOUTSET:
- OMP_CLAUSE_DEPEND_KIND (node)
- = OMP_CLAUSE_DEPEND_MUTEXINOUTSET;
- break;
- case OMP_DEPEND_DEPOBJ:
- OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ;
- break;
- default:
- gcc_unreachable ();
- }
- if (!iterator)
- gfc_add_block_to_block (block, &iter_block);
- omp_clauses = gfc_trans_add_clause (node, omp_clauses);
- }
- if (iterator)
- {
- BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
- TREE_VEC_ELT (iterator, 5) = tree_block;
- for (tree c = omp_clauses; c != prev_clauses;
- c = OMP_CLAUSE_CHAIN (c))
- OMP_CLAUSE_DECL (c) = build_tree_list (iterator,
- OMP_CLAUSE_DECL (c));
- }
- break;
- case OMP_LIST_MAP:
- for (; n != NULL; n = n->next)
- {
- if (!n->sym->attr.referenced)
- continue;
-
- bool always_modifier = false;
- tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
- tree node2 = NULL_TREE;
- tree node3 = NULL_TREE;
- tree node4 = NULL_TREE;
-
- /* OpenMP: automatically map pointer targets with the pointer;
- hence, always update the descriptor/pointer itself. */
- if (!openacc
- && ((n->expr == NULL && n->sym->attr.pointer)
- || (n->expr && gfc_expr_attr (n->expr).pointer)))
- always_modifier = true;
-
- switch (n->u.map_op)
- {
- case OMP_MAP_ALLOC:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALLOC);
- break;
- case OMP_MAP_IF_PRESENT:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_IF_PRESENT);
- break;
- case OMP_MAP_ATTACH:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ATTACH);
- break;
- case OMP_MAP_TO:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TO);
- break;
- case OMP_MAP_FROM:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FROM);
- break;
- case OMP_MAP_TOFROM:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_TOFROM);
- break;
- case OMP_MAP_ALWAYS_TO:
- always_modifier = true;
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TO);
- break;
- case OMP_MAP_ALWAYS_FROM:
- always_modifier = true;
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_FROM);
- break;
- case OMP_MAP_ALWAYS_TOFROM:
- always_modifier = true;
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_ALWAYS_TOFROM);
- break;
- case OMP_MAP_RELEASE:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_RELEASE);
- break;
- case OMP_MAP_DELETE:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DELETE);
- break;
- case OMP_MAP_DETACH:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DETACH);
- break;
- case OMP_MAP_FORCE_ALLOC:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_ALLOC);
- break;
- case OMP_MAP_FORCE_TO:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_TO);
- break;
- case OMP_MAP_FORCE_FROM:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_FROM);
- break;
- case OMP_MAP_FORCE_TOFROM:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_TOFROM);
- break;
- case OMP_MAP_FORCE_PRESENT:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_PRESENT);
- break;
- case OMP_MAP_FORCE_DEVICEPTR:
- OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_DEVICEPTR);
- break;
- default:
- gcc_unreachable ();
- }
-
- tree decl = gfc_trans_omp_variable (n->sym, false);
- if (DECL_P (decl))
- TREE_ADDRESSABLE (decl) = 1;
-
- gfc_ref *lastref = NULL;
-
- if (n->expr)
- for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
- if (ref->type == REF_COMPONENT || ref->type == REF_ARRAY)
- lastref = ref;
-
- bool allocatable = false, pointer = false;
-
- if (lastref && lastref->type == REF_COMPONENT)
- {
- gfc_component *c = lastref->u.c.component;
-
- if (c->ts.type == BT_CLASS)
- {
- pointer = CLASS_DATA (c)->attr.class_pointer;
- allocatable = CLASS_DATA (c)->attr.allocatable;
- }
- else
- {
- pointer = c->attr.pointer;
- allocatable = c->attr.allocatable;
- }
- }
-
- if (n->expr == NULL
- || (n->expr->ref->type == REF_ARRAY
- && n->expr->ref->u.ar.type == AR_FULL))
- {
- tree present = gfc_omp_check_optional_argument (decl, true);
- if (openacc && n->sym->ts.type == BT_CLASS)
- {
- tree type = TREE_TYPE (decl);
- if (n->sym->attr.optional)
- sorry ("optional class parameter");
- if (POINTER_TYPE_P (type))
- {
- node4 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
- OMP_CLAUSE_DECL (node4) = decl;
- OMP_CLAUSE_SIZE (node4) = size_int (0);
- decl = build_fold_indirect_ref (decl);
- }
- tree ptr = gfc_class_data_get (decl);
- ptr = build_fold_indirect_ref (ptr);
- OMP_CLAUSE_DECL (node) = ptr;
- OMP_CLAUSE_SIZE (node) = gfc_class_vtab_size_get (decl);
- node2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
- OMP_CLAUSE_DECL (node2) = decl;
- OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
- node3 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_ATTACH_DETACH);
- OMP_CLAUSE_DECL (node3) = gfc_class_data_get (decl);
- OMP_CLAUSE_SIZE (node3) = size_int (0);
- goto finalize_map_clause;
- }
- else if (POINTER_TYPE_P (TREE_TYPE (decl))
- && (gfc_omp_privatize_by_reference (decl)
- || GFC_DECL_GET_SCALAR_POINTER (decl)
- || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
- || GFC_DECL_CRAY_POINTEE (decl)
- || GFC_DESCRIPTOR_TYPE_P
- (TREE_TYPE (TREE_TYPE (decl)))
- || n->sym->ts.type == BT_DERIVED))
- {
- tree orig_decl = decl;
-
- /* For nonallocatable, nonpointer arrays, a temporary
- variable is generated, but this one is only defined if
- the variable is present; hence, we now set it to NULL
- to avoid accessing undefined variables. We cannot use
- a temporary variable here as otherwise the replacement
- of the variables in omp-low.c will not work. */
- if (present && GFC_ARRAY_TYPE_P (TREE_TYPE (decl)))
- {
- tree tmp = fold_build2_loc (input_location,
- MODIFY_EXPR,
- void_type_node, decl,
- null_pointer_node);
- tree cond = fold_build1_loc (input_location,
- TRUTH_NOT_EXPR,
- boolean_type_node,
- present);
- gfc_add_expr_to_block (block,
- build3_loc (input_location,
- COND_EXPR,
- void_type_node,
- cond, tmp,
- NULL_TREE));
- }
- node4 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
- OMP_CLAUSE_DECL (node4) = decl;
- OMP_CLAUSE_SIZE (node4) = size_int (0);
- decl = build_fold_indirect_ref (decl);
- if ((TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
- || gfc_omp_is_optional_argument (orig_decl))
- && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
- || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
- {
- node3 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
- OMP_CLAUSE_DECL (node3) = decl;
- OMP_CLAUSE_SIZE (node3) = size_int (0);
- decl = build_fold_indirect_ref (decl);
- }
- }
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
- {
- tree type = TREE_TYPE (decl);
- tree ptr = gfc_conv_descriptor_data_get (decl);
- if (present)
- ptr = gfc_build_cond_assign_expr (block, present, ptr,
- null_pointer_node);
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
- ptr = build_fold_indirect_ref (ptr);
- OMP_CLAUSE_DECL (node) = ptr;
- node2 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node2, GOMP_MAP_TO_PSET);
- OMP_CLAUSE_DECL (node2) = decl;
- OMP_CLAUSE_SIZE (node2) = TYPE_SIZE_UNIT (type);
- node3 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- if (present)
- {
- ptr = gfc_conv_descriptor_data_get (decl);
- ptr = gfc_build_addr_expr (NULL, ptr);
- ptr = gfc_build_cond_assign_expr (block, present, ptr,
- null_pointer_node);
- ptr = build_fold_indirect_ref (ptr);
- OMP_CLAUSE_DECL (node3) = ptr;
- }
- else
- OMP_CLAUSE_DECL (node3)
- = gfc_conv_descriptor_data_get (decl);
- OMP_CLAUSE_SIZE (node3) = size_int (0);
- if (n->u.map_op == OMP_MAP_ATTACH)
- {
- /* Standalone attach clauses used with arrays with
- descriptors must copy the descriptor to the target,
- else they won't have anything to perform the
- attachment onto (see OpenACC 2.6, "2.6.3. Data
- Structures with Pointers"). */
- OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_ATTACH);
- /* We don't want to map PTR at all in this case, so
- delete its node and shuffle the others down. */
- node = node2;
- node2 = node3;
- node3 = NULL;
- goto finalize_map_clause;
- }
- else if (n->u.map_op == OMP_MAP_DETACH)
- {
- OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_DETACH);
- /* Similarly to above, we don't want to unmap PTR
- here. */
- node = node2;
- node2 = node3;
- node3 = NULL;
- goto finalize_map_clause;
- }
- else
- OMP_CLAUSE_SET_MAP_KIND (node3,
- always_modifier
- ? GOMP_MAP_ALWAYS_POINTER
- : GOMP_MAP_POINTER);
-
- /* We have to check for n->sym->attr.dimension because
- of scalar coarrays. */
- if (n->sym->attr.pointer && n->sym->attr.dimension)
- {
- stmtblock_t cond_block;
- tree size
- = gfc_create_var (gfc_array_index_type, NULL);
- tree tem, then_b, else_b, zero, cond;
-
- gfc_init_block (&cond_block);
- tem
- = gfc_full_array_size (&cond_block, decl,
- GFC_TYPE_ARRAY_RANK (type));
- gfc_add_modify (&cond_block, size, tem);
- then_b = gfc_finish_block (&cond_block);
- gfc_init_block (&cond_block);
- zero = build_int_cst (gfc_array_index_type, 0);
- gfc_add_modify (&cond_block, size, zero);
- else_b = gfc_finish_block (&cond_block);
- tem = gfc_conv_descriptor_data_get (decl);
- tem = fold_convert (pvoid_type_node, tem);
- cond = fold_build2_loc (input_location, NE_EXPR,
- boolean_type_node,
- tem, null_pointer_node);
- if (present)
- cond = fold_build2_loc (input_location,
- TRUTH_ANDIF_EXPR,
- boolean_type_node,
- present, cond);
- gfc_add_expr_to_block (block,
- build3_loc (input_location,
- COND_EXPR,
- void_type_node,
- cond, then_b,
- else_b));
- OMP_CLAUSE_SIZE (node) = size;
- }
- else if (n->sym->attr.dimension)
- {
- stmtblock_t cond_block;
- gfc_init_block (&cond_block);
- tree size = gfc_full_array_size (&cond_block, decl,
- GFC_TYPE_ARRAY_RANK (type));
- if (present)
- {
- tree var = gfc_create_var (gfc_array_index_type,
- NULL);
- gfc_add_modify (&cond_block, var, size);
- tree cond_body = gfc_finish_block (&cond_block);
- tree cond = build3_loc (input_location, COND_EXPR,
- void_type_node, present,
- cond_body, NULL_TREE);
- gfc_add_expr_to_block (block, cond);
- OMP_CLAUSE_SIZE (node) = var;
- }
- else
- {
- gfc_add_block_to_block (block, &cond_block);
- OMP_CLAUSE_SIZE (node) = size;
- }
- }
- if (n->sym->attr.dimension)
- {
- tree elemsz
- = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- elemsz = fold_convert (gfc_array_index_type, elemsz);
- OMP_CLAUSE_SIZE (node)
- = fold_build2 (MULT_EXPR, gfc_array_index_type,
- OMP_CLAUSE_SIZE (node), elemsz);
- }
- }
- else if (present
- && TREE_CODE (decl) == INDIRECT_REF
- && (TREE_CODE (TREE_OPERAND (decl, 0))
- == INDIRECT_REF))
- {
- /* A single indirectref is handled by the middle end. */
- gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
- decl = TREE_OPERAND (decl, 0);
- decl = gfc_build_cond_assign_expr (block, present, decl,
- null_pointer_node);
- OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (decl);
- }
- else
- OMP_CLAUSE_DECL (node) = decl;
- }
- else if (n->expr
- && n->expr->expr_type == EXPR_VARIABLE
- && n->expr->ref->type == REF_ARRAY
- && !n->expr->ref->next)
- {
- /* An array element or array section which is not part of a
- derived type, etc. */
- bool element = n->expr->ref->u.ar.type == AR_ELEMENT;
- gfc_trans_omp_array_section (block, n, decl, element,
- GOMP_MAP_POINTER, node, node2,
- node3, node4);
- }
- else if (n->expr
- && n->expr->expr_type == EXPR_VARIABLE
- && (n->expr->ref->type == REF_COMPONENT
- || n->expr->ref->type == REF_ARRAY)
- && lastref
- && lastref->type == REF_COMPONENT
- && lastref->u.c.component->ts.type != BT_CLASS
- && lastref->u.c.component->ts.type != BT_DERIVED
- && !lastref->u.c.component->attr.dimension)
- {
- /* Derived type access with last component being a scalar. */
- gfc_init_se (&se, NULL);
-
- gfc_conv_expr (&se, n->expr);
- gfc_add_block_to_block (block, &se.pre);
- /* For BT_CHARACTER a pointer is returned. */
- OMP_CLAUSE_DECL (node)
- = POINTER_TYPE_P (TREE_TYPE (se.expr))
- ? build_fold_indirect_ref (se.expr) : se.expr;
- gfc_add_block_to_block (block, &se.post);
- if (pointer || allocatable)
- {
- node2 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- gomp_map_kind kind
- = (openacc ? GOMP_MAP_ATTACH_DETACH
- : GOMP_MAP_ALWAYS_POINTER);
- OMP_CLAUSE_SET_MAP_KIND (node2, kind);
- OMP_CLAUSE_DECL (node2)
- = POINTER_TYPE_P (TREE_TYPE (se.expr))
- ? se.expr
- : gfc_build_addr_expr (NULL, se.expr);
- OMP_CLAUSE_SIZE (node2) = size_int (0);
- if (!openacc
- && n->expr->ts.type == BT_CHARACTER
- && n->expr->ts.deferred)
- {
- gcc_assert (se.string_length);
- tree tmp
- = gfc_get_char_type (n->expr->ts.kind);
- OMP_CLAUSE_SIZE (node)
- = fold_build2 (MULT_EXPR, size_type_node,
- fold_convert (size_type_node,
- se.string_length),
- TYPE_SIZE_UNIT (tmp));
- node3 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_TO);
- OMP_CLAUSE_DECL (node3) = se.string_length;
- OMP_CLAUSE_SIZE (node3)
- = TYPE_SIZE_UNIT (gfc_charlen_type_node);
- }
- }
- }
- else if (n->expr
- && n->expr->expr_type == EXPR_VARIABLE
- && (n->expr->ref->type == REF_COMPONENT
- || n->expr->ref->type == REF_ARRAY))
- {
- gfc_init_se (&se, NULL);
- se.expr = gfc_maybe_dereference_var (n->sym, decl);
-
- for (gfc_ref *ref = n->expr->ref; ref; ref = ref->next)
- {
- if (ref->type == REF_COMPONENT)
- {
- if (ref->u.c.sym->attr.extension)
- conv_parent_component_references (&se, ref);
-
- gfc_conv_component_ref (&se, ref);
- }
- else if (ref->type == REF_ARRAY)
- {
- if (ref->u.ar.type == AR_ELEMENT && ref->next)
- gfc_conv_array_ref (&se, &ref->u.ar, n->expr,
- &n->expr->where);
- else
- gcc_assert (!ref->next);
- }
- else
- sorry ("unhandled expression type");
- }
-
- tree inner = se.expr;
-
- /* Last component is a derived type or class pointer. */
- if (lastref->type == REF_COMPONENT
- && (lastref->u.c.component->ts.type == BT_DERIVED
- || lastref->u.c.component->ts.type == BT_CLASS))
- {
- if (pointer || (openacc && allocatable))
- {
- tree data, size;
-
- if (lastref->u.c.component->ts.type == BT_CLASS)
- {
- data = gfc_class_data_get (inner);
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (data)));
- data = build_fold_indirect_ref (data);
- size = gfc_class_vtab_size_get (inner);
- }
- else /* BT_DERIVED. */
- {
- data = inner;
- size = TYPE_SIZE_UNIT (TREE_TYPE (inner));
- }
-
- OMP_CLAUSE_DECL (node) = data;
- OMP_CLAUSE_SIZE (node) = size;
- node2 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node2,
- openacc
- ? GOMP_MAP_ATTACH_DETACH
- : GOMP_MAP_ALWAYS_POINTER);
- OMP_CLAUSE_DECL (node2) = build_fold_addr_expr (data);
- OMP_CLAUSE_SIZE (node2) = size_int (0);
- }
- else
- {
- OMP_CLAUSE_DECL (node) = inner;
- OMP_CLAUSE_SIZE (node)
- = TYPE_SIZE_UNIT (TREE_TYPE (inner));
- }
- }
- else if (lastref->type == REF_ARRAY
- && lastref->u.ar.type == AR_FULL)
- {
- /* Just pass the (auto-dereferenced) decl through for
- bare attach and detach clauses. */
- if (n->u.map_op == OMP_MAP_ATTACH
- || n->u.map_op == OMP_MAP_DETACH)
- {
- OMP_CLAUSE_DECL (node) = inner;
- OMP_CLAUSE_SIZE (node) = size_zero_node;
- goto finalize_map_clause;
- }
-
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (inner)))
- {
- gomp_map_kind map_kind;
- tree desc_node;
- tree type = TREE_TYPE (inner);
- tree ptr = gfc_conv_descriptor_data_get (inner);
- ptr = build_fold_indirect_ref (ptr);
- OMP_CLAUSE_DECL (node) = ptr;
- int rank = GFC_TYPE_ARRAY_RANK (type);
- OMP_CLAUSE_SIZE (node)
- = gfc_full_array_size (block, inner, rank);
- tree elemsz
- = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- if (GOMP_MAP_COPY_TO_P (OMP_CLAUSE_MAP_KIND (node)))
- map_kind = GOMP_MAP_TO;
- else if (n->u.map_op == OMP_MAP_RELEASE
- || n->u.map_op == OMP_MAP_DELETE)
- map_kind = OMP_CLAUSE_MAP_KIND (node);
- else
- map_kind = GOMP_MAP_ALLOC;
- if (!openacc
- && n->expr->ts.type == BT_CHARACTER
- && n->expr->ts.deferred)
- {
- gcc_assert (se.string_length);
- tree len = fold_convert (size_type_node,
- se.string_length);
- elemsz = gfc_get_char_type (n->expr->ts.kind);
- elemsz = TYPE_SIZE_UNIT (elemsz);
- elemsz = fold_build2 (MULT_EXPR, size_type_node,
- len, elemsz);
- node4 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node4, map_kind);
- OMP_CLAUSE_DECL (node4) = se.string_length;
- OMP_CLAUSE_SIZE (node4)
- = TYPE_SIZE_UNIT (gfc_charlen_type_node);
- }
- elemsz = fold_convert (gfc_array_index_type, elemsz);
- OMP_CLAUSE_SIZE (node)
- = fold_build2 (MULT_EXPR, gfc_array_index_type,
- OMP_CLAUSE_SIZE (node), elemsz);
- desc_node = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- if (openacc)
- OMP_CLAUSE_SET_MAP_KIND (desc_node,
- GOMP_MAP_TO_PSET);
- else
- OMP_CLAUSE_SET_MAP_KIND (desc_node, map_kind);
- OMP_CLAUSE_DECL (desc_node) = inner;
- OMP_CLAUSE_SIZE (desc_node) = TYPE_SIZE_UNIT (type);
- if (openacc)
- node2 = desc_node;
- else
- {
- node2 = node;
- node = desc_node; /* Put first. */
- }
- node3 = build_omp_clause (input_location,
- OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node3,
- openacc
- ? GOMP_MAP_ATTACH_DETACH
- : GOMP_MAP_ALWAYS_POINTER);
- OMP_CLAUSE_DECL (node3)
- = gfc_conv_descriptor_data_get (inner);
- /* Similar to gfc_trans_omp_array_section (details
- there), we add/keep the cast for OpenMP to prevent
- that an 'alloc:' gets added for node3 ('desc.data')
- as that is part of the whole descriptor (node3).
- TODO: Remove once the ME handles this properly. */
- if (!openacc)
- OMP_CLAUSE_DECL (node3)
- = fold_convert (TREE_TYPE (TREE_OPERAND(ptr, 0)),
- OMP_CLAUSE_DECL (node3));
- else
- STRIP_NOPS (OMP_CLAUSE_DECL (node3));
- OMP_CLAUSE_SIZE (node3) = size_int (0);
- }
- else
- OMP_CLAUSE_DECL (node) = inner;
- }
- else if (lastref->type == REF_ARRAY)
- {
- /* An array element or section. */
- bool element = lastref->u.ar.type == AR_ELEMENT;
- gomp_map_kind kind = (openacc ? GOMP_MAP_ATTACH_DETACH
- : GOMP_MAP_ALWAYS_POINTER);
- gfc_trans_omp_array_section (block, n, inner, element,
- kind, node, node2, node3,
- node4);
- }
- else
- gcc_unreachable ();
- }
- else
- sorry ("unhandled expression");
-
- finalize_map_clause:
-
- omp_clauses = gfc_trans_add_clause (node, omp_clauses);
- if (node2)
- omp_clauses = gfc_trans_add_clause (node2, omp_clauses);
- if (node3)
- omp_clauses = gfc_trans_add_clause (node3, omp_clauses);
- if (node4)
- omp_clauses = gfc_trans_add_clause (node4, omp_clauses);
- }
- break;
- case OMP_LIST_TO:
- case OMP_LIST_FROM:
- case OMP_LIST_CACHE:
- for (; n != NULL; n = n->next)
- {
- if (!n->sym->attr.referenced)
- continue;
-
- switch (list)
- {
- case OMP_LIST_TO:
- clause_code = OMP_CLAUSE_TO;
- break;
- case OMP_LIST_FROM:
- clause_code = OMP_CLAUSE_FROM;
- break;
- case OMP_LIST_CACHE:
- clause_code = OMP_CLAUSE__CACHE_;
- break;
- default:
- gcc_unreachable ();
- }
- tree node = build_omp_clause (input_location, clause_code);
- if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
- {
- tree decl = gfc_trans_omp_variable (n->sym, false);
- if (gfc_omp_privatize_by_reference (decl))
- {
- if (gfc_omp_is_allocatable_or_ptr (decl))
- decl = build_fold_indirect_ref (decl);
- decl = build_fold_indirect_ref (decl);
- }
- else if (DECL_P (decl))
- TREE_ADDRESSABLE (decl) = 1;
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
- {
- tree type = TREE_TYPE (decl);
- tree ptr = gfc_conv_descriptor_data_get (decl);
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
- ptr = build_fold_indirect_ref (ptr);
- OMP_CLAUSE_DECL (node) = ptr;
- OMP_CLAUSE_SIZE (node)
- = gfc_full_array_size (block, decl,
- GFC_TYPE_ARRAY_RANK (type));
- tree elemsz
- = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- elemsz = fold_convert (gfc_array_index_type, elemsz);
- OMP_CLAUSE_SIZE (node)
- = fold_build2 (MULT_EXPR, gfc_array_index_type,
- OMP_CLAUSE_SIZE (node), elemsz);
- }
- else
- {
- OMP_CLAUSE_DECL (node) = decl;
- if (gfc_omp_is_allocatable_or_ptr (decl))
- OMP_CLAUSE_SIZE (node)
- = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (decl)));
- }
- }
- else
- {
- tree ptr;
- gfc_init_se (&se, NULL);
- if (n->expr->ref->u.ar.type == AR_ELEMENT)
- {
- gfc_conv_expr_reference (&se, n->expr);
- ptr = se.expr;
- gfc_add_block_to_block (block, &se.pre);
- OMP_CLAUSE_SIZE (node)
- = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
- }
- else
- {
- gfc_conv_expr_descriptor (&se, n->expr);
- ptr = gfc_conv_array_data (se.expr);
- tree type = TREE_TYPE (se.expr);
- gfc_add_block_to_block (block, &se.pre);
- OMP_CLAUSE_SIZE (node)
- = gfc_full_array_size (block, se.expr,
- GFC_TYPE_ARRAY_RANK (type));
- tree elemsz
- = TYPE_SIZE_UNIT (gfc_get_element_type (type));
- elemsz = fold_convert (gfc_array_index_type, elemsz);
- OMP_CLAUSE_SIZE (node)
- = fold_build2 (MULT_EXPR, gfc_array_index_type,
- OMP_CLAUSE_SIZE (node), elemsz);
- }
- gfc_add_block_to_block (block, &se.post);
- gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr)));
- OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
- }
- omp_clauses = gfc_trans_add_clause (node, omp_clauses);
- }
- break;
- default:
- break;
- }
- }
-
- if (clauses->if_expr)
- {
- tree if_var;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->if_expr);
- gfc_add_block_to_block (block, &se.pre);
- if_var = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
- OMP_CLAUSE_IF_MODIFIER (c) = ERROR_MARK;
- OMP_CLAUSE_IF_EXPR (c) = if_var;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- for (ifc = 0; ifc < OMP_IF_LAST; ifc++)
- if (clauses->if_exprs[ifc])
- {
- tree if_var;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->if_exprs[ifc]);
- gfc_add_block_to_block (block, &se.pre);
- if_var = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF);
- switch (ifc)
- {
- case OMP_IF_CANCEL:
- OMP_CLAUSE_IF_MODIFIER (c) = VOID_CST;
- break;
- case OMP_IF_PARALLEL:
- OMP_CLAUSE_IF_MODIFIER (c) = OMP_PARALLEL;
- break;
- case OMP_IF_SIMD:
- OMP_CLAUSE_IF_MODIFIER (c) = OMP_SIMD;
- break;
- case OMP_IF_TASK:
- OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASK;
- break;
- case OMP_IF_TASKLOOP:
- OMP_CLAUSE_IF_MODIFIER (c) = OMP_TASKLOOP;
- break;
- case OMP_IF_TARGET:
- OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET;
- break;
- case OMP_IF_TARGET_DATA:
- OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_DATA;
- break;
- case OMP_IF_TARGET_UPDATE:
- OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_UPDATE;
- break;
- case OMP_IF_TARGET_ENTER_DATA:
- OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_ENTER_DATA;
- break;
- case OMP_IF_TARGET_EXIT_DATA:
- OMP_CLAUSE_IF_MODIFIER (c) = OMP_TARGET_EXIT_DATA;
- break;
- default:
- gcc_unreachable ();
- }
- OMP_CLAUSE_IF_EXPR (c) = if_var;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->final_expr)
- {
- tree final_var;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->final_expr);
- gfc_add_block_to_block (block, &se.pre);
- final_var = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINAL);
- OMP_CLAUSE_FINAL_EXPR (c) = final_var;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->num_threads)
- {
- tree num_threads;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->num_threads);
- gfc_add_block_to_block (block, &se.pre);
- num_threads = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_THREADS);
- OMP_CLAUSE_NUM_THREADS_EXPR (c) = num_threads;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- chunk_size = NULL_TREE;
- if (clauses->chunk_size)
- {
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->chunk_size);
- gfc_add_block_to_block (block, &se.pre);
- chunk_size = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
- }
-
- if (clauses->sched_kind != OMP_SCHED_NONE)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SCHEDULE);
- OMP_CLAUSE_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
- switch (clauses->sched_kind)
- {
- case OMP_SCHED_STATIC:
- OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_STATIC;
- break;
- case OMP_SCHED_DYNAMIC:
- OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_DYNAMIC;
- break;
- case OMP_SCHED_GUIDED:
- OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_GUIDED;
- break;
- case OMP_SCHED_RUNTIME:
- OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_RUNTIME;
- break;
- case OMP_SCHED_AUTO:
- OMP_CLAUSE_SCHEDULE_KIND (c) = OMP_CLAUSE_SCHEDULE_AUTO;
- break;
- default:
- gcc_unreachable ();
- }
- if (clauses->sched_monotonic)
- OMP_CLAUSE_SCHEDULE_KIND (c)
- = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c)
- | OMP_CLAUSE_SCHEDULE_MONOTONIC);
- else if (clauses->sched_nonmonotonic)
- OMP_CLAUSE_SCHEDULE_KIND (c)
- = (omp_clause_schedule_kind) (OMP_CLAUSE_SCHEDULE_KIND (c)
- | OMP_CLAUSE_SCHEDULE_NONMONOTONIC);
- if (clauses->sched_simd)
- OMP_CLAUSE_SCHEDULE_SIMD (c) = 1;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->default_sharing != OMP_DEFAULT_UNKNOWN)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULT);
- switch (clauses->default_sharing)
- {
- case OMP_DEFAULT_NONE:
- OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_NONE;
- break;
- case OMP_DEFAULT_SHARED:
- OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_SHARED;
- break;
- case OMP_DEFAULT_PRIVATE:
- OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRIVATE;
- break;
- case OMP_DEFAULT_FIRSTPRIVATE:
- OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_FIRSTPRIVATE;
- break;
- case OMP_DEFAULT_PRESENT:
- OMP_CLAUSE_DEFAULT_KIND (c) = OMP_CLAUSE_DEFAULT_PRESENT;
- break;
- default:
- gcc_unreachable ();
- }
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->nowait)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOWAIT);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->ordered)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDERED);
- OMP_CLAUSE_ORDERED_EXPR (c)
- = clauses->orderedc ? build_int_cst (integer_type_node,
- clauses->orderedc) : NULL_TREE;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->order_concurrent)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ORDER);
- OMP_CLAUSE_ORDER_UNCONSTRAINED (c) = clauses->order_unconstrained;
- OMP_CLAUSE_ORDER_REPRODUCIBLE (c) = clauses->order_reproducible;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->untied)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_UNTIED);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->mergeable)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_MERGEABLE);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->collapse)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_COLLAPSE);
- OMP_CLAUSE_COLLAPSE_EXPR (c)
- = build_int_cst (integer_type_node, clauses->collapse);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->inbranch)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INBRANCH);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->notinbranch)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOTINBRANCH);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- switch (clauses->cancel)
- {
- case OMP_CANCEL_UNKNOWN:
- break;
- case OMP_CANCEL_PARALLEL:
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PARALLEL);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- break;
- case OMP_CANCEL_SECTIONS:
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SECTIONS);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- break;
- case OMP_CANCEL_DO:
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FOR);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- break;
- case OMP_CANCEL_TASKGROUP:
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TASKGROUP);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- break;
- }
-
- if (clauses->proc_bind != OMP_PROC_BIND_UNKNOWN)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PROC_BIND);
- switch (clauses->proc_bind)
- {
- case OMP_PROC_BIND_PRIMARY:
- OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_PRIMARY;
- break;
- case OMP_PROC_BIND_MASTER:
- OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER;
- break;
- case OMP_PROC_BIND_SPREAD:
- OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_SPREAD;
- break;
- case OMP_PROC_BIND_CLOSE:
- OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_CLOSE;
- break;
- default:
- gcc_unreachable ();
- }
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->safelen_expr)
- {
- tree safelen_var;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->safelen_expr);
- gfc_add_block_to_block (block, &se.pre);
- safelen_var = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SAFELEN);
- OMP_CLAUSE_SAFELEN_EXPR (c) = safelen_var;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->simdlen_expr)
- {
- if (declare_simd)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
- OMP_CLAUSE_SIMDLEN_EXPR (c)
- = gfc_conv_constant_to_tree (clauses->simdlen_expr);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- else
- {
- tree simdlen_var;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->simdlen_expr);
- gfc_add_block_to_block (block, &se.pre);
- simdlen_var = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMDLEN);
- OMP_CLAUSE_SIMDLEN_EXPR (c) = simdlen_var;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- }
-
- if (clauses->num_teams_upper)
- {
- tree num_teams_lower = NULL_TREE, num_teams_upper;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->num_teams_upper);
- gfc_add_block_to_block (block, &se.pre);
- num_teams_upper = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- if (clauses->num_teams_lower)
- {
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->num_teams_lower);
- gfc_add_block_to_block (block, &se.pre);
- num_teams_lower = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
- }
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS);
- OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (c) = num_teams_lower;
- OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = num_teams_upper;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->device)
- {
- tree device;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->device);
- gfc_add_block_to_block (block, &se.pre);
- device = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEVICE);
- OMP_CLAUSE_DEVICE_ID (c) = device;
-
- if (clauses->ancestor)
- OMP_CLAUSE_DEVICE_ANCESTOR (c) = 1;
-
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->thread_limit)
- {
- tree thread_limit;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->thread_limit);
- gfc_add_block_to_block (block, &se.pre);
- thread_limit = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREAD_LIMIT);
- OMP_CLAUSE_THREAD_LIMIT_EXPR (c) = thread_limit;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- chunk_size = NULL_TREE;
- if (clauses->dist_chunk_size)
- {
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->dist_chunk_size);
- gfc_add_block_to_block (block, &se.pre);
- chunk_size = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
- }
-
- if (clauses->dist_sched_kind != OMP_SCHED_NONE)
- {
- c = build_omp_clause (gfc_get_location (&where),
- OMP_CLAUSE_DIST_SCHEDULE);
- OMP_CLAUSE_DIST_SCHEDULE_CHUNK_EXPR (c) = chunk_size;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->grainsize)
- {
- tree grainsize;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->grainsize);
- gfc_add_block_to_block (block, &se.pre);
- grainsize = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GRAINSIZE);
- OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize;
- if (clauses->grainsize_strict)
- OMP_CLAUSE_GRAINSIZE_STRICT (c) = 1;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->num_tasks)
- {
- tree num_tasks;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->num_tasks);
- gfc_add_block_to_block (block, &se.pre);
- num_tasks = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TASKS);
- OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks;
- if (clauses->num_tasks_strict)
- OMP_CLAUSE_NUM_TASKS_STRICT (c) = 1;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->priority)
- {
- tree priority;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->priority);
- gfc_add_block_to_block (block, &se.pre);
- priority = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PRIORITY);
- OMP_CLAUSE_PRIORITY_EXPR (c) = priority;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->detach)
- {
- tree detach;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->detach);
- gfc_add_block_to_block (block, &se.pre);
- detach = se.expr;
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DETACH);
- TREE_ADDRESSABLE (detach) = 1;
- OMP_CLAUSE_DECL (c) = detach;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->filter)
- {
- tree filter;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->filter);
- gfc_add_block_to_block (block, &se.pre);
- filter = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FILTER);
- OMP_CLAUSE_FILTER_EXPR (c) = filter;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->hint)
- {
- tree hint;
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, clauses->hint);
- gfc_add_block_to_block (block, &se.pre);
- hint = gfc_evaluate_now (se.expr, block);
- gfc_add_block_to_block (block, &se.post);
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_HINT);
- OMP_CLAUSE_HINT_EXPR (c) = hint;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->simd)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SIMD);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- if (clauses->threads)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_THREADS);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- if (clauses->nogroup)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOGROUP);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
- {
- if (clauses->defaultmap[i] == OMP_DEFAULTMAP_UNSET)
- continue;
- enum omp_clause_defaultmap_kind behavior, category;
- switch ((gfc_omp_defaultmap_category) i)
- {
- case OMP_DEFAULTMAP_CAT_UNCATEGORIZED:
- category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_UNSPECIFIED;
- break;
- case OMP_DEFAULTMAP_CAT_SCALAR:
- category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR;
- break;
- case OMP_DEFAULTMAP_CAT_AGGREGATE:
- category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_AGGREGATE;
- break;
- case OMP_DEFAULTMAP_CAT_ALLOCATABLE:
- category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_ALLOCATABLE;
- break;
- case OMP_DEFAULTMAP_CAT_POINTER:
- category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_POINTER;
- break;
- default: gcc_unreachable ();
- }
- switch (clauses->defaultmap[i])
- {
- case OMP_DEFAULTMAP_ALLOC:
- behavior = OMP_CLAUSE_DEFAULTMAP_ALLOC;
- break;
- case OMP_DEFAULTMAP_TO: behavior = OMP_CLAUSE_DEFAULTMAP_TO; break;
- case OMP_DEFAULTMAP_FROM: behavior = OMP_CLAUSE_DEFAULTMAP_FROM; break;
- case OMP_DEFAULTMAP_TOFROM:
- behavior = OMP_CLAUSE_DEFAULTMAP_TOFROM;
- break;
- case OMP_DEFAULTMAP_FIRSTPRIVATE:
- behavior = OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE;
- break;
- case OMP_DEFAULTMAP_NONE: behavior = OMP_CLAUSE_DEFAULTMAP_NONE; break;
- case OMP_DEFAULTMAP_DEFAULT:
- behavior = OMP_CLAUSE_DEFAULTMAP_DEFAULT;
- break;
- default: gcc_unreachable ();
- }
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULTMAP);
- OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, behavior, category);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->depend_source)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEPEND);
- OMP_CLAUSE_DEPEND_KIND (c) = OMP_CLAUSE_DEPEND_SOURCE;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
-
- if (clauses->async)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_ASYNC);
- if (clauses->async_expr)
- OMP_CLAUSE_ASYNC_EXPR (c)
- = gfc_convert_expr_to_tree (block, clauses->async_expr);
- else
- OMP_CLAUSE_ASYNC_EXPR (c) = NULL;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- if (clauses->seq)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_SEQ);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- if (clauses->par_auto)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_AUTO);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- if (clauses->if_present)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_IF_PRESENT);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- if (clauses->finalize)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FINALIZE);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- if (clauses->independent)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_INDEPENDENT);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- if (clauses->wait_list)
- {
- gfc_expr_list *el;
-
- for (el = clauses->wait_list; el; el = el->next)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WAIT);
- OMP_CLAUSE_DECL (c) = gfc_convert_expr_to_tree (block, el->expr);
- OMP_CLAUSE_CHAIN (c) = omp_clauses;
- omp_clauses = c;
- }
- }
- if (clauses->num_gangs_expr)
- {
- tree num_gangs_var
- = gfc_convert_expr_to_tree (block, clauses->num_gangs_expr);
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_GANGS);
- OMP_CLAUSE_NUM_GANGS_EXPR (c) = num_gangs_var;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- if (clauses->num_workers_expr)
- {
- tree num_workers_var
- = gfc_convert_expr_to_tree (block, clauses->num_workers_expr);
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_WORKERS);
- OMP_CLAUSE_NUM_WORKERS_EXPR (c) = num_workers_var;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- if (clauses->vector_length_expr)
- {
- tree vector_length_var
- = gfc_convert_expr_to_tree (block, clauses->vector_length_expr);
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR_LENGTH);
- OMP_CLAUSE_VECTOR_LENGTH_EXPR (c) = vector_length_var;
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- }
- if (clauses->tile_list)
- {
- vec<tree, va_gc> *tvec;
- gfc_expr_list *el;
-
- vec_alloc (tvec, 4);
-
- for (el = clauses->tile_list; el; el = el->next)
- vec_safe_push (tvec, gfc_convert_expr_to_tree (block, el->expr));
-
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_TILE);
- OMP_CLAUSE_TILE_LIST (c) = build_tree_list_vec (tvec);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- tvec->truncate (0);
- }
- if (clauses->vector)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_VECTOR);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
-
- if (clauses->vector_expr)
- {
- tree vector_var
- = gfc_convert_expr_to_tree (block, clauses->vector_expr);
- OMP_CLAUSE_VECTOR_EXPR (c) = vector_var;
-
- /* TODO: We're not capturing location information for individual
- clauses. However, if we have an expression attached to the
- clause, that one provides better location information. */
- OMP_CLAUSE_LOCATION (c)
- = gfc_get_location (&clauses->vector_expr->where);
- }
- }
- if (clauses->worker)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_WORKER);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
-
- if (clauses->worker_expr)
- {
- tree worker_var
- = gfc_convert_expr_to_tree (block, clauses->worker_expr);
- OMP_CLAUSE_WORKER_EXPR (c) = worker_var;
-
- /* TODO: We're not capturing location information for individual
- clauses. However, if we have an expression attached to the
- clause, that one provides better location information. */
- OMP_CLAUSE_LOCATION (c)
- = gfc_get_location (&clauses->worker_expr->where);
- }
- }
- if (clauses->gang)
- {
- tree arg;
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GANG);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
-
- if (clauses->gang_num_expr)
- {
- arg = gfc_convert_expr_to_tree (block, clauses->gang_num_expr);
- OMP_CLAUSE_GANG_EXPR (c) = arg;
-
- /* TODO: We're not capturing location information for individual
- clauses. However, if we have an expression attached to the
- clause, that one provides better location information. */
- OMP_CLAUSE_LOCATION (c)
- = gfc_get_location (&clauses->gang_num_expr->where);
- }
-
- if (clauses->gang_static)
- {
- arg = clauses->gang_static_expr
- ? gfc_convert_expr_to_tree (block, clauses->gang_static_expr)
- : integer_minus_one_node;
- OMP_CLAUSE_GANG_STATIC_EXPR (c) = arg;
- }
- }
- if (clauses->bind != OMP_BIND_UNSET)
- {
- c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_BIND);
- omp_clauses = gfc_trans_add_clause (c, omp_clauses);
- switch (clauses->bind)
- {
- case OMP_BIND_TEAMS:
- OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_TEAMS;
- break;
- case OMP_BIND_PARALLEL:
- OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_PARALLEL;
- break;
- case OMP_BIND_THREAD:
- OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_THREAD;
- break;
- default:
- gcc_unreachable ();
- }
- }
- /* OpenACC 'nohost' clauses cannot appear here. */
- gcc_checking_assert (!clauses->nohost);
-
- return nreverse (omp_clauses);
-}
-
-/* Like gfc_trans_code, but force creation of a BIND_EXPR around it. */
-
-static tree
-gfc_trans_omp_code (gfc_code *code, bool force_empty)
-{
- tree stmt;
-
- pushlevel ();
- stmt = gfc_trans_code (code);
- if (TREE_CODE (stmt) != BIND_EXPR)
- {
- if (!IS_EMPTY_STMT (stmt) || force_empty)
- {
- tree block = poplevel (1, 0);
- stmt = build3_v (BIND_EXPR, NULL, stmt, block);
- }
- else
- poplevel (0, 0);
- }
- else
- poplevel (0, 0);
- return stmt;
-}
-
-/* Translate OpenACC 'parallel', 'kernels', 'serial', 'data', 'host_data'
- construct. */
-
-static tree
-gfc_trans_oacc_construct (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, oacc_clauses;
- enum tree_code construct_code;
-
- switch (code->op)
- {
- case EXEC_OACC_PARALLEL:
- construct_code = OACC_PARALLEL;
- break;
- case EXEC_OACC_KERNELS:
- construct_code = OACC_KERNELS;
- break;
- case EXEC_OACC_SERIAL:
- construct_code = OACC_SERIAL;
- break;
- case EXEC_OACC_DATA:
- construct_code = OACC_DATA;
- break;
- case EXEC_OACC_HOST_DATA:
- construct_code = OACC_HOST_DATA;
- break;
- default:
- gcc_unreachable ();
- }
-
- gfc_start_block (&block);
- oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc, false, true);
- stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build2_loc (gfc_get_location (&code->loc), construct_code,
- void_type_node, stmt, oacc_clauses);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-/* update, enter_data, exit_data, cache. */
-static tree
-gfc_trans_oacc_executable_directive (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, oacc_clauses;
- enum tree_code construct_code;
-
- switch (code->op)
- {
- case EXEC_OACC_UPDATE:
- construct_code = OACC_UPDATE;
- break;
- case EXEC_OACC_ENTER_DATA:
- construct_code = OACC_ENTER_DATA;
- break;
- case EXEC_OACC_EXIT_DATA:
- construct_code = OACC_EXIT_DATA;
- break;
- case EXEC_OACC_CACHE:
- construct_code = OACC_CACHE;
- break;
- default:
- gcc_unreachable ();
- }
-
- gfc_start_block (&block);
- oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc, false, true);
- stmt = build1_loc (input_location, construct_code, void_type_node,
- oacc_clauses);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_oacc_wait_directive (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, t;
- vec<tree, va_gc> *args;
- int nparms = 0;
- gfc_expr_list *el;
- gfc_omp_clauses *clauses = code->ext.omp_clauses;
- location_t loc = input_location;
-
- for (el = clauses->wait_list; el; el = el->next)
- nparms++;
-
- vec_alloc (args, nparms + 2);
- stmt = builtin_decl_explicit (BUILT_IN_GOACC_WAIT);
-
- gfc_start_block (&block);
-
- if (clauses->async_expr)
- t = gfc_convert_expr_to_tree (&block, clauses->async_expr);
- else
- t = build_int_cst (integer_type_node, -2);
-
- args->quick_push (t);
- args->quick_push (build_int_cst (integer_type_node, nparms));
-
- for (el = clauses->wait_list; el; el = el->next)
- args->quick_push (gfc_convert_expr_to_tree (&block, el->expr));
-
- stmt = build_call_expr_loc_vec (loc, stmt, args);
- gfc_add_expr_to_block (&block, stmt);
-
- vec_free (args);
-
- return gfc_finish_block (&block);
-}
-
-static tree gfc_trans_omp_sections (gfc_code *, gfc_omp_clauses *);
-static tree gfc_trans_omp_workshare (gfc_code *, gfc_omp_clauses *);
-
-static tree
-gfc_trans_omp_atomic (gfc_code *code)
-{
- gfc_code *atomic_code = code->block;
- gfc_se lse;
- gfc_se rse;
- gfc_se vse;
- gfc_expr *expr1, *expr2, *e, *capture_expr1 = NULL, *capture_expr2 = NULL;
- gfc_symbol *var;
- stmtblock_t block;
- tree lhsaddr, type, rhs, x, compare = NULL_TREE, comp_tgt = NULL_TREE;
- enum tree_code op = ERROR_MARK;
- enum tree_code aop = OMP_ATOMIC;
- bool var_on_left = false, else_branch = false;
- enum omp_memory_order mo, fail_mo;
- switch (atomic_code->ext.omp_clauses->memorder)
- {
- case OMP_MEMORDER_UNSET: mo = OMP_MEMORY_ORDER_UNSPECIFIED; break;
- case OMP_MEMORDER_ACQ_REL: mo = OMP_MEMORY_ORDER_ACQ_REL; break;
- case OMP_MEMORDER_ACQUIRE: mo = OMP_MEMORY_ORDER_ACQUIRE; break;
- case OMP_MEMORDER_RELAXED: mo = OMP_MEMORY_ORDER_RELAXED; break;
- case OMP_MEMORDER_RELEASE: mo = OMP_MEMORY_ORDER_RELEASE; break;
- case OMP_MEMORDER_SEQ_CST: mo = OMP_MEMORY_ORDER_SEQ_CST; break;
- default: gcc_unreachable ();
- }
- switch (atomic_code->ext.omp_clauses->fail)
- {
- case OMP_MEMORDER_UNSET: fail_mo = OMP_FAIL_MEMORY_ORDER_UNSPECIFIED; break;
- case OMP_MEMORDER_ACQUIRE: fail_mo = OMP_FAIL_MEMORY_ORDER_ACQUIRE; break;
- case OMP_MEMORDER_RELAXED: fail_mo = OMP_FAIL_MEMORY_ORDER_RELAXED; break;
- case OMP_MEMORDER_SEQ_CST: fail_mo = OMP_FAIL_MEMORY_ORDER_SEQ_CST; break;
- default: gcc_unreachable ();
- }
- mo = (omp_memory_order) (mo | fail_mo);
-
- code = code->block->next;
- if (atomic_code->ext.omp_clauses->compare)
- {
- gfc_expr *comp_expr;
- if (code->op == EXEC_IF)
- {
- comp_expr = code->block->expr1;
- gcc_assert (code->block->next->op == EXEC_ASSIGN);
- expr1 = code->block->next->expr1;
- expr2 = code->block->next->expr2;
- if (code->block->block)
- {
- gcc_assert (atomic_code->ext.omp_clauses->capture
- && code->block->block->next->op == EXEC_ASSIGN);
- else_branch = true;
- aop = OMP_ATOMIC_CAPTURE_OLD;
- capture_expr1 = code->block->block->next->expr1;
- capture_expr2 = code->block->block->next->expr2;
- }
- else if (atomic_code->ext.omp_clauses->capture)
- {
- gcc_assert (code->next->op == EXEC_ASSIGN);
- aop = OMP_ATOMIC_CAPTURE_NEW;
- capture_expr1 = code->next->expr1;
- capture_expr2 = code->next->expr2;
- }
- }
- else
- {
- gcc_assert (atomic_code->ext.omp_clauses->capture
- && code->op == EXEC_ASSIGN
- && code->next->op == EXEC_IF);
- aop = OMP_ATOMIC_CAPTURE_OLD;
- capture_expr1 = code->expr1;
- capture_expr2 = code->expr2;
- expr1 = code->next->block->next->expr1;
- expr2 = code->next->block->next->expr2;
- comp_expr = code->next->block->expr1;
- }
- gfc_init_se (&lse, NULL);
- gfc_conv_expr (&lse, comp_expr->value.op.op2);
- gfc_add_block_to_block (&block, &lse.pre);
- compare = lse.expr;
- var = expr1->symtree->n.sym;
- }
- else
- {
- gcc_assert (code->op == EXEC_ASSIGN);
- expr1 = code->expr1;
- expr2 = code->expr2;
- if (atomic_code->ext.omp_clauses->capture
- && (expr2->expr_type == EXPR_VARIABLE
- || (expr2->expr_type == EXPR_FUNCTION
- && expr2->value.function.isym
- && expr2->value.function.isym->id == GFC_ISYM_CONVERSION
- && (expr2->value.function.actual->expr->expr_type
- == EXPR_VARIABLE))))
- {
- capture_expr1 = expr1;
- capture_expr2 = expr2;
- expr1 = code->next->expr1;
- expr2 = code->next->expr2;
- aop = OMP_ATOMIC_CAPTURE_OLD;
- }
- else if (atomic_code->ext.omp_clauses->capture)
- {
- aop = OMP_ATOMIC_CAPTURE_NEW;
- capture_expr1 = code->next->expr1;
- capture_expr2 = code->next->expr2;
- }
- var = expr1->symtree->n.sym;
- }
-
- gfc_init_se (&lse, NULL);
- gfc_init_se (&rse, NULL);
- gfc_init_se (&vse, NULL);
- gfc_start_block (&block);
-
- if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
- != GFC_OMP_ATOMIC_WRITE)
- && expr2->expr_type == EXPR_FUNCTION
- && expr2->value.function.isym
- && expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
- expr2 = expr2->value.function.actual->expr;
-
- if ((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
- == GFC_OMP_ATOMIC_READ)
- {
- gfc_conv_expr (&vse, expr1);
- gfc_add_block_to_block (&block, &vse.pre);
-
- gfc_conv_expr (&lse, expr2);
- gfc_add_block_to_block (&block, &lse.pre);
- type = TREE_TYPE (lse.expr);
- lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
-
- x = build1 (OMP_ATOMIC_READ, type, lhsaddr);
- OMP_ATOMIC_MEMORY_ORDER (x) = mo;
- x = convert (TREE_TYPE (vse.expr), x);
- gfc_add_modify (&block, vse.expr, x);
-
- gfc_add_block_to_block (&block, &lse.pre);
- gfc_add_block_to_block (&block, &rse.pre);
-
- return gfc_finish_block (&block);
- }
-
- if (capture_expr2
- && capture_expr2->expr_type == EXPR_FUNCTION
- && capture_expr2->value.function.isym
- && capture_expr2->value.function.isym->id == GFC_ISYM_CONVERSION)
- capture_expr2 = capture_expr2->value.function.actual->expr;
- gcc_assert (!capture_expr2 || capture_expr2->expr_type == EXPR_VARIABLE);
-
- if (aop == OMP_ATOMIC_CAPTURE_OLD)
- {
- gfc_conv_expr (&vse, capture_expr1);
- gfc_add_block_to_block (&block, &vse.pre);
- gfc_conv_expr (&lse, capture_expr2);
- gfc_add_block_to_block (&block, &lse.pre);
- gfc_init_se (&lse, NULL);
- }
-
- gfc_conv_expr (&lse, expr1);
- gfc_add_block_to_block (&block, &lse.pre);
- type = TREE_TYPE (lse.expr);
- lhsaddr = gfc_build_addr_expr (NULL, lse.expr);
-
- if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
- == GFC_OMP_ATOMIC_WRITE)
- || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP)
- || compare)
- {
- gfc_conv_expr (&rse, expr2);
- gfc_add_block_to_block (&block, &rse.pre);
- }
- else if (expr2->expr_type == EXPR_OP)
- {
- gfc_expr *e;
- switch (expr2->value.op.op)
- {
- case INTRINSIC_PLUS:
- op = PLUS_EXPR;
- break;
- case INTRINSIC_TIMES:
- op = MULT_EXPR;
- break;
- case INTRINSIC_MINUS:
- op = MINUS_EXPR;
- break;
- case INTRINSIC_DIVIDE:
- if (expr2->ts.type == BT_INTEGER)
- op = TRUNC_DIV_EXPR;
- else
- op = RDIV_EXPR;
- break;
- case INTRINSIC_AND:
- op = TRUTH_ANDIF_EXPR;
- break;
- case INTRINSIC_OR:
- op = TRUTH_ORIF_EXPR;
- break;
- case INTRINSIC_EQV:
- op = EQ_EXPR;
- break;
- case INTRINSIC_NEQV:
- op = NE_EXPR;
- break;
- default:
- gcc_unreachable ();
- }
- e = expr2->value.op.op1;
- if (e->expr_type == EXPR_FUNCTION
- && e->value.function.isym
- && e->value.function.isym->id == GFC_ISYM_CONVERSION)
- e = e->value.function.actual->expr;
- if (e->expr_type == EXPR_VARIABLE
- && e->symtree != NULL
- && e->symtree->n.sym == var)
- {
- expr2 = expr2->value.op.op2;
- var_on_left = true;
- }
- else
- {
- e = expr2->value.op.op2;
- if (e->expr_type == EXPR_FUNCTION
- && e->value.function.isym
- && e->value.function.isym->id == GFC_ISYM_CONVERSION)
- e = e->value.function.actual->expr;
- gcc_assert (e->expr_type == EXPR_VARIABLE
- && e->symtree != NULL
- && e->symtree->n.sym == var);
- expr2 = expr2->value.op.op1;
- var_on_left = false;
- }
- gfc_conv_expr (&rse, expr2);
- gfc_add_block_to_block (&block, &rse.pre);
- }
- else
- {
- gcc_assert (expr2->expr_type == EXPR_FUNCTION);
- switch (expr2->value.function.isym->id)
- {
- case GFC_ISYM_MIN:
- op = MIN_EXPR;
- break;
- case GFC_ISYM_MAX:
- op = MAX_EXPR;
- break;
- case GFC_ISYM_IAND:
- op = BIT_AND_EXPR;
- break;
- case GFC_ISYM_IOR:
- op = BIT_IOR_EXPR;
- break;
- case GFC_ISYM_IEOR:
- op = BIT_XOR_EXPR;
- break;
- default:
- gcc_unreachable ();
- }
- e = expr2->value.function.actual->expr;
- if (e->expr_type == EXPR_FUNCTION
- && e->value.function.isym
- && e->value.function.isym->id == GFC_ISYM_CONVERSION)
- e = e->value.function.actual->expr;
- gcc_assert (e->expr_type == EXPR_VARIABLE
- && e->symtree != NULL
- && e->symtree->n.sym == var);
-
- gfc_conv_expr (&rse, expr2->value.function.actual->next->expr);
- gfc_add_block_to_block (&block, &rse.pre);
- if (expr2->value.function.actual->next->next != NULL)
- {
- tree accum = gfc_create_var (TREE_TYPE (rse.expr), NULL);
- gfc_actual_arglist *arg;
-
- gfc_add_modify (&block, accum, rse.expr);
- for (arg = expr2->value.function.actual->next->next; arg;
- arg = arg->next)
- {
- gfc_init_block (&rse.pre);
- gfc_conv_expr (&rse, arg->expr);
- gfc_add_block_to_block (&block, &rse.pre);
- x = fold_build2_loc (input_location, op, TREE_TYPE (accum),
- accum, rse.expr);
- gfc_add_modify (&block, accum, x);
- }
-
- rse.expr = accum;
- }
-
- expr2 = expr2->value.function.actual->next->expr;
- }
-
- lhsaddr = save_expr (lhsaddr);
- if (TREE_CODE (lhsaddr) != SAVE_EXPR
- && (TREE_CODE (lhsaddr) != ADDR_EXPR
- || !VAR_P (TREE_OPERAND (lhsaddr, 0))))
- {
- /* Make sure LHS is simple enough so that goa_lhs_expr_p can recognize
- it even after unsharing function body. */
- tree var = create_tmp_var_raw (TREE_TYPE (lhsaddr));
- DECL_CONTEXT (var) = current_function_decl;
- lhsaddr = build4 (TARGET_EXPR, TREE_TYPE (lhsaddr), var, lhsaddr,
- NULL_TREE, NULL_TREE);
- }
-
- if (compare)
- {
- tree var = create_tmp_var_raw (TREE_TYPE (lhsaddr));
- DECL_CONTEXT (var) = current_function_decl;
- lhsaddr = build4 (TARGET_EXPR, TREE_TYPE (lhsaddr), var, lhsaddr, NULL,
- NULL);
- lse.expr = build_fold_indirect_ref_loc (input_location, lhsaddr);
- compare = convert (TREE_TYPE (lse.expr), compare);
- compare = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node,
- lse.expr, compare);
- }
-
- if (expr2->expr_type == EXPR_VARIABLE || compare)
- rhs = rse.expr;
- else
- rhs = gfc_evaluate_now (rse.expr, &block);
-
- if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK)
- == GFC_OMP_ATOMIC_WRITE)
- || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP)
- || compare)
- x = rhs;
- else
- {
- x = convert (TREE_TYPE (rhs),
- build_fold_indirect_ref_loc (input_location, lhsaddr));
- if (var_on_left)
- x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), x, rhs);
- else
- x = fold_build2_loc (input_location, op, TREE_TYPE (rhs), rhs, x);
- }
-
- if (TREE_CODE (TREE_TYPE (rhs)) == COMPLEX_TYPE
- && TREE_CODE (type) != COMPLEX_TYPE)
- x = fold_build1_loc (input_location, REALPART_EXPR,
- TREE_TYPE (TREE_TYPE (rhs)), x);
-
- gfc_add_block_to_block (&block, &lse.pre);
- gfc_add_block_to_block (&block, &rse.pre);
-
- if (aop == OMP_ATOMIC_CAPTURE_NEW)
- {
- gfc_conv_expr (&vse, capture_expr1);
- gfc_add_block_to_block (&block, &vse.pre);
- gfc_add_block_to_block (&block, &lse.pre);
- }
-
- if (compare && else_branch)
- {
- tree var2 = create_tmp_var_raw (boolean_type_node);
- DECL_CONTEXT (var2) = current_function_decl;
- comp_tgt = build4 (TARGET_EXPR, boolean_type_node, var2,
- boolean_false_node, NULL, NULL);
- compare = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (var2),
- var2, compare);
- TREE_OPERAND (compare, 0) = comp_tgt;
- compare = omit_one_operand_loc (input_location, boolean_type_node,
- compare, comp_tgt);
- }
-
- if (compare)
- x = build3_loc (input_location, COND_EXPR, type, compare,
- convert (type, x), lse.expr);
-
- if (aop == OMP_ATOMIC)
- {
- x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x));
- OMP_ATOMIC_MEMORY_ORDER (x) = mo;
- OMP_ATOMIC_WEAK (x) = atomic_code->ext.omp_clauses->weak;
- gfc_add_expr_to_block (&block, x);
- }
- else
- {
- x = build2 (aop, type, lhsaddr, convert (type, x));
- OMP_ATOMIC_MEMORY_ORDER (x) = mo;
- OMP_ATOMIC_WEAK (x) = atomic_code->ext.omp_clauses->weak;
- if (compare && else_branch)
- {
- tree vtmp = create_tmp_var_raw (TREE_TYPE (x));
- DECL_CONTEXT (vtmp) = current_function_decl;
- x = fold_build2_loc (input_location, MODIFY_EXPR,
- TREE_TYPE (vtmp), vtmp, x);
- vtmp = build4 (TARGET_EXPR, TREE_TYPE (vtmp), vtmp,
- build_zero_cst (TREE_TYPE (vtmp)), NULL, NULL);
- TREE_OPERAND (x, 0) = vtmp;
- tree x2 = convert (TREE_TYPE (vse.expr), vtmp);
- x2 = fold_build2_loc (input_location, MODIFY_EXPR,
- TREE_TYPE (vse.expr), vse.expr, x2);
- x2 = build3_loc (input_location, COND_EXPR, void_type_node, comp_tgt,
- void_node, x2);
- x = omit_one_operand_loc (input_location, TREE_TYPE (x2), x2, x);
- gfc_add_expr_to_block (&block, x);
- }
- else
- {
- x = convert (TREE_TYPE (vse.expr), x);
- gfc_add_modify (&block, vse.expr, x);
- }
- }
-
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_barrier (void)
-{
- tree decl = builtin_decl_explicit (BUILT_IN_GOMP_BARRIER);
- return build_call_expr_loc (input_location, decl, 0);
-}
-
-static tree
-gfc_trans_omp_cancel (gfc_code *code)
-{
- int mask = 0;
- tree ifc = boolean_true_node;
- stmtblock_t block;
- switch (code->ext.omp_clauses->cancel)
- {
- case OMP_CANCEL_PARALLEL: mask = 1; break;
- case OMP_CANCEL_DO: mask = 2; break;
- case OMP_CANCEL_SECTIONS: mask = 4; break;
- case OMP_CANCEL_TASKGROUP: mask = 8; break;
- default: gcc_unreachable ();
- }
- gfc_start_block (&block);
- if (code->ext.omp_clauses->if_expr
- || code->ext.omp_clauses->if_exprs[OMP_IF_CANCEL])
- {
- gfc_se se;
- tree if_var;
-
- gcc_assert ((code->ext.omp_clauses->if_expr == NULL)
- ^ (code->ext.omp_clauses->if_exprs[OMP_IF_CANCEL] == NULL));
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, code->ext.omp_clauses->if_expr != NULL
- ? code->ext.omp_clauses->if_expr
- : code->ext.omp_clauses->if_exprs[OMP_IF_CANCEL]);
- gfc_add_block_to_block (&block, &se.pre);
- if_var = gfc_evaluate_now (se.expr, &block);
- gfc_add_block_to_block (&block, &se.post);
- tree type = TREE_TYPE (if_var);
- ifc = fold_build2_loc (input_location, NE_EXPR,
- boolean_type_node, if_var,
- build_zero_cst (type));
- }
- tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCEL);
- tree c_bool_type = TREE_TYPE (TREE_TYPE (decl));
- ifc = fold_convert (c_bool_type, ifc);
- gfc_add_expr_to_block (&block,
- build_call_expr_loc (input_location, decl, 2,
- build_int_cst (integer_type_node,
- mask), ifc));
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_cancellation_point (gfc_code *code)
-{
- int mask = 0;
- switch (code->ext.omp_clauses->cancel)
- {
- case OMP_CANCEL_PARALLEL: mask = 1; break;
- case OMP_CANCEL_DO: mask = 2; break;
- case OMP_CANCEL_SECTIONS: mask = 4; break;
- case OMP_CANCEL_TASKGROUP: mask = 8; break;
- default: gcc_unreachable ();
- }
- tree decl = builtin_decl_explicit (BUILT_IN_GOMP_CANCELLATION_POINT);
- return build_call_expr_loc (input_location, decl, 1,
- build_int_cst (integer_type_node, mask));
-}
-
-static tree
-gfc_trans_omp_critical (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, name = NULL_TREE;
- if (code->ext.omp_clauses->critical_name != NULL)
- name = get_identifier (code->ext.omp_clauses->critical_name);
- gfc_start_block (&block);
- stmt = make_node (OMP_CRITICAL);
- TREE_TYPE (stmt) = void_type_node;
- OMP_CRITICAL_BODY (stmt) = gfc_trans_code (code->block->next);
- OMP_CRITICAL_NAME (stmt) = name;
- OMP_CRITICAL_CLAUSES (stmt) = gfc_trans_omp_clauses (&block,
- code->ext.omp_clauses,
- code->loc);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-typedef struct dovar_init_d {
- tree var;
- tree init;
-} dovar_init;
-
-
-static tree
-gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
- gfc_omp_clauses *do_clauses, tree par_clauses)
-{
- gfc_se se;
- tree dovar, stmt, from, to, step, type, init, cond, incr, orig_decls;
- tree count = NULL_TREE, cycle_label, tmp, omp_clauses;
- stmtblock_t block;
- stmtblock_t body;
- gfc_omp_clauses *clauses = code->ext.omp_clauses;
- int i, collapse = clauses->collapse;
- vec<dovar_init> inits = vNULL;
- dovar_init *di;
- unsigned ix;
- vec<tree, va_heap, vl_embed> *saved_doacross_steps = doacross_steps;
- gfc_expr_list *tile = do_clauses ? do_clauses->tile_list : clauses->tile_list;
-
- /* Both collapsed and tiled loops are lowered the same way. In
- OpenACC, those clauses are not compatible, so prioritize the tile
- clause, if present. */
- if (tile)
- {
- collapse = 0;
- for (gfc_expr_list *el = tile; el; el = el->next)
- collapse++;
- }
-
- doacross_steps = NULL;
- if (clauses->orderedc)
- collapse = clauses->orderedc;
- if (collapse <= 0)
- collapse = 1;
-
- code = code->block->next;
- gcc_assert (code->op == EXEC_DO);
-
- init = make_tree_vec (collapse);
- cond = make_tree_vec (collapse);
- incr = make_tree_vec (collapse);
- orig_decls = clauses->orderedc ? make_tree_vec (collapse) : NULL_TREE;
-
- if (pblock == NULL)
- {
- gfc_start_block (&block);
- pblock = &block;
- }
-
- /* simd schedule modifier is only useful for composite do simd and other
- constructs including that, where gfc_trans_omp_do is only called
- on the simd construct and DO's clauses are translated elsewhere. */
- do_clauses->sched_simd = false;
-
- omp_clauses = gfc_trans_omp_clauses (pblock, do_clauses, code->loc);
-
- for (i = 0; i < collapse; i++)
- {
- int simple = 0;
- int dovar_found = 0;
- tree dovar_decl;
-
- if (clauses)
- {
- gfc_omp_namelist *n = NULL;
- if (op == EXEC_OMP_SIMD && collapse == 1)
- for (n = clauses->lists[OMP_LIST_LINEAR];
- n != NULL; n = n->next)
- if (code->ext.iterator->var->symtree->n.sym == n->sym)
- {
- dovar_found = 3;
- break;
- }
- if (n == NULL && op != EXEC_OMP_DISTRIBUTE)
- for (n = clauses->lists[OMP_LIST_LASTPRIVATE];
- n != NULL; n = n->next)
- if (code->ext.iterator->var->symtree->n.sym == n->sym)
- {
- dovar_found = 2;
- break;
- }
- if (n == NULL)
- for (n = clauses->lists[OMP_LIST_PRIVATE]; n != NULL; n = n->next)
- if (code->ext.iterator->var->symtree->n.sym == n->sym)
- {
- dovar_found = 1;
- break;
- }
- }
-
- /* Evaluate all the expressions in the iterator. */
- gfc_init_se (&se, NULL);
- gfc_conv_expr_lhs (&se, code->ext.iterator->var);
- gfc_add_block_to_block (pblock, &se.pre);
- dovar = se.expr;
- type = TREE_TYPE (dovar);
- gcc_assert (TREE_CODE (type) == INTEGER_TYPE);
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr_val (&se, code->ext.iterator->start);
- gfc_add_block_to_block (pblock, &se.pre);
- from = gfc_evaluate_now (se.expr, pblock);
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr_val (&se, code->ext.iterator->end);
- gfc_add_block_to_block (pblock, &se.pre);
- to = gfc_evaluate_now (se.expr, pblock);
-
- gfc_init_se (&se, NULL);
- gfc_conv_expr_val (&se, code->ext.iterator->step);
- gfc_add_block_to_block (pblock, &se.pre);
- step = gfc_evaluate_now (se.expr, pblock);
- dovar_decl = dovar;
-
- /* Special case simple loops. */
- if (VAR_P (dovar))
- {
- if (integer_onep (step))
- simple = 1;
- else if (tree_int_cst_equal (step, integer_minus_one_node))
- simple = -1;
- }
- else
- dovar_decl
- = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym,
- false);
-
- /* Loop body. */
- if (simple)
- {
- TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, dovar, from);
- /* The condition should not be folded. */
- TREE_VEC_ELT (cond, i) = build2_loc (input_location, simple > 0
- ? LE_EXPR : GE_EXPR,
- logical_type_node, dovar, to);
- TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
- type, dovar, step);
- TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
- MODIFY_EXPR,
- type, dovar,
- TREE_VEC_ELT (incr, i));
- }
- else
- {
- /* STEP is not 1 or -1. Use:
- for (count = 0; count < (to + step - from) / step; count++)
- {
- dovar = from + count * step;
- body;
- cycle_label:;
- } */
- tmp = fold_build2_loc (input_location, MINUS_EXPR, type, step, from);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, type, to, tmp);
- tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR, type, tmp,
- step);
- tmp = gfc_evaluate_now (tmp, pblock);
- count = gfc_create_var (type, "count");
- TREE_VEC_ELT (init, i) = build2_v (MODIFY_EXPR, count,
- build_int_cst (type, 0));
- /* The condition should not be folded. */
- TREE_VEC_ELT (cond, i) = build2_loc (input_location, LT_EXPR,
- logical_type_node,
- count, tmp);
- TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location, PLUS_EXPR,
- type, count,
- build_int_cst (type, 1));
- TREE_VEC_ELT (incr, i) = fold_build2_loc (input_location,
- MODIFY_EXPR, type, count,
- TREE_VEC_ELT (incr, i));
-
- /* Initialize DOVAR. */
- tmp = fold_build2_loc (input_location, MULT_EXPR, type, count, step);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, type, from, tmp);
- dovar_init e = {dovar, tmp};
- inits.safe_push (e);
- if (clauses->orderedc)
- {
- if (doacross_steps == NULL)
- vec_safe_grow_cleared (doacross_steps, clauses->orderedc, true);
- (*doacross_steps)[i] = step;
- }
- }
- if (orig_decls)
- TREE_VEC_ELT (orig_decls, i) = dovar_decl;
-
- if (dovar_found == 3
- && op == EXEC_OMP_SIMD
- && collapse == 1
- && !simple)
- {
- for (tmp = omp_clauses; tmp; tmp = OMP_CLAUSE_CHAIN (tmp))
- if (OMP_CLAUSE_CODE (tmp) == OMP_CLAUSE_LINEAR
- && OMP_CLAUSE_DECL (tmp) == dovar)
- {
- OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
- break;
- }
- }
- if (!dovar_found && op == EXEC_OMP_SIMD)
- {
- if (collapse == 1)
- {
- tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
- OMP_CLAUSE_LINEAR_STEP (tmp) = step;
- OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
- OMP_CLAUSE_DECL (tmp) = dovar_decl;
- omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
- }
- if (!simple)
- dovar_found = 3;
- }
- else if (!dovar_found && !simple)
- {
- tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
- OMP_CLAUSE_DECL (tmp) = dovar_decl;
- omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
- }
- if (dovar_found > 1)
- {
- tree c = NULL;
-
- tmp = NULL;
- if (!simple)
- {
- /* If dovar is lastprivate, but different counter is used,
- dovar += step needs to be added to
- OMP_CLAUSE_LASTPRIVATE_STMT, otherwise the copied dovar
- will have the value on entry of the last loop, rather
- than value after iterator increment. */
- if (clauses->orderedc)
- {
- if (clauses->collapse <= 1 || i >= clauses->collapse)
- tmp = count;
- else
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- type, count, build_one_cst (type));
- tmp = fold_build2_loc (input_location, MULT_EXPR, type,
- tmp, step);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
- from, tmp);
- }
- else
- {
- tmp = gfc_evaluate_now (step, pblock);
- tmp = fold_build2_loc (input_location, PLUS_EXPR, type,
- dovar, tmp);
- }
- tmp = fold_build2_loc (input_location, MODIFY_EXPR, type,
- dovar, tmp);
- for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
- && OMP_CLAUSE_DECL (c) == dovar_decl)
- {
- OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp;
- break;
- }
- else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LINEAR
- && OMP_CLAUSE_DECL (c) == dovar_decl)
- {
- OMP_CLAUSE_LINEAR_STMT (c) = tmp;
- break;
- }
- }
- if (c == NULL && op == EXEC_OMP_DO && par_clauses != NULL)
- {
- for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
- if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
- && OMP_CLAUSE_DECL (c) == dovar_decl)
- {
- tree l = build_omp_clause (input_location,
- OMP_CLAUSE_LASTPRIVATE);
- if (OMP_CLAUSE_LASTPRIVATE_CONDITIONAL (c))
- OMP_CLAUSE_LASTPRIVATE_CONDITIONAL (l) = 1;
- OMP_CLAUSE_DECL (l) = dovar_decl;
- OMP_CLAUSE_CHAIN (l) = omp_clauses;
- OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp;
- omp_clauses = l;
- OMP_CLAUSE_SET_CODE (c, OMP_CLAUSE_SHARED);
- break;
- }
- }
- gcc_assert (simple || c != NULL);
- }
- if (!simple)
- {
- if (op != EXEC_OMP_SIMD || dovar_found == 1)
- tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
- else if (collapse == 1)
- {
- tmp = build_omp_clause (input_location, OMP_CLAUSE_LINEAR);
- OMP_CLAUSE_LINEAR_STEP (tmp) = build_int_cst (type, 1);
- OMP_CLAUSE_LINEAR_NO_COPYIN (tmp) = 1;
- OMP_CLAUSE_LINEAR_NO_COPYOUT (tmp) = 1;
- }
- else
- tmp = build_omp_clause (input_location, OMP_CLAUSE_LASTPRIVATE);
- OMP_CLAUSE_DECL (tmp) = count;
- omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
- }
-
- if (i + 1 < collapse)
- code = code->block->next;
- }
-
- if (pblock != &block)
- {
- pushlevel ();
- gfc_start_block (&block);
- }
-
- gfc_start_block (&body);
-
- FOR_EACH_VEC_ELT (inits, ix, di)
- gfc_add_modify (&body, di->var, di->init);
- inits.release ();
-
- /* Cycle statement is implemented with a goto. Exit statement must not be
- present for this loop. */
- cycle_label = gfc_build_label_decl (NULL_TREE);
-
- /* Put these labels where they can be found later. */
-
- code->cycle_label = cycle_label;
- code->exit_label = NULL_TREE;
-
- /* Main loop body. */
- if (clauses->lists[OMP_LIST_REDUCTION_INSCAN])
- {
- gcc_assert (code->block->next->next->op == EXEC_OMP_SCAN);
- gcc_assert (code->block->next->next->next->next == NULL);
- locus *cloc = &code->block->next->next->loc;
- location_t loc = gfc_get_location (cloc);
-
- gfc_code code2 = *code->block->next;
- code2.next = NULL;
- tmp = gfc_trans_code (&code2);
- tmp = build2 (OMP_SCAN, void_type_node, tmp, NULL_TREE);
- SET_EXPR_LOCATION (tmp, loc);
- gfc_add_expr_to_block (&body, tmp);
- input_location = loc;
- tree c = gfc_trans_omp_clauses (&body,
- code->block->next->next->ext.omp_clauses,
- *cloc);
- code2 = *code->block->next->next->next;
- code2.next = NULL;
- tmp = gfc_trans_code (&code2);
- tmp = build2 (OMP_SCAN, void_type_node, tmp, c);
- SET_EXPR_LOCATION (tmp, loc);
- }
- else
- tmp = gfc_trans_omp_code (code->block->next, true);
- gfc_add_expr_to_block (&body, tmp);
-
- /* Label for cycle statements (if needed). */
- if (TREE_USED (cycle_label))
- {
- tmp = build1_v (LABEL_EXPR, cycle_label);
- gfc_add_expr_to_block (&body, tmp);
- }
-
- /* End of loop body. */
- switch (op)
- {
- case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break;
- case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break;
- case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break;
- case EXEC_OMP_LOOP: stmt = make_node (OMP_LOOP); break;
- case EXEC_OMP_TASKLOOP: stmt = make_node (OMP_TASKLOOP); break;
- case EXEC_OACC_LOOP: stmt = make_node (OACC_LOOP); break;
- default: gcc_unreachable ();
- }
-
- TREE_TYPE (stmt) = void_type_node;
- OMP_FOR_BODY (stmt) = gfc_finish_block (&body);
- OMP_FOR_CLAUSES (stmt) = omp_clauses;
- OMP_FOR_INIT (stmt) = init;
- OMP_FOR_COND (stmt) = cond;
- OMP_FOR_INCR (stmt) = incr;
- if (orig_decls)
- OMP_FOR_ORIG_DECLS (stmt) = orig_decls;
- gfc_add_expr_to_block (&block, stmt);
-
- vec_free (doacross_steps);
- doacross_steps = saved_doacross_steps;
-
- return gfc_finish_block (&block);
-}
-
-/* Translate combined OpenACC 'parallel loop', 'kernels loop', 'serial loop'
- construct. */
-
-static tree
-gfc_trans_oacc_combined_directive (gfc_code *code)
-{
- stmtblock_t block, *pblock = NULL;
- gfc_omp_clauses construct_clauses, loop_clauses;
- tree stmt, oacc_clauses = NULL_TREE;
- enum tree_code construct_code;
- location_t loc = input_location;
-
- switch (code->op)
- {
- case EXEC_OACC_PARALLEL_LOOP:
- construct_code = OACC_PARALLEL;
- break;
- case EXEC_OACC_KERNELS_LOOP:
- construct_code = OACC_KERNELS;
- break;
- case EXEC_OACC_SERIAL_LOOP:
- construct_code = OACC_SERIAL;
- break;
- default:
- gcc_unreachable ();
- }
-
- gfc_start_block (&block);
-
- memset (&loop_clauses, 0, sizeof (loop_clauses));
- if (code->ext.omp_clauses != NULL)
- {
- memcpy (&construct_clauses, code->ext.omp_clauses,
- sizeof (construct_clauses));
- loop_clauses.collapse = construct_clauses.collapse;
- loop_clauses.gang = construct_clauses.gang;
- loop_clauses.gang_static = construct_clauses.gang_static;
- loop_clauses.gang_num_expr = construct_clauses.gang_num_expr;
- loop_clauses.gang_static_expr = construct_clauses.gang_static_expr;
- loop_clauses.vector = construct_clauses.vector;
- loop_clauses.vector_expr = construct_clauses.vector_expr;
- loop_clauses.worker = construct_clauses.worker;
- loop_clauses.worker_expr = construct_clauses.worker_expr;
- loop_clauses.seq = construct_clauses.seq;
- loop_clauses.par_auto = construct_clauses.par_auto;
- loop_clauses.independent = construct_clauses.independent;
- loop_clauses.tile_list = construct_clauses.tile_list;
- loop_clauses.lists[OMP_LIST_PRIVATE]
- = construct_clauses.lists[OMP_LIST_PRIVATE];
- loop_clauses.lists[OMP_LIST_REDUCTION]
- = construct_clauses.lists[OMP_LIST_REDUCTION];
- construct_clauses.gang = false;
- construct_clauses.gang_static = false;
- construct_clauses.gang_num_expr = NULL;
- construct_clauses.gang_static_expr = NULL;
- construct_clauses.vector = false;
- construct_clauses.vector_expr = NULL;
- construct_clauses.worker = false;
- construct_clauses.worker_expr = NULL;
- construct_clauses.seq = false;
- construct_clauses.par_auto = false;
- construct_clauses.independent = false;
- construct_clauses.independent = false;
- construct_clauses.tile_list = NULL;
- construct_clauses.lists[OMP_LIST_PRIVATE] = NULL;
- if (construct_code == OACC_KERNELS)
- construct_clauses.lists[OMP_LIST_REDUCTION] = NULL;
- oacc_clauses = gfc_trans_omp_clauses (&block, &construct_clauses,
- code->loc, false, true);
- }
- if (!loop_clauses.seq)
- pblock = &block;
- else
- pushlevel ();
- stmt = gfc_trans_omp_do (code, EXEC_OACC_LOOP, pblock, &loop_clauses, NULL);
- protected_set_expr_location (stmt, loc);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- stmt = build2_loc (loc, construct_code, void_type_node, stmt, oacc_clauses);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_depobj (gfc_code *code)
-{
- stmtblock_t block;
- gfc_se se;
- gfc_init_se (&se, NULL);
- gfc_init_block (&block);
- gfc_conv_expr (&se, code->ext.omp_clauses->depobj);
- gcc_assert (se.pre.head == NULL && se.post.head == NULL);
- tree depobj = se.expr;
- location_t loc = EXPR_LOCATION (depobj);
- if (!POINTER_TYPE_P (TREE_TYPE (depobj)))
- depobj = gfc_build_addr_expr (NULL, depobj);
- depobj = fold_convert (build_pointer_type_for_mode (ptr_type_node,
- TYPE_MODE (ptr_type_node),
- true), depobj);
- gfc_omp_namelist *n = code->ext.omp_clauses->lists[OMP_LIST_DEPEND];
- if (n)
- {
- tree var;
- if (n->expr)
- var = gfc_convert_expr_to_tree (&block, n->expr);
- else
- var = gfc_get_symbol_decl (n->sym);
- if (!POINTER_TYPE_P (TREE_TYPE (var)))
- var = gfc_build_addr_expr (NULL, var);
- depobj = save_expr (depobj);
- tree r = build_fold_indirect_ref_loc (loc, depobj);
- gfc_add_expr_to_block (&block,
- build2 (MODIFY_EXPR, void_type_node, r, var));
- }
-
- /* Only one may be set. */
- gcc_assert (((int)(n != NULL) + (int)(code->ext.omp_clauses->destroy)
- + (int)(code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET))
- == 1);
- int k = -1; /* omp_clauses->destroy */
- if (!code->ext.omp_clauses->destroy)
- switch (code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET
- ? code->ext.omp_clauses->depobj_update : n->u.depend_op)
- {
- case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break;
- case OMP_DEPEND_OUT: k = GOMP_DEPEND_OUT; break;
- case OMP_DEPEND_INOUT: k = GOMP_DEPEND_INOUT; break;
- case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break;
- default: gcc_unreachable ();
- }
- tree t = build_int_cst (ptr_type_node, k);
- depobj = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (depobj), depobj,
- TYPE_SIZE_UNIT (ptr_type_node));
- depobj = build_fold_indirect_ref_loc (loc, depobj);
- gfc_add_expr_to_block (&block, build2 (MODIFY_EXPR, void_type_node, depobj, t));
-
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_error (gfc_code *code)
-{
- stmtblock_t block;
- gfc_se se;
- tree len, message;
- bool fatal = code->ext.omp_clauses->severity == OMP_SEVERITY_FATAL;
- tree fndecl = builtin_decl_explicit (fatal ? BUILT_IN_GOMP_ERROR
- : BUILT_IN_GOMP_WARNING);
- gfc_start_block (&block);
- gfc_init_se (&se, NULL );
- if (!code->ext.omp_clauses->message)
- {
- message = null_pointer_node;
- len = build_int_cst (size_type_node, 0);
- }
- else
- {
- gfc_conv_expr (&se, code->ext.omp_clauses->message);
- message = se.expr;
- if (!POINTER_TYPE_P (TREE_TYPE (message)))
- /* To ensure an ARRAY_TYPE is not passed as such. */
- message = gfc_build_addr_expr (NULL, message);
- len = se.string_length;
- }
- gfc_add_block_to_block (&block, &se.pre);
- gfc_add_expr_to_block (&block, build_call_expr_loc (input_location, fndecl,
- 2, message, len));
- gfc_add_block_to_block (&block, &se.post);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_flush (gfc_code *code)
-{
- tree call;
- if (!code->ext.omp_clauses
- || code->ext.omp_clauses->memorder == OMP_MEMORDER_UNSET
- || code->ext.omp_clauses->memorder == OMP_MEMORDER_SEQ_CST)
- {
- call = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
- call = build_call_expr_loc (input_location, call, 0);
- }
- else
- {
- enum memmodel mo = MEMMODEL_LAST;
- switch (code->ext.omp_clauses->memorder)
- {
- case OMP_MEMORDER_ACQ_REL: mo = MEMMODEL_ACQ_REL; break;
- case OMP_MEMORDER_RELEASE: mo = MEMMODEL_RELEASE; break;
- case OMP_MEMORDER_ACQUIRE: mo = MEMMODEL_ACQUIRE; break;
- default: gcc_unreachable (); break;
- }
- call = builtin_decl_explicit (BUILT_IN_ATOMIC_THREAD_FENCE);
- call = build_call_expr_loc (input_location, call, 1,
- build_int_cst (integer_type_node, mo));
- }
- return call;
-}
-
-static tree
-gfc_trans_omp_master (gfc_code *code)
-{
- tree stmt = gfc_trans_code (code->block->next);
- if (IS_EMPTY_STMT (stmt))
- return stmt;
- return build1_v (OMP_MASTER, stmt);
-}
-
-static tree
-gfc_trans_omp_masked (gfc_code *code, gfc_omp_clauses *clauses)
-{
- stmtblock_t block;
- tree body = gfc_trans_code (code->block->next);
- if (IS_EMPTY_STMT (body))
- return body;
- if (!clauses)
- clauses = code->ext.omp_clauses;
- gfc_start_block (&block);
- tree omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
- tree stmt = make_node (OMP_MASKED);
- TREE_TYPE (stmt) = void_type_node;
- OMP_MASKED_BODY (stmt) = body;
- OMP_MASKED_CLAUSES (stmt) = omp_clauses;
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-
-static tree
-gfc_trans_omp_ordered (gfc_code *code)
-{
- if (!flag_openmp)
- {
- if (!code->ext.omp_clauses->simd)
- return gfc_trans_code (code->block ? code->block->next : NULL);
- code->ext.omp_clauses->threads = 0;
- }
- tree omp_clauses = gfc_trans_omp_clauses (NULL, code->ext.omp_clauses,
- code->loc);
- return build2_loc (input_location, OMP_ORDERED, void_type_node,
- code->block ? gfc_trans_code (code->block->next)
- : NULL_TREE, omp_clauses);
-}
-
-static tree
-gfc_trans_omp_parallel (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, omp_clauses;
-
- gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc);
- pushlevel ();
- stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
- omp_clauses);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-enum
-{
- GFC_OMP_SPLIT_SIMD,
- GFC_OMP_SPLIT_DO,
- GFC_OMP_SPLIT_PARALLEL,
- GFC_OMP_SPLIT_DISTRIBUTE,
- GFC_OMP_SPLIT_TEAMS,
- GFC_OMP_SPLIT_TARGET,
- GFC_OMP_SPLIT_TASKLOOP,
- GFC_OMP_SPLIT_MASKED,
- GFC_OMP_SPLIT_NUM
-};
-
-enum
-{
- GFC_OMP_MASK_SIMD = (1 << GFC_OMP_SPLIT_SIMD),
- GFC_OMP_MASK_DO = (1 << GFC_OMP_SPLIT_DO),
- GFC_OMP_MASK_PARALLEL = (1 << GFC_OMP_SPLIT_PARALLEL),
- GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE),
- GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS),
- GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET),
- GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP),
- GFC_OMP_MASK_MASKED = (1 << GFC_OMP_SPLIT_MASKED)
-};
-
-/* If a var is in lastprivate/firstprivate/reduction but not in a
- data mapping/sharing clause, add it to 'map(tofrom:' if is_target
- and to 'shared' otherwise. */
-static void
-gfc_add_clause_implicitly (gfc_omp_clauses *clauses_out,
- gfc_omp_clauses *clauses_in,
- bool is_target, bool is_parallel_do)
-{
- int clauselist_to_add = is_target ? OMP_LIST_MAP : OMP_LIST_SHARED;
- gfc_omp_namelist *tail = NULL;
- for (int i = 0; i < 5; ++i)
- {
- gfc_omp_namelist *n;
- switch (i)
- {
- case 0: n = clauses_in->lists[OMP_LIST_FIRSTPRIVATE]; break;
- case 1: n = clauses_in->lists[OMP_LIST_LASTPRIVATE]; break;
- case 2: n = clauses_in->lists[OMP_LIST_REDUCTION]; break;
- case 3: n = clauses_in->lists[OMP_LIST_REDUCTION_INSCAN]; break;
- case 4: n = clauses_in->lists[OMP_LIST_REDUCTION_TASK]; break;
- default: gcc_unreachable ();
- }
- for (; n != NULL; n = n->next)
- {
- gfc_omp_namelist *n2, **n_firstp = NULL, **n_lastp = NULL;
- for (int j = 0; j < 6; ++j)
- {
- gfc_omp_namelist **n2ref = NULL, *prev2 = NULL;
- switch (j)
- {
- case 0:
- n2ref = &clauses_out->lists[clauselist_to_add];
- break;
- case 1:
- n2ref = &clauses_out->lists[OMP_LIST_FIRSTPRIVATE];
- break;
- case 2:
- if (is_target)
- n2ref = &clauses_in->lists[OMP_LIST_LASTPRIVATE];
- else
- n2ref = &clauses_out->lists[OMP_LIST_LASTPRIVATE];
- break;
- case 3: n2ref = &clauses_out->lists[OMP_LIST_REDUCTION]; break;
- case 4:
- n2ref = &clauses_out->lists[OMP_LIST_REDUCTION_INSCAN];
- break;
- case 5:
- n2ref = &clauses_out->lists[OMP_LIST_REDUCTION_TASK];
- break;
- default: gcc_unreachable ();
- }
- for (n2 = *n2ref; n2 != NULL; prev2 = n2, n2 = n2->next)
- if (n2->sym == n->sym)
- break;
- if (n2)
- {
- if (j == 0 /* clauselist_to_add */)
- break; /* Already present. */
- if (j == 1 /* OMP_LIST_FIRSTPRIVATE */)
- {
- n_firstp = prev2 ? &prev2->next : n2ref;
- continue;
- }
- if (j == 2 /* OMP_LIST_LASTPRIVATE */)
- {
- n_lastp = prev2 ? &prev2->next : n2ref;
- continue;
- }
- break;
- }
- }
- if (n_firstp && n_lastp)
- {
- /* For parallel do, GCC puts firstprivatee/lastprivate
- on the parallel. */
- if (is_parallel_do)
- continue;
- *n_firstp = (*n_firstp)->next;
- if (!is_target)
- *n_lastp = (*n_lastp)->next;
- }
- else if (is_target && n_lastp)
- ;
- else if (n2 || n_firstp || n_lastp)
- continue;
- if (clauses_out->lists[clauselist_to_add]
- && (clauses_out->lists[clauselist_to_add]
- == clauses_in->lists[clauselist_to_add]))
- {
- gfc_omp_namelist *p = NULL;
- for (n2 = clauses_in->lists[clauselist_to_add]; n2; n2 = n2->next)
- {
- if (p)
- {
- p->next = gfc_get_omp_namelist ();
- p = p->next;
- }
- else
- {
- p = gfc_get_omp_namelist ();
- clauses_out->lists[clauselist_to_add] = p;
- }
- *p = *n2;
- }
- }
- if (!tail)
- {
- tail = clauses_out->lists[clauselist_to_add];
- for (; tail && tail->next; tail = tail->next)
- ;
- }
- n2 = gfc_get_omp_namelist ();
- n2->where = n->where;
- n2->sym = n->sym;
- if (is_target)
- n2->u.map_op = OMP_MAP_TOFROM;
- if (tail)
- {
- tail->next = n2;
- tail = n2;
- }
- else
- clauses_out->lists[clauselist_to_add] = n2;
- }
- }
-}
-
-static void
-gfc_free_split_omp_clauses (gfc_code *code, gfc_omp_clauses *clausesa)
-{
- for (int i = 0; i < GFC_OMP_SPLIT_NUM; ++i)
- for (int j = 0; j < OMP_LIST_NUM; ++j)
- if (clausesa[i].lists[j] && clausesa[i].lists[j] != code->ext.omp_clauses->lists[j])
- for (gfc_omp_namelist *n = clausesa[i].lists[j]; n;)
- {
- gfc_omp_namelist *p = n;
- n = n->next;
- free (p);
- }
-}
-
-static void
-gfc_split_omp_clauses (gfc_code *code,
- gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM])
-{
- int mask = 0, innermost = 0;
- bool is_loop = false;
- memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses));
- switch (code->op)
- {
- case EXEC_OMP_DISTRIBUTE:
- innermost = GFC_OMP_SPLIT_DISTRIBUTE;
- break;
- case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
- mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
- innermost = GFC_OMP_SPLIT_DO;
- break;
- case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
- mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_PARALLEL
- | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_DISTRIBUTE_SIMD:
- mask = GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_DO:
- case EXEC_OMP_LOOP:
- innermost = GFC_OMP_SPLIT_DO;
- break;
- case EXEC_OMP_DO_SIMD:
- mask = GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_PARALLEL:
- innermost = GFC_OMP_SPLIT_PARALLEL;
- break;
- case EXEC_OMP_PARALLEL_DO:
- case EXEC_OMP_PARALLEL_LOOP:
- mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
- innermost = GFC_OMP_SPLIT_DO;
- break;
- case EXEC_OMP_PARALLEL_DO_SIMD:
- mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_PARALLEL_MASKED:
- mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED;
- innermost = GFC_OMP_SPLIT_MASKED;
- break;
- case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
- mask = (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED
- | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD);
- innermost = GFC_OMP_SPLIT_TASKLOOP;
- break;
- case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
- mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_TASKLOOP;
- break;
- case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
- mask = (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED
- | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD);
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
- mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_SIMD:
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_TARGET:
- innermost = GFC_OMP_SPLIT_TARGET;
- break;
- case EXEC_OMP_TARGET_PARALLEL:
- mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL;
- innermost = GFC_OMP_SPLIT_PARALLEL;
- break;
- case EXEC_OMP_TARGET_PARALLEL_DO:
- case EXEC_OMP_TARGET_PARALLEL_LOOP:
- mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
- innermost = GFC_OMP_SPLIT_DO;
- break;
- case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
- mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO
- | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_TARGET_SIMD:
- mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_TARGET_TEAMS:
- mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS;
- innermost = GFC_OMP_SPLIT_TEAMS;
- break;
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
- mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS
- | GFC_OMP_MASK_DISTRIBUTE;
- innermost = GFC_OMP_SPLIT_DISTRIBUTE;
- break;
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
- mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
- | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
- innermost = GFC_OMP_SPLIT_DO;
- break;
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
- | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
- mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS
- | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_TARGET_TEAMS_LOOP:
- mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO;
- innermost = GFC_OMP_SPLIT_DO;
- break;
- case EXEC_OMP_MASKED_TASKLOOP:
- mask = GFC_OMP_SPLIT_MASKED | GFC_OMP_SPLIT_TASKLOOP;
- innermost = GFC_OMP_SPLIT_TASKLOOP;
- break;
- case EXEC_OMP_MASTER_TASKLOOP:
- case EXEC_OMP_TASKLOOP:
- innermost = GFC_OMP_SPLIT_TASKLOOP;
- break;
- case EXEC_OMP_MASKED_TASKLOOP_SIMD:
- mask = GFC_OMP_MASK_MASKED | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_MASTER_TASKLOOP_SIMD:
- case EXEC_OMP_TASKLOOP_SIMD:
- mask = GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_TEAMS:
- innermost = GFC_OMP_SPLIT_TEAMS;
- break;
- case EXEC_OMP_TEAMS_DISTRIBUTE:
- mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE;
- innermost = GFC_OMP_SPLIT_DISTRIBUTE;
- break;
- case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
- mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
- | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
- innermost = GFC_OMP_SPLIT_DO;
- break;
- case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE
- | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
- mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
- innermost = GFC_OMP_SPLIT_SIMD;
- break;
- case EXEC_OMP_TEAMS_LOOP:
- mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO;
- innermost = GFC_OMP_SPLIT_DO;
- break;
- default:
- gcc_unreachable ();
- }
- if (mask == 0)
- {
- clausesa[innermost] = *code->ext.omp_clauses;
- return;
- }
- /* Loops are similar to DO but still a bit different. */
- switch (code->op)
- {
- case EXEC_OMP_LOOP:
- case EXEC_OMP_PARALLEL_LOOP:
- case EXEC_OMP_TEAMS_LOOP:
- case EXEC_OMP_TARGET_PARALLEL_LOOP:
- case EXEC_OMP_TARGET_TEAMS_LOOP:
- is_loop = true;
- default:
- break;
- }
- if (code->ext.omp_clauses != NULL)
- {
- if (mask & GFC_OMP_MASK_TARGET)
- {
- /* First the clauses that are unique to some constructs. */
- clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_MAP]
- = code->ext.omp_clauses->lists[OMP_LIST_MAP];
- clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IS_DEVICE_PTR]
- = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR];
- clausesa[GFC_OMP_SPLIT_TARGET].device
- = code->ext.omp_clauses->device;
- clausesa[GFC_OMP_SPLIT_TARGET].thread_limit
- = code->ext.omp_clauses->thread_limit;
- for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
- clausesa[GFC_OMP_SPLIT_TARGET].defaultmap[i]
- = code->ext.omp_clauses->defaultmap[i];
- clausesa[GFC_OMP_SPLIT_TARGET].if_exprs[OMP_IF_TARGET]
- = code->ext.omp_clauses->if_exprs[OMP_IF_TARGET];
- /* And this is copied to all. */
- clausesa[GFC_OMP_SPLIT_TARGET].if_expr
- = code->ext.omp_clauses->if_expr;
- clausesa[GFC_OMP_SPLIT_TARGET].nowait
- = code->ext.omp_clauses->nowait;
- }
- if (mask & GFC_OMP_MASK_TEAMS)
- {
- /* First the clauses that are unique to some constructs. */
- clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower
- = code->ext.omp_clauses->num_teams_lower;
- clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper
- = code->ext.omp_clauses->num_teams_upper;
- clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit
- = code->ext.omp_clauses->thread_limit;
- /* Shared and default clauses are allowed on parallel, teams
- and taskloop. */
- clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_SHARED]
- = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
- clausesa[GFC_OMP_SPLIT_TEAMS].default_sharing
- = code->ext.omp_clauses->default_sharing;
- }
- if (mask & GFC_OMP_MASK_DISTRIBUTE)
- {
- /* First the clauses that are unique to some constructs. */
- clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_sched_kind
- = code->ext.omp_clauses->dist_sched_kind;
- clausesa[GFC_OMP_SPLIT_DISTRIBUTE].dist_chunk_size
- = code->ext.omp_clauses->dist_chunk_size;
- /* Duplicate collapse. */
- clausesa[GFC_OMP_SPLIT_DISTRIBUTE].collapse
- = code->ext.omp_clauses->collapse;
- clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_concurrent
- = code->ext.omp_clauses->order_concurrent;
- clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_unconstrained
- = code->ext.omp_clauses->order_unconstrained;
- clausesa[GFC_OMP_SPLIT_DISTRIBUTE].order_reproducible
- = code->ext.omp_clauses->order_reproducible;
- }
- if (mask & GFC_OMP_MASK_PARALLEL)
- {
- /* First the clauses that are unique to some constructs. */
- clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_COPYIN]
- = code->ext.omp_clauses->lists[OMP_LIST_COPYIN];
- clausesa[GFC_OMP_SPLIT_PARALLEL].num_threads
- = code->ext.omp_clauses->num_threads;
- clausesa[GFC_OMP_SPLIT_PARALLEL].proc_bind
- = code->ext.omp_clauses->proc_bind;
- /* Shared and default clauses are allowed on parallel, teams
- and taskloop. */
- clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_SHARED]
- = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
- clausesa[GFC_OMP_SPLIT_PARALLEL].default_sharing
- = code->ext.omp_clauses->default_sharing;
- clausesa[GFC_OMP_SPLIT_PARALLEL].if_exprs[OMP_IF_PARALLEL]
- = code->ext.omp_clauses->if_exprs[OMP_IF_PARALLEL];
- /* And this is copied to all. */
- clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr
- = code->ext.omp_clauses->if_expr;
- }
- if (mask & GFC_OMP_MASK_MASKED)
- clausesa[GFC_OMP_SPLIT_MASKED].filter = code->ext.omp_clauses->filter;
- if ((mask & GFC_OMP_MASK_DO) && !is_loop)
- {
- /* First the clauses that are unique to some constructs. */
- clausesa[GFC_OMP_SPLIT_DO].ordered
- = code->ext.omp_clauses->ordered;
- clausesa[GFC_OMP_SPLIT_DO].orderedc
- = code->ext.omp_clauses->orderedc;
- clausesa[GFC_OMP_SPLIT_DO].sched_kind
- = code->ext.omp_clauses->sched_kind;
- if (innermost == GFC_OMP_SPLIT_SIMD)
- clausesa[GFC_OMP_SPLIT_DO].sched_simd
- = code->ext.omp_clauses->sched_simd;
- clausesa[GFC_OMP_SPLIT_DO].sched_monotonic
- = code->ext.omp_clauses->sched_monotonic;
- clausesa[GFC_OMP_SPLIT_DO].sched_nonmonotonic
- = code->ext.omp_clauses->sched_nonmonotonic;
- clausesa[GFC_OMP_SPLIT_DO].chunk_size
- = code->ext.omp_clauses->chunk_size;
- clausesa[GFC_OMP_SPLIT_DO].nowait
- = code->ext.omp_clauses->nowait;
- }
- if (mask & GFC_OMP_MASK_DO)
- {
- clausesa[GFC_OMP_SPLIT_DO].bind
- = code->ext.omp_clauses->bind;
- /* Duplicate collapse. */
- clausesa[GFC_OMP_SPLIT_DO].collapse
- = code->ext.omp_clauses->collapse;
- clausesa[GFC_OMP_SPLIT_DO].order_concurrent
- = code->ext.omp_clauses->order_concurrent;
- clausesa[GFC_OMP_SPLIT_DO].order_unconstrained
- = code->ext.omp_clauses->order_unconstrained;
- clausesa[GFC_OMP_SPLIT_DO].order_reproducible
- = code->ext.omp_clauses->order_reproducible;
- }
- if (mask & GFC_OMP_MASK_SIMD)
- {
- clausesa[GFC_OMP_SPLIT_SIMD].safelen_expr
- = code->ext.omp_clauses->safelen_expr;
- clausesa[GFC_OMP_SPLIT_SIMD].simdlen_expr
- = code->ext.omp_clauses->simdlen_expr;
- clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_ALIGNED]
- = code->ext.omp_clauses->lists[OMP_LIST_ALIGNED];
- /* Duplicate collapse. */
- clausesa[GFC_OMP_SPLIT_SIMD].collapse
- = code->ext.omp_clauses->collapse;
- clausesa[GFC_OMP_SPLIT_SIMD].if_exprs[OMP_IF_SIMD]
- = code->ext.omp_clauses->if_exprs[OMP_IF_SIMD];
- clausesa[GFC_OMP_SPLIT_SIMD].order_concurrent
- = code->ext.omp_clauses->order_concurrent;
- clausesa[GFC_OMP_SPLIT_SIMD].order_unconstrained
- = code->ext.omp_clauses->order_unconstrained;
- clausesa[GFC_OMP_SPLIT_SIMD].order_reproducible
- = code->ext.omp_clauses->order_reproducible;
- /* And this is copied to all. */
- clausesa[GFC_OMP_SPLIT_SIMD].if_expr
- = code->ext.omp_clauses->if_expr;
- }
- if (mask & GFC_OMP_MASK_TASKLOOP)
- {
- /* First the clauses that are unique to some constructs. */
- clausesa[GFC_OMP_SPLIT_TASKLOOP].nogroup
- = code->ext.omp_clauses->nogroup;
- clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize
- = code->ext.omp_clauses->grainsize;
- clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize_strict
- = code->ext.omp_clauses->grainsize_strict;
- clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks
- = code->ext.omp_clauses->num_tasks;
- clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks_strict
- = code->ext.omp_clauses->num_tasks_strict;
- clausesa[GFC_OMP_SPLIT_TASKLOOP].priority
- = code->ext.omp_clauses->priority;
- clausesa[GFC_OMP_SPLIT_TASKLOOP].final_expr
- = code->ext.omp_clauses->final_expr;
- clausesa[GFC_OMP_SPLIT_TASKLOOP].untied
- = code->ext.omp_clauses->untied;
- clausesa[GFC_OMP_SPLIT_TASKLOOP].mergeable
- = code->ext.omp_clauses->mergeable;
- clausesa[GFC_OMP_SPLIT_TASKLOOP].if_exprs[OMP_IF_TASKLOOP]
- = code->ext.omp_clauses->if_exprs[OMP_IF_TASKLOOP];
- /* And this is copied to all. */
- clausesa[GFC_OMP_SPLIT_TASKLOOP].if_expr
- = code->ext.omp_clauses->if_expr;
- /* Shared and default clauses are allowed on parallel, teams
- and taskloop. */
- clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_SHARED]
- = code->ext.omp_clauses->lists[OMP_LIST_SHARED];
- clausesa[GFC_OMP_SPLIT_TASKLOOP].default_sharing
- = code->ext.omp_clauses->default_sharing;
- /* Duplicate collapse. */
- clausesa[GFC_OMP_SPLIT_TASKLOOP].collapse
- = code->ext.omp_clauses->collapse;
- }
- /* Private clause is supported on all constructs but master/masked,
- it is enough to put it on the innermost one except for master/masked. For
- !$ omp parallel do put it on parallel though,
- as that's what we did for OpenMP 3.1. */
- clausesa[((innermost == GFC_OMP_SPLIT_DO && !is_loop)
- || code->op == EXEC_OMP_PARALLEL_MASTER
- || code->op == EXEC_OMP_PARALLEL_MASKED)
- ? (int) GFC_OMP_SPLIT_PARALLEL
- : innermost].lists[OMP_LIST_PRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_PRIVATE];
- /* Firstprivate clause is supported on all constructs but
- simd and masked/master. Put it on the outermost of those and duplicate
- on parallel and teams. */
- if (mask & GFC_OMP_MASK_TARGET)
- clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
- if (mask & GFC_OMP_MASK_TEAMS)
- clausesa[GFC_OMP_SPLIT_TEAMS].lists[OMP_LIST_FIRSTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
- else if (mask & GFC_OMP_MASK_DISTRIBUTE)
- clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_FIRSTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
- if (mask & GFC_OMP_MASK_TASKLOOP)
- clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_FIRSTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
- if ((mask & GFC_OMP_MASK_PARALLEL)
- && !(mask & GFC_OMP_MASK_TASKLOOP))
- clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
- else if ((mask & GFC_OMP_MASK_DO) && !is_loop)
- clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
- /* Lastprivate is allowed on distribute, do, simd, taskloop and loop.
- In parallel do{, simd} we actually want to put it on
- parallel rather than do. */
- if (mask & GFC_OMP_MASK_DISTRIBUTE)
- clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_LASTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
- if (mask & GFC_OMP_MASK_TASKLOOP)
- clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_LASTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
- if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop
- && !(mask & GFC_OMP_MASK_TASKLOOP))
- clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
- else if (mask & GFC_OMP_MASK_DO)
- clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_LASTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
- if (mask & GFC_OMP_MASK_SIMD)
- clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE]
- = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
- /* Reduction is allowed on simd, do, parallel, teams, taskloop, and loop.
- Duplicate it on all of them, but
- - omit on do if parallel is present;
- - omit on task and parallel if loop is present;
- additionally, inscan applies to do/simd only. */
- for (int i = OMP_LIST_REDUCTION; i <= OMP_LIST_REDUCTION_TASK; i++)
- {
- if (mask & GFC_OMP_MASK_TASKLOOP
- && i != OMP_LIST_REDUCTION_INSCAN)
- clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[i]
- = code->ext.omp_clauses->lists[i];
- if (mask & GFC_OMP_MASK_TEAMS
- && i != OMP_LIST_REDUCTION_INSCAN
- && !is_loop)
- clausesa[GFC_OMP_SPLIT_TEAMS].lists[i]
- = code->ext.omp_clauses->lists[i];
- if (mask & GFC_OMP_MASK_PARALLEL
- && i != OMP_LIST_REDUCTION_INSCAN
- && !(mask & GFC_OMP_MASK_TASKLOOP)
- && !is_loop)
- clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i]
- = code->ext.omp_clauses->lists[i];
- else if (mask & GFC_OMP_MASK_DO)
- clausesa[GFC_OMP_SPLIT_DO].lists[i]
- = code->ext.omp_clauses->lists[i];
- if (mask & GFC_OMP_MASK_SIMD)
- clausesa[GFC_OMP_SPLIT_SIMD].lists[i]
- = code->ext.omp_clauses->lists[i];
- }
- if (mask & GFC_OMP_MASK_TARGET)
- clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_IN_REDUCTION]
- = code->ext.omp_clauses->lists[OMP_LIST_IN_REDUCTION];
- if (mask & GFC_OMP_MASK_TASKLOOP)
- clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_IN_REDUCTION]
- = code->ext.omp_clauses->lists[OMP_LIST_IN_REDUCTION];
- /* Linear clause is supported on do and simd,
- put it on the innermost one. */
- clausesa[innermost].lists[OMP_LIST_LINEAR]
- = code->ext.omp_clauses->lists[OMP_LIST_LINEAR];
- }
- /* Propagate firstprivate/lastprivate/reduction vars to
- shared (parallel, teams) and map-tofrom (target). */
- if (mask & GFC_OMP_MASK_TARGET)
- gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_TARGET],
- code->ext.omp_clauses, true, false);
- if ((mask & GFC_OMP_MASK_PARALLEL) && innermost != GFC_OMP_MASK_PARALLEL)
- gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_PARALLEL],
- code->ext.omp_clauses, false,
- mask & GFC_OMP_MASK_DO);
- if (mask & GFC_OMP_MASK_TEAMS && innermost != GFC_OMP_MASK_TEAMS)
- gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_TEAMS],
- code->ext.omp_clauses, false, false);
- if (((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
- == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
- && !is_loop)
- clausesa[GFC_OMP_SPLIT_DO].nowait = true;
-
- /* Distribute allocate clause to do, parallel, distribute, teams, target
- and taskloop. The code below itereates over variables in the
- allocate list and checks if that available is also in any
- privatization clause on those construct. If yes, then we add it
- to the list of 'allocate'ed variables for that construct. If a
- variable is found in none of them then we issue an error. */
-
- if (code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE])
- {
- gfc_omp_namelist *alloc_nl, *priv_nl;
- gfc_omp_namelist *tails[GFC_OMP_SPLIT_NUM];
- for (alloc_nl = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
- alloc_nl; alloc_nl = alloc_nl->next)
- {
- bool found = false;
- for (int i = GFC_OMP_SPLIT_DO; i <= GFC_OMP_SPLIT_TASKLOOP; i++)
- {
- gfc_omp_namelist *p;
- int list;
- for (list = 0; list < OMP_LIST_NUM; list++)
- {
- switch (list)
- {
- case OMP_LIST_PRIVATE:
- case OMP_LIST_FIRSTPRIVATE:
- case OMP_LIST_LASTPRIVATE:
- case OMP_LIST_REDUCTION:
- case OMP_LIST_REDUCTION_INSCAN:
- case OMP_LIST_REDUCTION_TASK:
- case OMP_LIST_IN_REDUCTION:
- case OMP_LIST_TASK_REDUCTION:
- case OMP_LIST_LINEAR:
- for (priv_nl = clausesa[i].lists[list]; priv_nl;
- priv_nl = priv_nl->next)
- if (alloc_nl->sym == priv_nl->sym)
- {
- found = true;
- p = gfc_get_omp_namelist ();
- p->sym = alloc_nl->sym;
- p->expr = alloc_nl->expr;
- p->where = alloc_nl->where;
- if (clausesa[i].lists[OMP_LIST_ALLOCATE] == NULL)
- {
- clausesa[i].lists[OMP_LIST_ALLOCATE] = p;
- tails[i] = p;
- }
- else
- {
- tails[i]->next = p;
- tails[i] = tails[i]->next;
- }
- }
- break;
- default:
- break;
- }
- }
- }
- if (!found)
- gfc_error ("%qs specified in 'allocate' clause at %L but not "
- "in an explicit privatization clause",
- alloc_nl->sym->name, &alloc_nl->where);
- }
- }
-}
-
-static tree
-gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
- gfc_omp_clauses *clausesa, tree omp_clauses)
-{
- stmtblock_t block;
- gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
- tree stmt, body, omp_do_clauses = NULL_TREE;
- bool free_clausesa = false;
-
- if (pblock == NULL)
- gfc_start_block (&block);
- else
- gfc_init_block (&block);
-
- if (clausesa == NULL)
- {
- clausesa = clausesa_buf;
- gfc_split_omp_clauses (code, clausesa);
- free_clausesa = true;
- }
- if (flag_openmp)
- omp_do_clauses
- = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DO], code->loc);
- body = gfc_trans_omp_do (code, EXEC_OMP_SIMD, pblock ? pblock : &block,
- &clausesa[GFC_OMP_SPLIT_SIMD], omp_clauses);
- if (pblock == NULL)
- {
- if (TREE_CODE (body) != BIND_EXPR)
- body = build3_v (BIND_EXPR, NULL, body, poplevel (1, 0));
- else
- poplevel (0, 0);
- }
- else if (TREE_CODE (body) != BIND_EXPR)
- body = build3_v (BIND_EXPR, NULL, body, NULL_TREE);
- if (flag_openmp)
- {
- stmt = make_node (OMP_FOR);
- TREE_TYPE (stmt) = void_type_node;
- OMP_FOR_BODY (stmt) = body;
- OMP_FOR_CLAUSES (stmt) = omp_do_clauses;
- }
- else
- stmt = body;
- gfc_add_expr_to_block (&block, stmt);
- if (free_clausesa)
- gfc_free_split_omp_clauses (code, clausesa);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock,
- gfc_omp_clauses *clausesa)
-{
- stmtblock_t block, *new_pblock = pblock;
- gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
- tree stmt, omp_clauses = NULL_TREE;
- bool free_clausesa = false;
-
- if (pblock == NULL)
- gfc_start_block (&block);
- else
- gfc_init_block (&block);
-
- if (clausesa == NULL)
- {
- clausesa = clausesa_buf;
- gfc_split_omp_clauses (code, clausesa);
- free_clausesa = true;
- }
- omp_clauses
- = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
- code->loc);
- if (pblock == NULL)
- {
- if (!clausesa[GFC_OMP_SPLIT_DO].ordered
- && clausesa[GFC_OMP_SPLIT_DO].sched_kind != OMP_SCHED_STATIC)
- new_pblock = &block;
- else
- pushlevel ();
- }
- stmt = gfc_trans_omp_do (code, is_loop ? EXEC_OMP_LOOP : EXEC_OMP_DO,
- new_pblock, &clausesa[GFC_OMP_SPLIT_DO],
- omp_clauses);
- if (pblock == NULL)
- {
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- }
- else if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE);
- stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL,
- void_type_node, stmt, omp_clauses);
- OMP_PARALLEL_COMBINED (stmt) = 1;
- gfc_add_expr_to_block (&block, stmt);
- if (free_clausesa)
- gfc_free_split_omp_clauses (code, clausesa);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
- gfc_omp_clauses *clausesa)
-{
- stmtblock_t block;
- gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
- tree stmt, omp_clauses = NULL_TREE;
- bool free_clausesa = false;
-
- if (pblock == NULL)
- gfc_start_block (&block);
- else
- gfc_init_block (&block);
-
- if (clausesa == NULL)
- {
- clausesa = clausesa_buf;
- gfc_split_omp_clauses (code, clausesa);
- free_clausesa = true;
- }
- if (flag_openmp)
- omp_clauses
- = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
- code->loc);
- if (pblock == NULL)
- pushlevel ();
- stmt = gfc_trans_omp_do_simd (code, pblock, clausesa, omp_clauses);
- if (pblock == NULL)
- {
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- }
- else if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, NULL_TREE);
- if (flag_openmp)
- {
- stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL,
- void_type_node, stmt, omp_clauses);
- OMP_PARALLEL_COMBINED (stmt) = 1;
- }
- gfc_add_expr_to_block (&block, stmt);
- if (free_clausesa)
- gfc_free_split_omp_clauses (code, clausesa);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_parallel_sections (gfc_code *code)
-{
- stmtblock_t block;
- gfc_omp_clauses section_clauses;
- tree stmt, omp_clauses;
-
- memset (&section_clauses, 0, sizeof (section_clauses));
- section_clauses.nowait = true;
-
- gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc);
- pushlevel ();
- stmt = gfc_trans_omp_sections (code, &section_clauses);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL,
- void_type_node, stmt, omp_clauses);
- OMP_PARALLEL_COMBINED (stmt) = 1;
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_parallel_workshare (gfc_code *code)
-{
- stmtblock_t block;
- gfc_omp_clauses workshare_clauses;
- tree stmt, omp_clauses;
-
- memset (&workshare_clauses, 0, sizeof (workshare_clauses));
- workshare_clauses.nowait = true;
-
- gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc);
- pushlevel ();
- stmt = gfc_trans_omp_workshare (code, &workshare_clauses);
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL,
- void_type_node, stmt, omp_clauses);
- OMP_PARALLEL_COMBINED (stmt) = 1;
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_scope (gfc_code *code)
-{
- stmtblock_t block;
- tree body = gfc_trans_code (code->block->next);
- if (IS_EMPTY_STMT (body))
- return body;
- gfc_start_block (&block);
- tree omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc);
- tree stmt = make_node (OMP_SCOPE);
- TREE_TYPE (stmt) = void_type_node;
- OMP_SCOPE_BODY (stmt) = body;
- OMP_SCOPE_CLAUSES (stmt) = omp_clauses;
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
-{
- stmtblock_t block, body;
- tree omp_clauses, stmt;
- bool has_lastprivate = clauses->lists[OMP_LIST_LASTPRIVATE] != NULL;
- location_t loc = gfc_get_location (&code->loc);
-
- gfc_start_block (&block);
-
- omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
-
- gfc_init_block (&body);
- for (code = code->block; code; code = code->block)
- {
- /* Last section is special because of lastprivate, so even if it
- is empty, chain it in. */
- stmt = gfc_trans_omp_code (code->next,
- has_lastprivate && code->block == NULL);
- if (! IS_EMPTY_STMT (stmt))
- {
- stmt = build1_v (OMP_SECTION, stmt);
- gfc_add_expr_to_block (&body, stmt);
- }
- }
- stmt = gfc_finish_block (&body);
-
- stmt = build2_loc (loc, OMP_SECTIONS, void_type_node, stmt, omp_clauses);
- gfc_add_expr_to_block (&block, stmt);
-
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_single (gfc_code *code, gfc_omp_clauses *clauses)
-{
- tree omp_clauses = gfc_trans_omp_clauses (NULL, clauses, code->loc);
- tree stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build2_loc (gfc_get_location (&code->loc), OMP_SINGLE, void_type_node,
- stmt, omp_clauses);
- return stmt;
-}
-
-static tree
-gfc_trans_omp_task (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, omp_clauses;
-
- gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc);
- pushlevel ();
- stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- stmt = build2_loc (gfc_get_location (&code->loc), OMP_TASK, void_type_node,
- stmt, omp_clauses);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_taskgroup (gfc_code *code)
-{
- stmtblock_t block;
- gfc_start_block (&block);
- tree body = gfc_trans_code (code->block->next);
- tree stmt = make_node (OMP_TASKGROUP);
- TREE_TYPE (stmt) = void_type_node;
- OMP_TASKGROUP_BODY (stmt) = body;
- OMP_TASKGROUP_CLAUSES (stmt) = gfc_trans_omp_clauses (&block,
- code->ext.omp_clauses,
- code->loc);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_taskwait (gfc_code *code)
-{
- if (!code->ext.omp_clauses)
- {
- tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT);
- return build_call_expr_loc (input_location, decl, 0);
- }
- stmtblock_t block;
- gfc_start_block (&block);
- tree stmt = make_node (OMP_TASK);
- TREE_TYPE (stmt) = void_type_node;
- OMP_TASK_BODY (stmt) = NULL_TREE;
- OMP_TASK_CLAUSES (stmt) = gfc_trans_omp_clauses (&block,
- code->ext.omp_clauses,
- code->loc);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_taskyield (void)
-{
- tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKYIELD);
- return build_call_expr_loc (input_location, decl, 0);
-}
-
-static tree
-gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa)
-{
- stmtblock_t block;
- gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
- tree stmt, omp_clauses = NULL_TREE;
- bool free_clausesa = false;
-
- gfc_start_block (&block);
- if (clausesa == NULL)
- {
- clausesa = clausesa_buf;
- gfc_split_omp_clauses (code, clausesa);
- free_clausesa = true;
- }
- if (flag_openmp)
- omp_clauses
- = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_DISTRIBUTE],
- code->loc);
- switch (code->op)
- {
- case EXEC_OMP_DISTRIBUTE:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
- case EXEC_OMP_TEAMS_DISTRIBUTE:
- /* This is handled in gfc_trans_omp_do. */
- gcc_unreachable ();
- break;
- case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
- stmt = gfc_trans_omp_parallel_do (code, false, &block, clausesa);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- break;
- case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- stmt = gfc_trans_omp_parallel_do_simd (code, &block, clausesa);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- break;
- case EXEC_OMP_DISTRIBUTE_SIMD:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
- case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
- stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block,
- &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- break;
- default:
- gcc_unreachable ();
- }
- if (flag_openmp)
- {
- tree distribute = make_node (OMP_DISTRIBUTE);
- TREE_TYPE (distribute) = void_type_node;
- OMP_FOR_BODY (distribute) = stmt;
- OMP_FOR_CLAUSES (distribute) = omp_clauses;
- stmt = distribute;
- }
- gfc_add_expr_to_block (&block, stmt);
- if (free_clausesa)
- gfc_free_split_omp_clauses (code, clausesa);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
- tree omp_clauses)
-{
- stmtblock_t block;
- gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
- tree stmt;
- bool combined = true, free_clausesa = false;
-
- gfc_start_block (&block);
- if (clausesa == NULL)
- {
- clausesa = clausesa_buf;
- gfc_split_omp_clauses (code, clausesa);
- free_clausesa = true;
- }
- if (flag_openmp)
- {
- omp_clauses
- = chainon (omp_clauses,
- gfc_trans_omp_clauses (&block,
- &clausesa[GFC_OMP_SPLIT_TEAMS],
- code->loc));
- pushlevel ();
- }
- switch (code->op)
- {
- case EXEC_OMP_TARGET_TEAMS:
- case EXEC_OMP_TEAMS:
- stmt = gfc_trans_omp_code (code->block->next, true);
- combined = false;
- break;
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
- case EXEC_OMP_TEAMS_DISTRIBUTE:
- stmt = gfc_trans_omp_do (code, EXEC_OMP_DISTRIBUTE, NULL,
- &clausesa[GFC_OMP_SPLIT_DISTRIBUTE],
- NULL);
- break;
- case EXEC_OMP_TARGET_TEAMS_LOOP:
- case EXEC_OMP_TEAMS_LOOP:
- stmt = gfc_trans_omp_do (code, EXEC_OMP_LOOP, NULL,
- &clausesa[GFC_OMP_SPLIT_DO],
- NULL);
- break;
- default:
- stmt = gfc_trans_omp_distribute (code, clausesa);
- break;
- }
- if (flag_openmp)
- {
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- stmt = build2_loc (gfc_get_location (&code->loc), OMP_TEAMS,
- void_type_node, stmt, omp_clauses);
- if (combined)
- OMP_TEAMS_COMBINED (stmt) = 1;
- }
- gfc_add_expr_to_block (&block, stmt);
- if (free_clausesa)
- gfc_free_split_omp_clauses (code, clausesa);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_target (gfc_code *code)
-{
- stmtblock_t block;
- gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
- tree stmt, omp_clauses = NULL_TREE;
-
- gfc_start_block (&block);
- gfc_split_omp_clauses (code, clausesa);
- if (flag_openmp)
- omp_clauses
- = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TARGET],
- code->loc);
- switch (code->op)
- {
- case EXEC_OMP_TARGET:
- pushlevel ();
- stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- break;
- case EXEC_OMP_TARGET_PARALLEL:
- {
- stmtblock_t iblock;
-
- pushlevel ();
- gfc_start_block (&iblock);
- tree inner_clauses
- = gfc_trans_omp_clauses (&iblock, &clausesa[GFC_OMP_SPLIT_PARALLEL],
- code->loc);
- stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build2_loc (input_location, OMP_PARALLEL, void_type_node, stmt,
- inner_clauses);
- gfc_add_expr_to_block (&iblock, stmt);
- stmt = gfc_finish_block (&iblock);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- }
- break;
- case EXEC_OMP_TARGET_PARALLEL_DO:
- case EXEC_OMP_TARGET_PARALLEL_LOOP:
- stmt = gfc_trans_omp_parallel_do (code,
- (code->op
- == EXEC_OMP_TARGET_PARALLEL_LOOP),
- &block, clausesa);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- break;
- case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
- stmt = gfc_trans_omp_parallel_do_simd (code, &block, clausesa);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- break;
- case EXEC_OMP_TARGET_SIMD:
- stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block,
- &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- break;
- default:
- if (flag_openmp
- && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper
- || clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit))
- {
- gfc_omp_clauses clausesb;
- tree teams_clauses;
- /* For combined !$omp target teams, the num_teams and
- thread_limit clauses are evaluated before entering the
- target construct. */
- memset (&clausesb, '\0', sizeof (clausesb));
- clausesb.num_teams_lower
- = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower;
- clausesb.num_teams_upper
- = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper;
- clausesb.thread_limit = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit;
- clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower = NULL;
- clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper = NULL;
- clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = NULL;
- teams_clauses
- = gfc_trans_omp_clauses (&block, &clausesb, code->loc);
- pushlevel ();
- stmt = gfc_trans_omp_teams (code, clausesa, teams_clauses);
- }
- else
- {
- pushlevel ();
- stmt = gfc_trans_omp_teams (code, clausesa, NULL_TREE);
- }
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- break;
- }
- if (flag_openmp)
- {
- stmt = build2_loc (gfc_get_location (&code->loc), OMP_TARGET,
- void_type_node, stmt, omp_clauses);
- if (code->op != EXEC_OMP_TARGET)
- OMP_TARGET_COMBINED (stmt) = 1;
- cfun->has_omp_target = true;
- }
- gfc_add_expr_to_block (&block, stmt);
- gfc_free_split_omp_clauses (code, clausesa);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_taskloop (gfc_code *code, gfc_exec_op op)
-{
- stmtblock_t block;
- gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
- tree stmt, omp_clauses = NULL_TREE;
-
- gfc_start_block (&block);
- gfc_split_omp_clauses (code, clausesa);
- if (flag_openmp)
- omp_clauses
- = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TASKLOOP],
- code->loc);
- switch (op)
- {
- case EXEC_OMP_TASKLOOP:
- /* This is handled in gfc_trans_omp_do. */
- gcc_unreachable ();
- break;
- case EXEC_OMP_TASKLOOP_SIMD:
- stmt = gfc_trans_omp_do (code, EXEC_OMP_SIMD, &block,
- &clausesa[GFC_OMP_SPLIT_SIMD], NULL_TREE);
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- break;
- default:
- gcc_unreachable ();
- }
- if (flag_openmp)
- {
- tree taskloop = make_node (OMP_TASKLOOP);
- TREE_TYPE (taskloop) = void_type_node;
- OMP_FOR_BODY (taskloop) = stmt;
- OMP_FOR_CLAUSES (taskloop) = omp_clauses;
- stmt = taskloop;
- }
- gfc_add_expr_to_block (&block, stmt);
- gfc_free_split_omp_clauses (code, clausesa);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_master_masked_taskloop (gfc_code *code, gfc_exec_op op)
-{
- gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
- stmtblock_t block;
- tree stmt;
-
- if (op != EXEC_OMP_MASTER_TASKLOOP_SIMD
- && code->op != EXEC_OMP_MASTER_TASKLOOP)
- gfc_split_omp_clauses (code, clausesa);
-
- pushlevel ();
- if (op == EXEC_OMP_MASKED_TASKLOOP_SIMD
- || op == EXEC_OMP_MASTER_TASKLOOP_SIMD)
- stmt = gfc_trans_omp_taskloop (code, EXEC_OMP_TASKLOOP_SIMD);
- else
- {
- gcc_assert (op == EXEC_OMP_MASKED_TASKLOOP
- || op == EXEC_OMP_MASTER_TASKLOOP);
- stmt = gfc_trans_omp_do (code, EXEC_OMP_TASKLOOP, NULL,
- code->op != EXEC_OMP_MASTER_TASKLOOP
- ? &clausesa[GFC_OMP_SPLIT_TASKLOOP]
- : code->ext.omp_clauses, NULL);
- }
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- gfc_start_block (&block);
- if (op == EXEC_OMP_MASKED_TASKLOOP || op == EXEC_OMP_MASKED_TASKLOOP_SIMD)
- {
- tree clauses = gfc_trans_omp_clauses (&block,
- &clausesa[GFC_OMP_SPLIT_MASKED],
- code->loc);
- tree msk = make_node (OMP_MASKED);
- TREE_TYPE (msk) = void_type_node;
- OMP_MASKED_BODY (msk) = stmt;
- OMP_MASKED_CLAUSES (msk) = clauses;
- OMP_MASKED_COMBINED (msk) = 1;
- gfc_add_expr_to_block (&block, msk);
- }
- else
- {
- gcc_assert (op == EXEC_OMP_MASTER_TASKLOOP
- || op == EXEC_OMP_MASTER_TASKLOOP_SIMD);
- stmt = build1_v (OMP_MASTER, stmt);
- gfc_add_expr_to_block (&block, stmt);
- }
- if (op != EXEC_OMP_MASTER_TASKLOOP_SIMD
- && code->op != EXEC_OMP_MASTER_TASKLOOP)
- gfc_free_split_omp_clauses (code, clausesa);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_parallel_master_masked (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, omp_clauses;
- gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
- bool parallel_combined = false;
-
- if (code->op != EXEC_OMP_PARALLEL_MASTER)
- gfc_split_omp_clauses (code, clausesa);
-
- gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block,
- code->op == EXEC_OMP_PARALLEL_MASTER
- ? code->ext.omp_clauses
- : &clausesa[GFC_OMP_SPLIT_PARALLEL],
- code->loc);
- pushlevel ();
- if (code->op == EXEC_OMP_PARALLEL_MASTER)
- stmt = gfc_trans_omp_master (code);
- else if (code->op == EXEC_OMP_PARALLEL_MASKED)
- stmt = gfc_trans_omp_masked (code, &clausesa[GFC_OMP_SPLIT_MASKED]);
- else
- {
- gfc_exec_op op;
- switch (code->op)
- {
- case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
- op = EXEC_OMP_MASKED_TASKLOOP;
- break;
- case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
- op = EXEC_OMP_MASKED_TASKLOOP_SIMD;
- break;
- case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
- op = EXEC_OMP_MASTER_TASKLOOP;
- break;
- case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
- op = EXEC_OMP_MASTER_TASKLOOP_SIMD;
- break;
- default:
- gcc_unreachable ();
- }
- stmt = gfc_trans_omp_master_masked_taskloop (code, op);
- parallel_combined = true;
- }
- if (TREE_CODE (stmt) != BIND_EXPR)
- stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
- else
- poplevel (0, 0);
- stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL,
- void_type_node, stmt, omp_clauses);
- /* masked does have just filter clause, but during gimplification
- isn't represented by a gimplification omp context, so for
- !$omp parallel masked don't set OMP_PARALLEL_COMBINED,
- so that
- !$omp parallel masked
- !$omp taskloop simd lastprivate (x)
- isn't confused with
- !$omp parallel masked taskloop simd lastprivate (x) */
- if (parallel_combined)
- OMP_PARALLEL_COMBINED (stmt) = 1;
- gfc_add_expr_to_block (&block, stmt);
- if (code->op != EXEC_OMP_PARALLEL_MASTER)
- gfc_free_split_omp_clauses (code, clausesa);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_target_data (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, omp_clauses;
-
- gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc);
- stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build2_loc (gfc_get_location (&code->loc), OMP_TARGET_DATA,
- void_type_node, stmt, omp_clauses);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_target_enter_data (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, omp_clauses;
-
- gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc);
- stmt = build1_loc (input_location, OMP_TARGET_ENTER_DATA, void_type_node,
- omp_clauses);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_target_exit_data (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, omp_clauses;
-
- gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc);
- stmt = build1_loc (input_location, OMP_TARGET_EXIT_DATA, void_type_node,
- omp_clauses);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_target_update (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, omp_clauses;
-
- gfc_start_block (&block);
- omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc);
- stmt = build1_loc (input_location, OMP_TARGET_UPDATE, void_type_node,
- omp_clauses);
- gfc_add_expr_to_block (&block, stmt);
- return gfc_finish_block (&block);
-}
-
-static tree
-gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
-{
- tree res, tmp, stmt;
- stmtblock_t block, *pblock = NULL;
- stmtblock_t singleblock;
- int saved_ompws_flags;
- bool singleblock_in_progress = false;
- /* True if previous gfc_code in workshare construct is not workshared. */
- bool prev_singleunit;
- location_t loc = gfc_get_location (&code->loc);
-
- code = code->block->next;
-
- pushlevel ();
-
- gfc_start_block (&block);
- pblock = &block;
-
- ompws_flags = OMPWS_WORKSHARE_FLAG;
- prev_singleunit = false;
-
- /* Translate statements one by one to trees until we reach
- the end of the workshare construct. Adjacent gfc_codes that
- are a single unit of work are clustered and encapsulated in a
- single OMP_SINGLE construct. */
- for (; code; code = code->next)
- {
- if (code->here != 0)
- {
- res = gfc_trans_label_here (code);
- gfc_add_expr_to_block (pblock, res);
- }
-
- /* No dependence analysis, use for clauses with wait.
- If this is the last gfc_code, use default omp_clauses. */
- if (code->next == NULL && clauses->nowait)
- ompws_flags |= OMPWS_NOWAIT;
-
- /* By default, every gfc_code is a single unit of work. */
- ompws_flags |= OMPWS_CURR_SINGLEUNIT;
- ompws_flags &= ~(OMPWS_SCALARIZER_WS | OMPWS_SCALARIZER_BODY);
-
- switch (code->op)
- {
- case EXEC_NOP:
- res = NULL_TREE;
- break;
-
- case EXEC_ASSIGN:
- res = gfc_trans_assign (code);
- break;
-
- case EXEC_POINTER_ASSIGN:
- res = gfc_trans_pointer_assign (code);
- break;
-
- case EXEC_INIT_ASSIGN:
- res = gfc_trans_init_assign (code);
- break;
-
- case EXEC_FORALL:
- res = gfc_trans_forall (code);
- break;
-
- case EXEC_WHERE:
- res = gfc_trans_where (code);
- break;
-
- case EXEC_OMP_ATOMIC:
- res = gfc_trans_omp_directive (code);
- break;
-
- case EXEC_OMP_PARALLEL:
- case EXEC_OMP_PARALLEL_DO:
- case EXEC_OMP_PARALLEL_MASTER:
- case EXEC_OMP_PARALLEL_SECTIONS:
- case EXEC_OMP_PARALLEL_WORKSHARE:
- case EXEC_OMP_CRITICAL:
- saved_ompws_flags = ompws_flags;
- ompws_flags = 0;
- res = gfc_trans_omp_directive (code);
- ompws_flags = saved_ompws_flags;
- break;
-
- case EXEC_BLOCK:
- res = gfc_trans_block_construct (code);
- break;
-
- default:
- gfc_internal_error ("gfc_trans_omp_workshare(): Bad statement code");
- }
-
- gfc_set_backend_locus (&code->loc);
-
- if (res != NULL_TREE && ! IS_EMPTY_STMT (res))
- {
- if (prev_singleunit)
- {
- if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
- /* Add current gfc_code to single block. */
- gfc_add_expr_to_block (&singleblock, res);
- else
- {
- /* Finish single block and add it to pblock. */
- tmp = gfc_finish_block (&singleblock);
- tmp = build2_loc (loc, OMP_SINGLE,
- void_type_node, tmp, NULL_TREE);
- gfc_add_expr_to_block (pblock, tmp);
- /* Add current gfc_code to pblock. */
- gfc_add_expr_to_block (pblock, res);
- singleblock_in_progress = false;
- }
- }
- else
- {
- if (ompws_flags & OMPWS_CURR_SINGLEUNIT)
- {
- /* Start single block. */
- gfc_init_block (&singleblock);
- gfc_add_expr_to_block (&singleblock, res);
- singleblock_in_progress = true;
- loc = gfc_get_location (&code->loc);
- }
- else
- /* Add the new statement to the block. */
- gfc_add_expr_to_block (pblock, res);
- }
- prev_singleunit = (ompws_flags & OMPWS_CURR_SINGLEUNIT) != 0;
- }
- }
-
- /* Finish remaining SINGLE block, if we were in the middle of one. */
- if (singleblock_in_progress)
- {
- /* Finish single block and add it to pblock. */
- tmp = gfc_finish_block (&singleblock);
- tmp = build2_loc (loc, OMP_SINGLE, void_type_node, tmp,
- clauses->nowait
- ? build_omp_clause (input_location, OMP_CLAUSE_NOWAIT)
- : NULL_TREE);
- gfc_add_expr_to_block (pblock, tmp);
- }
-
- stmt = gfc_finish_block (pblock);
- if (TREE_CODE (stmt) != BIND_EXPR)
- {
- if (!IS_EMPTY_STMT (stmt))
- {
- tree bindblock = poplevel (1, 0);
- stmt = build3_v (BIND_EXPR, NULL, stmt, bindblock);
- }
- else
- poplevel (0, 0);
- }
- else
- poplevel (0, 0);
-
- if (IS_EMPTY_STMT (stmt) && !clauses->nowait)
- stmt = gfc_trans_omp_barrier ();
-
- ompws_flags = 0;
- return stmt;
-}
-
-tree
-gfc_trans_oacc_declare (gfc_code *code)
-{
- stmtblock_t block;
- tree stmt, oacc_clauses;
- enum tree_code construct_code;
-
- construct_code = OACC_DATA;
-
- gfc_start_block (&block);
-
- oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses,
- code->loc, false, true);
- stmt = gfc_trans_omp_code (code->block->next, true);
- stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
- oacc_clauses);
- gfc_add_expr_to_block (&block, stmt);
-
- return gfc_finish_block (&block);
-}
-
-tree
-gfc_trans_oacc_directive (gfc_code *code)
-{
- switch (code->op)
- {
- case EXEC_OACC_PARALLEL_LOOP:
- case EXEC_OACC_KERNELS_LOOP:
- case EXEC_OACC_SERIAL_LOOP:
- return gfc_trans_oacc_combined_directive (code);
- case EXEC_OACC_PARALLEL:
- case EXEC_OACC_KERNELS:
- case EXEC_OACC_SERIAL:
- case EXEC_OACC_DATA:
- case EXEC_OACC_HOST_DATA:
- return gfc_trans_oacc_construct (code);
- case EXEC_OACC_LOOP:
- return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses,
- NULL);
- case EXEC_OACC_UPDATE:
- case EXEC_OACC_CACHE:
- case EXEC_OACC_ENTER_DATA:
- case EXEC_OACC_EXIT_DATA:
- return gfc_trans_oacc_executable_directive (code);
- case EXEC_OACC_WAIT:
- return gfc_trans_oacc_wait_directive (code);
- case EXEC_OACC_ATOMIC:
- return gfc_trans_omp_atomic (code);
- case EXEC_OACC_DECLARE:
- return gfc_trans_oacc_declare (code);
- default:
- gcc_unreachable ();
- }
-}
-
-tree
-gfc_trans_omp_directive (gfc_code *code)
-{
- switch (code->op)
- {
- case EXEC_OMP_ATOMIC:
- return gfc_trans_omp_atomic (code);
- case EXEC_OMP_BARRIER:
- return gfc_trans_omp_barrier ();
- case EXEC_OMP_CANCEL:
- return gfc_trans_omp_cancel (code);
- case EXEC_OMP_CANCELLATION_POINT:
- return gfc_trans_omp_cancellation_point (code);
- case EXEC_OMP_CRITICAL:
- return gfc_trans_omp_critical (code);
- case EXEC_OMP_DEPOBJ:
- return gfc_trans_omp_depobj (code);
- case EXEC_OMP_DISTRIBUTE:
- case EXEC_OMP_DO:
- case EXEC_OMP_LOOP:
- case EXEC_OMP_SIMD:
- case EXEC_OMP_TASKLOOP:
- return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses,
- NULL);
- case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
- case EXEC_OMP_DISTRIBUTE_SIMD:
- return gfc_trans_omp_distribute (code, NULL);
- case EXEC_OMP_DO_SIMD:
- return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE);
- case EXEC_OMP_ERROR:
- return gfc_trans_omp_error (code);
- case EXEC_OMP_FLUSH:
- return gfc_trans_omp_flush (code);
- case EXEC_OMP_MASKED:
- return gfc_trans_omp_masked (code, NULL);
- case EXEC_OMP_MASTER:
- return gfc_trans_omp_master (code);
- case EXEC_OMP_MASKED_TASKLOOP:
- case EXEC_OMP_MASKED_TASKLOOP_SIMD:
- case EXEC_OMP_MASTER_TASKLOOP:
- case EXEC_OMP_MASTER_TASKLOOP_SIMD:
- return gfc_trans_omp_master_masked_taskloop (code, code->op);
- case EXEC_OMP_ORDERED:
- return gfc_trans_omp_ordered (code);
- case EXEC_OMP_PARALLEL:
- return gfc_trans_omp_parallel (code);
- case EXEC_OMP_PARALLEL_DO:
- return gfc_trans_omp_parallel_do (code, false, NULL, NULL);
- case EXEC_OMP_PARALLEL_LOOP:
- return gfc_trans_omp_parallel_do (code, true, NULL, NULL);
- case EXEC_OMP_PARALLEL_DO_SIMD:
- return gfc_trans_omp_parallel_do_simd (code, NULL, NULL);
- case EXEC_OMP_PARALLEL_MASKED:
- case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
- case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
- case EXEC_OMP_PARALLEL_MASTER:
- case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
- case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
- return gfc_trans_omp_parallel_master_masked (code);
- case EXEC_OMP_PARALLEL_SECTIONS:
- return gfc_trans_omp_parallel_sections (code);
- case EXEC_OMP_PARALLEL_WORKSHARE:
- return gfc_trans_omp_parallel_workshare (code);
- case EXEC_OMP_SCOPE:
- return gfc_trans_omp_scope (code);
- case EXEC_OMP_SECTIONS:
- return gfc_trans_omp_sections (code, code->ext.omp_clauses);
- case EXEC_OMP_SINGLE:
- return gfc_trans_omp_single (code, code->ext.omp_clauses);
- case EXEC_OMP_TARGET:
- case EXEC_OMP_TARGET_PARALLEL:
- case EXEC_OMP_TARGET_PARALLEL_DO:
- case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_PARALLEL_LOOP:
- case EXEC_OMP_TARGET_SIMD:
- case EXEC_OMP_TARGET_TEAMS:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
- case EXEC_OMP_TARGET_TEAMS_LOOP:
- return gfc_trans_omp_target (code);
- case EXEC_OMP_TARGET_DATA:
- return gfc_trans_omp_target_data (code);
- case EXEC_OMP_TARGET_ENTER_DATA:
- return gfc_trans_omp_target_enter_data (code);
- case EXEC_OMP_TARGET_EXIT_DATA:
- return gfc_trans_omp_target_exit_data (code);
- case EXEC_OMP_TARGET_UPDATE:
- return gfc_trans_omp_target_update (code);
- case EXEC_OMP_TASK:
- return gfc_trans_omp_task (code);
- case EXEC_OMP_TASKGROUP:
- return gfc_trans_omp_taskgroup (code);
- case EXEC_OMP_TASKLOOP_SIMD:
- return gfc_trans_omp_taskloop (code, code->op);
- case EXEC_OMP_TASKWAIT:
- return gfc_trans_omp_taskwait (code);
- case EXEC_OMP_TASKYIELD:
- return gfc_trans_omp_taskyield ();
- case EXEC_OMP_TEAMS:
- case EXEC_OMP_TEAMS_DISTRIBUTE:
- case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
- case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
- case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
- case EXEC_OMP_TEAMS_LOOP:
- return gfc_trans_omp_teams (code, NULL, NULL_TREE);
- case EXEC_OMP_WORKSHARE:
- return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
- default:
- gcc_unreachable ();
- }
-}
-
-void
-gfc_trans_omp_declare_simd (gfc_namespace *ns)
-{
- if (ns->entries)
- return;
-
- gfc_omp_declare_simd *ods;
- for (ods = ns->omp_declare_simd; ods; ods = ods->next)
- {
- tree c = gfc_trans_omp_clauses (NULL, ods->clauses, ods->where, true);
- tree fndecl = ns->proc_name->backend_decl;
- if (c != NULL_TREE)
- c = tree_cons (NULL_TREE, c, NULL_TREE);
- c = build_tree_list (get_identifier ("omp declare simd"), c);
- TREE_CHAIN (c) = DECL_ATTRIBUTES (fndecl);
- DECL_ATTRIBUTES (fndecl) = c;
- }
-}
-
-void
-gfc_trans_omp_declare_variant (gfc_namespace *ns)
-{
- tree base_fn_decl = ns->proc_name->backend_decl;
- gfc_namespace *search_ns = ns;
- gfc_omp_declare_variant *next;
-
- for (gfc_omp_declare_variant *odv = search_ns->omp_declare_variant;
- search_ns; odv = next)
- {
- /* Look in the parent namespace if there are no more directives in the
- current namespace. */
- if (!odv)
- {
- search_ns = search_ns->parent;
- if (search_ns)
- next = search_ns->omp_declare_variant;
- continue;
- }
-
- next = odv->next;
-
- if (odv->error_p)
- continue;
-
- /* Check directive the first time it is encountered. */
- bool error_found = true;
-
- if (odv->checked_p)
- error_found = false;
- if (odv->base_proc_symtree == NULL)
- {
- if (!search_ns->proc_name->attr.function
- && !search_ns->proc_name->attr.subroutine)
- gfc_error ("The base name for 'declare variant' must be "
- "specified at %L ", &odv->where);
- else
- error_found = false;
- }
- else
- {
- if (!search_ns->contained
- && strcmp (odv->base_proc_symtree->name,
- ns->proc_name->name))
- gfc_error ("The base name at %L does not match the name of the "
- "current procedure", &odv->where);
- else if (odv->base_proc_symtree->n.sym->attr.entry)
- gfc_error ("The base name at %L must not be an entry name",
- &odv->where);
- else if (odv->base_proc_symtree->n.sym->attr.generic)
- gfc_error ("The base name at %L must not be a generic name",
- &odv->where);
- else if (odv->base_proc_symtree->n.sym->attr.proc_pointer)
- gfc_error ("The base name at %L must not be a procedure pointer",
- &odv->where);
- else if (odv->base_proc_symtree->n.sym->attr.implicit_type)
- gfc_error ("The base procedure at %L must have an explicit "
- "interface", &odv->where);
- else
- error_found = false;
- }
-
- odv->checked_p = true;
- if (error_found)
- {
- odv->error_p = true;
- continue;
- }
-
- /* Ignore directives that do not apply to the current procedure. */
- if ((odv->base_proc_symtree == NULL && search_ns != ns)
- || (odv->base_proc_symtree != NULL
- && strcmp (odv->base_proc_symtree->name, ns->proc_name->name)))
- continue;
-
- tree set_selectors = NULL_TREE;
- gfc_omp_set_selector *oss;
-
- for (oss = odv->set_selectors; oss; oss = oss->next)
- {
- tree selectors = NULL_TREE;
- gfc_omp_selector *os;
- for (os = oss->trait_selectors; os; os = os->next)
- {
- tree properties = NULL_TREE;
- gfc_omp_trait_property *otp;
-
- for (otp = os->properties; otp; otp = otp->next)
- {
- switch (otp->property_kind)
- {
- case CTX_PROPERTY_USER:
- case CTX_PROPERTY_EXPR:
- {
- gfc_se se;
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, otp->expr);
- properties = tree_cons (NULL_TREE, se.expr,
- properties);
- }
- break;
- case CTX_PROPERTY_ID:
- properties = tree_cons (get_identifier (otp->name),
- NULL_TREE, properties);
- break;
- case CTX_PROPERTY_NAME_LIST:
- {
- tree prop = NULL_TREE, value = NULL_TREE;
- if (otp->is_name)
- prop = get_identifier (otp->name);
- else
- value = gfc_conv_constant_to_tree (otp->expr);
-
- properties = tree_cons (prop, value, properties);
- }
- break;
- case CTX_PROPERTY_SIMD:
- properties = gfc_trans_omp_clauses (NULL, otp->clauses,
- odv->where, true);
- break;
- default:
- gcc_unreachable ();
- }
- }
-
- if (os->score)
- {
- gfc_se se;
- gfc_init_se (&se, NULL);
- gfc_conv_expr (&se, os->score);
- properties = tree_cons (get_identifier (" score"),
- se.expr, properties);
- }
-
- selectors = tree_cons (get_identifier (os->trait_selector_name),
- properties, selectors);
- }
-
- set_selectors
- = tree_cons (get_identifier (oss->trait_set_selector_name),
- selectors, set_selectors);
- }
-
- const char *variant_proc_name = odv->variant_proc_symtree->name;
- gfc_symbol *variant_proc_sym = odv->variant_proc_symtree->n.sym;
- if (variant_proc_sym == NULL || variant_proc_sym->attr.implicit_type)
- {
- gfc_symtree *proc_st;
- gfc_find_sym_tree (variant_proc_name, gfc_current_ns, 1, &proc_st);
- variant_proc_sym = proc_st->n.sym;
- }
- if (variant_proc_sym == NULL)
- {
- gfc_error ("Cannot find symbol %qs", variant_proc_name);
- continue;
- }
- set_selectors = omp_check_context_selector
- (gfc_get_location (&odv->where), set_selectors);
- if (set_selectors != error_mark_node)
- {
- if (!variant_proc_sym->attr.implicit_type
- && !variant_proc_sym->attr.subroutine
- && !variant_proc_sym->attr.function)
- {
- gfc_error ("variant %qs at %L is not a function or subroutine",
- variant_proc_name, &odv->where);
- variant_proc_sym = NULL;
- }
- else if (omp_get_context_selector (set_selectors, "construct",
- "simd") == NULL_TREE)
- {
- char err[256];
- if (!gfc_compare_interfaces (ns->proc_name, variant_proc_sym,
- variant_proc_sym->name, 0, 1,
- err, sizeof (err), NULL, NULL))
- {
- gfc_error ("variant %qs and base %qs at %L have "
- "incompatible types: %s",
- variant_proc_name, ns->proc_name->name,
- &odv->where, err);
- variant_proc_sym = NULL;
- }
- }
- if (variant_proc_sym != NULL)
- {
- gfc_set_sym_referenced (variant_proc_sym);
- tree construct = omp_get_context_selector (set_selectors,
- "construct", NULL);
- omp_mark_declare_variant (gfc_get_location (&odv->where),
- gfc_get_symbol_decl (variant_proc_sym),
- construct);
- if (omp_context_selector_matches (set_selectors))
- {
- tree id = get_identifier ("omp declare variant base");
- tree variant = gfc_get_symbol_decl (variant_proc_sym);
- DECL_ATTRIBUTES (base_fn_decl)
- = tree_cons (id, build_tree_list (variant, set_selectors),
- DECL_ATTRIBUTES (base_fn_decl));
- }
- }
- }
- }
-}
generated by cgit v1.1 at 2025-04-21 05:57:33 +0000